koha-dev.rot13.org Git - koha_gimpoz/blob - C4/Biblio.pm

   1 package C4::Biblio;
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it under the
   8 # terms of the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any later
  10 # version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
  13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License along with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 require Exporter;
  22 use C4::Context;
  23 use C4::Database;
  24 use C4::Date;
  25 use MARC::Record;
  26 use MARC::File::USMARC;
  27 use MARC::File::XML;
  28 use ZOOM;
  29
  30 use vars qw($VERSION @ISA @EXPORT);
  31
  32 # set the version for version checking
  33 $VERSION = do { my @v = '$Revision$' =~ /\d+/g;
  34                 shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
  35
  36 @ISA = qw(Exporter);
  37
  38 #
  39 # don't forget MARCxxx subs are exported only for testing purposes. Should not be used
  40 # as the old-style API and the NEW one are the only public functions.
  41 #
  42 @EXPORT = qw(
  43   &newbiblio &newbiblioitem
  44   &newsubject &newsubtitle &newitems
  45
  46   &modbiblio &checkitems &modbibitem
  47   &modsubtitle &modsubject &modaddauthor &moditem
  48
  49   &delitem &deletebiblioitem &delbiblio
  50
  51   &getbiblio &bibdata &bibitems &bibitemdata
  52   &barcodes &ItemInfo &itemdata &itemissues &itemcount
  53   &getsubject &getaddauthor &getsubtitle
  54   &getwebbiblioitems &getwebsites
  55   &getbiblioitembybiblionumber
  56   &getbiblioitem &getitemsbybiblioitem
  57
  58   &MARCfind_marc_from_kohafield
  59   &MARCfind_frameworkcode
  60   &find_biblioitemnumber
  61   &MARCgettagslib
  62
  63   &NEWnewbiblio &NEWnewitem
  64   &NEWmodbiblio &NEWmoditem
  65   &NEWdelbiblio &NEWdelitem
  66   &NEWmodbiblioframework
  67
  68   &MARCkoha2marcBiblio &MARCmarc2koha
  69   &MARCkoha2marcItem &MARChtml2marc
  70   &MARCgetbiblio &MARCgetitem
  71   &XMLgetbiblio
  72   &char_decode
  73
  74   &FindDuplicate
  75   &DisplayISBN
  76
  77   &z3950_extended_services
  78   &set_service_options
  79
  80   &get_item_from_barcode
  81   &MARCfind_MARCbibid_from_oldbiblionumber
  82
  83 );
  84
  85 =head1 NAME
  86
  87 C4::Biblio - Acquisitions, Catalog Management Functions
  88
  89 =head1 SYNOPSIS
  90
  91 ( lot of changes for Koha 3.X)
  92
  93 Koha 1.2 and previous versions used a specific API to manage biblios. This API uses old-DB style parameters.
  94 They are based on a hash, and store data in biblio/biblioitems/items tables (plus additionalauthors,
  95 bibliosubject and bibliosubtitle where applicable).
  96
  97 In Koha 2.X, we introduced a MARC-DB.
  98
  99 In Koha 3.X, we removed this MARC-DB for search as we wanted to use Zebra as search system.
 100
 101 So in Koha 3.X, saving a record means :
 102
 103  - storing the raw marc record (iso2709) in biblioitems.marc field. It contains both biblio & items information.
 104  - storing the "decoded information" in biblio/biblioitems/items as previously.
 105  - using zebra to manage search & indexing on the MARC data.
 106
 107  In Koha, there is a systempreference for "MARC=ON" or "MARC=OFF" :
 108
 109  * MARC=ON : when MARC=ON, Koha uses a MARC::Record object (in sub parameters). Saving information in the DB means :
 110
 111  - transform the MARC record into a hash
 112  - add the raw MARC record into the hash
 113  - store them & update Zebra
 114
 115  * MARC=OFF : when MARC=OFF, Koha uses a hash object (in sub parameters). Saving information in the DB means :
 116
 117  - transform the hash into a MARC record
 118  - add the raw marc record into the hash
 119  - store them & update zebra
 120
 121 That's why we need 3 types of subs :
 122
 123 =head2 REALxxx subs
 124
 125 all I<subs beginning by REAL> do the effective storage of information (with a hash, one field of the hash being the raw marc record). Those subs also update the record in Zebra. REAL subs should be only for internal use (called by NEW or "something else" subs).
 126
 127 =head2 NEWxxx related subs
 128
 129 =over 4
 130
 131 all I<subs beginning by NEW> use MARC::Record as parameters. It's the API that MUST be used in the MARC acquisition system. They just create the hash, add it the raw marc record. Then, they call REALxxx sub.
 132
 133 all subs requires/use $dbh as 1st parameter and a MARC::Record object as 2nd parameter. They sometimes require another parameter.
 134
 135 =back
 136
 137 =head2 something_elsexxx related subs
 138
 139 =over 4
 140
 141 all I<subs beginning by seomething else> are the old-style API. They use a hash as parameter, transform the hash into a -small- marc record, and call REAL subs.
 142
 143 all subs require/use $dbh as 1st parameter and a hash as 2nd parameter.
 144
 145 =back
 146
 147 =head1 API
 148
 149 =cut
 150
 151 =head
 152
 153 z3950_extended_services can handle any interaction with Zebra's extended serices package.
 154
 155 $Zconn contains the server connection object (which is set before calling this s
 156 ubroutine)
 157
 158 $service type is one of:
 159         itemorder,create,drop,commit,update,xmlupdate
 160
 161 $service_options is a hash of key/value pairs. For instance,
 162 if service_type is 'update', $service_options should contain:
 163
 164 action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
 165 (recordidOpaque => Opaque Record ID (user supplied)
 166
 167 or
 168
 169 recordidNumber => Record ID number (system number))
 170 record => the record itself
 171
 172 and maybe:
 173
 174 syntax => the record syntax (transfer syntax)
 175 databaseName = Database from connection object
 176
 177 =cut
 178 sub z3950_extended_services {
 179         my ($Zconn,$serviceType,$serviceOptions,$record) = @_;
 180
 181         # create a new package object
 182         my $Zpackage = $Zconn->package();
 183
 184         # set our options
 185         $Zpackage->option(action => $serviceOptions->{'action'});
 186
 187         if ($serviceOptions->{'databaseName'}) {
 188                 $Zpackage->option(databaseName => $serviceOptions->{'databaseName'});
 189         }
 190         if ($serviceOptions->{'recordIdNumber'}) {
 191                 $Zpackage->option(recordIdNumber => $serviceOptions->{'recordIdNumber'});
 192         }
 193         if ($serviceOptions->{'recordIdOpaque'}) {
 194                 $Zpackage->option(recordIdOpaque => $serviceOptions->{'recordIdOpaque'});
 195         }
 196
 197         # this is an ILL request (Zebra doesn't support it)
 198         if ($serviceType eq 'itemorder') {
 199            $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
 200            $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
 201            $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
 202            $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
 203         }
 204
 205         if ($record) {
 206            my $xmlrecord = marc2xml($record);
 207            $Zpackage->option(record => $xmlrecord);
 208            if ($serviceOptions->{'syntax'}) {
 209               $Zpackage->option(syntax => $serviceOptions->{'syntax'});
 210            }
 211         }
 212
 213         # send the request, handle any exception encountered
 214         eval {  $Zpackage->send($serviceType) };
 215         if ($@ && $@->isa("ZOOM::Exception")) {
 216                 print "Oops!  ", $@->message(), "\n";
 217                 return $@->code();
 218         }
 219         # free up package resources
 220         $Zpackage->destroy();
 221 }
 222
 223 sub marc2xml {
 224         my ($record) = @_;
 225         my $xmlrecord;
 226         eval {
 227                 $xmlrecord=$record->as_xml();
 228         };
 229         if ($@){
 230                 warn "ERROR badly formatted marc record";
 231                 warn "Skipping record";
 232         }
 233         return $xmlrecord;
 234 }
 235 sub set_service_options {
 236         my ($option) = @_;
 237         my $serviceOptions;
 238         if ($option eq 'update') {
 239                 $serviceOptions->{ 'action' } = 'specialUpdate';
 240                 $serviceOptions->{ 'syntax' } = 'xml'; #zebra doesn't support others
 241         }
 242         if ($option eq 'commit') {
 243
 244         }
 245
 246         return $serviceOptions;
 247 }
 248
 249
 250 =head2 @tagslib = &MARCgettagslib($dbh,1|0,$frameworkcode);
 251
 252 =over 4
 253
 254 2nd param is 1 for liblibrarian and 0 for libopac
 255 $frameworkcode contains the framework reference. If empty or does not exist, the default one is used
 256
 257 returns a hash with all values for all fields and subfields for a given MARC framework :
 258         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 259                     ->{tab}        = "";            # XXX
 260                     ->{mandatory}  = $mandatory;
 261                     ->{repeatable} = $repeatable;
 262                     ->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 263                                  ->{tab}              = $tab;
 264                                  ->{mandatory}        = $mandatory;
 265                                  ->{repeatable}       = $repeatable;
 266                                  ->{authorised_value} = $authorised_value;
 267                                  ->{authtypecode}     = $authtypecode;
 268                                  ->{value_builder}    = $value_builder;
 269                                  ->{kohafield}        = $kohafield;
 270                                  ->{seealso}          = $seealso;
 271                                  ->{hidden}           = $hidden;
 272                                  ->{isurl}            = $isurl;
 273                                  ->{link}            = $link;
 274
 275 =back
 276
 277 =cut
 278
 279 sub MARCgettagslib {
 280     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
 281     $frameworkcode = "" unless $frameworkcode;
 282     $forlibrarian = 1 unless $forlibrarian;
 283     my $sth;
 284     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
 285
 286     # check that framework exists
 287     $sth =
 288       $dbh->prepare(
 289         "select count(*) from marc_tag_structure where frameworkcode=?");
 290     $sth->execute($frameworkcode);
 291     my ($total) = $sth->fetchrow;
 292     $frameworkcode = "" unless ( $total > 0 );
 293     $sth =
 294       $dbh->prepare(
 295 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
 296     );
 297     $sth->execute($frameworkcode);
 298     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
 299
 300     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) = $sth->fetchrow ) {
 301         $res->{$tag}->{lib}        = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 302         $res->{$tag}->{tab}        = "";            # XXX
 303         $res->{$tag}->{mandatory}  = $mandatory;
 304         $res->{$tag}->{repeatable} = $repeatable;
 305     }
 306
 307     $sth =
 308       $dbh->prepare(
 309 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
 310     );
 311     $sth->execute($frameworkcode);
 312
 313     my $subfield;
 314     my $authorised_value;
 315     my $authtypecode;
 316     my $value_builder;
 317     my $kohafield;
 318     my $seealso;
 319     my $hidden;
 320     my $isurl;
 321         my $link;
 322
 323     while (
 324         ( $tag,         $subfield,   $liblibrarian,   , $libopac,      $tab,
 325         $mandatory,     $repeatable, $authorised_value, $authtypecode,
 326         $value_builder, $kohafield,  $seealso,          $hidden,
 327         $isurl,                 $link )
 328         = $sth->fetchrow
 329       )
 330     {
 331         $res->{$tag}->{$subfield}->{lib}              = ($forlibrarian or !$libopac)?$liblibrarian:$libopac;
 332         $res->{$tag}->{$subfield}->{tab}              = $tab;
 333         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
 334         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
 335         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
 336         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
 337         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
 338         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
 339         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
 340         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
 341         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
 342         $res->{$tag}->{$subfield}->{link}            = $link;
 343     }
 344     return $res;
 345 }
 346
 347 =head2 ($tagfield,$tagsubfield) = &MARCfind_marc_from_kohafield($dbh,$kohafield);
 348
 349 =over 4
 350
 351 finds MARC tag and subfield for a given kohafield
 352 kohafield is "table.field" where table= biblio|biblioitems|items, and field a field of the previous table
 353
 354 =back
 355
 356 =cut
 357
 358 sub MARCfind_marc_from_kohafield {
 359     my ( $dbh, $kohafield,$frameworkcode ) = @_;
 360     return 0, 0 unless $kohafield;
 361     $frameworkcode='' unless $frameworkcode;
 362         my $relations = C4::Context->marcfromkohafield;
 363         return ($relations->{$frameworkcode}->{$kohafield}->[0],$relations->{$frameworkcode}->{$kohafield}->[1]);
 364 }
 365
 366 =head2 $MARCRecord = &MARCgetbiblio($dbh,$biblionumber);
 367
 368 =over 4
 369
 370 Returns a MARC::Record for the biblio $biblionumber.
 371
 372 =cut
 373
 374 sub MARCgetbiblio {
 375
 376     # Returns MARC::Record of the biblio passed in parameter.
 377     my ( $dbh, $biblionumber ) = @_;
 378         my $sth = $dbh->prepare('select marc from biblioitems where biblionumber=?');
 379         $sth->execute($biblionumber);
 380         my ($marc) = $sth->fetchrow;
 381         my $record = MARC::Record::new_from_usmarc($marc);
 382     return $record;
 383 }
 384
 385 =head2 $XML = &XMLgetbiblio($dbh,$biblionumber);
 386
 387 =over 4
 388
 389 Returns a raw XML for the biblio $biblionumber.
 390
 391 =cut
 392
 393 sub XMLgetbiblio {
 394
 395     # Returns MARC::Record of the biblio passed in parameter.
 396     my ( $dbh, $biblionumber ) = @_;
 397         my $sth = $dbh->prepare('select marcxml,marc from biblioitems where biblionumber=?');
 398         $sth->execute($biblionumber);
 399         my ($XML,$marc) = $sth->fetchrow;
 400 #       my $record =MARC::Record::new_from_usmarc($marc);
 401 #       warn "MARC : \n*-************************\n".$record->as_xml."\n*-************************\n";
 402     return $XML;
 403 }
 404
 405 =head2 $MARCrecord = &MARCgetitem($dbh,$biblionumber);
 406
 407 =over 4
 408
 409 Returns a MARC::Record with all items of biblio # $biblionumber
 410
 411 =back
 412
 413 =cut
 414
 415 sub MARCgetitem {
 416
 417     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 418         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 419         # get the complete MARC record
 420         my $sth = $dbh->prepare("select marc from biblioitems where biblionumber=?");
 421         $sth->execute($biblionumber);
 422         my ($rawmarc) = $sth->fetchrow;
 423         my $record = MARC::File::USMARC::decode($rawmarc);
 424         # now, find the relevant itemnumber
 425         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
 426         # prepare the new item record
 427         my $itemrecord = MARC::Record->new();
 428         # parse all fields fields from the complete record
 429         foreach ($record->field($itemnumberfield)) {
 430                 # when the item field is found, save it
 431                 if ($_->subfield($itemnumbersubfield) == $itemnumber) {
 432                         $itemrecord->append_fields($_);
 433                 }
 434         }
 435
 436     return $itemrecord;
 437 }
 438
 439 =head2 sub find_biblioitemnumber($dbh,$biblionumber);
 440
 441 =over 4
 442
 443 Returns the 1st biblioitemnumber related to $biblionumber. When MARC=ON we should have 1 biblionumber = 1 and only 1 biblioitemnumber
 444 This sub is useless when MARC=OFF
 445
 446 =back
 447
 448 =cut
 449 sub find_biblioitemnumber {
 450         my ( $dbh, $biblionumber ) = @_;
 451         my $sth = $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 452         $sth->execute($biblionumber);
 453         my ($biblioitemnumber) = $sth->fetchrow;
 454         return $biblioitemnumber;
 455 }
 456
 457 =head2 $frameworkcode = MARCfind_frameworkcode($dbh,$biblionumber);
 458
 459 =over 4
 460
 461 returns the framework of a given biblio
 462
 463 =back
 464
 465 =cut
 466
 467 sub MARCfind_frameworkcode {
 468         my ( $dbh, $biblionumber ) = @_;
 469         my $sth = $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
 470         $sth->execute($biblionumber);
 471         my ($frameworkcode) = $sth->fetchrow;
 472         return $frameworkcode;
 473 }
 474
 475 =head2 $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibliohash);
 476
 477 =over 4
 478
 479 MARCkoha2marcBiblio is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB biblio/biblioitem :
 480 all entries of the hash are transformed into their matching MARC field/subfield.
 481
 482 =back
 483
 484 =cut
 485
 486 sub MARCkoha2marcBiblio {
 487
 488         # this function builds partial MARC::Record from the old koha-DB fields
 489         my ( $dbh, $bibliohash ) = @_;
 490         # we don't have biblio entries in the hash, so we add them first
 491         my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
 492         $sth->execute($bibliohash->{biblionumber});
 493         my $biblio = $sth->fetchrow_hashref;
 494         foreach (keys %$biblio) {
 495                 $bibliohash->{$_}=$biblio->{$_};
 496         }
 497         $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 498         my $record = MARC::Record->new();
 499         foreach ( keys %$bibliohash ) {
 500                 &MARCkoha2marcOnefield( $sth, $record, "biblio." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
 501                 &MARCkoha2marcOnefield( $sth, $record, "biblioitems." . $_, $bibliohash->{$_}, '') if $bibliohash->{$_};
 502         }
 503
 504         # other fields => additional authors, subjects, subtitles
 505         my $sth2 = $dbh->prepare(" SELECT author FROM additionalauthors WHERE biblionumber=?");
 506         $sth2->execute($bibliohash->{biblionumber});
 507         while ( my $row = $sth2->fetchrow_hashref ) {
 508                 &MARCkoha2marcOnefield( $sth, $record, "additionalauthors.author", $bibliohash->{'author'},'' );
 509         }
 510         $sth2 = $dbh->prepare(" SELECT subject FROM bibliosubject WHERE biblionumber=?");
 511         $sth2->execute($bibliohash->{biblionumber});
 512         while ( my $row = $sth2->fetchrow_hashref ) {
 513                 &MARCkoha2marcOnefield( $sth, $record, "bibliosubject.subject", $row->{'subject'},'' );
 514         }
 515         $sth2 = $dbh->prepare(" SELECT subtitle FROM bibliosubtitle WHERE biblionumber=?");
 516         $sth2->execute($bibliohash->{biblionumber});
 517         while ( my $row = $sth2->fetchrow_hashref ) {
 518                 &MARCkoha2marcOnefield( $sth, $record, "bibliosubtitle.subtitle", $row->{'subtitle'},'' );
 519         }
 520
 521         return $record;
 522 }
 523
 524 =head2 $MARCRecord = &MARCkoha2marcItem($dbh,$biblionumber,itemnumber);
 525
 526 MARCkoha2marcItem is a wrapper between old-DB and MARC-DB. It returns a MARC::Record builded with old-DB items :
 527 all entries of the hash are transformed into their matching MARC field/subfield.
 528
 529 =over 4
 530
 531 =back
 532
 533 =cut
 534
 535 sub MARCkoha2marcItem {
 536
 537     # this function builds partial MARC::Record from the old koha-DB fields
 538     my ( $dbh, $item ) = @_;
 539
 540     #    my $dbh=&C4Connect;
 541     my $sth = $dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 542     my $record = MARC::Record->new();
 543
 544         foreach( keys %$item ) {
 545                 if ( $item->{$_} ) {
 546                         &MARCkoha2marcOnefield( $sth, $record, "items." . $_,
 547                                 $item->{$_},'' );
 548                 }
 549         }
 550     return $record;
 551 }
 552
 553 =head2 MARCkoha2marcOnefield
 554
 555 =over 4
 556
 557 This sub is for internal use only, used by koha2marcBiblio & koha2marcItem
 558
 559 =back
 560
 561 =cut
 562
 563 sub MARCkoha2marcOnefield {
 564     my ( $sth, $record, $kohafieldname, $value,$frameworkcode ) = @_;
 565     my $tagfield;
 566     my $tagsubfield;
 567     $sth->execute($frameworkcode,$kohafieldname);
 568     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
 569         if ( $record->field($tagfield) ) {
 570             my $tag = $record->field($tagfield);
 571             if ($tag) {
 572                 $tag->add_subfields( $tagsubfield, $value );
 573                 $record->delete_field($tag);
 574                 $record->add_fields($tag);
 575             }
 576         }
 577         else {
 578             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
 579         }
 580     }
 581     return $record;
 582 }
 583
 584 =head2 $MARCrecord = MARChtml2marc($dbh,$rtags,$rsubfields,$rvalues,%indicators);
 585
 586 =over 4
 587
 588 transforms the parameters (coming from HTML form) into a MARC::Record
 589 parameters with r are references to arrays.
 590
 591 FIXME : should be improved for 3.0, to avoid having 4 differents arrays
 592
 593 =back
 594
 595 =cut
 596
 597 sub MARChtml2marc {
 598         my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
 599         my $prevtag = -1;
 600         my $record = MARC::Record->new();
 601 #       my %subfieldlist=();
 602         my $prevvalue; # if tag <10
 603         my $field; # if tag >=10
 604         for (my $i=0; $i< @$rtags; $i++) {
 605                 next unless @$rvalues[$i];
 606                 # rebuild MARC::Record
 607 #                       warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
 608                 if (@$rtags[$i] ne $prevtag) {
 609                         if ($prevtag < 10) {
 610                                 if ($prevvalue) {
 611                                         if ($prevtag ne '000') {
 612                                                 $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
 613                                         } else {
 614                                                 $record->leader($prevvalue);
 615                                         }
 616                                 }
 617                         } else {
 618                                 if ($field) {
 619                                         $record->add_fields($field);
 620                                 }
 621                         }
 622                         $indicators{@$rtags[$i]}.='  ';
 623                         if (@$rtags[$i] <10) {
 624                                 $prevvalue= @$rvalues[$i];
 625                                 undef $field;
 626                         } else {
 627                                 undef $prevvalue;
 628                                 $field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
 629 #                       warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 630                         }
 631                         $prevtag = @$rtags[$i];
 632                 } else {
 633                         if (@$rtags[$i] <10) {
 634                                 $prevvalue=@$rvalues[$i];
 635                         } else {
 636                                 if (length(@$rvalues[$i])>0) {
 637                                         $field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
 638 #                       warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
 639                                 }
 640                         }
 641                         $prevtag= @$rtags[$i];
 642                 }
 643         }
 644         # the last has not been included inside the loop... do it now !
 645         $record->add_fields($field) if $field;
 646 #       warn "HTML2MARC=".$record->as_formatted;
 647         return $record;
 648 }
 649
 650
 651 =head2 $hash = &MARCmarc2koha($dbh,$MARCRecord);
 652
 653 =over 4
 654
 655 builds a hash with old-db datas from a MARC::Record
 656
 657 =back
 658
 659 =cut
 660
 661 sub MARCmarc2koha {
 662         my ($dbh,$record,$frameworkcode) = @_;
 663         my $sth=$dbh->prepare("select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?");
 664         my $result;
 665         my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
 666         $sth2->execute;
 667         my $field;
 668         while (($field)=$sth2->fetchrow) {
 669 #               warn "biblio.".$field;
 670                 $result=&MARCmarc2kohaOneField($sth,"biblio",$field,$record,$result,$frameworkcode);
 671         }
 672         $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
 673         $sth2->execute;
 674         while (($field)=$sth2->fetchrow) {
 675                 if ($field eq 'notes') { $field = 'bnotes'; }
 676 #               warn "biblioitems".$field;
 677                 $result=&MARCmarc2kohaOneField($sth,"biblioitems",$field,$record,$result,$frameworkcode);
 678         }
 679         $sth2=$dbh->prepare("SHOW COLUMNS from items");
 680         $sth2->execute;
 681         while (($field)=$sth2->fetchrow) {
 682 #               warn "items".$field;
 683                 $result=&MARCmarc2kohaOneField($sth,"items",$field,$record,$result,$frameworkcode);
 684         }
 685         # additional authors : specific
 686         $result = &MARCmarc2kohaOneField($sth,"bibliosubtitle","subtitle",$record,$result,$frameworkcode);
 687         $result = &MARCmarc2kohaOneField($sth,"additionalauthors","additionalauthors",$record,$result,$frameworkcode);
 688 # modify copyrightdate to keep only the 1st year found
 689         my $temp = $result->{'copyrightdate'};
 690         if ($temp){
 691                 $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 692                 if ($1>0) {
 693                         $result->{'copyrightdate'} = $1;
 694                 } else { # if no cYYYY, get the 1st date.
 695                         $temp =~ m/(\d\d\d\d)/;
 696                         $result->{'copyrightdate'} = $1;
 697                 }
 698         }
 699 # modify publicationyear to keep only the 1st year found
 700         $temp = $result->{'publicationyear'};
 701         $temp =~ m/c(\d\d\d\d)/; # search cYYYY first
 702         if ($1>0) {
 703                 $result->{'publicationyear'} = $1;
 704         } else { # if no cYYYY, get the 1st date.
 705                 $temp =~ m/(\d\d\d\d)/;
 706                 $result->{'publicationyear'} = $1;
 707         }
 708         return $result;
 709 }
 710
 711 sub MARCmarc2kohaOneField {
 712
 713 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
 714     my ( $sth, $kohatable, $kohafield, $record, $result,$frameworkcode ) = @_;
 715     #    warn "kohatable / $kohafield / $result / ";
 716     my $res = "";
 717     my $tagfield;
 718     my $subfield;
 719     ( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
 720     foreach my $field ( $record->field($tagfield) ) {
 721                 if ($field->tag()<10) {
 722                         if ($result->{$kohafield}) {
 723                                 # Reverse array filled with elements from repeated subfields
 724                                 # from first to last to avoid last to first concatenation of
 725                                 # elements in Koha DB.  -- thd.
 726                                 $result->{$kohafield} .= " | ".reverse($field->data());
 727                         } else {
 728                                 $result->{$kohafield} = $field->data();
 729                         }
 730                 } else {
 731                         if ( $field->subfields ) {
 732                                 my @subfields = $field->subfields();
 733                                 foreach my $subfieldcount ( 0 .. $#subfields ) {
 734                                         if ($subfields[$subfieldcount][0] eq $subfield) {
 735                                                 if ( $result->{$kohafield} ) {
 736                                                         $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
 737                                                 }
 738                                                 else {
 739                                                         $result->{$kohafield} = $subfields[$subfieldcount][1];
 740                                                 }
 741                                         }
 742                                 }
 743                         }
 744                 }
 745     }
 746 #       warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
 747     return $result;
 748 }
 749
 750 =head2 ($biblionumber,$biblioitemnumber) = NEWnewbibilio($dbh,$MARCRecord,$frameworkcode);
 751
 752 =over 4
 753
 754 creates a biblio from a MARC::Record.
 755
 756 =back
 757
 758 =cut
 759
 760 sub NEWnewbiblio {
 761     my ( $dbh,$Zconn,$record,$frameworkcode ) = @_;
 762     my $biblionumber;
 763     my $biblioitemnumber;
 764     my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
 765         $olddata->{frameworkcode} = $frameworkcode;
 766     $biblionumber = REALnewbiblio( $dbh, $olddata );
 767         $olddata->{biblionumber} = $biblionumber;
 768         # add biblionumber into the MARC record (it's the ID for zebra)
 769         my ( $tagfield, $tagsubfield ) =
 770                                         MARCfind_marc_from_kohafield( $dbh, "biblio.biblionumber",$frameworkcode );
 771         # create the field
 772         my $newfield;
 773         if ($tagfield<10) {
 774                 $newfield = MARC::Field->new(
 775                         $tagfield, $biblionumber,
 776                 );
 777         } else {
 778                 $newfield = MARC::Field->new(
 779                         $tagfield, '', '', "$tagsubfield" => $biblionumber,
 780                 );
 781         }
 782         # drop old field (just in case it already exist and create new one...
 783         my $old_field = $record->field($tagfield);
 784         $record->delete_field($old_field);
 785         $record->add_fields($newfield);
 786
 787         #create the marc entry, that stores the rax marc record in Koha 3.0
 788         $olddata->{marc} = $record->as_usmarc();
 789         $olddata->{marcxml} = $record->as_xml();
 790         # and create biblioitem, that's all folks !
 791     $biblioitemnumber = REALnewbiblioitem( $dbh, $Zconn, $olddata );
 792
 793     # search subtiles, addiauthors and subjects
 794     ( $tagfield, $tagsubfield ) =
 795       MARCfind_marc_from_kohafield( $dbh, "additionalauthors.author",$frameworkcode );
 796     my @addiauthfields = $record->field($tagfield);
 797     foreach my $addiauthfield (@addiauthfields) {
 798         my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
 799         foreach my $subfieldcount ( 0 .. $#addiauthsubfields ) {
 800             REALmodaddauthor( $dbh, $biblionumber,
 801                 $addiauthsubfields[$subfieldcount] );
 802         }
 803     }
 804     ( $tagfield, $tagsubfield ) =
 805       MARCfind_marc_from_kohafield( $dbh, "bibliosubtitle.subtitle",$frameworkcode );
 806     my @subtitlefields = $record->field($tagfield);
 807     foreach my $subtitlefield (@subtitlefields) {
 808         my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
 809         foreach my $subfieldcount ( 0 .. $#subtitlesubfields ) {
 810             REALnewsubtitle( $dbh, $biblionumber,
 811                 $subtitlesubfields[$subfieldcount] );
 812         }
 813     }
 814     ( $tagfield, $tagsubfield ) =
 815       MARCfind_marc_from_kohafield( $dbh, "bibliosubject.subject",$frameworkcode );
 816     my @subj = $record->field($tagfield);
 817     my @subjects;
 818     foreach my $subject (@subj) {
 819         my @subjsubfield = $subject->subfield($tagsubfield);
 820         foreach my $subfieldcount ( 0 .. $#subjsubfield ) {
 821             push @subjects, $subjsubfield[$subfieldcount];
 822         }
 823     }
 824     REALmodsubject( $dbh, $biblionumber, 1, @subjects );
 825     return ( $biblionumber, $biblioitemnumber );
 826 }
 827
 828 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
 829
 830 =over 4
 831
 832 modify the framework of a biblio
 833
 834 =back
 835
 836 =cut
 837
 838 sub NEWmodbiblioframework {
 839         my ($dbh,$biblionumber,$frameworkcode) =@_;
 840         my $sth = $dbh->prepare("Update biblio SET frameworkcode=? WHERE biblionumber=?");
 841         $sth->execute($frameworkcode,$biblionumber);
 842         return 1;
 843 }
 844
 845 =head2 NEWmodbiblio($dbh,$Zconn,$MARCrecord,$biblionumber,$frameworkcode);
 846
 847 =over 4
 848
 849 modify a biblio (MARC=ON)
 850
 851 =back
 852
 853 =cut
 854
 855 sub NEWmodbiblio {
 856         my ($dbh,$Zconn,$record,$biblionumber,$frameworkcode) =@_;
 857         $frameworkcode="" unless $frameworkcode;
 858 #       &MARCmodbiblio($dbh,$bibid,$record,$frameworkcode,0);
 859         my $oldbiblio = MARCmarc2koha($dbh,$record,$frameworkcode);
 860
 861         $oldbiblio->{frameworkcode} = $frameworkcode;
 862         #create the marc entry, that stores the rax marc record in Koha 3.0
 863         $oldbiblio->{biblionumber} = $biblionumber unless $oldbiblio->{biblionumber};
 864         $oldbiblio->{marc} = $record->as_usmarc();
 865         $oldbiblio->{marcxml} = $record->as_xml();
 866         warn "dans NEWmodbiblio $biblionumber = ".$oldbiblio->{biblionumber}." = ".$oldbiblio->{marcxml};
 867         REALmodbiblio($dbh,$oldbiblio);
 868         REALmodbiblioitem($dbh,$Zconn,$oldbiblio);
 869         # now, modify addi authors, subject, addititles.
 870         my ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"additionalauthors.author",$frameworkcode);
 871         my @addiauthfields = $record->field($tagfield);
 872         foreach my $addiauthfield (@addiauthfields) {
 873                 my @addiauthsubfields = $addiauthfield->subfield($tagsubfield);
 874                 $dbh->do("delete from additionalauthors where biblionumber=$biblionumber");
 875                 foreach my $subfieldcount (0..$#addiauthsubfields) {
 876                         REALmodaddauthor($dbh,$biblionumber,$addiauthsubfields[$subfieldcount]);
 877                 }
 878         }
 879         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubtitle.subtitle",$frameworkcode);
 880         my @subtitlefields = $record->field($tagfield);
 881         foreach my $subtitlefield (@subtitlefields) {
 882                 my @subtitlesubfields = $subtitlefield->subfield($tagsubfield);
 883                 # delete & create subtitle again because REALmodsubtitle can't handle new subtitles
 884                 # between 2 modifs
 885                 $dbh->do("delete from bibliosubtitle where biblionumber=$biblionumber");
 886                 foreach my $subfieldcount (0..$#subtitlesubfields) {
 887                         foreach my $subtit(split /\||#/,$subtitlesubfields[$subfieldcount]) {
 888                                 REALnewsubtitle($dbh,$biblionumber,$subtit);
 889                         }
 890                 }
 891         }
 892         ($tagfield,$tagsubfield) = MARCfind_marc_from_kohafield($dbh,"bibliosubject.subject",$frameworkcode);
 893         my @subj = $record->field($tagfield);
 894         my @subjects;
 895         foreach my $subject (@subj) {
 896                 my @subjsubfield = $subject->subfield($tagsubfield);
 897                 foreach my $subfieldcount (0..$#subjsubfield) {
 898                         push @subjects,$subjsubfield[$subfieldcount];
 899                 }
 900         }
 901         REALmodsubject($dbh,$biblionumber,1,@subjects);
 902         return 1;
 903 }
 904
 905 =head2 NEWmodbilbioframework($dbh,$biblionumber,$frameworkcode);
 906
 907 =over 4
 908
 909 delete a biblio
 910
 911 =back
 912
 913 =cut
 914
 915 sub NEWdelbiblio {
 916     my ( $dbh, $bibid ) = @_;
 917     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 918     &REALdelbiblio( $dbh, $biblio );
 919     my $sth =
 920       $dbh->prepare(
 921         "select biblioitemnumber from biblioitems where biblionumber=?");
 922     $sth->execute($biblio);
 923     while ( my ($biblioitemnumber) = $sth->fetchrow ) {
 924         REALdelbiblioitem( $dbh, $biblioitemnumber );
 925     }
 926     &MARCdelbiblio( $dbh, $bibid, 0 );
 927 }
 928
 929 =head2 $itemnumber = NEWnewitem($dbh, $Zconn, $record, $biblionumber, $biblioitemnumber);
 930
 931 =over 4
 932
 933 creates an item from a MARC::Record
 934
 935 =back
 936
 937 =cut
 938
 939 sub NEWnewitem {
 940     my ( $dbh,$Zconn,$record,$biblionumber,$biblioitemnumber ) = @_;
 941
 942     # add item in old-DB
 943         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 944     my $item = &MARCmarc2koha( $dbh,$record,$frameworkcode );
 945     # needs old biblionumber and biblioitemnumber
 946     $item->{'biblionumber'} = $biblionumber;
 947     $item->{'biblioitemnumber'}=$biblioitemnumber;
 948     $item->{marc} = $record->as_usmarc();
 949     warn $item->{marc};
 950     my ( $itemnumber, $error ) = &REALnewitems( $dbh, $Zconn, $item, $item->{barcode} );
 951         return $itemnumber;
 952 }
 953
 954
 955 =head2 $itemnumber = NEWmoditem($dbh, $Zconn, $record, $biblionumber, $biblioitemnumber,$itemnumber);
 956
 957 =over 4
 958
 959 Modify an item
 960
 961 =back
 962
 963 =cut
 964
 965 sub NEWmoditem {
 966     my ( $dbh, $Zconn, $record, $biblionumber, $biblioitemnumber, $itemnumber) = @_;
 967
 968         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblionumber);
 969     my $olditem = MARCmarc2koha( $dbh, $record,$frameworkcode );
 970         # add MARC record
 971         $olditem->{marc} = $record->as_usmarc();
 972         $olditem->{biblionumber} = $biblionumber;
 973         $olditem->{biblioitemnumber} = $biblioitemnumber;
 974         # and modify item
 975     REALmoditem( $dbh, $Zconn, $olditem );
 976 }
 977
 978
 979 =head2 $itemnumber = NEWdelitem($dbh, $biblionumber, $biblioitemnumber, $itemnumber);
 980
 981 =over 4
 982
 983 delete an item
 984
 985 =back
 986
 987 =cut
 988
 989 sub NEWdelitem {
 990     my ( $dbh, $bibid, $itemnumber ) = @_;
 991     my $biblio = &MARCfind_oldbiblionumber_from_MARCbibid( $dbh, $bibid );
 992     &REALdelitem( $dbh, $itemnumber );
 993     &MARCdelitem( $dbh, $bibid, $itemnumber );
 994 }
 995
 996
 997 =head2 $biblionumber = REALnewbiblio($dbh,$biblio);
 998
 999 =over 4
1000
1001 adds a record in biblio table. Datas are in the hash $biblio.
1002
1003 =back
1004
1005 =cut
1006
1007 sub REALnewbiblio {
1008     my ( $dbh, $biblio ) = @_;
1009
1010         $dbh->do('lock tables biblio WRITE');
1011     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
1012     $sth->execute;
1013     my $data   = $sth->fetchrow_arrayref;
1014     my $bibnum = $$data[0] + 1;
1015     my $series = 0;
1016
1017     if ( $biblio->{'seriestitle'} ) { $series = 1 }
1018     $sth->finish;
1019     $sth =
1020       $dbh->prepare("insert into biblio set     biblionumber=?, title=?,                author=?,       copyrightdate=?,
1021                                                                                         serial=?,               seriestitle=?,  notes=?,        abstract=?,
1022                                                                                         unititle=?"
1023     );
1024     $sth->execute(
1025         $bibnum,             $biblio->{'title'},
1026         $biblio->{'author'}, $biblio->{'copyrightdate'},
1027         $biblio->{'serial'},             $biblio->{'seriestitle'},
1028         $biblio->{'notes'},  $biblio->{'abstract'},
1029                 $biblio->{'unititle'}
1030     );
1031
1032     $sth->finish;
1033         $dbh->do('unlock tables');
1034     return ($bibnum);
1035 }
1036
1037 =head2 $biblionumber = REALmodbiblio($dbh,$biblio);
1038
1039 =over 4
1040
1041 modify a record in biblio table. Datas are in the hash $biblio.
1042
1043 =back
1044
1045 =cut
1046
1047 sub REALmodbiblio {
1048     my ( $dbh, $biblio ) = @_;
1049     my $sth = $dbh->prepare("Update biblio set  title=?,                author=?,       abstract=?,     copyrightdate=?,
1050                                                                                                 seriestitle=?,  serial=?,       unititle=?,     notes=?,        frameworkcode=?
1051                                                                                         where biblionumber = ?"
1052     );
1053     $sth->execute(
1054                 $biblio->{'title'},       $biblio->{'author'},
1055                 $biblio->{'abstract'},    $biblio->{'copyrightdate'},
1056                 $biblio->{'seriestitle'}, $biblio->{'serial'},
1057                 $biblio->{'unititle'},    $biblio->{'notes'},
1058                 $biblio->{frameworkcode},
1059                 $biblio->{'biblionumber'}
1060     );
1061         $sth->finish;
1062         return ( $biblio->{'biblionumber'} );
1063 }    # sub modbiblio
1064
1065 =head2 REALmodsubtitle($dbh,$bibnum,$subtitle);
1066
1067 =over 4
1068
1069 modify subtitles in bibliosubtitle table.
1070
1071 =back
1072
1073 =cut
1074
1075 sub REALmodsubtitle {
1076     my ( $dbh, $bibnum, $subtitle ) = @_;
1077     my $sth =
1078       $dbh->prepare(
1079         "update bibliosubtitle set subtitle = ? where biblionumber = ?");
1080     $sth->execute( $subtitle, $bibnum );
1081     $sth->finish;
1082 }    # sub modsubtitle
1083
1084 =head2 REALmodaddauthor($dbh,$bibnum,$author);
1085
1086 =over 4
1087
1088 adds or modify additional authors
1089 NOTE :  Strange sub : seems to delete MANY and add only ONE author... maybe buggy ?
1090
1091 =back
1092
1093 =cut
1094
1095 sub REALmodaddauthor {
1096     my ( $dbh, $bibnum, @authors ) = @_;
1097
1098     #    my $dbh   = C4Connect;
1099     my $sth =
1100       $dbh->prepare("Delete from additionalauthors where biblionumber = ?");
1101
1102     $sth->execute($bibnum);
1103     $sth->finish;
1104     foreach my $author (@authors) {
1105         if ( $author ne '' ) {
1106             $sth =
1107               $dbh->prepare(
1108                 "Insert into additionalauthors set author = ?, biblionumber = ?"
1109             );
1110
1111             $sth->execute( $author, $bibnum );
1112
1113             $sth->finish;
1114         }    # if
1115     }
1116 }    # sub modaddauthor
1117
1118 =head2 $errors = REALmodsubject($dbh,$bibnum, $force, @subject);
1119
1120 =over 4
1121
1122 modify/adds subjects
1123
1124 =back
1125
1126 =cut
1127 sub REALmodsubject {
1128     my ( $dbh, $bibnum, $force, @subject ) = @_;
1129
1130     #  my $dbh   = C4Connect;
1131     my $count = @subject;
1132     my $error="";
1133     for ( my $i = 0 ; $i < $count ; $i++ ) {
1134         $subject[$i] =~ s/^ //g;
1135         $subject[$i] =~ s/ $//g;
1136         my $sth =
1137           $dbh->prepare(
1138 "select * from catalogueentry where entrytype = 's' and catalogueentry = ?"
1139         );
1140         $sth->execute( $subject[$i] );
1141
1142         if ( my $data = $sth->fetchrow_hashref ) {
1143         }
1144         else {
1145             if ( $force eq $subject[$i] || $force == 1 ) {
1146
1147                 # subject not in aut, chosen to force anway
1148                 # so insert into cataloguentry so its in auth file
1149                 my $sth2 =
1150                   $dbh->prepare(
1151 "Insert into catalogueentry (entrytype,catalogueentry) values ('s',?)"
1152                 );
1153
1154                 $sth2->execute( $subject[$i] ) if ( $subject[$i] );
1155                 $sth2->finish;
1156             }
1157             else {
1158                 $error =
1159                   "$subject[$i]\n does not exist in the subject authority file";
1160                 my $sth2 =
1161                   $dbh->prepare(
1162 "Select * from catalogueentry where entrytype = 's' and (catalogueentry like ? or catalogueentry like ? or catalogueentry like ?)"
1163                 );
1164                 $sth2->execute( "$subject[$i] %", "% $subject[$i] %",
1165                     "% $subject[$i]" );
1166                 while ( my $data = $sth2->fetchrow_hashref ) {
1167                     $error .= "<br>$data->{'catalogueentry'}";
1168                 }    # while
1169                 $sth2->finish;
1170             }    # else
1171         }    # else
1172         $sth->finish;
1173     }    # else
1174     if ($error eq '') {
1175         my $sth =
1176           $dbh->prepare("Delete from bibliosubject where biblionumber = ?");
1177         $sth->execute($bibnum);
1178         $sth->finish;
1179         $sth =
1180           $dbh->prepare(
1181             "Insert into bibliosubject (subject,biblionumber) values (?,?)");
1182         my $query;
1183         foreach $query (@subject) {
1184             $sth->execute( $query, $bibnum ) if ( $query && $bibnum );
1185         }    # foreach
1186         $sth->finish;
1187     }    # if
1188
1189     #  $dbh->disconnect;
1190     return ($error);
1191 }    # sub modsubject
1192
1193 =head2 REALmodbiblioitem($dbh, $biblioitem);
1194
1195 =over 4
1196
1197 modify a biblioitem
1198
1199 =back
1200
1201 =cut
1202 sub REALmodbiblioitem {
1203     my ( $dbh, $Zconn, $biblioitem ) = @_;
1204     my $query;
1205
1206     my $sth = $dbh->prepare("update biblioitems set number=?,volume=?,                  volumedate=?,           lccn=?,
1207                                                                                 itemtype=?,                     url=?,                          isbn=?,                         issn=?,
1208                                                                                 publishercode=?,        publicationyear=?,      classification=?,       dewey=?,
1209                                                                                 subclass=?,                     illus=?,                        pages=?,                        volumeddesc=?,
1210                                                                                 notes=?,                        size=?,                         place=?,                        marc=?,
1211                                                                                 marcxml=?
1212                                                         where biblioitemnumber=?");
1213         $sth->execute(  $biblioitem->{number},                  $biblioitem->{volume},  $biblioitem->{volumedate},      $biblioitem->{lccn},
1214                                         $biblioitem->{itemtype},                $biblioitem->{url},             $biblioitem->{isbn},    $biblioitem->{issn},
1215                                 $biblioitem->{publishercode},   $biblioitem->{publicationyear}, $biblioitem->{classification},  $biblioitem->{dewey},
1216                                 $biblioitem->{subclass},                $biblioitem->{illus},           $biblioitem->{pages},   $biblioitem->{volumeddesc},
1217                                 $biblioitem->{bnotes},                  $biblioitem->{size},            $biblioitem->{place},   $biblioitem->{marc},
1218                                         $biblioitem->{marcxml},                 $biblioitem->{biblioitemnumber});
1219         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1220
1221         #my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
1222         z3950_extended_services($Zconn,'update',set_service_options('update'),$record);
1223          #z3950_extended_services($Zconn,'commit',set_service_options('commit'));
1224
1225
1226 #       warn "MOD : $biblioitem->{biblioitemnumber} = ".$biblioitem->{marc};
1227 }    # sub modbibitem
1228
1229 =head2 REALnewbiblioitem($dbh,$Zconn,$biblioitem);
1230
1231 =over 4
1232
1233 adds a biblioitem ($biblioitem is a hash with the values)
1234
1235 =back
1236
1237 =cut
1238
1239 sub REALnewbiblioitem {
1240         my ( $dbh, $Zconn, $biblioitem ) = @_;
1241
1242         $dbh->do("lock tables biblioitems WRITE, biblio WRITE, marc_subfield_structure READ");
1243         my $sth = $dbh->prepare("Select max(biblioitemnumber) from biblioitems");
1244         my $data;
1245         my $biblioitemnumber;
1246
1247         $sth->execute;
1248         $data       = $sth->fetchrow_arrayref;
1249         $biblioitemnumber = $$data[0] + 1;
1250
1251         # Insert biblioitemnumber in MARC record, we need it to manage items later...
1252         my $frameworkcode=MARCfind_frameworkcode($dbh,$biblioitem->{biblionumber});
1253         my ($biblioitemnumberfield,$biblioitemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'biblioitems.biblioitemnumber',$frameworkcode);
1254         my $record = MARC::File::USMARC::decode($biblioitem->{marc});
1255         my $field=$record->field($biblioitemnumberfield);
1256         $field->update($biblioitemnumbersubfield => "$biblioitemnumber");
1257         $biblioitem->{marc} = $record->as_usmarc();
1258         $biblioitem->{marcxml} = $record->as_xml();
1259
1260         $sth = $dbh->prepare( "insert into biblioitems set
1261                                                                         biblioitemnumber = ?,           biblionumber     = ?,
1262                                                                         volume           = ?,                   number           = ?,
1263                                                                         classification  = ?,                    itemtype         = ?,
1264                                                                         url              = ?,                           isbn             = ?,
1265                                                                         issn             = ?,                           dewey            = ?,
1266                                                                         subclass         = ?,                           publicationyear  = ?,
1267                                                                         publishercode    = ?,           volumedate       = ?,
1268                                                                         volumeddesc      = ?,           illus            = ?,
1269                                                                         pages            = ?,                           notes            = ?,
1270                                                                         size             = ?,                           lccn             = ?,
1271                                                                         marc             = ?,                           place            = ?,
1272                                                                         marcxml          = ?"
1273         );
1274         $sth->execute(
1275                 $biblioitemnumber,               $biblioitem->{'biblionumber'},
1276                 $biblioitem->{'volume'},         $biblioitem->{'number'},
1277                 $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
1278                 $biblioitem->{'url'},            $biblioitem->{'isbn'},
1279                 $biblioitem->{'issn'},           $biblioitem->{'dewey'},
1280                 $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
1281                 $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
1282                 $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
1283                 $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
1284                 $biblioitem->{'size'},           $biblioitem->{'lccn'},
1285                 $biblioitem->{'marc'},           $biblioitem->{'place'},
1286                 $biblioitem->{marcxml},
1287         );
1288         $dbh->do("unlock tables");
1289         #my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
1290         z3950_extended_services($Zconn,'update',set_service_options('update'),$record);
1291         #z3950_extended_services($Zconn,'commit',set_service_options('commit'));
1292         #zebra_create($biblioitem->{biblionumber}, $record);
1293         return ($biblioitemnumber);
1294 }
1295
1296 =head2 REALnewsubtitle($dbh,$bibnum,$subtitle);
1297
1298 =over 4
1299
1300 create a new subtitle
1301
1302 =back
1303
1304 =cut
1305 sub REALnewsubtitle {
1306     my ( $dbh, $bibnum, $subtitle ) = @_;
1307     my $sth =
1308       $dbh->prepare(
1309         "insert into bibliosubtitle set biblionumber = ?, subtitle = ?");
1310     $sth->execute( $bibnum, $subtitle ) if $subtitle;
1311     $sth->finish;
1312 }
1313
1314 =head2 ($itemnumber,$errors)= REALnewitems($dbh,$Zconn,$item,$barcode);
1315
1316 =over 4
1317
1318 create a item. $item is a hash and $barcode the barcode.
1319
1320 =back
1321
1322 =cut
1323
1324 sub REALnewitems {
1325     my ( $dbh, $Zconn,$item, $barcode ) = @_;
1326
1327 #       warn "OLDNEWITEMS";
1328
1329         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE,marc_subfield_structure WRITE');
1330     my $sth = $dbh->prepare("Select max(itemnumber) from items");
1331     my $data;
1332     my $itemnumber;
1333     my $error = "";
1334     $sth->execute;
1335     $data       = $sth->fetchrow_hashref;
1336     $itemnumber = $data->{'max(itemnumber)'} + 1;
1337
1338 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
1339     if ( $item->{'loan'} ) {
1340         $item->{'notforloan'} = $item->{'loan'};
1341     }
1342         $item->{'biblioitemnumber'} = 1;
1343     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1344     if ( $item->{'dateaccessioned'} ) {
1345         $sth = $dbh->prepare( "Insert into items set
1346                                                         itemnumber           = ?,                       biblionumber         = ?,
1347                                                         multivolumepart      = ?,
1348                                                         biblioitemnumber     = ?,                       barcode              = ?,
1349                                                         booksellerid         = ?,                       dateaccessioned      = ?,
1350                                                         homebranch           = ?,                       holdingbranch        = ?,
1351                                                         price                = ?,                       replacementprice     = ?,
1352                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1353                                                         multivolume                     = ?,                    stack                           = ?,
1354                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1355                                                         paidfor                         = ?,                    itemnotes            = ?,
1356                                                         itemcallnumber  =?,                                                     notforloan = ?,
1357                                                         location = ?
1358                                                         "
1359         );
1360         $sth->execute(
1361                         $itemnumber,                            $item->{'biblionumber'},
1362                         $item->{'multivolumepart'},
1363                         $item->{'biblioitemnumber'},$item->{barcode},
1364                         $item->{'booksellerid'},        $item->{'dateaccessioned'},
1365                         $item->{'homebranch'},          $item->{'holdingbranch'},
1366                         $item->{'price'},                       $item->{'replacementprice'},
1367                         $item->{multivolume},           $item->{stack},
1368                         $item->{itemlost},                      $item->{wthdrawn},
1369                         $item->{paidfor},                       $item->{'itemnotes'},
1370                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1371                         $item->{'location'}
1372         );
1373                 if ( defined $sth->errstr ) {
1374                         $error .= $sth->errstr;
1375                 }
1376     }
1377     else {
1378         $sth = $dbh->prepare( "Insert into items set
1379                                                         itemnumber           = ?,                       biblionumber         = ?,
1380                                                         multivolumepart      = ?,
1381                                                         biblioitemnumber     = ?,                       barcode              = ?,
1382                                                         booksellerid         = ?,                       dateaccessioned      = NOW(),
1383                                                         homebranch           = ?,                       holdingbranch        = ?,
1384                                                         price                = ?,                       replacementprice     = ?,
1385                                                         replacementpricedate = NOW(),           datelastseen            = NOW(),
1386                                                         multivolume                     = ?,                    stack                           = ?,
1387                                                         itemlost                        = ?,                    wthdrawn                        = ?,
1388                                                         paidfor                         = ?,                    itemnotes            = ?,
1389                                                         itemcallnumber  =?,                                                     notforloan = ?,
1390                                                         location = ?
1391                                                         "
1392         );
1393         $sth->execute(
1394                         $itemnumber,                            $item->{'biblionumber'},
1395                         $item->{'multivolumepart'},
1396                         $item->{'biblioitemnumber'},$item->{barcode},
1397                         $item->{'booksellerid'},
1398                         $item->{'homebranch'},          $item->{'holdingbranch'},
1399                         $item->{'price'},                       $item->{'replacementprice'},
1400                         $item->{multivolume},           $item->{stack},
1401                         $item->{itemlost},                      $item->{wthdrawn},
1402                         $item->{paidfor},                       $item->{'itemnotes'},
1403                         $item->{'itemcallnumber'},      $item->{'notforloan'},
1404                         $item->{'location'}
1405         );
1406                 if ( defined $sth->errstr ) {
1407                         $error .= $sth->errstr;
1408                 }
1409     }
1410         # item stored, now, deal with the marc part...
1411         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1412                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1413                                                                         biblio.biblionumber=?");
1414         $sth->execute($item->{biblionumber});
1415     if ( defined $sth->errstr ) {
1416         $error .= $sth->errstr;
1417     }
1418         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1419         warn "ERROR IN REALnewitem, MARC record not found FOR $item->{biblionumber} => $rawmarc <=" unless $rawmarc;
1420         my $record = MARC::File::USMARC::decode($rawmarc);
1421         # ok, we have the marc record, add item number to the item field (in {marc}, and add the field to the record)
1422         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1423         my $itemrecord = MARC::Record->new_from_usmarc($item->{marc});
1424         warn $itemrecord;
1425         warn $itemnumberfield;
1426         warn $itemrecord->field($itemnumberfield);
1427         my $itemfield = $itemrecord->field($itemnumberfield);
1428         $itemfield->add_subfields($itemnumbersubfield => "$itemnumber");
1429         $record->insert_grouped_field($itemfield);
1430         # save the record into biblioitem
1431         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=?");
1432         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber});
1433     if ( defined $sth->errstr ) {
1434         $error .= $sth->errstr;
1435     }
1436         #my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
1437          z3950_extended_services($Zconn,'update',set_service_options('update'),$record);
1438          # z3950_extended_services($Zconn,'commit',set_service_options('commit'));
1439          #zebra_create($item->{biblionumber},$record);
1440         $dbh->do('unlock tables');
1441     return ( $itemnumber, $error );
1442 }
1443
1444 =head2 REALmoditem($dbh,$Zconn,$item);
1445
1446 =over 4
1447
1448 modify item
1449
1450 =back
1451
1452 =cut
1453
1454 sub REALmoditem {
1455     my ( $dbh, $Zconn, $item ) = @_;
1456     $item->{'bibitemnum'} = 1;
1457         my $error;
1458         $dbh->do('lock tables items WRITE, biblio WRITE,biblioitems WRITE');
1459     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
1460     my $query = "update items set  barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1461     my @bind = (
1462         $item->{'barcode'},                     $item->{'itemnotes'},
1463         $item->{'itemcallnumber'},      $item->{'notforloan'},
1464         $item->{'location'},            $item->{multivolumepart},
1465                 $item->{multivolume},           $item->{stack},
1466                 $item->{wthdrawn},
1467     );
1468     if ( $item->{'lost'} ne '' ) {
1469         $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
1470                                                         itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
1471                                                         location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
1472         @bind = (
1473             $item->{'bibitemnum'},     $item->{'barcode'},
1474             $item->{'itemnotes'},          $item->{'homebranch'},
1475             $item->{'lost'},           $item->{'wthdrawn'},
1476             $item->{'itemcallnumber'}, $item->{'notforloan'},
1477             $item->{'location'},                $item->{multivolumepart},
1478                         $item->{multivolume},           $item->{stack},
1479                         $item->{wthdrawn},
1480         );
1481                 if ($item->{homebranch}) {
1482                         $query.=",homebranch=?";
1483                         push @bind, $item->{homebranch};
1484                 }
1485                 if ($item->{holdingbranch}) {
1486                         $query.=",holdingbranch=?";
1487                         push @bind, $item->{holdingbranch};
1488                 }
1489     }
1490         $query.=" where itemnumber=?";
1491         push @bind,$item->{'itemnum'};
1492    if ( $item->{'replacement'} ne '' ) {
1493         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
1494     }
1495     my $sth = $dbh->prepare($query);
1496     $sth->execute(@bind);
1497
1498         # item stored, now, deal with the marc part...
1499         $sth = $dbh->prepare("select biblioitems.marc,biblio.frameworkcode from biblioitems,biblio
1500                                                         where   biblio.biblionumber=biblioitems.biblionumber and
1501                                                                         biblio.biblionumber=? and
1502                                                                         biblioitems.biblioitemnumber=?");
1503         $sth->execute($item->{biblionumber},$item->{biblioitemnumber});
1504     if ( defined $sth->errstr ) {
1505         $error .= $sth->errstr;
1506     }
1507         my ($rawmarc,$frameworkcode) = $sth->fetchrow;
1508         warn "ERROR IN REALmoditem, MARC record not found" unless $rawmarc;
1509         my $record = MARC::File::USMARC::decode($rawmarc);
1510         # ok, we have the marc record, find the previous item record for this itemnumber and delete it
1511         my ($itemnumberfield,$itemnumbersubfield) = MARCfind_marc_from_kohafield($dbh,'items.itemnumber',$frameworkcode);
1512         # prepare the new item record
1513         my $itemrecord = MARC::File::USMARC::decode($item->{marc});
1514         my $itemfield = $itemrecord->field($itemnumberfield);
1515         $itemfield->add_subfields($itemnumbersubfield => '$itemnumber');
1516         # parse all fields fields from the complete record
1517         foreach ($record->field($itemnumberfield)) {
1518                 # when the previous field is found, replace by the new one
1519                 if ($_->subfield($itemnumbersubfield) == $item->{itemnum}) {
1520                         $_->replace_with($itemfield);
1521                 }
1522         }
1523 #       $record->insert_grouped_field($itemfield);
1524         # save the record into biblioitem
1525         $sth=$dbh->prepare("update biblioitems set marc=?,marcxml=? where biblionumber=? and biblioitemnumber=?");
1526         $sth->execute($record->as_usmarc(),$record->as_xml(),$item->{biblionumber},$item->{biblioitemnumber});
1527         #my $Zconn = C4::Context->Zconn or die "unable to set Zconn";
1528          z3950_extended_services($Zconn,'update',set_service_options('update'),$record);
1529          # z3950_extended_services($Zconn,'commit',set_service_options('commit'));
1530          #zebra_create($item->biblionumber,$record);
1531     if ( defined $sth->errstr ) {
1532         $error .= $sth->errstr;
1533     }
1534         $dbh->do('unlock tables');
1535
1536     #  $dbh->disconnect;
1537 }
1538
1539 =head2 REALdelitem($dbh,$itemnum);
1540
1541 =over 4
1542
1543 delete item
1544
1545 =back
1546
1547 =cut
1548
1549 sub REALdelitem {
1550     my ( $dbh, $itemnum ) = @_;
1551
1552     #  my $dbh=C4Connect;
1553     my $sth = $dbh->prepare("select * from items where itemnumber=?");
1554     $sth->execute($itemnum);
1555     my $data = $sth->fetchrow_hashref;
1556     $sth->finish;
1557     my $query = "Insert into deleteditems set ";
1558     my @bind  = ();
1559     foreach my $temp ( keys %$data ) {
1560         $query .= "$temp = ?,";
1561         push ( @bind, $data->{$temp} );
1562     }
1563     $query =~ s/\,$//;
1564
1565     #  print $query;
1566     $sth = $dbh->prepare($query);
1567     $sth->execute(@bind);
1568     $sth->finish;
1569     $sth = $dbh->prepare("Delete from items where itemnumber=?");
1570     $sth->execute($itemnum);
1571     $sth->finish;
1572
1573     #  $dbh->disconnect;
1574 }
1575
1576 =head2 REALdelbiblioitem($dbh,$biblioitemnumber);
1577
1578 =over 4
1579
1580 deletes a biblioitem
1581 NOTE : not standard sub name. Should be REALdelbiblioitem()
1582
1583 =back
1584
1585 =cut
1586
1587 sub REALdelbiblioitem {
1588     my ( $dbh, $biblioitemnumber ) = @_;
1589
1590     #    my $dbh   = C4Connect;
1591     my $sth = $dbh->prepare( "Select * from biblioitems
1592 where biblioitemnumber = ?"
1593     );
1594     my $results;
1595
1596     $sth->execute($biblioitemnumber);
1597
1598     if ( $results = $sth->fetchrow_hashref ) {
1599         $sth->finish;
1600         $sth =
1601           $dbh->prepare(
1602 "Insert into deletedbiblioitems (biblioitemnumber, biblionumber, volume, number, classification, itemtype,
1603                                         isbn, issn ,dewey ,subclass ,publicationyear ,publishercode ,volumedate ,volumeddesc ,timestamp ,illus ,
1604                                         pages ,notes ,size ,url ,lccn ) values(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
1605         );
1606
1607         $sth->execute(
1608             $results->{biblioitemnumber}, $results->{biblionumber},
1609             $results->{volume},           $results->{number},
1610             $results->{classification},   $results->{itemtype},
1611             $results->{isbn},             $results->{issn},
1612             $results->{dewey},            $results->{subclass},
1613             $results->{publicationyear},  $results->{publishercode},
1614             $results->{volumedate},       $results->{volumeddesc},
1615             $results->{timestamp},        $results->{illus},
1616             $results->{pages},            $results->{notes},
1617             $results->{size},             $results->{url},
1618             $results->{lccn}
1619         );
1620         my $sth2 =
1621           $dbh->prepare("Delete from biblioitems where biblioitemnumber = ?");
1622         $sth2->execute($biblioitemnumber);
1623         $sth2->finish();
1624     }    # if
1625     $sth->finish;
1626
1627     # Now delete all the items attached to the biblioitem
1628     $sth = $dbh->prepare("Select * from items where biblioitemnumber = ?");
1629     $sth->execute($biblioitemnumber);
1630     my @results;
1631     while ( my $data = $sth->fetchrow_hashref ) {
1632         my $query = "Insert into deleteditems set ";
1633         my @bind  = ();
1634         foreach my $temp ( keys %$data ) {
1635             $query .= "$temp = ?,";
1636             push ( @bind, $data->{$temp} );
1637         }
1638         $query =~ s/\,$//;
1639         my $sth2 = $dbh->prepare($query);
1640         $sth2->execute(@bind);
1641     }    # while
1642     $sth->finish;
1643     $sth = $dbh->prepare("Delete from items where biblioitemnumber = ?");
1644     $sth->execute($biblioitemnumber);
1645     $sth->finish();
1646
1647     #    $dbh->disconnect;
1648 }    # sub deletebiblioitem
1649
1650 =head2 REALdelbiblio($dbh,$biblio);
1651
1652 =over 4
1653
1654 delete a biblio
1655
1656 =back
1657
1658 =cut
1659
1660 sub REALdelbiblio {
1661     my ( $dbh, $biblio ) = @_;
1662     my $sth = $dbh->prepare("select * from biblio where biblionumber=?");
1663     $sth->execute($biblio);
1664     if ( my $data = $sth->fetchrow_hashref ) {
1665         $sth->finish;
1666         my $query = "Insert into deletedbiblio set ";
1667         my @bind  = ();
1668         foreach my $temp ( keys %$data ) {
1669             $query .= "$temp = ?,";
1670             push ( @bind, $data->{$temp} );
1671         }
1672
1673         #replacing the last , by ",?)"
1674         $query =~ s/\,$//;
1675         $sth = $dbh->prepare($query);
1676         $sth->execute(@bind);
1677         $sth->finish;
1678         $sth = $dbh->prepare("Delete from biblio where biblionumber=?");
1679         $sth->execute($biblio);
1680         $sth->finish;
1681     }
1682     $sth->finish;
1683 }
1684
1685 =head2 $number = itemcount($biblio);
1686
1687 =over 4
1688
1689 returns the number of items attached to a biblio
1690
1691 =back
1692
1693 =cut
1694
1695 sub itemcount {
1696     my ($biblio) = @_;
1697     my $dbh = C4::Context->dbh;
1698
1699     #  print $query;
1700     my $sth = $dbh->prepare("Select count(*) from items where biblionumber=?");
1701     $sth->execute($biblio);
1702     my $data = $sth->fetchrow_hashref;
1703     $sth->finish;
1704     return ( $data->{'count(*)'} );
1705 }
1706
1707 =head2 $biblionumber = newbiblio($biblio);
1708
1709 =over 4
1710
1711 create a biblio. The parameter is a hash
1712
1713 =back
1714
1715 =cut
1716
1717 sub newbiblio {
1718     my ($biblio) = @_;
1719     my $dbh    = C4::Context->dbh;
1720     my $bibnum = REALnewbiblio( $dbh, $biblio );
1721     # finds new (MARC bibid
1722     #   my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1723 #     my $record = &MARCkoha2marcBiblio( $dbh, $bibnum );
1724 #     MARCaddbiblio( $dbh, $record, $bibnum,'' );
1725     return ($bibnum);
1726 }
1727
1728 =head2   $biblionumber = &modbiblio($biblio);
1729
1730 =over 4
1731
1732 Update a biblio record.
1733
1734 C<$biblio> is a reference-to-hash whose keys are the fields in the
1735 biblio table in the Koha database. All fields must be present, not
1736 just the ones you wish to change.
1737
1738 C<&modbiblio> updates the record defined by
1739 C<$biblio-E<gt>{biblionumber}> with the values in C<$biblio>.
1740
1741 C<&modbiblio> returns C<$biblio-E<gt>{biblionumber}> whether it was
1742 successful or not.
1743
1744 =back
1745
1746 =cut
1747
1748 sub modbiblio {
1749         my ($biblio) = @_;
1750         my $dbh  = C4::Context->dbh;
1751         my $biblionumber=REALmodbiblio($dbh,$biblio);
1752         my $record = MARCkoha2marcBiblio($dbh,$biblionumber,$biblionumber);
1753         # finds new (MARC bibid
1754         my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$biblionumber);
1755         MARCmodbiblio($dbh,$bibid,$record,"",0);
1756         return($biblionumber);
1757 } # sub modbiblio
1758
1759 =head2   &modsubtitle($biblionumber, $subtitle);
1760
1761 =over 4
1762
1763 Sets the subtitle of a book.
1764
1765 C<$biblionumber> is the biblionumber of the book to modify.
1766
1767 C<$subtitle> is the new subtitle.
1768
1769 =back
1770
1771 =cut
1772
1773 sub modsubtitle {
1774     my ( $bibnum, $subtitle ) = @_;
1775     my $dbh = C4::Context->dbh;
1776     &REALmodsubtitle( $dbh, $bibnum, $subtitle );
1777 }    # sub modsubtitle
1778
1779 =head2 &modaddauthor($biblionumber, $author);
1780
1781 =over 4
1782
1783 Replaces all additional authors for the book with biblio number
1784 C<$biblionumber> with C<$author>. If C<$author> is the empty string,
1785 C<&modaddauthor> deletes all additional authors.
1786
1787 =back
1788
1789 =cut
1790
1791 sub modaddauthor {
1792     my ( $bibnum, @authors ) = @_;
1793     my $dbh = C4::Context->dbh;
1794     &REALmodaddauthor( $dbh, $bibnum, @authors );
1795 }    # sub modaddauthor
1796
1797 =head2 $error = &modsubject($biblionumber, $force, @subjects);
1798
1799 =over 4
1800
1801 $force - a subject to force
1802 $error - Error message, or undef if successful.
1803
1804 =back
1805
1806 =cut
1807
1808 sub modsubject {
1809     my ( $bibnum, $force, @subject ) = @_;
1810     my $dbh = C4::Context->dbh;
1811     my $error = &REALmodsubject( $dbh, $bibnum, $force, @subject );
1812     if ($error eq ''){
1813                 # When MARC is off, ensures that the MARC biblio table gets updated with new
1814                 # subjects, of course, it deletes the biblio in marc, and then recreates.
1815                 # This check is to ensure that no MARC data exists to lose.
1816 #               if (C4::Context->preference("MARC") eq '0'){
1817 #               warn "in modSUBJECT";
1818 #                       my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
1819 #                       my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
1820 #                       &MARCmodbiblio($dbh,$bibid, $MARCRecord);
1821 #               }
1822         }
1823         return ($error);
1824 }    # sub modsubject
1825
1826 =head2 modbibitem($dbh, $Zconn,$biblioitem);
1827
1828 =over 4
1829
1830 modify a biblioitem. The parameter is a hash
1831
1832 =back
1833
1834 =cut
1835
1836 sub modbibitem {
1837     my ($dbh, $Zconn, $biblioitem) = @_;
1838     #my $dbh = C4::Context->dbh;
1839     &REALmodbiblioitem( $dbh, $Zconn, $biblioitem );
1840 }    # sub modbibitem
1841
1842 =head2 $biblioitemnumber = newbiblioitem($biblioitem)
1843
1844 =over 4
1845
1846 create a biblioitem, the parameter is a hash
1847
1848 =back
1849
1850 =cut
1851
1852 sub newbiblioitem {
1853     my ($dbh, $Zconn, $biblioitem) = @_;
1854     #my $dbh        = C4::Context->dbh;
1855         # add biblio information to the hash
1856     my $MARCbiblio = MARCkoha2marcBiblio( $dbh, $biblioitem );
1857         $biblioitem->{marc} = $MARCbiblio->as_usmarc();
1858     my $bibitemnum = &REALnewbiblioitem( $dbh, $Zconn, $biblioitem );
1859     return ($bibitemnum);
1860 }
1861
1862 =head2 newsubtitle($biblionumber,$subtitle);
1863
1864 =over 4
1865
1866 insert a subtitle for $biblionumber biblio
1867
1868 =back
1869
1870 =cut
1871
1872
1873 sub newsubtitle {
1874     my ( $bibnum, $subtitle ) = @_;
1875     my $dbh = C4::Context->dbh;
1876     &REALnewsubtitle( $dbh, $bibnum, $subtitle );
1877 }
1878
1879 =head2 $errors = newitems($dbh, $Zconn, $item, @barcodes);
1880
1881 =over 4
1882
1883 insert items ($item is a hash)
1884
1885 =back
1886
1887 =cut
1888
1889
1890 sub newitems {
1891     my ( $dbh, $Zconn, $item, @barcodes ) = @_;
1892     #my $dbh = C4::Context->dbh;
1893     my $errors;
1894     my $itemnumber;
1895     my $error;
1896     foreach my $barcode (@barcodes) {
1897                 # add items, one by one for each barcode.
1898                 my $oneitem=$item;
1899                 $oneitem->{barcode}= $barcode;
1900         my $MARCitem = &MARCkoha2marcItem( $dbh, $oneitem);
1901                 $oneitem->{marc} = $MARCitem->as_usmarc;
1902         ( $itemnumber, $error ) = &REALnewitems( $dbh,$Zconn,$oneitem);
1903 #         $errors .= $error;
1904 #         &MARCadditem( $dbh, $MARCitem, $item->{biblionumber} );
1905     }
1906     return ($errors);
1907 }
1908
1909 =head2 moditem($dbh,$Zconn,$item);
1910
1911 =over 4
1912
1913 modify an item ($item is a hash with all item informations)
1914
1915 =back
1916
1917 =cut
1918
1919
1920 sub moditem {
1921     my ($dbh,$Zconn,$item) = @_;
1922     #my $dbh = C4::Context->dbh;
1923     &REALmoditem( $dbh, $Zconn, $item );
1924     my $MARCitem =
1925       &MARCkoha2marcItem( $dbh, $item->{'biblionumber'}, $item->{'itemnum'} );
1926     my $bibid =
1927       &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $item->{biblionumber} );
1928     &MARCmoditem( $dbh, $MARCitem, $bibid, $item->{itemnum}, 0 );
1929 }
1930
1931 =head2 $error = checkitems($count,@barcodes);
1932
1933 =over 4
1934
1935 check for each @barcode entry that the barcode is not a duplicate
1936
1937 =back
1938
1939 =cut
1940
1941 sub checkitems {
1942     my ( $count, @barcodes ) = @_;
1943     my $dbh = C4::Context->dbh;
1944     my $error;
1945     my $sth = $dbh->prepare("Select * from items where barcode=?");
1946     for ( my $i = 0 ; $i < $count ; $i++ ) {
1947         $barcodes[$i] = uc $barcodes[$i];
1948         $sth->execute( $barcodes[$i] );
1949         if ( my $data = $sth->fetchrow_hashref ) {
1950             $error .= " Duplicate Barcode: $barcodes[$i]";
1951         }
1952     }
1953     $sth->finish;
1954     return ($error);
1955 }
1956
1957 =head2 $delitem($itemnum);
1958
1959 =over 4
1960
1961 delete item $itemnum being the item number to delete
1962
1963 =back
1964
1965 =cut
1966
1967 sub delitem {
1968     my ($itemnum) = @_;
1969     my $dbh = C4::Context->dbh;
1970     &REALdelitem( $dbh, $itemnum );
1971 }
1972
1973 =head2 deletebiblioitem($biblioitemnumber);
1974
1975 =over 4
1976
1977 delete the biblioitem $biblioitemnumber
1978
1979 =back
1980
1981 =cut
1982
1983 sub deletebiblioitem {
1984     my ($biblioitemnumber) = @_;
1985     my $dbh = C4::Context->dbh;
1986     &REALdelbiblioitem( $dbh, $biblioitemnumber );
1987 }    # sub deletebiblioitem
1988
1989 =head2 delbiblio($biblionumber)
1990
1991 =over 4
1992
1993 delete biblio $biblionumber
1994
1995 =back
1996
1997 =cut
1998
1999 sub delbiblio {
2000     my ($biblio) = @_;
2001     my $dbh = C4::Context->dbh;
2002     &REALdelbiblio( $dbh, $biblio );
2003     my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber( $dbh, $biblio );
2004     &MARCdelbiblio( $dbh, $bibid, 0 );
2005 }
2006
2007 =head2 ($count,@results) = getbiblio($biblionumber);
2008
2009 =over 4
2010
2011 return an array with hash of biblios.
2012
2013 FIXME : biblionumber being the primary key, this sub will always return only 1 result, API should be modified...
2014
2015 =back
2016
2017 =cut
2018
2019 sub getbiblio {
2020     my ($biblionumber) = @_;
2021     my $dbh = C4::Context->dbh;
2022     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
2023
2024     # || die "Cannot prepare $query\n" . $dbh->errstr;
2025     my $count = 0;
2026     my @results;
2027
2028     $sth->execute($biblionumber);
2029
2030     # || die "Cannot execute $query\n" . $sth->errstr;
2031     while ( my $data = $sth->fetchrow_hashref ) {
2032         $results[$count] = $data;
2033         $count++;
2034     }    # while
2035
2036     $sth->finish;
2037     return ( $count, @results );
2038 }    # sub getbiblio
2039
2040 =item bibdata
2041
2042   $data = &bibdata($biblionumber, $type);
2043
2044 Returns information about the book with the given biblionumber.
2045
2046 C<$type> is ignored.
2047
2048 C<&bibdata> returns a reference-to-hash. The keys are the fields in
2049 the C<biblio>, C<biblioitems>, and C<bibliosubtitle> tables in the
2050 Koha database.
2051
2052 In addition, C<$data-E<gt>{subject}> is the list of the book's
2053 subjects, separated by C<" , "> (space, comma, space).
2054
2055 If there are multiple biblioitems with the given biblionumber, only
2056 the first one is considered.
2057
2058 =cut
2059 #'
2060 sub bibdata {
2061         my ($bibnum, $type) = @_;
2062         my $dbh   = C4::Context->dbh;
2063         my $sth   = $dbh->prepare("Select *, biblioitems.notes AS bnotes, biblio.notes
2064                                                                 from biblio
2065                                                                 left join biblioitems on biblioitems.biblionumber = biblio.biblionumber
2066                                                                 left join bibliosubtitle on
2067                                                                 biblio.biblionumber = bibliosubtitle.biblionumber
2068                                                                 left join itemtypes on biblioitems.itemtype=itemtypes.itemtype
2069                                                                 where biblio.biblionumber = ?
2070                                                                 ");
2071         $sth->execute($bibnum);
2072         my $data;
2073         $data  = $sth->fetchrow_hashref;
2074         $sth->finish;
2075         # handle management of repeated subtitle
2076         $sth   = $dbh->prepare("Select * from bibliosubtitle where biblionumber = ?");
2077         $sth->execute($bibnum);
2078         my @subtitles;
2079         while (my $dat = $sth->fetchrow_hashref){
2080                 my %line;
2081                 $line{subtitle} = $dat->{subtitle};
2082                 push @subtitles, \%line;
2083         } # while
2084         $data->{subtitles} = \@subtitles;
2085         $sth->finish;
2086         $sth   = $dbh->prepare("Select * from bibliosubject where biblionumber = ?");
2087         $sth->execute($bibnum);
2088         my @subjects;
2089         while (my $dat = $sth->fetchrow_hashref){
2090                 my %line;
2091                 $line{subject} = $dat->{'subject'};
2092                 push @subjects, \%line;
2093         } # while
2094         $data->{subjects} = \@subjects;
2095         $sth->finish;
2096         $sth   = $dbh->prepare("Select * from additionalauthors where biblionumber = ?");
2097         $sth->execute($bibnum);
2098         while (my $dat = $sth->fetchrow_hashref){
2099                 $data->{'additionalauthors'} .= "$dat->{'author'} - ";
2100         } # while
2101         chop $data->{'additionalauthors'};
2102         chop $data->{'additionalauthors'};
2103         chop $data->{'additionalauthors'};
2104         $sth->finish;
2105         return($data);
2106 } # sub bibdata
2107
2108 =head2 ($count,@results) = getbiblioitem($biblioitemnumber);
2109
2110 =over 4
2111
2112 return an array with hash of biblioitemss.
2113
2114 FIXME : biblioitemnumber being unique, this sub will always return only 1 result, API should be modified...
2115
2116 =back
2117
2118 =cut
2119
2120 sub getbiblioitem {
2121     my ($biblioitemnum) = @_;
2122     my $dbh = C4::Context->dbh;
2123     my $sth = $dbh->prepare( "Select * from biblioitems where
2124 biblioitemnumber = ?"
2125     );
2126     my $count = 0;
2127     my @results;
2128
2129     $sth->execute($biblioitemnum);
2130
2131     while ( my $data = $sth->fetchrow_hashref ) {
2132         $results[$count] = $data;
2133         $count++;
2134     }    # while
2135
2136     $sth->finish;
2137     return ( $count, @results );
2138 }    # sub getbiblioitem
2139
2140 =head2 ($count,@results) = getbiblioitembybiblionumber($biblionumber);
2141
2142 =over 4
2143
2144 return an array with hash of biblioitems for the given biblionumber.
2145
2146 =back
2147
2148 =cut
2149
2150 sub getbiblioitembybiblionumber {
2151     my ($biblionumber) = @_;
2152     my $dbh = C4::Context->dbh;
2153     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
2154     my $count = 0;
2155     my @results;
2156
2157     $sth->execute($biblionumber);
2158
2159     while ( my $data = $sth->fetchrow_hashref ) {
2160         $results[$count] = $data;
2161         $count++;
2162     }    # while
2163
2164     $sth->finish;
2165     return ( $count, @results );
2166 }    # sub
2167
2168 =head2 ($count,@results) = getitemsbybiblioitem($biblionumber);
2169
2170 =over 4
2171
2172 returns an array with hash of items
2173
2174 =back
2175
2176 =cut
2177
2178 sub getitemsbybiblioitem {
2179     my ($biblioitemnum) = @_;
2180     my $dbh = C4::Context->dbh;
2181     my $sth = $dbh->prepare( "Select * from items, biblio where
2182 biblio.biblionumber = items.biblionumber and biblioitemnumber
2183 = ?"
2184     );
2185
2186     # || die "Cannot prepare $query\n" . $dbh->errstr;
2187     my $count = 0;
2188     my @results;
2189
2190     $sth->execute($biblioitemnum);
2191
2192     # || die "Cannot execute $query\n" . $sth->errstr;
2193     while ( my $data = $sth->fetchrow_hashref ) {
2194         $results[$count] = $data;
2195         $count++;
2196     }    # while
2197
2198     $sth->finish;
2199     return ( $count, @results );
2200 }    # sub getitemsbybiblioitem
2201
2202 =item ItemInfo
2203
2204   @results = &ItemInfo($env, $biblionumber, $type);
2205
2206 Returns information about books with the given biblionumber.
2207
2208 C<$type> may be either C<intra> or anything else. If it is not set to
2209 C<intra>, then the search will exclude lost, very overdue, and
2210 withdrawn items.
2211
2212 C<$env> is ignored.
2213
2214 C<&ItemInfo> returns a list of references-to-hash. Each element
2215 contains a number of keys. Most of them are table items from the
2216 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
2217 Koha database. Other keys include:
2218
2219 =over 4
2220
2221 =item C<$data-E<gt>{branchname}>
2222
2223 The name (not the code) of the branch to which the book belongs.
2224
2225 =item C<$data-E<gt>{datelastseen}>
2226
2227 This is simply C<items.datelastseen>, except that while the date is
2228 stored in YYYY-MM-DD format in the database, here it is converted to
2229 DD/MM/YYYY format. A NULL date is returned as C<//>.
2230
2231 =item C<$data-E<gt>{datedue}>
2232
2233 =item C<$data-E<gt>{class}>
2234
2235 This is the concatenation of C<biblioitems.classification>, the book's
2236 Dewey code, and C<biblioitems.subclass>.
2237
2238 =item C<$data-E<gt>{ocount}>
2239
2240 I think this is the number of copies of the book available.
2241
2242 =item C<$data-E<gt>{order}>
2243
2244 If this is set, it is set to C<One Order>.
2245
2246 =back
2247
2248 =cut
2249 #'
2250 sub ItemInfo {
2251         my ($env,$biblionumber,$type) = @_;
2252         my $dbh   = C4::Context->dbh;
2253         my $query = "SELECT *,items.notforloan as itemnotforloan FROM items, biblio, biblioitems
2254                                         left join itemtypes on biblioitems.itemtype = itemtypes.itemtype
2255                                         WHERE items.biblionumber = ?
2256                                         AND biblioitems.biblioitemnumber = items.biblioitemnumber
2257                                         AND biblio.biblionumber = items.biblionumber";
2258         $query .= " order by items.dateaccessioned desc";
2259         my $sth=$dbh->prepare($query);
2260         $sth->execute($biblionumber);
2261         my $i=0;
2262         my @results;
2263         while (my $data=$sth->fetchrow_hashref){
2264                 my $datedue = '';
2265                 my $isth=$dbh->prepare("Select issues.*,borrowers.cardnumber from issues,borrowers where itemnumber = ? and returndate is null and issues.borrowernumber=borrowers.borrowernumber");
2266                 $isth->execute($data->{'itemnumber'});
2267                 if (my $idata=$isth->fetchrow_hashref){
2268                 $data->{borrowernumber} = $idata->{borrowernumber};
2269                 $data->{cardnumber} = $idata->{cardnumber};
2270                 $datedue = format_date($idata->{'date_due'});
2271                 }
2272                 if ($datedue eq ''){
2273                         my ($restype,$reserves)=C4::Reserves2::CheckReserves($data->{'itemnumber'});
2274                         if ($restype) {
2275                                 $datedue=$restype;
2276                         }
2277                 }
2278                 $isth->finish;
2279         #get branch information.....
2280                 my $bsth=$dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
2281                 $bsth->execute($data->{'holdingbranch'});
2282                 if (my $bdata=$bsth->fetchrow_hashref){
2283                         $data->{'branchname'} = $bdata->{'branchname'};
2284                 }
2285                 my $date=format_date($data->{'datelastseen'});
2286                 $data->{'datelastseen'}=$date;
2287                 $data->{'datedue'}=$datedue;
2288         # get notforloan complete status if applicable
2289                 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield="items.notforloan"');
2290                 $sthnflstatus->execute;
2291                 my ($authorised_valuecode) = $sthnflstatus->fetchrow;
2292                 if ($authorised_valuecode) {
2293                         $sthnflstatus = $dbh->prepare("select lib from authorised_values where category=? and authorised_value=?");
2294                         $sthnflstatus->execute($authorised_valuecode,$data->{itemnotforloan});
2295                         my ($lib) = $sthnflstatus->fetchrow;
2296                         $data->{notforloan} = $lib;
2297                 }
2298                 $results[$i]=$data;
2299                 $i++;
2300         }
2301         $sth->finish;
2302         return(@results);
2303 }
2304
2305 =item bibitems
2306
2307   ($count, @results) = &bibitems($biblionumber);
2308
2309 Given the biblionumber for a book, C<&bibitems> looks up that book's
2310 biblioitems (different publications of the same book, the audio book
2311 and film versions, etc.).
2312
2313 C<$count> is the number of elements in C<@results>.
2314
2315 C<@results> is an array of references-to-hash; the keys are the fields
2316 of the C<biblioitems> and C<itemtypes> tables of the Koha database. In
2317 addition, C<itemlost> indicates the availability of the item: if it is
2318 "2", then all copies of the item are long overdue; if it is "1", then
2319 all copies are lost; otherwise, there is at least one copy available.
2320
2321 =cut
2322 #'
2323 sub bibitems {
2324     my ($bibnum) = @_;
2325     my $dbh   = C4::Context->dbh;
2326     my $sth   = $dbh->prepare("SELECT biblioitems.*,
2327                         itemtypes.*,
2328                         MIN(items.itemlost)        as itemlost,
2329                         MIN(items.dateaccessioned) as dateaccessioned
2330                           FROM biblioitems, itemtypes, items
2331                          WHERE biblioitems.biblionumber     = ?
2332                            AND biblioitems.itemtype         = itemtypes.itemtype
2333                            AND biblioitems.biblioitemnumber = items.biblioitemnumber
2334                       GROUP BY items.biblioitemnumber");
2335     my $count = 0;
2336     my @results;
2337     $sth->execute($bibnum);
2338     while (my $data = $sth->fetchrow_hashref) {
2339         $results[$count] = $data;
2340         $count++;
2341     } # while
2342     $sth->finish;
2343     return($count, @results);
2344 } # sub bibitems
2345
2346
2347 =item bibitemdata
2348
2349   $itemdata = &bibitemdata($biblioitemnumber);
2350
2351 Looks up the biblioitem with the given biblioitemnumber. Returns a
2352 reference-to-hash. The keys are the fields from the C<biblio>,
2353 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
2354 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
2355
2356 =cut
2357 #'
2358 sub bibitemdata {
2359     my ($bibitem) = @_;
2360     my $dbh   = C4::Context->dbh;
2361     my $sth   = $dbh->prepare("Select *,biblioitems.notes as bnotes from biblio, biblioitems,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype");
2362     my $data;
2363
2364     $sth->execute($bibitem);
2365
2366     $data = $sth->fetchrow_hashref;
2367
2368     $sth->finish;
2369     return($data);
2370 } # sub bibitemdata
2371
2372
2373 =item getbibliofromitemnumber
2374
2375   $item = &getbibliofromitemnumber($env, $dbh, $itemnumber);
2376
2377 Looks up the item with the given itemnumber.
2378
2379 C<$env> and C<$dbh> are ignored.
2380
2381 C<&itemnodata> returns a reference-to-hash whose keys are the fields
2382 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
2383 database.
2384
2385 =cut
2386 #'
2387 sub getbibliofromitemnumber {
2388   my ($env,$dbh,$itemnumber) = @_;
2389   $dbh = C4::Context->dbh;
2390   my $sth=$dbh->prepare("Select * from biblio,items,biblioitems
2391     where items.itemnumber = ?
2392     and biblio.biblionumber = items.biblionumber
2393     and biblioitems.biblioitemnumber = items.biblioitemnumber");
2394 #  print $query;
2395   $sth->execute($itemnumber);
2396   my $data=$sth->fetchrow_hashref;
2397   $sth->finish;
2398   return($data);
2399 }
2400
2401 =item barcodes
2402
2403   @barcodes = &barcodes($biblioitemnumber);
2404
2405 Given a biblioitemnumber, looks up the corresponding items.
2406
2407 Returns an array of references-to-hash; the keys are C<barcode> and
2408 C<itemlost>.
2409
2410 The returned items include very overdue items, but not lost ones.
2411
2412 =cut
2413 #'
2414 sub barcodes{
2415     #called from request.pl
2416     my ($biblioitemnumber)=@_;
2417     my $dbh = C4::Context->dbh;
2418     my $sth=$dbh->prepare("SELECT barcode, itemlost, holdingbranch FROM items
2419                            WHERE biblioitemnumber = ?
2420                              AND (wthdrawn <> 1 OR wthdrawn IS NULL)");
2421     $sth->execute($biblioitemnumber);
2422     my @barcodes;
2423     my $i=0;
2424     while (my $data=$sth->fetchrow_hashref){
2425         $barcodes[$i]=$data;
2426         $i++;
2427     }
2428     $sth->finish;
2429     return(@barcodes);
2430 }
2431
2432
2433 =item itemdata
2434
2435   $item = &itemdata($barcode);
2436
2437 Looks up the item with the given barcode, and returns a
2438 reference-to-hash containing information about that item. The keys of
2439 the hash are the fields from the C<items> and C<biblioitems> tables in
2440 the Koha database.
2441
2442 =cut
2443 #'
2444 sub get_item_from_barcode {
2445   my ($barcode)=@_;
2446   my $dbh = C4::Context->dbh;
2447   my $sth=$dbh->prepare("Select * from items,biblioitems where barcode=?
2448   and items.biblioitemnumber=biblioitems.biblioitemnumber");
2449   $sth->execute($barcode);
2450   my $data=$sth->fetchrow_hashref;
2451   $sth->finish;
2452   return($data);
2453 }
2454
2455
2456 =item itemissues
2457
2458   @issues = &itemissues($biblioitemnumber, $biblio);
2459
2460 Looks up information about who has borrowed the bookZ<>(s) with the
2461 given biblioitemnumber.
2462
2463 C<$biblio> is ignored.
2464
2465 C<&itemissues> returns an array of references-to-hash. The keys
2466 include the fields from the C<items> table in the Koha database.
2467 Additional keys include:
2468
2469 =over 4
2470
2471 =item C<date_due>
2472
2473 If the item is currently on loan, this gives the due date.
2474
2475 If the item is not on loan, then this is either "Available" or
2476 "Cancelled", if the item has been withdrawn.
2477
2478 =item C<card>
2479
2480 If the item is currently on loan, this gives the card number of the
2481 patron who currently has the item.
2482
2483 =item C<timestamp0>, C<timestamp1>, C<timestamp2>
2484
2485 These give the timestamp for the last three times the item was
2486 borrowed.
2487
2488 =item C<card0>, C<card1>, C<card2>
2489
2490 The card number of the last three patrons who borrowed this item.
2491
2492 =item C<borrower0>, C<borrower1>, C<borrower2>
2493
2494 The borrower number of the last three patrons who borrowed this item.
2495
2496 =back
2497
2498 =cut
2499 #'
2500 sub itemissues {
2501     my ($bibitem, $biblio)=@_;
2502     my $dbh   = C4::Context->dbh;
2503     # FIXME - If this function die()s, the script will abort, and the
2504     # user won't get anything; depending on how far the script has
2505     # gotten, the user might get a blank page. It would be much better
2506     # to at least print an error message. The easiest way to do this
2507     # is to set $SIG{__DIE__}.
2508     my $sth   = $dbh->prepare("Select * from items where
2509 items.biblioitemnumber = ?")
2510       || die $dbh->errstr;
2511     my $i     = 0;
2512     my @results;
2513
2514     $sth->execute($bibitem)
2515       || die $sth->errstr;
2516
2517     while (my $data = $sth->fetchrow_hashref) {
2518         # Find out who currently has this item.
2519         # FIXME - Wouldn't it be better to do this as a left join of
2520         # some sort? Currently, this code assumes that if
2521         # fetchrow_hashref() fails, then the book is on the shelf.
2522         # fetchrow_hashref() can fail for any number of reasons (e.g.,
2523         # database server crash), not just because no items match the
2524         # search criteria.
2525         my $sth2   = $dbh->prepare("select * from issues,borrowers
2526 where itemnumber = ?
2527 and returndate is NULL
2528 and issues.borrowernumber = borrowers.borrowernumber");
2529
2530         $sth2->execute($data->{'itemnumber'});
2531         if (my $data2 = $sth2->fetchrow_hashref) {
2532             $data->{'date_due'} = $data2->{'date_due'};
2533             $data->{'card'}     = $data2->{'cardnumber'};
2534             $data->{'borrower'}     = $data2->{'borrowernumber'};
2535         } else {
2536             if ($data->{'wthdrawn'} eq '1') {
2537                 $data->{'date_due'} = 'Cancelled';
2538             } else {
2539                 $data->{'date_due'} = 'Available';
2540             } # else
2541         } # else
2542
2543         $sth2->finish;
2544
2545         # Find the last 3 people who borrowed this item.
2546         $sth2 = $dbh->prepare("select * from issues, borrowers
2547                                                 where itemnumber = ?
2548                                                                         and issues.borrowernumber = borrowers.borrowernumber
2549                                                                         and returndate is not NULL
2550                                                                         order by returndate desc,timestamp desc") || die $dbh->errstr;
2551         $sth2->execute($data->{'itemnumber'}) || die $sth2->errstr;
2552         for (my $i2 = 0; $i2 < 2; $i2++) { # FIXME : error if there is less than 3 pple borrowing this item
2553             if (my $data2 = $sth2->fetchrow_hashref) {
2554                 $data->{"timestamp$i2"} = $data2->{'timestamp'};
2555                 $data->{"card$i2"}      = $data2->{'cardnumber'};
2556                 $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
2557             } # if
2558         } # for
2559
2560         $sth2->finish;
2561         $results[$i] = $data;
2562         $i++;
2563     }
2564
2565     $sth->finish;
2566     return(@results);
2567 }
2568
2569 =item getsubject
2570
2571   ($count, $subjects) = &getsubject($biblionumber);
2572
2573 Looks up the subjects of the book with the given biblionumber. Returns
2574 a two-element list. C<$subjects> is a reference-to-array, where each
2575 element is a subject of the book, and C<$count> is the number of
2576 elements in C<$subjects>.
2577
2578 =cut
2579 #'
2580 sub getsubject {
2581   my ($bibnum)=@_;
2582   my $dbh = C4::Context->dbh;
2583   my $sth=$dbh->prepare("Select * from bibliosubject where biblionumber=?");
2584   $sth->execute($bibnum);
2585   my @results;
2586   my $i=0;
2587   while (my $data=$sth->fetchrow_hashref){
2588     $results[$i]=$data;
2589     $i++;
2590   }
2591   $sth->finish;
2592   return($i,\@results);
2593 }
2594
2595 =item getaddauthor
2596
2597   ($count, $authors) = &getaddauthor($biblionumber);
2598
2599 Looks up the additional authors for the book with the given
2600 biblionumber.
2601
2602 Returns a two-element list. C<$authors> is a reference-to-array, where
2603 each element is an additional author, and C<$count> is the number of
2604 elements in C<$authors>.
2605
2606 =cut
2607 #'
2608 sub getaddauthor {
2609   my ($bibnum)=@_;
2610   my $dbh = C4::Context->dbh;
2611   my $sth=$dbh->prepare("Select * from additionalauthors where biblionumber=?");
2612   $sth->execute($bibnum);
2613   my @results;
2614   my $i=0;
2615   while (my $data=$sth->fetchrow_hashref){
2616     $results[$i]=$data;
2617     $i++;
2618   }
2619   $sth->finish;
2620   return($i,\@results);
2621 }
2622
2623
2624 =item getsubtitle
2625
2626   ($count, $subtitles) = &getsubtitle($biblionumber);
2627
2628 Looks up the subtitles for the book with the given biblionumber.
2629
2630 Returns a two-element list. C<$subtitles> is a reference-to-array,
2631 where each element is a subtitle, and C<$count> is the number of
2632 elements in C<$subtitles>.
2633
2634 =cut
2635 #'
2636 sub getsubtitle {
2637   my ($bibnum)=@_;
2638   my $dbh = C4::Context->dbh;
2639   my $sth=$dbh->prepare("Select * from bibliosubtitle where biblionumber=?");
2640   $sth->execute($bibnum);
2641   my @results;
2642   my $i=0;
2643   while (my $data=$sth->fetchrow_hashref){
2644     $results[$i]=$data;
2645     $i++;
2646   }
2647   $sth->finish;
2648   return($i,\@results);
2649 }
2650
2651
2652 =item getwebsites
2653
2654   ($count, @websites) = &getwebsites($biblionumber);
2655
2656 Looks up the web sites pertaining to the book with the given
2657 biblionumber.
2658
2659 C<$count> is the number of elements in C<@websites>.
2660
2661 C<@websites> is an array of references-to-hash; the keys are the
2662 fields from the C<websites> table in the Koha database.
2663
2664 =cut
2665 #FIXME : could maybe be deleted. Otherwise, would be better in a Websites.pm package
2666 #(with add / modify / delete subs)
2667
2668 sub getwebsites {
2669     my ($biblionumber) = @_;
2670     my $dbh   = C4::Context->dbh;
2671     my $sth   = $dbh->prepare("Select * from websites where biblionumber = ?");
2672     my $count = 0;
2673     my @results;
2674
2675     $sth->execute($biblionumber);
2676     while (my $data = $sth->fetchrow_hashref) {
2677         # FIXME - The URL scheme shouldn't be stripped off, at least
2678         # not here, since it's part of the URL, and will be useful in
2679         # constructing a link to the site. If you don't want the user
2680         # to see the "http://" part, strip that off when building the
2681         # HTML code.
2682         $data->{'url'} =~ s/^http:\/\///;       # FIXME - Leaning toothpick
2683                                                 # syndrome
2684         $results[$count] = $data;
2685         $count++;
2686     } # while
2687
2688     $sth->finish;
2689     return($count, @results);
2690 } # sub getwebsites
2691
2692 =item getwebbiblioitems
2693
2694   ($count, @results) = &getwebbiblioitems($biblionumber);
2695
2696 Given a book's biblionumber, looks up the web versions of the book
2697 (biblioitems with itemtype C<WEB>).
2698
2699 C<$count> is the number of items in C<@results>. C<@results> is an
2700 array of references-to-hash; the keys are the items from the
2701 C<biblioitems> table of the Koha database.
2702
2703 =cut
2704 #'
2705 sub getwebbiblioitems {
2706     my ($biblionumber) = @_;
2707     my $dbh   = C4::Context->dbh;
2708     my $sth   = $dbh->prepare("Select * from biblioitems where biblionumber = ?
2709 and itemtype = 'WEB'");
2710     my $count = 0;
2711     my @results;
2712
2713     $sth->execute($biblionumber);
2714     while (my $data = $sth->fetchrow_hashref) {
2715         $data->{'url'} =~ s/^http:\/\///;
2716         $results[$count] = $data;
2717         $count++;
2718     } # while
2719
2720     $sth->finish;
2721     return($count, @results);
2722 } # sub getwebbiblioitems
2723
2724 sub char_decode {
2725
2726     # converts ISO 5426 coded string to ISO 8859-1
2727     # sloppy code : should be improved in next issue
2728     my ( $string, $encoding ) = @_;
2729     $_ = $string;
2730
2731     #   $encoding = C4::Context->preference("marcflavour") unless $encoding;
2732     if ( $encoding eq "UNIMARC" ) {
2733 #         s/\xe1/Æ/gm;
2734         s/\xe2/Ð/gm;
2735         s/\xe9/Ø/gm;
2736         s/\xec/þ/gm;
2737         s/\xf1/æ/gm;
2738         s/\xf3/ð/gm;
2739         s/\xf9/ø/gm;
2740         s/\xfb/ß/gm;
2741         s/\xc1\x61/à/gm;
2742         s/\xc1\x65/è/gm;
2743         s/\xc1\x69/ì/gm;
2744         s/\xc1\x6f/ò/gm;
2745         s/\xc1\x75/ù/gm;
2746         s/\xc1\x41/À/gm;
2747         s/\xc1\x45/È/gm;
2748         s/\xc1\x49/Ì/gm;
2749         s/\xc1\x4f/Ò/gm;
2750         s/\xc1\x55/Ù/gm;
2751         s/\xc2\x41/Á/gm;
2752         s/\xc2\x45/É/gm;
2753         s/\xc2\x49/Í/gm;
2754         s/\xc2\x4f/Ó/gm;
2755         s/\xc2\x55/Ú/gm;
2756         s/\xc2\x59/Ý/gm;
2757         s/\xc2\x61/á/gm;
2758         s/\xc2\x65/é/gm;
2759         s/\xc2\x69/í/gm;
2760         s/\xc2\x6f/ó/gm;
2761         s/\xc2\x75/ú/gm;
2762         s/\xc2\x79/ý/gm;
2763         s/\xc3\x41/Â/gm;
2764         s/\xc3\x45/Ê/gm;
2765         s/\xc3\x49/Î/gm;
2766         s/\xc3\x4f/Ô/gm;
2767         s/\xc3\x55/Û/gm;
2768         s/\xc3\x61/â/gm;
2769         s/\xc3\x65/ê/gm;
2770         s/\xc3\x69/î/gm;
2771         s/\xc3\x6f/ô/gm;
2772         s/\xc3\x75/û/gm;
2773         s/\xc4\x41/Ã/gm;
2774         s/\xc4\x4e/Ñ/gm;
2775         s/\xc4\x4f/Õ/gm;
2776         s/\xc4\x61/ã/gm;
2777         s/\xc4\x6e/ñ/gm;
2778         s/\xc4\x6f/õ/gm;
2779         s/\xc8\x41/Ä/gm;
2780         s/\xc8\x45/Ë/gm;
2781         s/\xc8\x49/Ï/gm;
2782         s/\xc8\x61/ä/gm;
2783         s/\xc8\x65/ë/gm;
2784         s/\xc8\x69/ï/gm;
2785         s/\xc8\x6F/ö/gm;
2786         s/\xc8\x75/ü/gm;
2787         s/\xc8\x76/ÿ/gm;
2788         s/\xc9\x41/Ä/gm;
2789         s/\xc9\x45/Ë/gm;
2790         s/\xc9\x49/Ï/gm;
2791         s/\xc9\x4f/Ö/gm;
2792         s/\xc9\x55/Ü/gm;
2793         s/\xc9\x61/ä/gm;
2794         s/\xc9\x6f/ö/gm;
2795         s/\xc9\x75/ü/gm;
2796         s/\xca\x41/Å/gm;
2797         s/\xca\x61/å/gm;
2798         s/\xd0\x43/Ç/gm;
2799         s/\xd0\x63/ç/gm;
2800
2801         # this handles non-sorting blocks (if implementation requires this)
2802         $string = nsb_clean($_);
2803     }
2804     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2805         if (/[\xc1-\xff]/) {
2806             s/\xe1\x61/à/gm;
2807             s/\xe1\x65/è/gm;
2808             s/\xe1\x69/ì/gm;
2809             s/\xe1\x6f/ò/gm;
2810             s/\xe1\x75/ù/gm;
2811             s/\xe1\x41/À/gm;
2812             s/\xe1\x45/È/gm;
2813             s/\xe1\x49/Ì/gm;
2814             s/\xe1\x4f/Ò/gm;
2815             s/\xe1\x55/Ù/gm;
2816             s/\xe2\x41/Á/gm;
2817             s/\xe2\x45/É/gm;
2818             s/\xe2\x49/Í/gm;
2819             s/\xe2\x4f/Ó/gm;
2820             s/\xe2\x55/Ú/gm;
2821             s/\xe2\x59/Ý/gm;
2822             s/\xe2\x61/á/gm;
2823             s/\xe2\x65/é/gm;
2824             s/\xe2\x69/í/gm;
2825             s/\xe2\x6f/ó/gm;
2826             s/\xe2\x75/ú/gm;
2827             s/\xe2\x79/ý/gm;
2828             s/\xe3\x41/Â/gm;
2829             s/\xe3\x45/Ê/gm;
2830             s/\xe3\x49/Î/gm;
2831             s/\xe3\x4f/Ô/gm;
2832             s/\xe3\x55/Û/gm;
2833             s/\xe3\x61/â/gm;
2834             s/\xe3\x65/ê/gm;
2835             s/\xe3\x69/î/gm;
2836             s/\xe3\x6f/ô/gm;
2837             s/\xe3\x75/û/gm;
2838             s/\xe4\x41/Ã/gm;
2839             s/\xe4\x4e/Ñ/gm;
2840             s/\xe4\x4f/Õ/gm;
2841             s/\xe4\x61/ã/gm;
2842             s/\xe4\x6e/ñ/gm;
2843             s/\xe4\x6f/õ/gm;
2844             s/\xe8\x45/Ë/gm;
2845             s/\xe8\x49/Ï/gm;
2846             s/\xe8\x65/ë/gm;
2847             s/\xe8\x69/ï/gm;
2848             s/\xe8\x76/ÿ/gm;
2849             s/\xe9\x41/Ä/gm;
2850             s/\xe9\x4f/Ö/gm;
2851             s/\xe9\x55/Ü/gm;
2852             s/\xe9\x61/ä/gm;
2853             s/\xe9\x6f/ö/gm;
2854             s/\xe9\x75/ü/gm;
2855             s/\xea\x41/Å/gm;
2856             s/\xea\x61/å/gm;
2857
2858             # this handles non-sorting blocks (if implementation requires this)
2859             $string = nsb_clean($_);
2860         }
2861     }
2862     return ($string);
2863 }
2864
2865 sub nsb_clean {
2866     my $NSB = '\x88';    # NSB : begin Non Sorting Block
2867     my $NSE = '\x89';    # NSE : Non Sorting Block end
2868                          # handles non sorting blocks
2869     my ($string) = @_;
2870     $_ = $string;
2871     s/$NSB/(/gm;
2872     s/[ ]{0,1}$NSE/) /gm;
2873     $string = $_;
2874     return ($string);
2875 }
2876
2877 sub FindDuplicate {
2878         my ($record)=@_;
2879         my $dbh = C4::Context->dbh;
2880         my $result = MARCmarc2koha($dbh,$record,'');
2881         my $sth;
2882         my ($biblionumber,$bibid,$title);
2883         # search duplicate on ISBN, easy and fast...
2884         if ($result->{isbn}) {
2885                 $sth = $dbh->prepare("select biblio.biblionumber,bibid,title from biblio,biblioitems,marc_biblio where biblio.biblionumber=biblioitems.biblionumber and marc_biblio.biblionumber=biblioitems.biblionumber and isbn=?");
2886                 $sth->execute($result->{'isbn'});
2887                 ($biblionumber,$bibid,$title) = $sth->fetchrow;
2888                 return $biblionumber,$bibid,$title if ($biblionumber);
2889         }
2890         # a more complex search : build a request for SearchMarc::catalogsearch()
2891         my (@tags, @and_or, @excluding, @operator, @value, $offset,$length);
2892         # search on biblio.title
2893         my ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.title","");
2894         if ($record->field($tag)) {
2895                 if ($record->field($tag)->subfields($subfield)) {
2896                         push @tags, "'".$tag.$subfield."'";
2897                         push @and_or, "and";
2898                         push @excluding, "";
2899                         push @operator, "contains";
2900                         push @value, $record->field($tag)->subfield($subfield);
2901 #                       warn "for title, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2902                 }
2903         }
2904         # ... and on biblio.author
2905         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblio.author","");
2906         if ($record->field($tag)) {
2907                 if ($record->field($tag)->subfields($subfield)) {
2908                         push @tags, "'".$tag.$subfield."'";
2909                         push @and_or, "and";
2910                         push @excluding, "";
2911                         push @operator, "contains";
2912                         push @value, $record->field($tag)->subfield($subfield);
2913 #                       warn "for author, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2914                 }
2915         }
2916         # ... and on publicationyear.
2917         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publicationyear","");
2918         if ($record->field($tag)) {
2919                 if ($record->field($tag)->subfields($subfield)) {
2920                         push @tags, "'".$tag.$subfield."'";
2921                         push @and_or, "and";
2922                         push @excluding, "";
2923                         push @operator, "=";
2924                         push @value, $record->field($tag)->subfield($subfield);
2925 #                       warn "for publicationyear, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2926                 }
2927         }
2928         # ... and on size.
2929         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.size","");
2930         if ($record->field($tag)) {
2931                 if ($record->field($tag)->subfields($subfield)) {
2932                         push @tags, "'".$tag.$subfield."'";
2933                         push @and_or, "and";
2934                         push @excluding, "";
2935                         push @operator, "=";
2936                         push @value, $record->field($tag)->subfield($subfield);
2937 #                       warn "for size, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2938                 }
2939         }
2940         # ... and on publisher.
2941         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.publishercode","");
2942         if ($record->field($tag)) {
2943                 if ($record->field($tag)->subfields($subfield)) {
2944                         push @tags, "'".$tag.$subfield."'";
2945                         push @and_or, "and";
2946                         push @excluding, "";
2947                         push @operator, "=";
2948                         push @value, $record->field($tag)->subfield($subfield);
2949 #                       warn "for publishercode, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2950                 }
2951         }
2952         # ... and on volume.
2953         ($tag,$subfield) = MARCfind_marc_from_kohafield($dbh,"biblioitems.volume","");
2954         if ($record->field($tag)) {
2955                 if ($record->field($tag)->subfields($subfield)) {
2956                         push @tags, "'".$tag.$subfield."'";
2957                         push @and_or, "and";
2958                         push @excluding, "";
2959                         push @operator, "=";
2960                         push @value, $record->field($tag)->subfield($subfield);
2961 #                       warn "for volume, I add $tag / $subfield".$record->field($tag)->subfield($subfield);
2962                 }
2963         }
2964
2965         my ($finalresult,$nbresult) = C4::SearchMarc::catalogsearch($dbh,\@tags,\@and_or,\@excluding,\@operator,\@value,0,10);
2966         # there is at least 1 result => return the 1st one
2967         if ($nbresult) {
2968 #               warn "$nbresult => ".@$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2969                 return @$finalresult[0]->{biblionumber},@$finalresult[0]->{bibid},@$finalresult[0]->{title};
2970         }
2971         # no result, returns nothing
2972         return;
2973 }
2974
2975 sub DisplayISBN {
2976         my ($isbn)=@_;
2977         my $seg1;
2978         if(substr($isbn, 0, 1) <=7) {
2979                 $seg1 = substr($isbn, 0, 1);
2980         } elsif(substr($isbn, 0, 2) <= 94) {
2981                 $seg1 = substr($isbn, 0, 2);
2982         } elsif(substr($isbn, 0, 3) <= 995) {
2983                 $seg1 = substr($isbn, 0, 3);
2984         } elsif(substr($isbn, 0, 4) <= 9989) {
2985                 $seg1 = substr($isbn, 0, 4);
2986         } else {
2987                 $seg1 = substr($isbn, 0, 5);
2988         }
2989         my $x = substr($isbn, length($seg1));
2990         my $seg2;
2991         if(substr($x, 0, 2) <= 19) {
2992 #               if(sTmp2 < 10) sTmp2 = "0" sTmp2;
2993                 $seg2 = substr($x, 0, 2);
2994         } elsif(substr($x, 0, 3) <= 699) {
2995                 $seg2 = substr($x, 0, 3);
2996         } elsif(substr($x, 0, 4) <= 8399) {
2997                 $seg2 = substr($x, 0, 4);
2998         } elsif(substr($x, 0, 5) <= 89999) {
2999                 $seg2 = substr($x, 0, 5);
3000         } elsif(substr($x, 0, 6) <= 9499999) {
3001                 $seg2 = substr($x, 0, 6);
3002         } else {
3003                 $seg2 = substr($x, 0, 7);
3004         }
3005         my $seg3=substr($x,length($seg2));
3006         $seg3=substr($seg3,0,length($seg3)-1) ;
3007         my $seg4 = substr($x, -1, 1);
3008         return "$seg1-$seg2-$seg3-$seg4";
3009 }
3010
3011
3012 END { }    # module clean-up code here (global destructor)
3013
3014 =back
3015
3016 =head1 AUTHOR
3017
3018 Koha Developement team <info@koha.org>
3019
3020 Paul POULAIN paul.poulain@free.fr
3021
3022 =cut
3023
3024 # $Id$
3025 # $Log$
3026 # Revision 1.148  2006/02/25 19:23:01  kados
3027 # cleaning up POD docs, deleting zebra_create as it's no longer used (
3028 # replaced by z3950_extended_services).
3029 #
3030 # Revision 1.147  2006/02/25 19:09:59  kados
3031 # readding some lost subs
3032 #
3033 # Revision 1.145  2006/02/22 01:02:39  kados
3034 # Replacing all calls to zebra_update with calls to
3035 # z3950_extended_services. More work coming, but it's
3036 # working now.
3037 #
3038 # Revision 1.144  2006/02/20 14:22:38  kados
3039 # typo
3040 #
3041 # Revision 1.143  2006/02/20 13:26:11  kados
3042 # A new subroutine to handle Z39.50 extended services. You pass it a
3043 # connection object, service type, service options, and a record, and
3044 # it performs the service and handles any exception found.
3045 #
3046 # Revision 1.142  2006/02/16 20:49:56  kados
3047 # destroy a connection after we're done -- we really should just have one
3048 # connection object and not destroy it until the whole transaction is
3049 # finished -- but this will do for now
3050 #
3051 # Revision 1.141  2006/02/16 19:47:22  rangi
3052 # Trying to error trap a little more.
3053 #
3054 # Revision 1.140  2006/02/14 21:36:03  kados
3055 # adding a 'use ZOOM' to biblio.pm, needed for non-mod_perl install.
3056 # also adding diagnostic error if not able to connect to Zebra
3057 #
3058 # Revision 1.139  2006/02/14 19:53:25  rangi
3059 # Just a little missing my
3060 #
3061 # Seems to be working great Paul, and I like what you did with zebradb
3062 #
3063 # Revision 1.138  2006/02/14 11:25:22  tipaul
3064 # road to 3.0 : updating a biblio in zebra seems to work. Still working on it, there are probably some bugs !
3065 #
3066 # Revision 1.137  2006/02/13 16:34:26  tipaul
3067 # fixing some warnings (perl -w should be quiet)
3068 #
3069 # Revision 1.136  2006/01/10 17:01:29  tipaul
3070 # adding a XMLgetbiblio in Biblio.pm (1st draft, to use with zebra)
3071 #
3072 # Revision 1.135  2006/01/06 16:39:37  tipaul
3073 # synch'ing head and rel_2_2 (from 2.2.5, including npl templates)
3074 # Seems not to break too many things, but i'm probably wrong here.
3075 # at least, new features/bugfixes from 2.2.5 are here (tested on some features on my head local copy)
3076 #
3077 # - removing useless directories (koha-html and koha-plucene)
3078 #
3079 # Revision 1.134  2006/01/04 15:54:55  tipaul
3080 # utf8 is a : go for beta test in HEAD.
3081 # some explanations :
3082 # - updater/updatedatabase => will transform all tables in innoDB (not related to utf8, just to warn you) AND collate them in utf8 / utf8_general_ci. The SQL command is : ALTER TABLE tablename DEFAULT CHARACTER SET utf8 COLLATE utf8_general_ci.
3083 # - *-top.inc will show the pages in utf8
3084 # - THE HARD THING : for me, mysql-client and mysql-server were set up to communicate in iso8859-1, whatever the mysql collation ! Thus, pages were improperly shown, as datas were transmitted in iso8859-1 format ! After a full day of investigation, someone on usenet pointed "set NAMES 'utf8'" to explain that I wanted utf8. I could put this in my.cnf, but if I do that, ALL databases will "speak" in utf8, that's not what we want. Thus, I added a line in Context.pm : everytime a DB handle is opened, the communication is set to utf8.
3085 # - using marcxml field and no more the iso2709 raw marc biblioitems.marc field.
3086 #
3087 # Revision 1.133  2005/12/12 14:25:51  thd
3088 #
3089 #
3090 # Reverse array filled with elements from repeated subfields
3091 # to avoid last to first concatenation of elements in Koha DB.-
3092 #
3093 # Revision 1.132  2005-10-26 09:12:33  tipaul
3094 # big commit, still breaking things...
3095 #
3096 # * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
3097 # * code cleaning (cleaning warnings from perl -w) continued
3098 #
3099 # Revision 1.131  2005/09/22 10:01:45  tipaul
3100 # see mail on koha-devel : code cleaning on Search.pm + normalizing API + use of biblionumber everywhere (instead of bn, biblio, ...)
3101 #
3102 # Revision 1.130  2005/09/02 14:34:14  tipaul
3103 # continuing the work to move to zebra. Begin of work for MARC=OFF support.
3104 # IMPORTANT NOTE : the MARCkoha2marc sub API has been modified. Instead of biblionumber & biblioitemnumber, it now gets a hash.
3105 # The sub is used only in Biblio.pm, so the API change should be harmless (except for me, but i'm aware ;-) )
3106 #
3107 # Revision 1.129  2005/08/12 13:50:31  tipaul
3108 # removing useless sub declarations
3109 #
3110 # Revision 1.128  2005/08/11 16:12:47  tipaul
3111 # Playing with the zebra...
3112 #
3113 # * go to koha cvs home directory
3114 # * in misc/zebra there is a unimarc directory. I suggest that marc21 libraries create a marc21 directory
3115 # * put your zebra.cfg files here & create your database.
3116 # * from koha cvs home directory, ln -s misc/zebra/marc21 zebra (I mean create a symbolic link to YOUR zebra directory)
3117 # * now, everytime you add/modify a biblio/item your zebra DB is updated correctly.
3118 #
3119 # NOTE :
3120 # * this uses a system call in perl. CPU consumming, but we are waiting for indexdata Perl/zoom
3121 # * deletion still not work
3122 # * UNIMARC zebra config files are provided in misc/zebra/unimarc directory. The most important line being :
3123 # in zebra.cfg :
3124 # recordId: (bib1,Local-number)
3125 # storeKeys:1
3126 #
3127 # in .abs file :
3128 # elm 090            Local-number            -
3129 # elm 090/?          Local-number            -
3130 # elm 090/?/9        Local-number            !:w
3131 #
3132 # (090$9 being the field mapped to biblio.biblionumber in Koha)
3133 #
3134 # Revision 1.127  2005/08/11 14:37:32  tipaul
3135 # * POD documenting
3136 # * removing useless subs
3137 # * removing some subs that are also elsewhere
3138 # * renaming all OLDxxx subs to REALxxx subs (should not change anything, as OLDxxx, as well as REAL, are supposed to be for Biblio.pm internal use only)
3139 #
3140 # Revision 1.126  2005/08/11 09:13:28  tipaul
3141 # just removing useless subs (a lot !!!) for code cleaning
3142 #
3143 # Revision 1.125  2005/08/11 09:00:07  tipaul
3144 # Ok guys, this time, it seems that item add and modif begin working as expected...
3145 # Still a lot of bugs to fix, of course
3146 #
3147 # Revision 1.124  2005/08/10 10:21:15  tipaul
3148 # continuing the road to zebra :
3149 # - the biblio add begins to work.
3150 # - the biblio modif begins to work.
3151 #
3152 # (still without doing anything on zebra)
3153 # (no new change in updatedatabase)
3154 #
3155 # Revision 1.123  2005/08/09 14:10:28  tipaul
3156 # 1st commit to go to zebra.
3157 # don't update your cvs if you want to have a working head...
3158 #
3159 # this commit contains :
3160 # * updater/updatedatabase : get rid with marc_* tables, but DON'T remove them. As a lot of things uses them, it would not be a good idea for instance to drop them. If you really want to play, you can rename them to test head without them but being still able to reintroduce them...
3161 # * Biblio.pm : modify MARCgetbiblio to find the raw marc record in biblioitems.marc field, not from marc_subfield_table, modify MARCfindframeworkcode to find frameworkcode in biblio.frameworkcode, modify some other subs to use biblio.biblionumber & get rid of bibid.
3162 # * other files : get rid of bibid and use biblionumber instead.
3163 #
3164 # What is broken :
3165 # * does not do anything on zebra yet.
3166 # * if you rename marc_subfield_table, you can't search anymore.
3167 # * you can view a biblio & bibliodetails, go to MARC editor, but NOT save any modif.
3168 # * don't try to add a biblio, it would add data poorly... (don't try to delete either, it may work, but that would be a surprise ;-) )
3169 #
3170 # IMPORTANT NOTE : you need MARC::XML package (http://search.cpan.org/~esummers/MARC-XML-0.7/lib/MARC/File/XML.pm), that requires a recent version of MARC::Record
3171 # Updatedatabase stores the iso2709 data in biblioitems.marc field & an xml version in biblioitems.marcxml Not sure we will keep it when releasing the stable version, but I think it's a good idea to have something readable in sql, at least for development stage.
3172
3173 # tipaul cutted previous commit notes