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
  22 require Exporter;
  23 # use utf8;
  24 use C4::Context;
  25 use MARC::Record;
  26 use MARC::File::USMARC;
  27 use MARC::File::XML;
  28 use ZOOM;
  29 use C4::Koha;
  30 use C4::Branch;
  31 use C4::Dates qw/format_date/;
  32 use C4::Log; # logaction
  33 use C4::ClassSource;
  34 use vars qw($VERSION @ISA @EXPORT);
  35
  36 # TODO: fix version
  37 # $VERSION = ?;
  38
  39 @ISA = qw( Exporter );
  40
  41 # EXPORTED FUNCTIONS.
  42
  43 # to add biblios or items
  44 push @EXPORT, qw( &AddBiblio &AddBiblioAndItems );
  45
  46 # to get something
  47 push @EXPORT, qw(
  48   &GetBiblio
  49   &GetBiblioData
  50   &GetBiblioItemData
  51   &GetBiblioItemInfosOf
  52   &GetBiblioItemByBiblioNumber
  53   &GetBiblioFromItemNumber
  54
  55   &GetMarcItem
  56   &GetItem
  57   &GetItemInfosOf
  58   &GetItemStatus
  59   &GetItemLocation
  60   &GetLostItems
  61   &GetItemsForInventory
  62   &GetItemsCount
  63
  64   &GetMarcNotes
  65   &GetMarcSubjects
  66   &GetMarcBiblio
  67   &GetMarcAuthors
  68   &GetMarcSeries
  69   GetMarcUrls
  70   &GetUsedMarcStructure
  71
  72   &GetItemsInfo
  73   &GetItemsByBiblioitemnumber
  74   &GetItemnumberFromBarcode
  75   &get_itemnumbers_of
  76   &GetXmlBiblio
  77
  78   &GetAuthorisedValueDesc
  79   &GetMarcStructure
  80   &GetMarcFromKohaField
  81   &GetFrameworkCode
  82   &GetPublisherNameFromIsbn
  83   &TransformKohaToMarc
  84 );
  85
  86 # To modify something
  87 push @EXPORT, qw(
  88   &ModBiblio
  89   &ModBiblioframework
  90   &ModZebra
  91 );
  92
  93 # To delete something
  94 push @EXPORT, qw(
  95   &DelBiblio
  96   &DelItem
  97 );
  98
  99 # Internal functions
 100 # those functions are exported but should not be used
 101 # they are usefull is few circumstances, so are exported.
 102 # but don't use them unless you're a core developer ;-)
 103 push @EXPORT, qw(
 104   &ModBiblioMarc
 105 );
 106
 107 # Others functions
 108 push @EXPORT, qw(
 109   &TransformMarcToKoha
 110   &TransformHtmlToMarc2
 111   &TransformHtmlToMarc
 112   &TransformHtmlToXml
 113   &PrepareItemrecordDisplay
 114   &char_decode
 115   &GetNoZebraIndexes
 116 );
 117
 118 =head1 NAME
 119
 120 C4::Biblio - cataloging management functions
 121
 122 =head1 DESCRIPTION
 123
 124 Biblio.pm contains functions for managing storage and editing of bibliographic data within Koha. Most of the functions in this module are used for cataloging records: adding, editing, or removing biblios, biblioitems, or items. Koha's stores bibliographic information in three places:
 125
 126 =over 4
 127
 128 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
 129
 130 =item 2. as raw MARC in the Zebra index and storage engine
 131
 132 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
 133
 134 =back
 135
 136 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
 137
 138 Because the data isn't completely normalized there's a chance for information to get out of sync. The design choice to go with a un-normalized schema was driven by performance and stability concerns. However, if this occur, it can be considered as a bug : The API is (or should be) complete & the only entry point for all biblio/items managements.
 139
 140 =over 4
 141
 142 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
 143
 144 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
 145
 146 =back
 147
 148 Because of this design choice, the process of managing storage and editing is a bit convoluted. Historically, Biblio.pm's grown to an unmanagable size and as a result we have several types of functions currently:
 149
 150 =over 4
 151
 152 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
 153
 154 =item 2. _koha_* - low-level internal functions for managing the koha tables
 155
 156 =item 3. Marc management function : as the MARC record is stored in biblioitems.marc(xml), some subs dedicated to it's management are in this package. They should be used only internally by Biblio.pm, the only official entry points being AddBiblio, AddItem, ModBiblio, ModItem.
 157
 158 =item 4. Zebra functions used to update the Zebra index
 159
 160 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
 161
 162 =back
 163
 164 The MARC record (in biblioitems.marcxml) contains the complete marc record, including items. It also contains the biblionumber. That is the reason why it is not stored directly by AddBiblio, with all other fields . To save a biblio, we need to :
 165
 166 =over 4
 167
 168 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
 169
 170 =item 2. add the biblionumber and biblioitemnumber into the MARC records
 171
 172 =item 3. save the marc record
 173
 174 =back
 175
 176 When dealing with items, we must :
 177
 178 =over 4
 179
 180 =item 1. save the item in items table, that gives us an itemnumber
 181
 182 =item 2. add the itemnumber to the item MARC field
 183
 184 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
 185
 186 When modifying a biblio or an item, the behaviour is quite similar.
 187
 188 =back
 189
 190 =head1 EXPORTED FUNCTIONS
 191
 192 =head2 AddBiblio
 193
 194 =over 4
 195
 196 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
 197 Exported function (core API) for adding a new biblio to koha.
 198
 199 =back
 200
 201 =cut
 202
 203 sub AddBiblio {
 204     my ( $record, $frameworkcode ) = @_;
 205     my ($biblionumber,$biblioitemnumber,$error);
 206     my $dbh = C4::Context->dbh;
 207     # transform the data into koha-table style data
 208     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 209     ($biblionumber,$error) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
 210     $olddata->{'biblionumber'} = $biblionumber;
 211     ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $olddata );
 212
 213     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 214
 215     # now add the record
 216     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 217
 218     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
 219         if C4::Context->preference("CataloguingLog");
 220
 221     return ( $biblionumber, $biblioitemnumber );
 222 }
 223
 224 =head2 AddBiblioAndItems
 225
 226 =over 4
 227
 228 ($biblionumber,$biblioitemnumber, $itemnumber_ref, $error_ref) = AddBiblioAndItems($record, $frameworkcode);
 229
 230 =back
 231
 232 Efficiently add a biblio record and create item records from its
 233 embedded item fields.  This routine is suitable for batch jobs.
 234
 235 The goal of this API is to have a similar effect to using AddBiblio
 236 and AddItems in succession, but without inefficient repeated
 237 parsing of the MARC XML bib record.
 238
 239 One functional difference is that the duplicate item barcode
 240 check is implemented in this API, instead of relying on
 241 the caller to do it, like AddItem does.
 242
 243 This function returns the biblionumber and biblioitemnumber of the
 244 new bib, an arrayref of new itemsnumbers, and an arrayref of item
 245 errors encountered during the processing.  Each entry in the errors
 246 list is a hashref containing the following keys:
 247
 248 =over 2
 249
 250 =item item_sequence
 251
 252 Sequence number of original item tag in the MARC record.
 253
 254 =item item_barcode
 255
 256 Item barcode, provide to assist in the construction of
 257 useful error messages.
 258
 259 =item error_condition
 260
 261 Code representing the error condition.  Can be 'duplicate_barcode',
 262 'invalid_homebranch', or 'invalid_holdingbranch'.
 263
 264 =item error_information
 265
 266 Additional information appropriate to the error condition.
 267
 268 =back
 269
 270 =cut
 271
 272 sub AddBiblioAndItems {
 273     my ( $record, $frameworkcode ) = @_;
 274     my ($biblionumber,$biblioitemnumber,$error);
 275     my @itemnumbers = ();
 276     my @errors = ();
 277     my $dbh = C4::Context->dbh;
 278
 279     # transform the data into koha-table style data
 280     # FIXME - this paragraph copied from AddBiblio
 281     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 282     ($biblionumber,$error) = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
 283     $olddata->{'biblionumber'} = $biblionumber;
 284     ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $olddata );
 285
 286     # FIXME - this paragraph copied from AddBiblio
 287     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 288
 289     # now we loop through the item tags and start creating items
 290     my @bad_item_fields = ();
 291     my ($itemtag, $itemsubfield) = &GetMarcFromKohaField("items.itemnumber",'');
 292     my $item_sequence_num = 0;
 293     ITEMFIELD: foreach my $item_field ($record->field($itemtag)) {
 294         $item_sequence_num++;
 295         # we take the item field and stick it into a new
 296         # MARC record -- this is required so far because (FIXME)
 297         # TransformMarcToKoha requires a MARC::Record, not a MARC::Field
 298         # and there is no TransformMarcFieldToKoha
 299         my $temp_item_marc = MARC::Record->new();
 300         $temp_item_marc->append_fields($item_field);
 301
 302         # add biblionumber and biblioitemnumber
 303         my $item = TransformMarcToKoha( $dbh, $temp_item_marc, $frameworkcode, 'items' );
 304         $item->{'biblionumber'} = $biblionumber;
 305         $item->{'biblioitemnumber'} = $biblioitemnumber;
 306
 307         # check for duplicate barcode
 308         my %item_errors = CheckItemPreSave($item);
 309         if (%item_errors) {
 310             push @errors, _repack_item_errors($item_sequence_num, $item, \%item_errors);
 311             push @bad_item_fields, $item_field;
 312             next ITEMFIELD;
 313         }
 314         my $duplicate_barcode = exists($item->{'barcode'}) && GetItemnumberFromBarcode($item->{'barcode'});
 315         if ($duplicate_barcode) {
 316             warn "ERROR: cannot add item $item->{'barcode'} for biblio $biblionumber: duplicate barcode\n";
 317         }
 318
 319         # Make sure item statuses are set to 0 if empty or NULL in both the item and the MARC
 320         for ('notforloan', 'damaged','itemlost','wthdrawn') {
 321             if (!$item->{$_} or $item->{$_} eq "") {
 322                 $item->{$_} = 0;
 323                 &MARCitemchange( $temp_item_marc, "items.$_", 0 );
 324             }
 325         }
 326
 327         # FIXME - dateaccessioned stuff copied from AddItem
 328         if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
 329
 330             # find today's date
 331             my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 332                 localtime(time);
 333             $year += 1900;
 334             $mon  += 1;
 335             my $date =
 336             "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
 337             $item->{'dateaccessioned'} = $date;
 338             &MARCitemchange( $temp_item_marc, "items.dateaccessioned", $date );
 339         }
 340
 341         my ( $itemnumber, $error ) = &_koha_new_items( $dbh, $item, $item->{barcode} );
 342         warn $error if $error;
 343         push @itemnumbers, $itemnumber; # FIXME not checking error
 344
 345         # FIXME - not copied from AddItem
 346         # FIXME - AddItems equiv code about passing $sth to TransformKohaToMarcOneField is stupid
 347         &MARCitemchange( $temp_item_marc, "items.itemnumber", $itemnumber );
 348
 349         &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
 350         if C4::Context->preference("CataloguingLog");
 351
 352         $item_field->replace_with($temp_item_marc->field($itemtag));
 353     }
 354
 355     # remove any MARC item fields for rejected items
 356     foreach my $item_field (@bad_item_fields) {
 357         $record->delete_field($item_field);
 358     }
 359
 360     # now add the record
 361     # FIXME - this paragraph copied from AddBiblio -- however, moved  since
 362     # since we need to create the items row and plug in the itemnumbers in the
 363     # MARC
 364     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 365
 366     # FIXME - when using this API, do we log both bib and item add, or just
 367     #         bib
 368     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
 369         if C4::Context->preference("CataloguingLog");
 370
 371     return ( $biblionumber, $biblioitemnumber, \@itemnumbers, \@errors);
 372
 373 }
 374
 375 sub _repack_item_errors {
 376     my $item_sequence_num = shift;
 377     my $item_ref = shift;
 378     my $error_ref = shift;
 379
 380     my @repacked_errors = ();
 381
 382     foreach my $error_code (sort keys %{ $error_ref }) {
 383         my $repacked_error = {};
 384         $repacked_error->{'item_sequence'} = $item_sequence_num;
 385         $repacked_error->{'item_barcode'} = exists($item_ref->{'barcode'}) ? $item_ref->{'barcode'} : '';
 386         $repacked_error->{'error_code'} = $error_code;
 387         $repacked_error->{'error_information'} = $error_ref->{$error_code};
 388         push @repacked_errors, $repacked_error;
 389     }
 390
 391     return @repacked_errors;
 392 }
 393
 394 =head2 ModBiblio
 395
 396     ModBiblio( $record,$biblionumber,$frameworkcode);
 397     Exported function (core API) to modify a biblio
 398
 399 =cut
 400
 401 sub ModBiblio {
 402     my ( $record, $biblionumber, $frameworkcode ) = @_;
 403     if (C4::Context->preference("CataloguingLog")) {
 404         my $newrecord = GetMarcBiblio($biblionumber);
 405         &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,"BEFORE=>".$newrecord->as_formatted);
 406     }
 407
 408     my $dbh = C4::Context->dbh;
 409
 410     $frameworkcode = "" unless $frameworkcode;
 411
 412     # get the items before and append them to the biblio before updating the record, atm we just have the biblio
 413     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 414     my $oldRecord = GetMarcBiblio( $biblionumber );
 415
 416     # parse each item, and, for an unknown reason, re-encode each subfield
 417     # if you don't do that, the record will have encoding mixed
 418     # and the biblio will be re-encoded.
 419     # strange, I (Paul P.) searched more than 1 day to understand what happends
 420     # but could only solve the problem this way...
 421    my @fields = $oldRecord->field( $itemtag );
 422     foreach my $fielditem ( @fields ){
 423         my $field;
 424         foreach ($fielditem->subfields()) {
 425             if ($field) {
 426                 $field->add_subfields(Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 427             } else {
 428                 $field = MARC::Field->new("$itemtag",'','',Encode::encode('utf-8',$_->[0]) => Encode::encode('utf-8',$_->[1]));
 429             }
 430           }
 431         $record->append_fields($field);
 432     }
 433
 434     # update biblionumber and biblioitemnumber in MARC
 435     # FIXME - this is assuming a 1 to 1 relationship between
 436     # biblios and biblioitems
 437     my $sth =  $dbh->prepare("select biblioitemnumber from biblioitems where biblionumber=?");
 438     $sth->execute($biblionumber);
 439     my ($biblioitemnumber) = $sth->fetchrow;
 440     $sth->finish();
 441     _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
 442
 443     # update the MARC record (that now contains biblio and items) with the new record data
 444     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 445
 446     # load the koha-table data object
 447     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 448
 449     # modify the other koha tables
 450     _koha_modify_biblio( $dbh, $oldbiblio, $frameworkcode );
 451     _koha_modify_biblioitem_nonmarc( $dbh, $oldbiblio );
 452     return 1;
 453 }
 454
 455 =head2 ModBiblioframework
 456
 457     ModBiblioframework($biblionumber,$frameworkcode);
 458     Exported function to modify a biblio framework
 459
 460 =cut
 461
 462 sub ModBiblioframework {
 463     my ( $biblionumber, $frameworkcode ) = @_;
 464     my $dbh = C4::Context->dbh;
 465     my $sth = $dbh->prepare(
 466         "UPDATE biblio SET frameworkcode=? WHERE biblionumber=?"
 467     );
 468     $sth->execute($frameworkcode, $biblionumber);
 469     return 1;
 470 }
 471
 472 =head2 DelBiblio
 473
 474 =over
 475
 476 my $error = &DelBiblio($dbh,$biblionumber);
 477 Exported function (core API) for deleting a biblio in koha.
 478 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
 479 Also backs it up to deleted* tables
 480 Checks to make sure there are not issues on any of the items
 481 return:
 482 C<$error> : undef unless an error occurs
 483
 484 =back
 485
 486 =cut
 487
 488 sub DelBiblio {
 489     my ( $biblionumber ) = @_;
 490     my $dbh = C4::Context->dbh;
 491     my $error;    # for error handling
 492
 493     # First make sure this biblio has no items attached
 494     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber=?");
 495     $sth->execute($biblionumber);
 496     if (my $itemnumber = $sth->fetchrow){
 497         # Fix this to use a status the template can understand
 498         $error .= "This Biblio has items attached, please delete them first before deleting this biblio ";
 499     }
 500
 501     return $error if $error;
 502
 503     # Delete in Zebra. Be careful NOT to move this line after _koha_delete_biblio
 504     # for at least 2 reasons :
 505     # - we need to read the biblio if NoZebra is set (to remove it from the indexes
 506     # - if something goes wrong, the biblio may be deleted from Koha but not from zebra
 507     #   and we would have no way to remove it (except manually in zebra, but I bet it would be very hard to handle the problem)
 508     ModZebra($biblionumber, "recordDelete", "biblioserver", undef);
 509
 510     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
 511     $sth =
 512       $dbh->prepare(
 513         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 514     $sth->execute($biblionumber);
 515     while ( my $biblioitemnumber = $sth->fetchrow ) {
 516
 517         # delete this biblioitem
 518         $error = _koha_delete_biblioitems( $dbh, $biblioitemnumber );
 519         return $error if $error;
 520     }
 521
 522     # delete biblio from Koha tables and save in deletedbiblio
 523     # must do this *after* _koha_delete_biblioitems, otherwise
 524     # delete cascade will prevent deletedbiblioitems rows
 525     # from being generated by _koha_delete_biblioitems
 526     $error = _koha_delete_biblio( $dbh, $biblionumber );
 527
 528     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"")
 529         if C4::Context->preference("CataloguingLog");
 530     return;
 531 }
 532
 533 =head2 DelItem
 534
 535 =over
 536
 537 DelItem( $biblionumber, $itemnumber );
 538 Exported function (core API) for deleting an item record in Koha.
 539
 540 =back
 541
 542 =cut
 543
 544 sub DelItem {
 545     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 546
 547     # check the item has no current issues
 548
 549
 550     &_koha_delete_item( $dbh, $itemnumber );
 551
 552     # get the MARC record
 553     my $record = GetMarcBiblio($biblionumber);
 554     my $frameworkcode = GetFrameworkCode($biblionumber);
 555
 556     # backup the record
 557     my $copy2deleted = $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
 558     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 559
 560     #search item field code
 561     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 562     my @fields = $record->field($itemtag);
 563
 564     # delete the item specified
 565     foreach my $field (@fields) {
 566         if ( $field->subfield($itemsubfield) eq $itemnumber ) {
 567             $record->delete_field($field);
 568         }
 569     }
 570     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 571     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item")
 572         if C4::Context->preference("CataloguingLog");
 573 }
 574
 575 =head2 CheckItemPreSave
 576
 577 =over 4
 578
 579     my $item_ref = TransformMarcToKoha($marc, 'items');
 580     # do stuff
 581     my %errors = CheckItemPreSave($item_ref);
 582     if (exists $errors{'duplicate_barcode'}) {
 583         print "item has duplicate barcode: ", $errors{'duplicate_barcode'}, "\n";
 584     } elsif (exists $errors{'invalid_homebranch'}) {
 585         print "item has invalid home branch: ", $errors{'invalid_homebranch'}, "\n";
 586     } elsif (exists $errors{'invalid_holdingbranch'}) {
 587         print "item has invalid holding branch: ", $errors{'invalid_holdingbranch'}, "\n";
 588     } else {
 589         print "item is OK";
 590     }
 591
 592 =back
 593
 594 Given a hashref containing item fields, determine if it can be
 595 inserted or updated in the database.  Specifically, checks for
 596 database integrity issues, and returns a hash containing any
 597 of the following keys, if applicable.
 598
 599 =over 2
 600
 601 =item duplicate_barcode
 602
 603 Barcode, if it duplicates one already found in the database.
 604
 605 =item invalid_homebranch
 606
 607 Home branch, if not defined in branches table.
 608
 609 =item invalid_holdingbranch
 610
 611 Holding branch, if not defined in branches table.
 612
 613 =back
 614
 615 This function does NOT implement any policy-related checks,
 616 e.g., whether current operator is allowed to save an
 617 item that has a given branch code.
 618
 619 =cut
 620
 621 sub CheckItemPreSave {
 622     my $item_ref = shift;
 623
 624     my %errors = ();
 625
 626     # check for duplicate barcode
 627     if (exists $item_ref->{'barcode'} and defined $item_ref->{'barcode'}) {
 628         my $existing_itemnumber = GetItemnumberFromBarcode($item_ref->{'barcode'});
 629         if ($existing_itemnumber) {
 630             if (!exists $item_ref->{'itemnumber'}                       # new item
 631                 or $item_ref->{'itemnumber'} != $existing_itemnumber) { # existing item
 632                 $errors{'duplicate_barcode'} = $item_ref->{'barcode'};
 633             }
 634         }
 635     }
 636
 637     # check for valid home branch
 638     if (exists $item_ref->{'homebranch'} and defined $item_ref->{'homebranch'}) {
 639         my $branch_name = GetBranchName($item_ref->{'homebranch'});
 640         unless (defined $branch_name) {
 641             # relies on fact that branches.branchname is a non-NULL column,
 642             # so GetBranchName returns undef only if branch does not exist
 643             $errors{'invalid_homebranch'} = $item_ref->{'homebranch'};
 644         }
 645     }
 646
 647     # check for valid holding branch
 648     if (exists $item_ref->{'holdingbranch'} and defined $item_ref->{'holdingbranch'}) {
 649         my $branch_name = GetBranchName($item_ref->{'holdingbranch'});
 650         unless (defined $branch_name) {
 651             # relies on fact that branches.branchname is a non-NULL column,
 652             # so GetBranchName returns undef only if branch does not exist
 653             $errors{'invalid_holdingbranch'} = $item_ref->{'holdingbranch'};
 654         }
 655     }
 656
 657     return %errors;
 658
 659 }
 660
 661 =head2 GetBiblioData
 662
 663 =over 4
 664
 665 $data = &GetBiblioData($biblionumber);
 666 Returns information about the book with the given biblionumber.
 667 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
 668 the C<biblio> and C<biblioitems> tables in the
 669 Koha database.
 670 In addition, C<$data-E<gt>{subject}> is the list of the book's
 671 subjects, separated by C<" , "> (space, comma, space).
 672 If there are multiple biblioitems with the given biblionumber, only
 673 the first one is considered.
 674
 675 =back
 676
 677 =cut
 678
 679 sub GetBiblioData {
 680     my ( $bibnum ) = @_;
 681     my $dbh = C4::Context->dbh;
 682
 683   #  my $query =  C4::Context->preference('item-level_itypes') ?
 684     #   " SELECT * , biblioitems.notes AS bnotes, biblio.notes
 685     #       FROM biblio
 686     #        LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 687     #       WHERE biblio.biblionumber = ?
 688     #        AND biblioitems.biblionumber = biblio.biblionumber
 689     #";
 690
 691     my $query = " SELECT * , biblioitems.notes AS bnotes, itemtypes.notforloan as bi_notforloan, biblio.notes
 692             FROM biblio
 693             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 694             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
 695             WHERE biblio.biblionumber = ?
 696             AND biblioitems.biblionumber = biblio.biblionumber ";
 697
 698     my $sth = $dbh->prepare($query);
 699     $sth->execute($bibnum);
 700     my $data;
 701     $data = $sth->fetchrow_hashref;
 702     $sth->finish;
 703
 704     return ($data);
 705 }    # sub GetBiblioData
 706
 707
 708 =head2 GetItemsInfo
 709
 710 =over 4
 711
 712   @results = &GetItemsInfo($biblionumber, $type);
 713
 714 Returns information about books with the given biblionumber.
 715
 716 C<$type> may be either C<intra> or anything else. If it is not set to
 717 C<intra>, then the search will exclude lost, very overdue, and
 718 withdrawn items.
 719
 720 C<&GetItemsInfo> returns a list of references-to-hash. Each element
 721 contains a number of keys. Most of them are table items from the
 722 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
 723 Koha database. Other keys include:
 724
 725 =over 4
 726
 727 =item C<$data-E<gt>{branchname}>
 728
 729 The name (not the code) of the branch to which the book belongs.
 730
 731 =item C<$data-E<gt>{datelastseen}>
 732
 733 This is simply C<items.datelastseen>, except that while the date is
 734 stored in YYYY-MM-DD format in the database, here it is converted to
 735 DD/MM/YYYY format. A NULL date is returned as C<//>.
 736
 737 =item C<$data-E<gt>{datedue}>
 738
 739 =item C<$data-E<gt>{class}>
 740
 741 This is the concatenation of C<biblioitems.classification>, the book's
 742 Dewey code, and C<biblioitems.subclass>.
 743
 744 =item C<$data-E<gt>{ocount}>
 745
 746 I think this is the number of copies of the book available.
 747
 748 =item C<$data-E<gt>{order}>
 749
 750 If this is set, it is set to C<One Order>.
 751
 752 =back
 753
 754 =back
 755
 756 =cut
 757
 758 sub GetItemsInfo {
 759     my ( $biblionumber, $type ) = @_;
 760     my $dbh   = C4::Context->dbh;
 761     my $query = "SELECT *,items.notforloan as itemnotforloan
 762                  FROM items
 763                  LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
 764                  LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
 765     $query .=  (C4::Context->preference('item-level_itypes')) ?
 766                      " LEFT JOIN itemtypes on items.itype = itemtypes.itemtype "
 767                     : " LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype ";
 768     $query .= "WHERE items.biblionumber = ? ORDER BY items.dateaccessioned desc" ;
 769     my $sth = $dbh->prepare($query);
 770     $sth->execute($biblionumber);
 771     my $i = 0;
 772     my @results;
 773     my ( $date_due, $count_reserves );
 774
 775     my $isth    = $dbh->prepare(
 776         "SELECT issues.*,borrowers.cardnumber,borrowers.surname,borrowers.firstname,borrowers.branchcode as bcode
 777         FROM   issues LEFT JOIN borrowers ON issues.borrowernumber=borrowers.borrowernumber
 778         WHERE  itemnumber = ?
 779             AND returndate IS NULL"
 780        );
 781     while ( my $data = $sth->fetchrow_hashref ) {
 782         my $datedue = '';
 783         $isth->execute( $data->{'itemnumber'} );
 784         if ( my $idata = $isth->fetchrow_hashref ) {
 785             $data->{borrowernumber} = $idata->{borrowernumber};
 786             $data->{cardnumber}     = $idata->{cardnumber};
 787             $data->{surname}     = $idata->{surname};
 788             $data->{firstname}     = $idata->{firstname};
 789             $datedue                = $idata->{'date_due'};
 790         if (C4::Context->preference("IndependantBranches")){
 791         my $userenv = C4::Context->userenv;
 792         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
 793             $data->{'NOTSAMEBRANCH'} = 1 if ($idata->{'bcode'} ne $userenv->{branch});
 794         }
 795         }
 796         }
 797         if ( $datedue eq '' ) {
 798             my ( $restype, $reserves ) =
 799               C4::Reserves::CheckReserves( $data->{'itemnumber'} );
 800             if ($restype) {
 801                 $count_reserves = $restype;
 802             }
 803         }
 804         $isth->finish;
 805
 806         #get branch information.....
 807         my $bsth = $dbh->prepare(
 808             "SELECT * FROM branches WHERE branchcode = ?
 809         "
 810         );
 811         $bsth->execute( $data->{'holdingbranch'} );
 812         if ( my $bdata = $bsth->fetchrow_hashref ) {
 813             $data->{'branchname'} = $bdata->{'branchname'};
 814         }
 815         $data->{'datedue'}        = $datedue;
 816         $data->{'count_reserves'} = $count_reserves;
 817
 818         # get notforloan complete status if applicable
 819         my $sthnflstatus = $dbh->prepare(
 820             'SELECT authorised_value
 821             FROM   marc_subfield_structure
 822             WHERE  kohafield="items.notforloan"
 823         '
 824         );
 825
 826         $sthnflstatus->execute;
 827         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
 828         if ($authorised_valuecode) {
 829             $sthnflstatus = $dbh->prepare(
 830                 "SELECT lib FROM authorised_values
 831                  WHERE  category=?
 832                  AND authorised_value=?"
 833             );
 834             $sthnflstatus->execute( $authorised_valuecode,
 835                 $data->{itemnotforloan} );
 836             my ($lib) = $sthnflstatus->fetchrow;
 837             $data->{notforloan} = $lib;
 838         }
 839
 840         # my stack procedures
 841         my $stackstatus = $dbh->prepare(
 842             'SELECT authorised_value
 843              FROM   marc_subfield_structure
 844              WHERE  kohafield="items.stack"
 845         '
 846         );
 847         $stackstatus->execute;
 848
 849         ($authorised_valuecode) = $stackstatus->fetchrow;
 850         if ($authorised_valuecode) {
 851             $stackstatus = $dbh->prepare(
 852                 "SELECT lib
 853                  FROM   authorised_values
 854                  WHERE  category=?
 855                  AND    authorised_value=?
 856             "
 857             );
 858             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
 859             my ($lib) = $stackstatus->fetchrow;
 860             $data->{stack} = $lib;
 861         }
 862         # Find the last 3 people who borrowed this item.
 863         my $sth2 = $dbh->prepare("SELECT * FROM issues,borrowers
 864                                     WHERE itemnumber = ?
 865                                     AND issues.borrowernumber = borrowers.borrowernumber
 866                                     AND returndate IS NOT NULL LIMIT 3");
 867         $sth2->execute($data->{'itemnumber'});
 868         my $ii = 0;
 869         while (my $data2 = $sth2->fetchrow_hashref()) {
 870             $data->{"timestamp$ii"} = $data2->{'timestamp'} if $data2->{'timestamp'};
 871             $data->{"card$ii"}      = $data2->{'cardnumber'} if $data2->{'cardnumber'};
 872             $data->{"borrower$ii"}  = $data2->{'borrowernumber'} if $data2->{'borrowernumber'};
 873             $ii++;
 874         }
 875
 876         $results[$i] = $data;
 877         $i++;
 878     }
 879     $sth->finish;
 880
 881     return (@results);
 882 }
 883
 884 =head2 getitemstatus
 885
 886 =over 4
 887
 888 $itemstatushash = &getitemstatus($fwkcode);
 889 returns information about status.
 890 Can be MARC dependant.
 891 fwkcode is optional.
 892 But basically could be can be loan or not
 893 Create a status selector with the following code
 894
 895 =head3 in PERL SCRIPT
 896
 897 my $itemstatushash = getitemstatus;
 898 my @itemstatusloop;
 899 foreach my $thisstatus (keys %$itemstatushash) {
 900     my %row =(value => $thisstatus,
 901                 statusname => $itemstatushash->{$thisstatus}->{'statusname'},
 902             );
 903     push @itemstatusloop, \%row;
 904 }
 905 $template->param(statusloop=>\@itemstatusloop);
 906
 907
 908 =head3 in TEMPLATE
 909
 910             <select name="statusloop">
 911                 <option value="">Default</option>
 912             <!-- TMPL_LOOP name="statusloop" -->
 913                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
 914             <!-- /TMPL_LOOP -->
 915             </select>
 916
 917 =cut
 918
 919 sub GetItemStatus {
 920
 921     # returns a reference to a hash of references to status...
 922     my ($fwk) = @_;
 923     my %itemstatus;
 924     my $dbh = C4::Context->dbh;
 925     my $sth;
 926     $fwk = '' unless ($fwk);
 927     my ( $tag, $subfield ) =
 928       GetMarcFromKohaField( "items.notforloan", $fwk );
 929     if ( $tag and $subfield ) {
 930         my $sth =
 931           $dbh->prepare(
 932             "SELECT authorised_value
 933             FROM marc_subfield_structure
 934             WHERE tagfield=?
 935                 AND tagsubfield=?
 936                 AND frameworkcode=?
 937             "
 938           );
 939         $sth->execute( $tag, $subfield, $fwk );
 940         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 941             my $authvalsth =
 942               $dbh->prepare(
 943                 "SELECT authorised_value,lib
 944                 FROM authorised_values
 945                 WHERE category=?
 946                 ORDER BY lib
 947                 "
 948               );
 949             $authvalsth->execute($authorisedvaluecat);
 950             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 951                 $itemstatus{$authorisedvalue} = $lib;
 952             }
 953             $authvalsth->finish;
 954             return \%itemstatus;
 955             exit 1;
 956         }
 957         else {
 958
 959             #No authvalue list
 960             # build default
 961         }
 962         $sth->finish;
 963     }
 964
 965     #No authvalue list
 966     #build default
 967     $itemstatus{"1"} = "Not For Loan";
 968     return \%itemstatus;
 969 }
 970
 971 =head2 getitemlocation
 972
 973 =over 4
 974
 975 $itemlochash = &getitemlocation($fwk);
 976 returns informations about location.
 977 where fwk stands for an optional framework code.
 978 Create a location selector with the following code
 979
 980 =head3 in PERL SCRIPT
 981
 982 my $itemlochash = getitemlocation;
 983 my @itemlocloop;
 984 foreach my $thisloc (keys %$itemlochash) {
 985     my $selected = 1 if $thisbranch eq $branch;
 986     my %row =(locval => $thisloc,
 987                 selected => $selected,
 988                 locname => $itemlochash->{$thisloc},
 989             );
 990     push @itemlocloop, \%row;
 991 }
 992 $template->param(itemlocationloop => \@itemlocloop);
 993
 994 =head3 in TEMPLATE
 995
 996 <select name="location">
 997     <option value="">Default</option>
 998 <!-- TMPL_LOOP name="itemlocationloop" -->
 999     <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
1000 <!-- /TMPL_LOOP -->
1001 </select>
1002
1003 =back
1004
1005 =cut
1006
1007 sub GetItemLocation {
1008
1009     # returns a reference to a hash of references to location...
1010     my ($fwk) = @_;
1011     my %itemlocation;
1012     my $dbh = C4::Context->dbh;
1013     my $sth;
1014     $fwk = '' unless ($fwk);
1015     my ( $tag, $subfield ) =
1016       GetMarcFromKohaField( "items.location", $fwk );
1017     if ( $tag and $subfield ) {
1018         my $sth =
1019           $dbh->prepare(
1020             "SELECT authorised_value
1021             FROM marc_subfield_structure
1022             WHERE tagfield=?
1023                 AND tagsubfield=?
1024                 AND frameworkcode=?"
1025           );
1026         $sth->execute( $tag, $subfield, $fwk );
1027         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
1028             my $authvalsth =
1029               $dbh->prepare(
1030                 "SELECT authorised_value,lib
1031                 FROM authorised_values
1032                 WHERE category=?
1033                 ORDER BY lib"
1034               );
1035             $authvalsth->execute($authorisedvaluecat);
1036             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
1037                 $itemlocation{$authorisedvalue} = $lib;
1038             }
1039             $authvalsth->finish;
1040             return \%itemlocation;
1041             exit 1;
1042         }
1043         else {
1044
1045             #No authvalue list
1046             # build default
1047         }
1048         $sth->finish;
1049     }
1050
1051     #No authvalue list
1052     #build default
1053     $itemlocation{"1"} = "Not For Loan";
1054     return \%itemlocation;
1055 }
1056
1057 =head2 GetLostItems
1058
1059 $items = GetLostItems($where,$orderby);
1060
1061 This function get the items lost into C<$items>.
1062
1063 =over 2
1064
1065 =item input:
1066 C<$where> is a hashref. it containts a field of the items table as key
1067 and the value to match as value.
1068 C<$orderby> is a field of the items table.
1069
1070 =item return:
1071 C<$items> is a reference to an array full of hasref which keys are items' table column.
1072
1073 =item usage in the perl script:
1074
1075 my %where;
1076 $where{barcode} = 0001548;
1077 my $items = GetLostItems( \%where, "homebranch" );
1078 $template->param(itemsloop => $items);
1079
1080 =back
1081
1082 =cut
1083
1084 sub GetLostItems {
1085     # Getting input args.
1086     my $where   = shift;
1087     my $orderby = shift;
1088     my $dbh     = C4::Context->dbh;
1089
1090     my $query   = "
1091         SELECT *
1092         FROM   items
1093         WHERE  itemlost IS NOT NULL
1094           AND  itemlost <> 0
1095     ";
1096     foreach my $key (keys %$where) {
1097         $query .= " AND " . $key . " LIKE '%" . $where->{$key} . "%'";
1098     }
1099     $query .= " ORDER BY ".$orderby if defined $orderby;
1100
1101     my $sth = $dbh->prepare($query);
1102     $sth->execute;
1103     my @items;
1104     while ( my $row = $sth->fetchrow_hashref ){
1105         push @items, $row;
1106     }
1107     return \@items;
1108 }
1109
1110 =head2 GetItemsForInventory
1111
1112 $itemlist = GetItemsForInventory($minlocation,$maxlocation,$datelastseen,$offset,$size)
1113
1114 Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
1115
1116 The sub returns a list of hashes, containing itemnumber, author, title, barcode & item callnumber.
1117 It is ordered by callnumber,title.
1118
1119 The minlocation & maxlocation parameters are used to specify a range of item callnumbers
1120 the datelastseen can be used to specify that you want to see items not seen since a past date only.
1121 offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
1122
1123 =cut
1124
1125 sub GetItemsForInventory {
1126     my ( $minlocation, $maxlocation,$location, $datelastseen, $branch, $offset, $size ) = @_;
1127     my $dbh = C4::Context->dbh;
1128     my $sth;
1129     if ($datelastseen) {
1130         $datelastseen=format_date_in_iso($datelastseen);
1131         my $query =
1132                 "SELECT itemnumber,barcode,itemcallnumber,title,author,biblio.biblionumber,datelastseen
1133                  FROM items
1134                    LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1135                  WHERE itemcallnumber>= ?
1136                    AND itemcallnumber <=?
1137                    AND (datelastseen< ? OR datelastseen IS NULL)";
1138         $query.= " AND items.location=".$dbh->quote($location) if $location;
1139         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1140         $query .= " ORDER BY itemcallnumber,title";
1141         $sth = $dbh->prepare($query);
1142         $sth->execute( $minlocation, $maxlocation, $datelastseen );
1143     }
1144     else {
1145         my $query ="
1146                 SELECT itemnumber,barcode,itemcallnumber,biblio.biblionumber,title,author,datelastseen
1147                 FROM items
1148                   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
1149                 WHERE itemcallnumber>= ?
1150                   AND itemcallnumber <=?";
1151         $query.= " AND items.location=".$dbh->quote($location) if $location;
1152         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
1153         $query .= " ORDER BY itemcallnumber,title";
1154         $sth = $dbh->prepare($query);
1155         $sth->execute( $minlocation, $maxlocation );
1156     }
1157     my @results;
1158     while ( my $row = $sth->fetchrow_hashref ) {
1159         $offset-- if ($offset);
1160         $row->{datelastseen}=format_date($row->{datelastseen});
1161         if ( ( !$offset ) && $size ) {
1162             push @results, $row;
1163             $size--;
1164         }
1165     }
1166     return \@results;
1167 }
1168
1169 =head2 &GetBiblioItemData
1170
1171 =over 4
1172
1173 $itemdata = &GetBiblioItemData($biblioitemnumber);
1174
1175 Looks up the biblioitem with the given biblioitemnumber. Returns a
1176 reference-to-hash. The keys are the fields from the C<biblio>,
1177 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
1178 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
1179
1180 =back
1181
1182 =cut
1183
1184 #'
1185 sub GetBiblioItemData {
1186     my ($biblioitemnumber) = @_;
1187     my $dbh       = C4::Context->dbh;
1188     my $query = "SELECT *,biblioitems.notes AS bnotes
1189         FROM biblio, biblioitems ";
1190     unless(C4::Context->preference('item-level_itypes')) {
1191         $query .= "LEFT JOIN itemtypes on biblioitems.itemtype=itemtypes.itemtype ";
1192     }
1193     $query .= " WHERE biblio.biblionumber = biblioitems.biblionumber
1194         AND biblioitemnumber = ? ";
1195     my $sth       =  $dbh->prepare($query);
1196     my $data;
1197     $sth->execute($biblioitemnumber);
1198     $data = $sth->fetchrow_hashref;
1199     $sth->finish;
1200     return ($data);
1201 }    # sub &GetBiblioItemData
1202
1203 =head2 GetItemnumberFromBarcode
1204
1205 =over 4
1206
1207 $result = GetItemnumberFromBarcode($barcode);
1208
1209 =back
1210
1211 =cut
1212
1213 sub GetItemnumberFromBarcode {
1214     my ($barcode) = @_;
1215     my $dbh = C4::Context->dbh;
1216
1217     my $rq =
1218       $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?");
1219     $rq->execute($barcode);
1220     my ($result) = $rq->fetchrow;
1221     return ($result);
1222 }
1223
1224 =head2 GetBiblioItemByBiblioNumber
1225
1226 =over 4
1227
1228 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
1229
1230 =back
1231
1232 =cut
1233
1234 sub GetBiblioItemByBiblioNumber {
1235     my ($biblionumber) = @_;
1236     my $dbh = C4::Context->dbh;
1237     my $sth = $dbh->prepare("Select * FROM biblioitems WHERE biblionumber = ?");
1238     my $count = 0;
1239     my @results;
1240
1241     $sth->execute($biblionumber);
1242
1243     while ( my $data = $sth->fetchrow_hashref ) {
1244         push @results, $data;
1245     }
1246
1247     $sth->finish;
1248     return @results;
1249 }
1250
1251 =head2 GetBiblioFromItemNumber
1252
1253 =over 4
1254
1255 $item = &GetBiblioFromItemNumber($itemnumber,$barcode);
1256
1257 Looks up the item with the given itemnumber. if undef, try the barcode.
1258
1259 C<&itemnodata> returns a reference-to-hash whose keys are the fields
1260 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
1261 database.
1262
1263 =back
1264
1265 =cut
1266
1267 #'
1268 sub GetBiblioFromItemNumber {
1269     my ( $itemnumber, $barcode ) = @_;
1270     my $dbh = C4::Context->dbh;
1271     my $sth;
1272     if($itemnumber) {
1273         $sth=$dbh->prepare(  "SELECT * FROM items
1274             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1275             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1276              WHERE items.itemnumber = ?") ;
1277         $sth->execute($itemnumber);
1278     } else {
1279         $sth=$dbh->prepare(  "SELECT * FROM items
1280             LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1281             LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1282              WHERE items.barcode = ?") ;
1283         $sth->execute($barcode);
1284     }
1285     my $data = $sth->fetchrow_hashref;
1286     $sth->finish;
1287     return ($data);
1288 }
1289
1290 =head2 GetBiblio
1291
1292 =over 4
1293
1294 ( $count, @results ) = &GetBiblio($biblionumber);
1295
1296 =back
1297
1298 =cut
1299
1300 sub GetBiblio {
1301     my ($biblionumber) = @_;
1302     my $dbh = C4::Context->dbh;
1303     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber = ?");
1304     my $count = 0;
1305     my @results;
1306     $sth->execute($biblionumber);
1307     while ( my $data = $sth->fetchrow_hashref ) {
1308         $results[$count] = $data;
1309         $count++;
1310     }    # while
1311     $sth->finish;
1312     return ( $count, @results );
1313 }    # sub GetBiblio
1314
1315 =head2 GetItem
1316
1317 =over 4
1318
1319 $data = &GetItem($itemnumber,$barcode);
1320
1321 return Item information, for a given itemnumber or barcode
1322
1323 =back
1324
1325 =cut
1326
1327 sub GetItem {
1328     my ($itemnumber,$barcode) = @_;
1329     my $dbh = C4::Context->dbh;
1330     if ($itemnumber) {
1331         my $sth = $dbh->prepare("
1332             SELECT * FROM items
1333             WHERE itemnumber = ?");
1334         $sth->execute($itemnumber);
1335         my $data = $sth->fetchrow_hashref;
1336         return $data;
1337     } else {
1338         my $sth = $dbh->prepare("
1339             SELECT * FROM items
1340             WHERE barcode = ?"
1341             );
1342         $sth->execute($barcode);
1343         my $data = $sth->fetchrow_hashref;
1344         return $data;
1345     }
1346 }    # sub GetItem
1347
1348 =head2 get_itemnumbers_of
1349
1350 =over 4
1351
1352 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1353
1354 Given a list of biblionumbers, return the list of corresponding itemnumbers
1355 for each biblionumber.
1356
1357 Return a reference on a hash where keys are biblionumbers and values are
1358 references on array of itemnumbers.
1359
1360 =back
1361
1362 =cut
1363
1364 sub get_itemnumbers_of {
1365     my @biblionumbers = @_;
1366
1367     my $dbh = C4::Context->dbh;
1368
1369     my $query = '
1370         SELECT itemnumber,
1371             biblionumber
1372         FROM items
1373         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1374     ';
1375     my $sth = $dbh->prepare($query);
1376     $sth->execute(@biblionumbers);
1377
1378     my %itemnumbers_of;
1379
1380     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1381         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1382     }
1383
1384     return \%itemnumbers_of;
1385 }
1386
1387 =head2 GetItemInfosOf
1388
1389 =over 4
1390
1391 GetItemInfosOf(@itemnumbers);
1392
1393 =back
1394
1395 =cut
1396
1397 sub GetItemInfosOf {
1398     my @itemnumbers = @_;
1399
1400     my $query = '
1401         SELECT *
1402         FROM items
1403         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
1404     ';
1405     return get_infos_of( $query, 'itemnumber' );
1406 }
1407
1408 =head2 GetItemsByBiblioitemnumber
1409
1410 =over 4
1411
1412 GetItemsByBiblioitemnumber($biblioitemnumber);
1413
1414 Returns an arrayref of hashrefs suitable for use in a TMPL_LOOP
1415 Called by moredetail.pl
1416
1417 =back
1418
1419 =cut
1420
1421 sub GetItemsByBiblioitemnumber {
1422     my ( $bibitem ) = @_;
1423     my $dbh = C4::Context->dbh;
1424     my $sth = $dbh->prepare("SELECT * FROM items WHERE items.biblioitemnumber = ?") || die $dbh->errstr;
1425     # Get all items attached to a biblioitem
1426     my $i = 0;
1427     my @results;
1428     $sth->execute($bibitem) || die $sth->errstr;
1429     while ( my $data = $sth->fetchrow_hashref ) {
1430         # Foreach item, get circulation information
1431         my $sth2 = $dbh->prepare( "SELECT * FROM issues,borrowers
1432                                    WHERE itemnumber = ?
1433                                    AND returndate is NULL
1434                                    AND issues.borrowernumber = borrowers.borrowernumber"
1435         );
1436         $sth2->execute( $data->{'itemnumber'} );
1437         if ( my $data2 = $sth2->fetchrow_hashref ) {
1438             # if item is out, set the due date and who it is out too
1439             $data->{'date_due'}   = $data2->{'date_due'};
1440             $data->{'cardnumber'} = $data2->{'cardnumber'};
1441             $data->{'borrowernumber'}   = $data2->{'borrowernumber'};
1442         }
1443         else {
1444             # set date_due to blank, so in the template we check itemlost, and wthdrawn
1445             $data->{'date_due'} = '';
1446         }    # else
1447         $sth2->finish;
1448         # Find the last 3 people who borrowed this item.
1449         my $query2 = "SELECT * FROM issues, borrowers WHERE itemnumber = ?
1450                       AND issues.borrowernumber = borrowers.borrowernumber
1451                       AND returndate is not NULL
1452                       ORDER BY returndate desc,timestamp desc LIMIT 3";
1453         $sth2 = $dbh->prepare($query2) || die $dbh->errstr;
1454         $sth2->execute( $data->{'itemnumber'} ) || die $sth2->errstr;
1455         my $i2 = 0;
1456         while ( my $data2 = $sth2->fetchrow_hashref ) {
1457             $data->{"timestamp$i2"} = $data2->{'timestamp'};
1458             $data->{"card$i2"}      = $data2->{'cardnumber'};
1459             $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
1460             $i2++;
1461         }
1462         $sth2->finish;
1463         push(@results,$data);
1464     }
1465     $sth->finish;
1466     return (\@results);
1467 }
1468
1469
1470 =head2 GetBiblioItemInfosOf
1471
1472 =over 4
1473
1474 GetBiblioItemInfosOf(@biblioitemnumbers);
1475
1476 =back
1477
1478 =cut
1479
1480 sub GetBiblioItemInfosOf {
1481     my @biblioitemnumbers = @_;
1482
1483     my $query = '
1484         SELECT biblioitemnumber,
1485             publicationyear,
1486             itemtype
1487         FROM biblioitems
1488         WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1489     ';
1490     return get_infos_of( $query, 'biblioitemnumber' );
1491 }
1492
1493 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1494
1495 =head2 GetMarcStructure
1496
1497 =over 4
1498
1499 $res = GetMarcStructure($forlibrarian,$frameworkcode);
1500
1501 Returns a reference to a big hash of hash, with the Marc structure for the given frameworkcode
1502 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1503 $frameworkcode : the framework code to read
1504
1505 =back
1506
1507 =cut
1508
1509 sub GetMarcStructure {
1510     my ( $forlibrarian, $frameworkcode ) = @_;
1511     my $dbh=C4::Context->dbh;
1512     $frameworkcode = "" unless $frameworkcode;
1513     my $sth;
1514     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
1515
1516     # check that framework exists
1517     $sth =
1518       $dbh->prepare(
1519         "SELECT COUNT(*) FROM marc_tag_structure WHERE frameworkcode=?");
1520     $sth->execute($frameworkcode);
1521     my ($total) = $sth->fetchrow;
1522     $frameworkcode = "" unless ( $total > 0 );
1523     $sth =
1524       $dbh->prepare(
1525         "SELECT tagfield,liblibrarian,libopac,mandatory,repeatable
1526         FROM marc_tag_structure
1527         WHERE frameworkcode=?
1528         ORDER BY tagfield"
1529       );
1530     $sth->execute($frameworkcode);
1531     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1532
1533     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
1534         $sth->fetchrow )
1535     {
1536         $res->{$tag}->{lib} =
1537           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1538         $res->{$tab}->{tab}        = "";
1539         $res->{$tag}->{mandatory}  = $mandatory;
1540         $res->{$tag}->{repeatable} = $repeatable;
1541     }
1542
1543     $sth =
1544       $dbh->prepare(
1545             "SELECT tagfield,tagsubfield,liblibrarian,libopac,tab,mandatory,repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue
1546                 FROM marc_subfield_structure
1547             WHERE frameworkcode=?
1548                 ORDER BY tagfield,tagsubfield
1549             "
1550     );
1551
1552     $sth->execute($frameworkcode);
1553
1554     my $subfield;
1555     my $authorised_value;
1556     my $authtypecode;
1557     my $value_builder;
1558     my $kohafield;
1559     my $seealso;
1560     my $hidden;
1561     my $isurl;
1562     my $link;
1563     my $defaultvalue;
1564
1565     while (
1566         (
1567             $tag,          $subfield,      $liblibrarian,
1568             ,              $libopac,       $tab,
1569             $mandatory,    $repeatable,    $authorised_value,
1570             $authtypecode, $value_builder, $kohafield,
1571             $seealso,      $hidden,        $isurl,
1572             $link,$defaultvalue
1573         )
1574         = $sth->fetchrow
1575       )
1576     {
1577         $res->{$tag}->{$subfield}->{lib} =
1578           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1579         $res->{$tag}->{$subfield}->{tab}              = $tab;
1580         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1581         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1582         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1583         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1584         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1585         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1586         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1587         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1588         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1589         $res->{$tag}->{$subfield}->{'link'}           = $link;
1590         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1591     }
1592     return $res;
1593 }
1594
1595 =head2 GetUsedMarcStructure
1596
1597     the same function as GetMarcStructure expcet it just take field
1598     in tab 0-9. (used field)
1599
1600     my $results = GetUsedMarcStructure($frameworkcode);
1601
1602     L<$results> is a ref to an array which each case containts a ref
1603     to a hash which each keys is the columns from marc_subfield_structure
1604
1605     L<$frameworkcode> is the framework code.
1606
1607 =cut
1608
1609 sub GetUsedMarcStructure($){
1610     my $frameworkcode = shift || '';
1611     my $dbh           = C4::Context->dbh;
1612     my $query         = qq/
1613         SELECT *
1614         FROM   marc_subfield_structure
1615         WHERE   tab > -1
1616             AND frameworkcode = ?
1617     /;
1618     my @results;
1619     my $sth = $dbh->prepare($query);
1620     $sth->execute($frameworkcode);
1621     while (my $row = $sth->fetchrow_hashref){
1622         push @results,$row;
1623     }
1624     return \@results;
1625 }
1626
1627 =head2 GetMarcFromKohaField
1628
1629 =over 4
1630
1631 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($kohafield,$frameworkcode);
1632 Returns the MARC fields & subfields mapped to the koha field
1633 for the given frameworkcode
1634
1635 =back
1636
1637 =cut
1638
1639 sub GetMarcFromKohaField {
1640     my ( $kohafield, $frameworkcode ) = @_;
1641     return 0, 0 unless $kohafield;
1642     my $relations = C4::Context->marcfromkohafield;
1643     return (
1644         $relations->{$frameworkcode}->{$kohafield}->[0],
1645         $relations->{$frameworkcode}->{$kohafield}->[1]
1646     );
1647 }
1648
1649 =head2 GetMarcBiblio
1650
1651 =over 4
1652
1653 Returns MARC::Record of the biblionumber passed in parameter.
1654 the marc record contains both biblio & item datas
1655
1656 =back
1657
1658 =cut
1659
1660 sub GetMarcBiblio {
1661     my $biblionumber = shift;
1662     my $dbh          = C4::Context->dbh;
1663     my $sth          =
1664       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1665     $sth->execute($biblionumber);
1666      my ($marcxml) = $sth->fetchrow;
1667      MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1668      $marcxml =~ s/\x1e//g;
1669      $marcxml =~ s/\x1f//g;
1670      $marcxml =~ s/\x1d//g;
1671      $marcxml =~ s/\x0f//g;
1672      $marcxml =~ s/\x0c//g;
1673 #   warn $marcxml;
1674     my $record = MARC::Record->new();
1675     if ($marcxml) {
1676         $record = eval {MARC::Record::new_from_xml( $marcxml, "utf8", C4::Context->preference('marcflavour'))};
1677         if ($@) {warn $@;}
1678 #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
1679         return $record;
1680     } else {
1681         return undef;
1682     }
1683 }
1684
1685 =head2 GetXmlBiblio
1686
1687 =over 4
1688
1689 my $marcxml = GetXmlBiblio($biblionumber);
1690
1691 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1692 The XML contains both biblio & item datas
1693
1694 =back
1695
1696 =cut
1697
1698 sub GetXmlBiblio {
1699     my ( $biblionumber ) = @_;
1700     my $dbh = C4::Context->dbh;
1701     my $sth =
1702       $dbh->prepare("SELECT marcxml FROM biblioitems WHERE biblionumber=? ");
1703     $sth->execute($biblionumber);
1704     my ($marcxml) = $sth->fetchrow;
1705     return $marcxml;
1706 }
1707
1708 =head2 GetAuthorisedValueDesc
1709
1710 =over 4
1711
1712 my $subfieldvalue =get_authorised_value_desc(
1713     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category);
1714 Retrieve the complete description for a given authorised value.
1715
1716 Now takes $category and $value pair too.
1717 my $auth_value_desc =GetAuthorisedValueDesc(
1718     '','', 'DVD' ,'','','CCODE');
1719
1720 =back
1721
1722 =cut
1723
1724 sub GetAuthorisedValueDesc {
1725     my ( $tag, $subfield, $value, $framework, $tagslib, $category ) = @_;
1726     my $dbh = C4::Context->dbh;
1727
1728     if (!$category) {
1729 #---- branch
1730         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1731             return C4::Branch::GetBranchName($value);
1732         }
1733
1734 #---- itemtypes
1735         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1736             return getitemtypeinfo($value)->{description};
1737         }
1738
1739 #---- "true" authorized value
1740         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'}
1741     }
1742
1743     if ( $category ne "" ) {
1744         my $sth =
1745             $dbh->prepare(
1746                     "SELECT lib FROM authorised_values WHERE category = ? AND authorised_value = ?"
1747                     );
1748         $sth->execute( $category, $value );
1749         my $data = $sth->fetchrow_hashref;
1750         return $data->{'lib'};
1751     }
1752     else {
1753         return $value;    # if nothing is found return the original value
1754     }
1755 }
1756
1757 =head2 GetMarcItem
1758
1759 =over 4
1760
1761 Returns MARC::Record of the item passed in parameter.
1762
1763 =back
1764
1765 =cut
1766
1767 sub GetMarcItem {
1768     my ( $biblionumber, $itemnumber ) = @_;
1769
1770     # GetMarcItem has been revised so that it does the following:
1771     #  1. Gets the item information from the items table.
1772     #  2. Converts it to a MARC field for storage in the bib record.
1773     #
1774     # The previous behavior was:
1775     #  1. Get the bib record.
1776     #  2. Return the MARC tag corresponding to the item record.
1777     #
1778     # The difference is that one treats the items row as authoritative,
1779     # while the other treats the MARC representation as authoritative
1780     # under certain circumstances.
1781     #
1782     # FIXME - a big one
1783     #
1784     # As of 2007-11-27, this change hopefully does not introduce
1785     # any bugs.  However, it does mean that for code that uses
1786     # ModItemInMarconefield to update one subfield (corresponding to
1787     # an items column) is now less efficient.
1788     #
1789     # The API needs to be shifted to the following:
1790     #  1. User updates items record.
1791     #  2. Linked bib is sent for indexing.
1792     #
1793     # The missing step 1.5 is updating the item tag in the bib MARC record
1794     # so that the indexes are updated.  Depending on performance considerations,
1795     # this may ultimately mean of of the following:
1796     #  a. MARC field for item is updated right away.
1797     #  b. MARC field for item is updated only as part of indexing.
1798     #  c. MARC field for item is never actually stored in bib record; instead
1799     #     it is generated only when needed for indexing, item export, and
1800     #     (maybe) OPAC display.
1801     #
1802
1803     my $itemrecord = GetItem($itemnumber);
1804
1805     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
1806     # Also, don't emit a subfield if the underlying field is blank.
1807     my $mungeditem = { map {  $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()  } keys %{ $itemrecord } };
1808
1809     my $itemmarc = TransformKohaToMarc($mungeditem);
1810     return $itemmarc;
1811
1812 }
1813
1814
1815
1816 =head2 GetMarcNotes
1817
1818 =over 4
1819
1820 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1821 Get all notes from the MARC record and returns them in an array.
1822 The note are stored in differents places depending on MARC flavour
1823
1824 =back
1825
1826 =cut
1827
1828 sub GetMarcNotes {
1829     my ( $record, $marcflavour ) = @_;
1830     my $scope;
1831     if ( $marcflavour eq "MARC21" ) {
1832         $scope = '5..';
1833     }
1834     else {    # assume unimarc if not marc21
1835         $scope = '3..';
1836     }
1837     my @marcnotes;
1838     my $note = "";
1839     my $tag  = "";
1840     my $marcnote;
1841     foreach my $field ( $record->field($scope) ) {
1842         my $value = $field->as_string();
1843         if ( $note ne "" ) {
1844             $marcnote = { marcnote => $note, };
1845             push @marcnotes, $marcnote;
1846             $note = $value;
1847         }
1848         if ( $note ne $value ) {
1849             $note = $note . " " . $value;
1850         }
1851     }
1852
1853     if ( $note ) {
1854         $marcnote = { marcnote => $note };
1855         push @marcnotes, $marcnote;    #load last tag into array
1856     }
1857     return \@marcnotes;
1858 }    # end GetMarcNotes
1859
1860 =head2 GetMarcSubjects
1861
1862 =over 4
1863
1864 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1865 Get all subjects from the MARC record and returns them in an array.
1866 The subjects are stored in differents places depending on MARC flavour
1867
1868 =back
1869
1870 =cut
1871
1872 sub GetMarcSubjects {
1873     my ( $record, $marcflavour ) = @_;
1874     my ( $mintag, $maxtag );
1875     if ( $marcflavour eq "MARC21" ) {
1876         $mintag = "600";
1877         $maxtag = "699";
1878     }
1879     else {    # assume unimarc if not marc21
1880         $mintag = "600";
1881         $maxtag = "611";
1882     }
1883
1884     my @marcsubjects;
1885     my $subject = "";
1886     my $subfield = "";
1887     my $marcsubject;
1888
1889     foreach my $field ( $record->field('6..' )) {
1890         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1891         my @subfields_loop;
1892         my @subfields = $field->subfields();
1893         my $counter = 0;
1894         my @link_loop;
1895         # if there is an authority link, build the link with an= subfield9
1896         my $subfield9 = $field->subfield('9');
1897         for my $subject_subfield (@subfields ) {
1898             # don't load unimarc subfields 3,4,5
1899             next if (($marcflavour eq "UNIMARC") and ($subject_subfield->[0] =~ (3|4|5) ) );
1900             my $code = $subject_subfield->[0];
1901             my $value = $subject_subfield->[1];
1902             my $linkvalue = $value;
1903             $linkvalue =~ s/(\(|\))//g;
1904             my $operator = " and " unless $counter==0;
1905             if ($subfield9) {
1906                 @link_loop = ({'limit' => 'an' ,link => "$subfield9" });
1907             } else {
1908                 push @link_loop, {'limit' => 'su', link => $linkvalue, operator => $operator };
1909             }
1910             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1911             # ignore $9
1912             my @this_link_loop = @link_loop;
1913             push @subfields_loop, {code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($subject_subfield->[0] == 9 );
1914             $counter++;
1915         }
1916
1917         push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1918
1919     }
1920         return \@marcsubjects;
1921 }  #end getMARCsubjects
1922
1923 =head2 GetMarcAuthors
1924
1925 =over 4
1926
1927 authors = GetMarcAuthors($record,$marcflavour);
1928 Get all authors from the MARC record and returns them in an array.
1929 The authors are stored in differents places depending on MARC flavour
1930
1931 =back
1932
1933 =cut
1934
1935 sub GetMarcAuthors {
1936     my ( $record, $marcflavour ) = @_;
1937     my ( $mintag, $maxtag );
1938     # tagslib useful for UNIMARC author reponsabilities
1939     my $tagslib = &GetMarcStructure( 1, '' ); # FIXME : we don't have the framework available, we take the default framework. May be bugguy on some setups, will be usually correct.
1940     if ( $marcflavour eq "MARC21" ) {
1941         $mintag = "700";
1942         $maxtag = "720";
1943     }
1944     elsif ( $marcflavour eq "UNIMARC" ) {    # assume unimarc if not marc21
1945         $mintag = "700";
1946         $maxtag = "712";
1947     }
1948     else {
1949         return;
1950     }
1951     my @marcauthors;
1952
1953     foreach my $field ( $record->fields ) {
1954         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1955         my @subfields_loop;
1956         my @link_loop;
1957         my @subfields = $field->subfields();
1958         my $count_auth = 0;
1959         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1960         my $subfield9 = $field->subfield('9');
1961         for my $authors_subfield (@subfields) {
1962             # don't load unimarc subfields 3, 5
1963             next if ($marcflavour eq 'UNIMARC' and ($authors_subfield->[0] =~ (3|5) ) );
1964             my $subfieldcode = $authors_subfield->[0];
1965             my $value = $authors_subfield->[1];
1966             my $linkvalue = $value;
1967             $linkvalue =~ s/(\(|\))//g;
1968             my $operator = " and " unless $count_auth==0;
1969             # if we have an authority link, use that as the link, otherwise use standard searching
1970             if ($subfield9) {
1971                 @link_loop = ({'limit' => 'Koha-Auth-Number' ,link => "$subfield9" });
1972             }
1973             else {
1974                 # reset $linkvalue if UNIMARC author responsibility
1975                 if ( $marcflavour eq 'UNIMARC' and ($authors_subfield->[0] eq '4')) {
1976                     $linkvalue = "(".GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ).")";
1977                 }
1978                 push @link_loop, {'limit' => 'au', link => $linkvalue, operator => $operator };
1979             }
1980             my @this_link_loop = @link_loop;
1981             my $separator = C4::Context->preference("authoritysep") unless $count_auth==0;
1982             push @subfields_loop, {code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator} unless ($authors_subfield->[0] == 9 );
1983             $count_auth++;
1984         }
1985         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1986     }
1987     return \@marcauthors;
1988 }
1989
1990 =head2 GetMarcUrls
1991
1992 =over 4
1993
1994 $marcurls = GetMarcUrls($record,$marcflavour);
1995 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1996 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1997
1998 =back
1999
2000 =cut
2001
2002 sub GetMarcUrls {
2003     my ($record, $marcflavour) = @_;
2004     my @marcurls;
2005     my $marcurl;
2006     for my $field ($record->field('856')) {
2007         my $url = $field->subfield('u');
2008         my @notes;
2009         for my $note ( $field->subfield('z')) {
2010             push @notes , {note => $note};
2011         }
2012         $marcurl = {  MARCURL => $url,
2013                       notes => \@notes,
2014                     };
2015         if($marcflavour eq 'MARC21') {
2016             my $s3 = $field->subfield('3');
2017             my $link = $field->subfield('y');
2018             $marcurl->{'linktext'} = $link || $s3 || $url ;;
2019             $marcurl->{'part'} = $s3 if($link);
2020             $marcurl->{'toc'} = 1 if($s3 =~ /^[Tt]able/) ;
2021         } else {
2022             $marcurl->{'linktext'} = $url;
2023         }
2024         push @marcurls, $marcurl;
2025     }
2026     return \@marcurls;
2027 }  #end GetMarcUrls
2028
2029 =head2 GetMarcSeries
2030
2031 =over 4
2032
2033 $marcseriesarray = GetMarcSeries($record,$marcflavour);
2034 Get all series from the MARC record and returns them in an array.
2035 The series are stored in differents places depending on MARC flavour
2036
2037 =back
2038
2039 =cut
2040
2041 sub GetMarcSeries {
2042     my ($record, $marcflavour) = @_;
2043     my ($mintag, $maxtag);
2044     if ($marcflavour eq "MARC21") {
2045         $mintag = "440";
2046         $maxtag = "490";
2047     } else {           # assume unimarc if not marc21
2048         $mintag = "600";
2049         $maxtag = "619";
2050     }
2051
2052     my @marcseries;
2053     my $subjct = "";
2054     my $subfield = "";
2055     my $marcsubjct;
2056
2057     foreach my $field ($record->field('440'), $record->field('490')) {
2058         my @subfields_loop;
2059         #my $value = $field->subfield('a');
2060         #$marcsubjct = {MARCSUBJCT => $value,};
2061         my @subfields = $field->subfields();
2062         #warn "subfields:".join " ", @$subfields;
2063         my $counter = 0;
2064         my @link_loop;
2065         for my $series_subfield (@subfields) {
2066             my $volume_number;
2067             undef $volume_number;
2068             # see if this is an instance of a volume
2069             if ($series_subfield->[0] eq 'v') {
2070                 $volume_number=1;
2071             }
2072
2073             my $code = $series_subfield->[0];
2074             my $value = $series_subfield->[1];
2075             my $linkvalue = $value;
2076             $linkvalue =~ s/(\(|\))//g;
2077             my $operator = " and " unless $counter==0;
2078             push @link_loop, {link => $linkvalue, operator => $operator };
2079             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
2080             if ($volume_number) {
2081             push @subfields_loop, {volumenum => $value};
2082             }
2083             else {
2084             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
2085             }
2086             $counter++;
2087         }
2088         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
2089         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
2090         #push @marcsubjcts, $marcsubjct;
2091         #$subjct = $value;
2092
2093     }
2094     my $marcseriessarray=\@marcseries;
2095     return $marcseriessarray;
2096 }  #end getMARCseriess
2097
2098 =head2 GetFrameworkCode
2099
2100 =over 4
2101
2102     $frameworkcode = GetFrameworkCode( $biblionumber )
2103
2104 =back
2105
2106 =cut
2107
2108 sub GetFrameworkCode {
2109     my ( $biblionumber ) = @_;
2110     my $dbh = C4::Context->dbh;
2111     my $sth = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
2112     $sth->execute($biblionumber);
2113     my ($frameworkcode) = $sth->fetchrow;
2114     return $frameworkcode;
2115 }
2116
2117 =head2 GetPublisherNameFromIsbn
2118
2119     $name = GetPublishercodeFromIsbn($isbn);
2120     if(defined $name){
2121         ...
2122     }
2123
2124 =cut
2125
2126 sub GetPublisherNameFromIsbn($){
2127     my $isbn = shift;
2128     $isbn =~ s/[- _]//g;
2129     $isbn =~ s/^0*//;
2130     my @codes = (split '-', DisplayISBN($isbn));
2131     my $code = $codes[0].$codes[1].$codes[2];
2132     my $dbh  = C4::Context->dbh;
2133     my $query = qq{
2134         SELECT distinct publishercode
2135         FROM   biblioitems
2136         WHERE  isbn LIKE ?
2137         AND    publishercode IS NOT NULL
2138         LIMIT 1
2139     };
2140     my $sth = $dbh->prepare($query);
2141     $sth->execute("$code%");
2142     my $name = $sth->fetchrow;
2143     return $name if length $name;
2144     return undef;
2145 }
2146
2147 =head2 TransformKohaToMarc
2148
2149 =over 4
2150
2151     $record = TransformKohaToMarc( $hash )
2152     This function builds partial MARC::Record from a hash
2153     Hash entries can be from biblio or biblioitems.
2154     This function is called in acquisition module, to create a basic catalogue entry from user entry
2155
2156 =back
2157
2158 =cut
2159
2160 sub TransformKohaToMarc {
2161
2162     my ( $hash ) = @_;
2163     my $dbh = C4::Context->dbh;
2164     my $sth =
2165     $dbh->prepare(
2166         "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2167     );
2168     my $record = MARC::Record->new();
2169     foreach (keys %{$hash}) {
2170         &TransformKohaToMarcOneField( $sth, $record, $_,
2171             $hash->{$_}, '' );
2172         }
2173     return $record;
2174 }
2175
2176 =head2 TransformKohaToMarcOneField
2177
2178 =over 4
2179
2180     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
2181
2182 =back
2183
2184 =cut
2185
2186 sub TransformKohaToMarcOneField {
2187     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
2188     $frameworkcode='' unless $frameworkcode;
2189     my $tagfield;
2190     my $tagsubfield;
2191
2192     if ( !defined $sth ) {
2193         my $dbh = C4::Context->dbh;
2194         $sth = $dbh->prepare(
2195             "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?"
2196         );
2197     }
2198     $sth->execute( $frameworkcode, $kohafieldname );
2199     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
2200         my $tag = $record->field($tagfield);
2201         if ($tag) {
2202             $tag->update( $tagsubfield => $value );
2203             $record->delete_field($tag);
2204             $record->insert_fields_ordered($tag);
2205         }
2206         else {
2207             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
2208         }
2209     }
2210     return $record;
2211 }
2212
2213 =head2 TransformHtmlToXml
2214
2215 =over 4
2216
2217 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
2218
2219 $auth_type contains :
2220 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
2221 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
2222 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
2223
2224 =back
2225
2226 =cut
2227
2228 sub TransformHtmlToXml {
2229     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
2230     my $xml = MARC::File::XML::header('UTF-8');
2231     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
2232     MARC::File::XML->default_record_format($auth_type);
2233     # in UNIMARC, field 100 contains the encoding
2234     # check that there is one, otherwise the
2235     # MARC::Record->new_from_xml will fail (and Koha will die)
2236     my $unimarc_and_100_exist=0;
2237     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
2238     my $prevvalue;
2239     my $prevtag = -1;
2240     my $first   = 1;
2241     my $j       = -1;
2242     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
2243         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
2244             # if we have a 100 field and it's values are not correct, skip them.
2245             # if we don't have any valid 100 field, we will create a default one at the end
2246             my $enc = substr( @$values[$i], 26, 2 );
2247             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
2248                 $unimarc_and_100_exist=1;
2249             } else {
2250                 next;
2251             }
2252         }
2253         @$values[$i] =~ s/&/&amp;/g;
2254         @$values[$i] =~ s/</&lt;/g;
2255         @$values[$i] =~ s/>/&gt;/g;
2256         @$values[$i] =~ s/"/&quot;/g;
2257         @$values[$i] =~ s/'/&apos;/g;
2258 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2259 #             utf8::decode( @$values[$i] );
2260 #         }
2261         if ( ( @$tags[$i] ne $prevtag ) ) {
2262             $j++ unless ( @$tags[$i] eq "" );
2263             if ( !$first ) {
2264                 $xml .= "</datafield>\n";
2265                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2266                     && ( @$values[$i] ne "" ) )
2267                 {
2268                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2269                     my $ind2;
2270                     if ( @$indicator[$j] ) {
2271                         $ind2 = substr( @$indicator[$j], 1, 1 );
2272                     }
2273                     else {
2274                         warn "Indicator in @$tags[$i] is empty";
2275                         $ind2 = " ";
2276                     }
2277                     $xml .=
2278 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2279                     $xml .=
2280 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2281                     $first = 0;
2282                 }
2283                 else {
2284                     $first = 1;
2285                 }
2286             }
2287             else {
2288                 if ( @$values[$i] ne "" ) {
2289
2290                     # leader
2291                     if ( @$tags[$i] eq "000" ) {
2292                         $xml .= "<leader>@$values[$i]</leader>\n";
2293                         $first = 1;
2294
2295                         # rest of the fixed fields
2296                     }
2297                     elsif ( @$tags[$i] < 10 ) {
2298                         $xml .=
2299 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2300                         $first = 1;
2301                     }
2302                     else {
2303                         my $ind1 = substr( @$indicator[$j], 0, 1 );
2304                         my $ind2 = substr( @$indicator[$j], 1, 1 );
2305                         $xml .=
2306 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2307                         $xml .=
2308 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2309                         $first = 0;
2310                     }
2311                 }
2312             }
2313         }
2314         else {    # @$tags[$i] eq $prevtag
2315             if ( @$values[$i] eq "" ) {
2316             }
2317             else {
2318                 if ($first) {
2319                     my $ind1 = substr( @$indicator[$j], 0, 1 );
2320                     my $ind2 = substr( @$indicator[$j], 1, 1 );
2321                     $xml .=
2322 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2323                     $first = 0;
2324                 }
2325                 $xml .=
2326 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2327             }
2328         }
2329         $prevtag = @$tags[$i];
2330     }
2331     if (C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist) {
2332 #     warn "SETTING 100 for $auth_type";
2333         use POSIX qw(strftime);
2334         my $string = strftime( "%Y%m%d", localtime(time) );
2335         # set 50 to position 26 is biblios, 13 if authorities
2336         my $pos=26;
2337         $pos=13 if $auth_type eq 'UNIMARCAUTH';
2338         $string = sprintf( "%-*s", 35, $string );
2339         substr( $string, $pos , 6, "50" );
2340         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2341         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2342         $xml .= "</datafield>\n";
2343     }
2344     $xml .= MARC::File::XML::footer();
2345     return $xml;
2346 }
2347
2348 =head2 TransformHtmlToMarc
2349
2350     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
2351     L<$params> is a ref to an array as below:
2352     {
2353         'tag_010_indicator_531951' ,
2354         'tag_010_code_a_531951_145735' ,
2355         'tag_010_subfield_a_531951_145735' ,
2356         'tag_200_indicator_873510' ,
2357         'tag_200_code_a_873510_673465' ,
2358         'tag_200_subfield_a_873510_673465' ,
2359         'tag_200_code_b_873510_704318' ,
2360         'tag_200_subfield_b_873510_704318' ,
2361         'tag_200_code_e_873510_280822' ,
2362         'tag_200_subfield_e_873510_280822' ,
2363         'tag_200_code_f_873510_110730' ,
2364         'tag_200_subfield_f_873510_110730' ,
2365     }
2366     L<$cgi> is the CGI object which containts the value.
2367     L<$record> is the MARC::Record object.
2368
2369 =cut
2370
2371 sub TransformHtmlToMarc {
2372     my $params = shift;
2373     my $cgi    = shift;
2374
2375     # creating a new record
2376     my $record  = MARC::Record->new();
2377     my $i=0;
2378     my @fields;
2379     while ($params->[$i]){ # browse all CGI params
2380         my $param = $params->[$i];
2381         my $newfield=0;
2382         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2383         if ($param eq 'biblionumber') {
2384             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
2385                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
2386             if ($biblionumbertagfield < 10) {
2387                 $newfield = MARC::Field->new(
2388                     $biblionumbertagfield,
2389                     $cgi->param($param),
2390                 );
2391             } else {
2392                 $newfield = MARC::Field->new(
2393                     $biblionumbertagfield,
2394                     '',
2395                     '',
2396                     "$biblionumbertagsubfield" => $cgi->param($param),
2397                 );
2398             }
2399             push @fields,$newfield if($newfield);
2400         }
2401         elsif ($param =~ /^tag_(\d*)_indicator_/){ # new field start when having 'input name="..._indicator_..."
2402             my $tag  = $1;
2403
2404             my $ind1 = substr($cgi->param($param),0,1);
2405             my $ind2 = substr($cgi->param($param),1,1);
2406             $newfield=0;
2407             my $j=$i+1;
2408
2409             if($tag < 10){ # no code for theses fields
2410     # in MARC editor, 000 contains the leader.
2411                 if ($tag eq '000' ) {
2412                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
2413     # between 001 and 009 (included)
2414                 } else {
2415                     $newfield = MARC::Field->new(
2416                         $tag,
2417                         $cgi->param($params->[$j+1]),
2418                     );
2419                 }
2420     # > 009, deal with subfields
2421             } else {
2422                 while($params->[$j] =~ /_code_/){ # browse all it's subfield
2423                     my $inner_param = $params->[$j];
2424                     if ($newfield){
2425                         if($cgi->param($params->[$j+1])){  # only if there is a value (code => value)
2426                             $newfield->add_subfields(
2427                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
2428                             );
2429                         }
2430                     } else {
2431                         if ( $cgi->param($params->[$j+1]) ) { # creating only if there is a value (code => value)
2432                             $newfield = MARC::Field->new(
2433                                 $tag,
2434                                 ''.$ind1,
2435                                 ''.$ind2,
2436                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
2437                             );
2438                         }
2439                     }
2440                     $j+=2;
2441                 }
2442             }
2443             push @fields,$newfield if($newfield);
2444         }
2445         $i++;
2446     }
2447
2448     $record->append_fields(@fields);
2449     return $record;
2450 }
2451
2452 # cache inverted MARC field map
2453 our $inverted_field_map;
2454
2455 =head2 TransformMarcToKoha
2456
2457 =over 4
2458
2459     $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2460
2461 =back
2462
2463 Extract data from a MARC bib record into a hashref representing
2464 Koha biblio, biblioitems, and items fields.
2465
2466 =cut
2467 sub TransformMarcToKoha {
2468     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2469
2470     my $result;
2471
2472     unless (defined $inverted_field_map) {
2473         $inverted_field_map = _get_inverted_marc_field_map();
2474     }
2475
2476     my %tables = ();
2477     if ($limit_table eq 'items') {
2478         $tables{'items'} = 1;
2479     } else {
2480         $tables{'items'} = 1;
2481         $tables{'biblio'} = 1;
2482         $tables{'biblioitems'} = 1;
2483     }
2484
2485     # traverse through record
2486     MARCFIELD: foreach my $field ($record->fields()) {
2487         my $tag = $field->tag();
2488         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2489         if ($field->is_control_field()) {
2490             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2491             ENTRY: foreach my $entry (@{ $kohafields }) {
2492                 my ($subfield, $table, $column) = @{ $entry };
2493                 next ENTRY unless exists $tables{$table};
2494                 my $key = _disambiguate($table, $column);
2495                 if ($result->{$key}) {
2496                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($field->data() eq "")) {
2497                         $result->{$key} .= " | " . $field->data();
2498                     }
2499                 } else {
2500                     $result->{$key} = $field->data();
2501                 }
2502             }
2503         } else {
2504             # deal with subfields
2505             MARCSUBFIELD: foreach my $sf ($field->subfields()) {
2506                 my $code = $sf->[0];
2507                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2508                 my $value = $sf->[1];
2509                 SFENTRY: foreach my $entry (@{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} }) {
2510                     my ($table, $column) = @{ $entry };
2511                     next SFENTRY unless exists $tables{$table};
2512                     my $key = _disambiguate($table, $column);
2513                     if ($result->{$key}) {
2514                         unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2515                             $result->{$key} .= " | " . $value;
2516                         }
2517                     } else {
2518                         $result->{$key} = $value;
2519                     }
2520                 }
2521             }
2522         }
2523     }
2524
2525     # modify copyrightdate to keep only the 1st year found
2526     if (exists $result->{'copyrightdate'}) {
2527         my $temp = $result->{'copyrightdate'};
2528         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2529         if ( $1 > 0 ) {
2530             $result->{'copyrightdate'} = $1;
2531         }
2532         else {                      # if no cYYYY, get the 1st date.
2533             $temp =~ m/(\d\d\d\d)/;
2534             $result->{'copyrightdate'} = $1;
2535         }
2536     }
2537
2538     # modify publicationyear to keep only the 1st year found
2539     if (exists $result->{'publicationyear'}) {
2540         my $temp = $result->{'publicationyear'};
2541         $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2542         if ( $1 > 0 ) {
2543             $result->{'publicationyear'} = $1;
2544         }
2545         else {                      # if no cYYYY, get the 1st date.
2546             $temp =~ m/(\d\d\d\d)/;
2547             $result->{'publicationyear'} = $1;
2548         }
2549     }
2550
2551     return $result;
2552 }
2553
2554 sub _get_inverted_marc_field_map {
2555     my $relations = C4::Context->marcfromkohafield;
2556
2557     my $field_map = {};
2558     my $relations = C4::Context->marcfromkohafield;
2559
2560     foreach my $frameworkcode (keys %{ $relations }) {
2561         foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) {
2562             my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2563             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2564             my ($table, $column) = split /[.]/, $kohafield, 2;
2565             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2566             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2567         }
2568     }
2569     return $field_map;
2570 }
2571
2572 =head2 _disambiguate
2573
2574 =over 4
2575
2576 $newkey = _disambiguate($table, $field);
2577
2578 This is a temporary hack to distinguish between the
2579 following sets of columns when using TransformMarcToKoha.
2580
2581 items.cn_source & biblioitems.cn_source
2582 items.cn_sort & biblioitems.cn_sort
2583
2584 Columns that are currently NOT distinguished (FIXME
2585 due to lack of time to fully test) are:
2586
2587 biblio.notes and biblioitems.notes
2588 biblionumber
2589 timestamp
2590 biblioitemnumber
2591
2592 FIXME - this is necessary because prefixing each column
2593 name with the table name would require changing lots
2594 of code and templates, and exposing more of the DB
2595 structure than is good to the UI templates, particularly
2596 since biblio and bibloitems may well merge in a future
2597 version.  In the future, it would also be good to
2598 separate DB access and UI presentation field names
2599 more.
2600
2601 =back
2602
2603 =cut
2604
2605 sub _disambiguate {
2606     my ($table, $column) = @_;
2607     if ($column eq "cn_sort" or $column eq "cn_source") {
2608         return $table . '.' . $column;
2609     } else {
2610         return $column;
2611     }
2612
2613 }
2614
2615 =head2 get_koha_field_from_marc
2616
2617 =over 4
2618
2619 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2620
2621 Internal function to map data from the MARC record to a specific non-MARC field.
2622 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2623
2624 =back
2625
2626 =cut
2627
2628 sub get_koha_field_from_marc {
2629     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
2630     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
2631     my $kohafield;
2632     foreach my $field ( $record->field($tagfield) ) {
2633         if ( $field->tag() < 10 ) {
2634             if ( $kohafield ) {
2635                 $kohafield .= " | " . $field->data();
2636             }
2637             else {
2638                 $kohafield = $field->data();
2639             }
2640         }
2641         else {
2642             if ( $field->subfields ) {
2643                 my @subfields = $field->subfields();
2644                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2645                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2646                         if ( $kohafield ) {
2647                             $kohafield .=
2648                               " | " . $subfields[$subfieldcount][1];
2649                         }
2650                         else {
2651                             $kohafield =
2652                               $subfields[$subfieldcount][1];
2653                         }
2654                     }
2655                 }
2656             }
2657         }
2658     }
2659     return $kohafield;
2660 }
2661
2662
2663 =head2 TransformMarcToKohaOneField
2664
2665 =over 4
2666
2667 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2668
2669 =back
2670
2671 =cut
2672
2673 sub TransformMarcToKohaOneField {
2674
2675     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2676     # only the 1st will be retrieved...
2677     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2678     my $res = "";
2679     my ( $tagfield, $subfield ) =
2680       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2681         $frameworkcode );
2682     foreach my $field ( $record->field($tagfield) ) {
2683         if ( $field->tag() < 10 ) {
2684             if ( $result->{$kohafield} ) {
2685                 $result->{$kohafield} .= " | " . $field->data();
2686             }
2687             else {
2688                 $result->{$kohafield} = $field->data();
2689             }
2690         }
2691         else {
2692             if ( $field->subfields ) {
2693                 my @subfields = $field->subfields();
2694                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2695                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2696                         if ( $result->{$kohafield} ) {
2697                             $result->{$kohafield} .=
2698                               " | " . $subfields[$subfieldcount][1];
2699                         }
2700                         else {
2701                             $result->{$kohafield} =
2702                               $subfields[$subfieldcount][1];
2703                         }
2704                     }
2705                 }
2706             }
2707         }
2708     }
2709     return $result;
2710 }
2711
2712 =head1  OTHER FUNCTIONS
2713
2714 =head2 char_decode
2715
2716 =over 4
2717
2718 my $string = char_decode( $string, $encoding );
2719
2720 converts ISO 5426 coded string to UTF-8
2721 sloppy code : should be improved in next issue
2722
2723 =back
2724
2725 =cut
2726
2727 sub char_decode {
2728     my ( $string, $encoding ) = @_;
2729     $_ = $string;
2730
2731     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2732     if ( $encoding eq "UNIMARC" ) {
2733
2734         #         s/\xe1/Æ/gm;
2735         s/\xe2/Ğ/gm;
2736         s/\xe9/Ø/gm;
2737         s/\xec/ş/gm;
2738         s/\xf1/æ/gm;
2739         s/\xf3/ğ/gm;
2740         s/\xf9/ø/gm;
2741         s/\xfb/ß/gm;
2742         s/\xc1\x61/à/gm;
2743         s/\xc1\x65/è/gm;
2744         s/\xc1\x69/ì/gm;
2745         s/\xc1\x6f/ò/gm;
2746         s/\xc1\x75/ù/gm;
2747         s/\xc1\x41/À/gm;
2748         s/\xc1\x45/È/gm;
2749         s/\xc1\x49/Ì/gm;
2750         s/\xc1\x4f/Ò/gm;
2751         s/\xc1\x55/Ù/gm;
2752         s/\xc2\x41/Á/gm;
2753         s/\xc2\x45/É/gm;
2754         s/\xc2\x49/Í/gm;
2755         s/\xc2\x4f/Ó/gm;
2756         s/\xc2\x55/Ú/gm;
2757         s/\xc2\x59/İ/gm;
2758         s/\xc2\x61/á/gm;
2759         s/\xc2\x65/é/gm;
2760         s/\xc2\x69/í/gm;
2761         s/\xc2\x6f/ó/gm;
2762         s/\xc2\x75/ú/gm;
2763         s/\xc2\x79/ı/gm;
2764         s/\xc3\x41/Â/gm;
2765         s/\xc3\x45/Ê/gm;
2766         s/\xc3\x49/Î/gm;
2767         s/\xc3\x4f/Ô/gm;
2768         s/\xc3\x55/Û/gm;
2769         s/\xc3\x61/â/gm;
2770         s/\xc3\x65/ê/gm;
2771         s/\xc3\x69/î/gm;
2772         s/\xc3\x6f/ô/gm;
2773         s/\xc3\x75/û/gm;
2774         s/\xc4\x41/Ã/gm;
2775         s/\xc4\x4e/Ñ/gm;
2776         s/\xc4\x4f/Õ/gm;
2777         s/\xc4\x61/ã/gm;
2778         s/\xc4\x6e/ñ/gm;
2779         s/\xc4\x6f/õ/gm;
2780         s/\xc8\x41/Ä/gm;
2781         s/\xc8\x45/Ë/gm;
2782         s/\xc8\x49/Ï/gm;
2783         s/\xc8\x61/ä/gm;
2784         s/\xc8\x65/ë/gm;
2785         s/\xc8\x69/ï/gm;
2786         s/\xc8\x6F/ö/gm;
2787         s/\xc8\x75/ü/gm;
2788         s/\xc8\x76/ÿ/gm;
2789         s/\xc9\x41/Ä/gm;
2790         s/\xc9\x45/Ë/gm;
2791         s/\xc9\x49/Ï/gm;
2792         s/\xc9\x4f/Ö/gm;
2793         s/\xc9\x55/Ü/gm;
2794         s/\xc9\x61/ä/gm;
2795         s/\xc9\x6f/ö/gm;
2796         s/\xc9\x75/ü/gm;
2797         s/\xca\x41/Å/gm;
2798         s/\xca\x61/å/gm;
2799         s/\xd0\x43/Ç/gm;
2800         s/\xd0\x63/ç/gm;
2801
2802         # this handles non-sorting blocks (if implementation requires this)
2803         $string = nsb_clean($_);
2804     }
2805     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2806         ##MARC-8 to UTF-8
2807
2808         s/\xe1\x61/à/gm;
2809         s/\xe1\x65/è/gm;
2810         s/\xe1\x69/ì/gm;
2811         s/\xe1\x6f/ò/gm;
2812         s/\xe1\x75/ù/gm;
2813         s/\xe1\x41/À/gm;
2814         s/\xe1\x45/È/gm;
2815         s/\xe1\x49/Ì/gm;
2816         s/\xe1\x4f/Ò/gm;
2817         s/\xe1\x55/Ù/gm;
2818         s/\xe2\x41/Á/gm;
2819         s/\xe2\x45/É/gm;
2820         s/\xe2\x49/Í/gm;
2821         s/\xe2\x4f/Ó/gm;
2822         s/\xe2\x55/Ú/gm;
2823         s/\xe2\x59/İ/gm;
2824         s/\xe2\x61/á/gm;
2825         s/\xe2\x65/é/gm;
2826         s/\xe2\x69/í/gm;
2827         s/\xe2\x6f/ó/gm;
2828         s/\xe2\x75/ú/gm;
2829         s/\xe2\x79/ı/gm;
2830         s/\xe3\x41/Â/gm;
2831         s/\xe3\x45/Ê/gm;
2832         s/\xe3\x49/Î/gm;
2833         s/\xe3\x4f/Ô/gm;
2834         s/\xe3\x55/Û/gm;
2835         s/\xe3\x61/â/gm;
2836         s/\xe3\x65/ê/gm;
2837         s/\xe3\x69/î/gm;
2838         s/\xe3\x6f/ô/gm;
2839         s/\xe3\x75/û/gm;
2840         s/\xe4\x41/Ã/gm;
2841         s/\xe4\x4e/Ñ/gm;
2842         s/\xe4\x4f/Õ/gm;
2843         s/\xe4\x61/ã/gm;
2844         s/\xe4\x6e/ñ/gm;
2845         s/\xe4\x6f/õ/gm;
2846         s/\xe6\x41/Ă/gm;
2847         s/\xe6\x45/Ĕ/gm;
2848         s/\xe6\x65/ĕ/gm;
2849         s/\xe6\x61/ă/gm;
2850         s/\xe8\x45/Ë/gm;
2851         s/\xe8\x49/Ï/gm;
2852         s/\xe8\x65/ë/gm;
2853         s/\xe8\x69/ï/gm;
2854         s/\xe8\x76/ÿ/gm;
2855         s/\xe9\x41/A/gm;
2856         s/\xe9\x4f/O/gm;
2857         s/\xe9\x55/U/gm;
2858         s/\xe9\x61/a/gm;
2859         s/\xe9\x6f/o/gm;
2860         s/\xe9\x75/u/gm;
2861         s/\xea\x41/A/gm;
2862         s/\xea\x61/a/gm;
2863
2864         #Additional Turkish characters
2865         s/\x1b//gm;
2866         s/\x1e//gm;
2867         s/(\xf0)s/\xc5\x9f/gm;
2868         s/(\xf0)S/\xc5\x9e/gm;
2869         s/(\xf0)c/ç/gm;
2870         s/(\xf0)C/Ç/gm;
2871         s/\xe7\x49/\\xc4\xb0/gm;
2872         s/(\xe6)G/\xc4\x9e/gm;
2873         s/(\xe6)g/ğ\xc4\x9f/gm;
2874         s/\xB8/ı/gm;
2875         s/\xB9/£/gm;
2876         s/(\xe8|\xc8)o/ö/gm;
2877         s/(\xe8|\xc8)O/Ö/gm;
2878         s/(\xe8|\xc8)u/ü/gm;
2879         s/(\xe8|\xc8)U/Ü/gm;
2880         s/\xc2\xb8/\xc4\xb1/gm;
2881         s/¸/\xc4\xb1/gm;
2882
2883         # this handles non-sorting blocks (if implementation requires this)
2884         $string = nsb_clean($_);
2885     }
2886     return ($string);
2887 }
2888
2889 =head2 nsb_clean
2890
2891 =over 4
2892
2893 my $string = nsb_clean( $string, $encoding );
2894
2895 =back
2896
2897 =cut
2898
2899 sub nsb_clean {
2900     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2901     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2902                               # handles non sorting blocks
2903     my ($string) = @_;
2904     $_ = $string;
2905     s/$NSB/(/gm;
2906     s/[ ]{0,1}$NSE/) /gm;
2907     $string = $_;
2908     return ($string);
2909 }
2910
2911 =head2 PrepareItemrecordDisplay
2912
2913 =over 4
2914
2915 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2916
2917 Returns a hash with all the fields for Display a given item data in a template
2918
2919 =back
2920
2921 =cut
2922
2923 sub PrepareItemrecordDisplay {
2924
2925     my ( $bibnum, $itemnum ) = @_;
2926
2927     my $dbh = C4::Context->dbh;
2928     my $frameworkcode = &GetFrameworkCode( $bibnum );
2929     my ( $itemtagfield, $itemtagsubfield ) =
2930       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2931     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2932     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2933     my @loop_data;
2934     my $authorised_values_sth =
2935       $dbh->prepare(
2936 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
2937       );
2938     foreach my $tag ( sort keys %{$tagslib} ) {
2939         my $previous_tag = '';
2940         if ( $tag ne '' ) {
2941             # loop through each subfield
2942             my $cntsubf;
2943             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2944                 next if ( subfield_is_koha_internal_p($subfield) );
2945                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2946                 my %subfield_data;
2947                 $subfield_data{tag}           = $tag;
2948                 $subfield_data{subfield}      = $subfield;
2949                 $subfield_data{countsubfield} = $cntsubf++;
2950                 $subfield_data{kohafield}     =
2951                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2952
2953          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2954                 $subfield_data{marc_lib} =
2955                     "<span id=\"error\" title=\""
2956                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2957                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2958                   . "</span>";
2959                 $subfield_data{mandatory} =
2960                   $tagslib->{$tag}->{$subfield}->{mandatory};
2961                 $subfield_data{repeatable} =
2962                   $tagslib->{$tag}->{$subfield}->{repeatable};
2963                 $subfield_data{hidden} = "display:none"
2964                   if $tagslib->{$tag}->{$subfield}->{hidden};
2965                 my ( $x, $value );
2966                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2967                   if ($itemrecord);
2968                 $value =~ s/"/&quot;/g;
2969
2970                 # search for itemcallnumber if applicable
2971                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2972                     'items.itemcallnumber'
2973                     && C4::Context->preference('itemcallnumber') )
2974                 {
2975                     my $CNtag =
2976                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2977                     my $CNsubfield =
2978                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2979                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2980                     if ($temp) {
2981                         $value = $temp->subfield($CNsubfield);
2982                     }
2983                 }
2984                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2985                     my @authorised_values;
2986                     my %authorised_lib;
2987
2988                     # builds list, depending on authorised value...
2989                     #---- branch
2990                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2991                         "branches" )
2992                     {
2993                         if ( ( C4::Context->preference("IndependantBranches") )
2994                             && ( C4::Context->userenv->{flags} != 1 ) )
2995                         {
2996                             my $sth =
2997                               $dbh->prepare(
2998                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
2999                               );
3000                             $sth->execute( C4::Context->userenv->{branch} );
3001                             push @authorised_values, ""
3002                               unless (
3003                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
3004                             while ( my ( $branchcode, $branchname ) =
3005                                 $sth->fetchrow_array )
3006                             {
3007                                 push @authorised_values, $branchcode;
3008                                 $authorised_lib{$branchcode} = $branchname;
3009                             }
3010                         }
3011                         else {
3012                             my $sth =
3013                               $dbh->prepare(
3014                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
3015                               );
3016                             $sth->execute;
3017                             push @authorised_values, ""
3018                               unless (
3019                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
3020                             while ( my ( $branchcode, $branchname ) =
3021                                 $sth->fetchrow_array )
3022                             {
3023                                 push @authorised_values, $branchcode;
3024                                 $authorised_lib{$branchcode} = $branchname;
3025                             }
3026                         }
3027
3028                         #----- itemtypes
3029                     }
3030                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
3031                         "itemtypes" )
3032                     {
3033                         my $sth =
3034                           $dbh->prepare(
3035                             "SELECT itemtype,description FROM itemtypes ORDER BY description"
3036                           );
3037                         $sth->execute;
3038                         push @authorised_values, ""
3039                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3040                         while ( my ( $itemtype, $description ) =
3041                             $sth->fetchrow_array )
3042                         {
3043                             push @authorised_values, $itemtype;
3044                             $authorised_lib{$itemtype} = $description;
3045                         }
3046
3047                         #---- "true" authorised value
3048                     }
3049                     else {
3050                         $authorised_values_sth->execute(
3051                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
3052                         push @authorised_values, ""
3053                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3054                         while ( my ( $value, $lib ) =
3055                             $authorised_values_sth->fetchrow_array )
3056                         {
3057                             push @authorised_values, $value;
3058                             $authorised_lib{$value} = $lib;
3059                         }
3060                     }
3061                     $subfield_data{marc_value} = CGI::scrolling_list(
3062                         -name     => 'field_value',
3063                         -values   => \@authorised_values,
3064                         -default  => "$value",
3065                         -labels   => \%authorised_lib,
3066                         -size     => 1,
3067                         -tabindex => '',
3068                         -multiple => 0,
3069                     );
3070                 }
3071                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
3072                     $subfield_data{marc_value} =
3073 "<input type=\"text\" name=\"field_value\"  size=47 maxlength=255> <a href=\"javascript:Dopop('cataloguing/thesaurus_popup.pl?category=$tagslib->{$tag}->{$subfield}->{thesaurus_category}&index=',)\">...</a>";
3074
3075 #"
3076 # COMMENTED OUT because No $i is provided with this API.
3077 # And thus, no value_builder can be activated.
3078 # BUT could be thought over.
3079 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
3080 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
3081 #             require $plugin;
3082 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
3083 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
3084 #             $subfield_data{marc_value}="<input type=\"text\" value=\"$value\" name=\"field_value\"  size=47 maxlength=255 DISABLE READONLY OnFocus=\"javascript:Focus$function_name()\" OnBlur=\"javascript:Blur$function_name()\"> <a href=\"javascript:Clic$function_name()\">...</a> $javascript";
3085                 }
3086                 else {
3087                     $subfield_data{marc_value} =
3088 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
3089                 }
3090                 push( @loop_data, \%subfield_data );
3091             }
3092         }
3093     }
3094     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
3095       if ( $itemrecord && $itemrecord->field($itemtagfield) );
3096     return {
3097         'itemtagfield'    => $itemtagfield,
3098         'itemtagsubfield' => $itemtagsubfield,
3099         'itemnumber'      => $itemnumber,
3100         'iteminformation' => \@loop_data
3101     };
3102 }
3103 #"
3104
3105 #
3106 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3107 # at the same time
3108 # replaced by a zebraqueue table, that is filled with ModZebra to run.
3109 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3110 # =head2 ModZebrafiles
3111 #
3112 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
3113 #
3114 # =cut
3115 #
3116 # sub ModZebrafiles {
3117 #
3118 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
3119 #
3120 #     my $op;
3121 #     my $zebradir =
3122 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
3123 #     unless ( opendir( DIR, "$zebradir" ) ) {
3124 #         warn "$zebradir not found";
3125 #         return;
3126 #     }
3127 #     closedir DIR;
3128 #     my $filename = $zebradir . $biblionumber;
3129 #
3130 #     if ($record) {
3131 #         open( OUTPUT, ">", $filename . ".xml" );
3132 #         print OUTPUT $record;
3133 #         close OUTPUT;
3134 #     }
3135 # }
3136
3137 =head2 ModZebra
3138
3139 =over 4
3140
3141 ModZebra( $biblionumber, $op, $server, $newRecord );
3142
3143     $biblionumber is the biblionumber we want to index
3144     $op is specialUpdate or delete, and is used to know what we want to do
3145     $server is the server that we want to update
3146     $newRecord is the MARC::Record containing the new record. It is usefull only when NoZebra=1, and is used to know what to add to the nozebra database. (the record in mySQL being, if it exist, the previous record, the one just before the modif. We need both : the previous and the new one.
3147
3148 =back
3149
3150 =cut
3151
3152 sub ModZebra {
3153 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
3154     my ( $biblionumber, $op, $server, $newRecord ) = @_;
3155     my $dbh=C4::Context->dbh;
3156
3157     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
3158     # at the same time
3159     # replaced by a zebraqueue table, that is filled with ModZebra to run.
3160     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
3161
3162     if (C4::Context->preference("NoZebra")) {
3163         # lock the nozebra table : we will read index lines, update them in Perl process
3164         # and write everything in 1 transaction.
3165         # lock the table to avoid someone else overwriting what we are doing
3166         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE');
3167         my %result; # the result hash that will be builded by deletion / add, and written on mySQL at the end, to improve speed
3168         my $record;
3169         if ($server eq 'biblioserver') {
3170             $record= GetMarcBiblio($biblionumber);
3171         } else {
3172             $record= C4::AuthoritiesMarc::GetAuthority($biblionumber);
3173         }
3174         if ($op eq 'specialUpdate') {
3175             # OK, we have to add or update the record
3176             # 1st delete (virtually, in indexes), if record actually exists
3177             if ($record) {
3178                 %result = _DelBiblioNoZebra($biblionumber,$record,$server);
3179             }
3180             # ... add the record
3181             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
3182         } else {
3183             # it's a deletion, delete the record...
3184             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
3185             %result=_DelBiblioNoZebra($biblionumber,$record,$server);
3186         }
3187         # ok, now update the database...
3188         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
3189         foreach my $key (keys %result) {
3190             foreach my $index (keys %{$result{$key}}) {
3191                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
3192             }
3193         }
3194         $dbh->do('UNLOCK TABLES');
3195
3196     } else {
3197         #
3198         # we use zebra, just fill zebraqueue table
3199         #
3200         my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
3201         $sth->execute($biblionumber,$server,$op);
3202         $sth->finish;
3203     }
3204 }
3205
3206 =head2 GetNoZebraIndexes
3207
3208     %indexes = GetNoZebraIndexes;
3209
3210     return the data from NoZebraIndexes syspref.
3211
3212 =cut
3213
3214 sub GetNoZebraIndexes {
3215     my $index = C4::Context->preference('NoZebraIndexes');
3216     my %indexes;
3217     foreach my $line (split /('|"),/,$index) {
3218         $line =~ /(.*)=>(.*)/;
3219         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
3220         my $fields = $2;
3221         $index =~ s/'|"|\s//g;
3222
3223
3224         $fields =~ s/'|"|\s//g;
3225         $indexes{$index}=$fields;
3226     }
3227     return %indexes;
3228 }
3229
3230 =head1 INTERNAL FUNCTIONS
3231
3232 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
3233
3234     function to delete a biblio in NoZebra indexes
3235     This function does NOT delete anything in database : it reads all the indexes entries
3236     that have to be deleted & delete them in the hash
3237     The SQL part is done either :
3238     - after the Add if we are modifying a biblio (delete + add again)
3239     - immediatly after this sub if we are doing a true deletion.
3240     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
3241
3242 =cut
3243
3244
3245 sub _DelBiblioNoZebra {
3246     my ($biblionumber, $record, $server)=@_;
3247
3248     # Get the indexes
3249     my $dbh = C4::Context->dbh;
3250     # Get the indexes
3251     my %index;
3252     my $title;
3253     if ($server eq 'biblioserver') {
3254         %index=GetNoZebraIndexes;
3255         # get title of the record (to store the 10 first letters with the index)
3256         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3257         $title = lc($record->subfield($titletag,$titlesubfield));
3258     } else {
3259         # for authorities, the "title" is the $a mainentry
3260         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3261         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3262         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3263         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
3264         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
3265         $index{'auth_type'}    = '152b';
3266     }
3267
3268     my %result;
3269     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3270     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3271     # limit to 10 char, should be enough, and limit the DB size
3272     $title = substr($title,0,10);
3273     #parse each field
3274     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3275     foreach my $field ($record->fields()) {
3276         #parse each subfield
3277         next if $field->tag <10;
3278         foreach my $subfield ($field->subfields()) {
3279             my $tag = $field->tag();
3280             my $subfieldcode = $subfield->[0];
3281             my $indexed=0;
3282             # check each index to see if the subfield is stored somewhere
3283             # otherwise, store it in __RAW__ index
3284             foreach my $key (keys %index) {
3285 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3286                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3287                     $indexed=1;
3288                     my $line= lc $subfield->[1];
3289                     # remove meaningless value in the field...
3290                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3291                     # ... and split in words
3292                     foreach (split / /,$line) {
3293                         next unless $_; # skip  empty values (multiple spaces)
3294                         # if the entry is already here, do nothing, the biblionumber has already be removed
3295                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3296                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3297                             $sth2->execute($server,$key,$_);
3298                             my $existing_biblionumbers = $sth2->fetchrow;
3299                             # it exists
3300                             if ($existing_biblionumbers) {
3301 #                                 warn " existing for $key $_: $existing_biblionumbers";
3302                                 $result{$key}->{$_} =$existing_biblionumbers;
3303                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3304                             }
3305                         }
3306                     }
3307                 }
3308             }
3309             # the subfield is not indexed, store it in __RAW__ index anyway
3310             unless ($indexed) {
3311                 my $line= lc $subfield->[1];
3312                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3313                 # ... and split in words
3314                 foreach (split / /,$line) {
3315                     next unless $_; # skip  empty values (multiple spaces)
3316                     # if the entry is already here, do nothing, the biblionumber has already be removed
3317                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
3318                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
3319                         $sth2->execute($server,'__RAW__',$_);
3320                         my $existing_biblionumbers = $sth2->fetchrow;
3321                         # it exists
3322                         if ($existing_biblionumbers) {
3323                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
3324                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
3325                         }
3326                     }
3327                 }
3328             }
3329         }
3330     }
3331     return %result;
3332 }
3333
3334 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
3335
3336     function to add a biblio in NoZebra indexes
3337
3338 =cut
3339
3340 sub _AddBiblioNoZebra {
3341     my ($biblionumber, $record, $server, %result)=@_;
3342     my $dbh = C4::Context->dbh;
3343     # Get the indexes
3344     my %index;
3345     my $title;
3346     if ($server eq 'biblioserver') {
3347         %index=GetNoZebraIndexes;
3348         # get title of the record (to store the 10 first letters with the index)
3349         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
3350         $title = lc($record->subfield($titletag,$titlesubfield));
3351     } else {
3352         # warn "server : $server";
3353         # for authorities, the "title" is the $a mainentry
3354         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
3355         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
3356         $title = $record->subfield($authref->{auth_tag_to_report},'a');
3357         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
3358         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
3359         $index{'auth_type'}     = '152b';
3360     }
3361
3362     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3363     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
3364     # limit to 10 char, should be enough, and limit the DB size
3365     $title = substr($title,0,10);
3366     #parse each field
3367     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3368     foreach my $field ($record->fields()) {
3369         #parse each subfield
3370         next if $field->tag <10;
3371         foreach my $subfield ($field->subfields()) {
3372             my $tag = $field->tag();
3373             my $subfieldcode = $subfield->[0];
3374             my $indexed=0;
3375             # check each index to see if the subfield is stored somewhere
3376             # otherwise, store it in __RAW__ index
3377             foreach my $key (keys %index) {
3378 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3379                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
3380                     $indexed=1;
3381                     my $line= lc $subfield->[1];
3382                     # remove meaningless value in the field...
3383                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3384                     # ... and split in words
3385                     foreach (split / /,$line) {
3386                         next unless $_; # skip  empty values (multiple spaces)
3387                         # if the entry is already here, improve weight
3388 #                         warn "managing $_";
3389                         if ($result{$key}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3390                             my $weight=$1+1;
3391                             $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3392                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3393                         } else {
3394                             # get the value if it exist in the nozebra table, otherwise, create it
3395                             $sth2->execute($server,$key,$_);
3396                             my $existing_biblionumbers = $sth2->fetchrow;
3397                             # it exists
3398                             if ($existing_biblionumbers) {
3399                                 $result{$key}->{"$_"} =$existing_biblionumbers;
3400                                 my $weight=$1+1;
3401                                 $result{$key}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3402                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3403                             # create a new ligne for this entry
3404                             } else {
3405 #                             warn "INSERT : $server / $key / $_";
3406                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
3407                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
3408                             }
3409                         }
3410                     }
3411                 }
3412             }
3413             # the subfield is not indexed, store it in __RAW__ index anyway
3414             unless ($indexed) {
3415                 my $line= lc $subfield->[1];
3416                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
3417                 # ... and split in words
3418                 foreach (split / /,$line) {
3419                     next unless $_; # skip  empty values (multiple spaces)
3420                     # if the entry is already here, improve weight
3421                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,$title\-(\d);/) {
3422                         my $weight=$1+1;
3423                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3424                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3425                     } else {
3426                         # get the value if it exist in the nozebra table, otherwise, create it
3427                         $sth2->execute($server,'__RAW__',$_);
3428                         my $existing_biblionumbers = $sth2->fetchrow;
3429                         # it exists
3430                         if ($existing_biblionumbers) {
3431                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
3432                             my $weight=$1+1;
3433                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,$title\-(\d);//;
3434                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3435                         # create a new ligne for this entry
3436                         } else {
3437                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
3438                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
3439                         }
3440                     }
3441                 }
3442             }
3443         }
3444     }
3445     return %result;
3446 }
3447
3448
3449 =head2 MARCitemchange
3450
3451 =over 4
3452
3453 &MARCitemchange( $record, $itemfield, $newvalue )
3454
3455 Function to update a single value in an item field.
3456 Used twice, could probably be replaced by something else, but works well...
3457
3458 =back
3459
3460 =back
3461
3462 =cut
3463
3464 sub MARCitemchange {
3465     my ( $record, $itemfield, $newvalue ) = @_;
3466     my $dbh = C4::Context->dbh;
3467
3468     my ( $tagfield, $tagsubfield ) =
3469       GetMarcFromKohaField( $itemfield, "" );
3470     if ( ($tagfield) && ($tagsubfield) ) {
3471         my $tag = $record->field($tagfield);
3472         if ($tag) {
3473             $tag->update( $tagsubfield => $newvalue );
3474             $record->delete_field($tag);
3475             $record->insert_fields_ordered($tag);
3476         }
3477     }
3478 }
3479 =head2 _find_value
3480
3481 =over 4
3482
3483 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3484
3485 Find the given $subfield in the given $tag in the given
3486 MARC::Record $record.  If the subfield is found, returns
3487 the (indicators, value) pair; otherwise, (undef, undef) is
3488 returned.
3489
3490 PROPOSITION :
3491 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3492 I suggest we export it from this module.
3493
3494 =back
3495
3496 =cut
3497
3498 sub _find_value {
3499     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3500     my @result;
3501     my $indicator;
3502     if ( $tagfield < 10 ) {
3503         if ( $record->field($tagfield) ) {
3504             push @result, $record->field($tagfield)->data();
3505         }
3506         else {
3507             push @result, "";
3508         }
3509     }
3510     else {
3511         foreach my $field ( $record->field($tagfield) ) {
3512             my @subfields = $field->subfields();
3513             foreach my $subfield (@subfields) {
3514                 if ( @$subfield[0] eq $insubfield ) {
3515                     push @result, @$subfield[1];
3516                     $indicator = $field->indicator(1) . $field->indicator(2);
3517                 }
3518             }
3519         }
3520     }
3521     return ( $indicator, @result );
3522 }
3523
3524 =head2 _koha_marc_update_bib_ids
3525
3526 =over 4
3527
3528 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3529
3530 Internal function to add or update biblionumber and biblioitemnumber to
3531 the MARC XML.
3532
3533 =back
3534
3535 =cut
3536
3537 sub _koha_marc_update_bib_ids {
3538     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
3539
3540     # we must add bibnum and bibitemnum in MARC::Record...
3541     # we build the new field with biblionumber and biblioitemnumber
3542     # we drop the original field
3543     # we add the new builded field.
3544     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
3545     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3546
3547     if ($biblio_tag != $biblioitem_tag) {
3548         # biblionumber & biblioitemnumber are in different fields
3549
3550         # deal with biblionumber
3551         my ($new_field, $old_field);
3552         if ($biblio_tag < 10) {
3553             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3554         } else {
3555             $new_field =
3556               MARC::Field->new( $biblio_tag, '', '',
3557                 "$biblio_subfield" => $biblionumber );
3558         }
3559
3560         # drop old field and create new one...
3561         $old_field = $record->field($biblio_tag);
3562         $record->delete_field($old_field);
3563         $record->append_fields($new_field);
3564
3565         # deal with biblioitemnumber
3566         if ($biblioitem_tag < 10) {
3567             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3568         } else {
3569             $new_field =
3570               MARC::Field->new( $biblioitem_tag, '', '',
3571                 "$biblioitem_subfield" => $biblioitemnumber, );
3572         }
3573         # drop old field and create new one...
3574         $old_field = $record->field($biblioitem_tag);
3575         $record->delete_field($old_field);
3576         $record->insert_fields_ordered($new_field);
3577
3578     } else {
3579         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3580         my $new_field = MARC::Field->new(
3581             $biblio_tag, '', '',
3582             "$biblio_subfield" => $biblionumber,
3583             "$biblioitem_subfield" => $biblioitemnumber
3584         );
3585
3586         # drop old field and create new one...
3587         my $old_field = $record->field($biblio_tag);
3588         $record->delete_field($old_field);
3589         $record->insert_fields_ordered($new_field);
3590     }
3591 }
3592
3593 =head2 _koha_add_biblio
3594
3595 =over 4
3596
3597 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3598
3599 Internal function to add a biblio ($biblio is a hash with the values)
3600
3601 =back
3602
3603 =cut
3604
3605 sub _koha_add_biblio {
3606     my ( $dbh, $biblio, $frameworkcode ) = @_;
3607
3608     my $error;
3609
3610     # set the series flag
3611     my $serial = 0;
3612     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3613
3614     my $query =
3615         "INSERT INTO biblio
3616         SET frameworkcode = ?,
3617             author = ?,
3618             title = ?,
3619             unititle =?,
3620             notes = ?,
3621             serial = ?,
3622             seriestitle = ?,
3623             copyrightdate = ?,
3624             datecreated=NOW(),
3625             abstract = ?
3626         ";
3627     my $sth = $dbh->prepare($query);
3628     $sth->execute(
3629         $frameworkcode,
3630         $biblio->{'author'},
3631         $biblio->{'title'},
3632         $biblio->{'unititle'},
3633         $biblio->{'notes'},
3634         $serial,
3635         $biblio->{'seriestitle'},
3636         $biblio->{'copyrightdate'},
3637         $biblio->{'abstract'}
3638     );
3639
3640     my $biblionumber = $dbh->{'mysql_insertid'};
3641     if ( $dbh->errstr ) {
3642         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3643         warn $error;
3644     }
3645
3646     $sth->finish();
3647     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3648     return ($biblionumber,$error);
3649 }
3650
3651 =head2 _koha_modify_biblio
3652
3653 =over 4
3654
3655 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3656
3657 Internal function for updating the biblio table
3658
3659 =back
3660
3661 =cut
3662
3663 sub _koha_modify_biblio {
3664     my ( $dbh, $biblio, $frameworkcode ) = @_;
3665     my $error;
3666
3667     my $query = "
3668         UPDATE biblio
3669         SET    frameworkcode = ?,
3670                author = ?,
3671                title = ?,
3672                unititle = ?,
3673                notes = ?,
3674                serial = ?,
3675                seriestitle = ?,
3676                copyrightdate = ?,
3677                abstract = ?
3678         WHERE  biblionumber = ?
3679         "
3680     ;
3681     my $sth = $dbh->prepare($query);
3682
3683     $sth->execute(
3684         $frameworkcode,
3685         $biblio->{'author'},
3686         $biblio->{'title'},
3687         $biblio->{'unititle'},
3688         $biblio->{'notes'},
3689         $biblio->{'serial'},
3690         $biblio->{'seriestitle'},
3691         $biblio->{'copyrightdate'},
3692         $biblio->{'abstract'},
3693         $biblio->{'biblionumber'}
3694     ) if $biblio->{'biblionumber'};
3695
3696     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3697         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3698         warn $error;
3699     }
3700     return ( $biblio->{'biblionumber'},$error );
3701 }
3702
3703 =head2 _koha_modify_biblioitem_nonmarc
3704
3705 =over 4
3706
3707 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3708
3709 Updates biblioitems row except for marc and marcxml, which should be changed
3710 via ModBiblioMarc
3711
3712 =back
3713
3714 =cut
3715
3716 sub _koha_modify_biblioitem_nonmarc {
3717     my ( $dbh, $biblioitem ) = @_;
3718     my $error;
3719
3720     # re-calculate the cn_sort, it may have changed
3721     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3722
3723     my $query =
3724     "UPDATE biblioitems
3725     SET biblionumber    = ?,
3726         volume          = ?,
3727         number          = ?,
3728         itemtype        = ?,
3729         isbn            = ?,
3730         issn            = ?,
3731         publicationyear = ?,
3732         publishercode   = ?,
3733         volumedate      = ?,
3734         volumedesc      = ?,
3735         collectiontitle = ?,
3736         collectionissn  = ?,
3737         collectionvolume= ?,
3738         editionstatement= ?,
3739         editionresponsibility = ?,
3740         illus           = ?,
3741         pages           = ?,
3742         notes           = ?,
3743         size            = ?,
3744         place           = ?,
3745         lccn            = ?,
3746         url             = ?,
3747         cn_source       = ?,
3748         cn_class        = ?,
3749         cn_item         = ?,
3750         cn_suffix       = ?,
3751         cn_sort         = ?,
3752         totalissues     = ?
3753         where biblioitemnumber = ?
3754         ";
3755     my $sth = $dbh->prepare($query);
3756     $sth->execute(
3757         $biblioitem->{'biblionumber'},
3758         $biblioitem->{'volume'},
3759         $biblioitem->{'number'},
3760         $biblioitem->{'itemtype'},
3761         $biblioitem->{'isbn'},
3762         $biblioitem->{'issn'},
3763         $biblioitem->{'publicationyear'},
3764         $biblioitem->{'publishercode'},
3765         $biblioitem->{'volumedate'},
3766         $biblioitem->{'volumedesc'},
3767         $biblioitem->{'collectiontitle'},
3768         $biblioitem->{'collectionissn'},
3769         $biblioitem->{'collectionvolume'},
3770         $biblioitem->{'editionstatement'},
3771         $biblioitem->{'editionresponsibility'},
3772         $biblioitem->{'illus'},
3773         $biblioitem->{'pages'},
3774         $biblioitem->{'bnotes'},
3775         $biblioitem->{'size'},
3776         $biblioitem->{'place'},
3777         $biblioitem->{'lccn'},
3778         $biblioitem->{'url'},
3779         $biblioitem->{'biblioitems.cn_source'},
3780         $biblioitem->{'cn_class'},
3781         $biblioitem->{'cn_item'},
3782         $biblioitem->{'cn_suffix'},
3783         $cn_sort,
3784         $biblioitem->{'totalissues'},
3785         $biblioitem->{'biblioitemnumber'}
3786     );
3787     if ( $dbh->errstr ) {
3788         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3789         warn $error;
3790     }
3791     return ($biblioitem->{'biblioitemnumber'},$error);
3792 }
3793
3794 =head2 _koha_add_biblioitem
3795
3796 =over 4
3797
3798 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3799
3800 Internal function to add a biblioitem
3801
3802 =back
3803
3804 =cut
3805
3806 sub _koha_add_biblioitem {
3807     my ( $dbh, $biblioitem ) = @_;
3808     my $error;
3809
3810     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3811     my $query =
3812     "INSERT INTO biblioitems SET
3813         biblionumber    = ?,
3814         volume          = ?,
3815         number          = ?,
3816         itemtype        = ?,
3817         isbn            = ?,
3818         issn            = ?,
3819         publicationyear = ?,
3820         publishercode   = ?,
3821         volumedate      = ?,
3822         volumedesc      = ?,
3823         collectiontitle = ?,
3824         collectionissn  = ?,
3825         collectionvolume= ?,
3826         editionstatement= ?,
3827         editionresponsibility = ?,
3828         illus           = ?,
3829         pages           = ?,
3830         notes           = ?,
3831         size            = ?,
3832         place           = ?,
3833         lccn            = ?,
3834         marc            = ?,
3835         url             = ?,
3836         cn_source       = ?,
3837         cn_class        = ?,
3838         cn_item         = ?,
3839         cn_suffix       = ?,
3840         cn_sort         = ?,
3841         totalissues     = ?
3842         ";
3843     my $sth = $dbh->prepare($query);
3844     $sth->execute(
3845         $biblioitem->{'biblionumber'},
3846         $biblioitem->{'volume'},
3847         $biblioitem->{'number'},
3848         $biblioitem->{'itemtype'},
3849         $biblioitem->{'isbn'},
3850         $biblioitem->{'issn'},
3851         $biblioitem->{'publicationyear'},
3852         $biblioitem->{'publishercode'},
3853         $biblioitem->{'volumedate'},
3854         $biblioitem->{'volumedesc'},
3855         $biblioitem->{'collectiontitle'},
3856         $biblioitem->{'collectionissn'},
3857         $biblioitem->{'collectionvolume'},
3858         $biblioitem->{'editionstatement'},
3859         $biblioitem->{'editionresponsibility'},
3860         $biblioitem->{'illus'},
3861         $biblioitem->{'pages'},
3862         $biblioitem->{'bnotes'},
3863         $biblioitem->{'size'},
3864         $biblioitem->{'place'},
3865         $biblioitem->{'lccn'},
3866         $biblioitem->{'marc'},
3867         $biblioitem->{'url'},
3868         $biblioitem->{'biblioitems.cn_source'},
3869         $biblioitem->{'cn_class'},
3870         $biblioitem->{'cn_item'},
3871         $biblioitem->{'cn_suffix'},
3872         $cn_sort,
3873         $biblioitem->{'totalissues'}
3874     );
3875     my $bibitemnum = $dbh->{'mysql_insertid'};
3876     if ( $dbh->errstr ) {
3877         $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
3878         warn $error;
3879     }
3880     $sth->finish();
3881     return ($bibitemnum,$error);
3882 }
3883
3884 =head2 _koha_new_items
3885
3886 =over 4
3887
3888 my ($itemnumber,$error) = _koha_new_items( $dbh, $item, $barcode );
3889
3890 =back
3891
3892 =cut
3893
3894 sub _koha_new_items {
3895     my ( $dbh, $item, $barcode ) = @_;
3896     my $error;
3897     my ($items_cn_sort) = GetClassSort($item->{'items.cn_source'}, $item->{'itemcallnumber'}, "");
3898
3899     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
3900     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
3901         my $today = C4::Dates->new();
3902         $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
3903     }
3904     my $query =
3905            "INSERT INTO items SET
3906             biblionumber        = ?,
3907             biblioitemnumber    = ?,
3908             barcode             = ?,
3909             dateaccessioned     = ?,
3910             booksellerid        = ?,
3911             homebranch          = ?,
3912             price               = ?,
3913             replacementprice    = ?,
3914             replacementpricedate = NOW(),
3915             datelastborrowed    = ?,
3916             datelastseen        = NOW(),
3917             stack               = ?,
3918             notforloan          = ?,
3919             damaged             = ?,
3920             itemlost            = ?,
3921             wthdrawn            = ?,
3922             itemcallnumber      = ?,
3923             restricted          = ?,
3924             itemnotes           = ?,
3925             holdingbranch       = ?,
3926             paidfor             = ?,
3927             location            = ?,
3928             onloan              = ?,
3929             issues              = ?,
3930             renewals            = ?,
3931             reserves            = ?,
3932             cn_source           = ?,
3933             cn_sort             = ?,
3934             ccode               = ?,
3935             itype               = ?,
3936             materials           = ?,
3937             uri                 = ?
3938           ";
3939     my $sth = $dbh->prepare($query);
3940     $sth->execute(
3941             $item->{'biblionumber'},
3942             $item->{'biblioitemnumber'},
3943             $barcode,
3944             $item->{'dateaccessioned'},
3945             $item->{'booksellerid'},
3946             $item->{'homebranch'},
3947             $item->{'price'},
3948             $item->{'replacementprice'},
3949             $item->{datelastborrowed},
3950             $item->{stack},
3951             $item->{'notforloan'},
3952             $item->{'damaged'},
3953             $item->{'itemlost'},
3954             $item->{'wthdrawn'},
3955             $item->{'itemcallnumber'},
3956             $item->{'restricted'},
3957             $item->{'itemnotes'},
3958             $item->{'holdingbranch'},
3959             $item->{'paidfor'},
3960             $item->{'location'},
3961             $item->{'onloan'},
3962             $item->{'issues'},
3963             $item->{'renewals'},
3964             $item->{'reserves'},
3965             $item->{'items.cn_source'},
3966             $items_cn_sort,
3967             $item->{'ccode'},
3968             $item->{'itype'},
3969             $item->{'materials'},
3970             $item->{'uri'},
3971     );
3972     my $itemnumber = $dbh->{'mysql_insertid'};
3973     if ( defined $sth->errstr ) {
3974         $error.="ERROR in _koha_new_items $query".$sth->errstr;
3975     }
3976     $sth->finish();
3977     return ( $itemnumber, $error );
3978 }
3979
3980 =head2 _koha_delete_biblio
3981
3982 =over 4
3983
3984 $error = _koha_delete_biblio($dbh,$biblionumber);
3985
3986 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3987
3988 C<$dbh> - the database handle
3989 C<$biblionumber> - the biblionumber of the biblio to be deleted
3990
3991 =back
3992
3993 =cut
3994
3995 # FIXME: add error handling
3996
3997 sub _koha_delete_biblio {
3998     my ( $dbh, $biblionumber ) = @_;
3999
4000     # get all the data for this biblio
4001     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
4002     $sth->execute($biblionumber);
4003
4004     if ( my $data = $sth->fetchrow_hashref ) {
4005
4006         # save the record in deletedbiblio
4007         # find the fields to save
4008         my $query = "INSERT INTO deletedbiblio SET ";
4009         my @bind  = ();
4010         foreach my $temp ( keys %$data ) {
4011             $query .= "$temp = ?,";
4012             push( @bind, $data->{$temp} );
4013         }
4014
4015         # replace the last , by ",?)"
4016         $query =~ s/\,$//;
4017         my $bkup_sth = $dbh->prepare($query);
4018         $bkup_sth->execute(@bind);
4019         $bkup_sth->finish;
4020
4021         # delete the biblio
4022         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
4023         $del_sth->execute($biblionumber);
4024         $del_sth->finish;
4025     }
4026     $sth->finish;
4027     return undef;
4028 }
4029
4030 =head2 _koha_delete_biblioitems
4031
4032 =over 4
4033
4034 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
4035
4036 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
4037
4038 C<$dbh> - the database handle
4039 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
4040
4041 =back
4042
4043 =cut
4044
4045 # FIXME: add error handling
4046
4047 sub _koha_delete_biblioitems {
4048     my ( $dbh, $biblioitemnumber ) = @_;
4049
4050     # get all the data for this biblioitem
4051     my $sth =
4052       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
4053     $sth->execute($biblioitemnumber);
4054
4055     if ( my $data = $sth->fetchrow_hashref ) {
4056
4057         # save the record in deletedbiblioitems
4058         # find the fields to save
4059         my $query = "INSERT INTO deletedbiblioitems SET ";
4060         my @bind  = ();
4061         foreach my $temp ( keys %$data ) {
4062             $query .= "$temp = ?,";
4063             push( @bind, $data->{$temp} );
4064         }
4065
4066         # replace the last , by ",?)"
4067         $query =~ s/\,$//;
4068         my $bkup_sth = $dbh->prepare($query);
4069         $bkup_sth->execute(@bind);
4070         $bkup_sth->finish;
4071
4072         # delete the biblioitem
4073         my $del_sth =
4074           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
4075         $del_sth->execute($biblioitemnumber);
4076         $del_sth->finish;
4077     }
4078     $sth->finish;
4079     return undef;
4080 }
4081
4082 =head2 _koha_delete_item
4083
4084 =over 4
4085
4086 _koha_delete_item( $dbh, $itemnum );
4087
4088 Internal function to delete an item record from the koha tables
4089
4090 =back
4091
4092 =cut
4093
4094 sub _koha_delete_item {
4095     my ( $dbh, $itemnum ) = @_;
4096
4097     # save the deleted item to deleteditems table
4098     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
4099     $sth->execute($itemnum);
4100     my $data = $sth->fetchrow_hashref();
4101     $sth->finish();
4102     my $query = "INSERT INTO deleteditems SET ";
4103     my @bind  = ();
4104     foreach my $key ( keys %$data ) {
4105         $query .= "$key = ?,";
4106         push( @bind, $data->{$key} );
4107     }
4108     $query =~ s/\,$//;
4109     $sth = $dbh->prepare($query);
4110     $sth->execute(@bind);
4111     $sth->finish();
4112
4113     # delete from items table
4114     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
4115     $sth->execute($itemnum);
4116     $sth->finish();
4117     return undef;
4118 }
4119
4120 =head1 UNEXPORTED FUNCTIONS
4121
4122 =head2 ModBiblioMarc
4123
4124     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
4125
4126     Add MARC data for a biblio to koha
4127
4128     Function exported, but should NOT be used, unless you really know what you're doing
4129
4130 =cut
4131
4132 sub ModBiblioMarc {
4133
4134 # pass the MARC::Record to this function, and it will create the records in the marc field
4135     my ( $record, $biblionumber, $frameworkcode ) = @_;
4136     my $dbh = C4::Context->dbh;
4137     my @fields = $record->fields();
4138     if ( !$frameworkcode ) {
4139         $frameworkcode = "";
4140     }
4141     my $sth =
4142       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
4143     $sth->execute( $frameworkcode, $biblionumber );
4144     $sth->finish;
4145     my $encoding = C4::Context->preference("marcflavour");
4146
4147     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
4148     if ( $encoding eq "UNIMARC" ) {
4149         my $string;
4150         if ( length($record->subfield( 100, "a" )) == 35 ) {
4151             $string = $record->subfield( 100, "a" );
4152             my $f100 = $record->field(100);
4153             $record->delete_field($f100);
4154         }
4155         else {
4156             $string = POSIX::strftime( "%Y%m%d", localtime );
4157             $string =~ s/\-//g;
4158             $string = sprintf( "%-*s", 35, $string );
4159         }
4160         substr( $string, 22, 6, "frey50" );
4161         unless ( $record->subfield( 100, "a" ) ) {
4162             $record->insert_grouped_field(
4163                 MARC::Field->new( 100, "", "", "a" => $string ) );
4164         }
4165     }
4166     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
4167     $sth =
4168       $dbh->prepare(
4169         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
4170     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
4171         $biblionumber );
4172     $sth->finish;
4173     return $biblionumber;
4174 }
4175
4176 =head2 z3950_extended_services
4177
4178 z3950_extended_services($serviceType,$serviceOptions,$record);
4179
4180     z3950_extended_services is used to handle all interactions with Zebra's extended serices package, which is employed to perform all management of the MARC data stored in Zebra.
4181
4182 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
4183
4184 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
4185
4186     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
4187
4188 and maybe
4189
4190     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
4191     syntax => the record syntax (transfer syntax)
4192     databaseName = Database from connection object
4193
4194     To set serviceOptions, call set_service_options($serviceType)
4195
4196 C<$record> the record, if one is needed for the service type
4197
4198     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
4199
4200 =cut
4201
4202 sub z3950_extended_services {
4203     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
4204
4205     # get our connection object
4206     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
4207
4208     # create a new package object
4209     my $Zpackage = $Zconn->package();
4210
4211     # set our options
4212     $Zpackage->option( action => $action );
4213
4214     if ( $serviceOptions->{'databaseName'} ) {
4215         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
4216     }
4217     if ( $serviceOptions->{'recordIdNumber'} ) {
4218         $Zpackage->option(
4219             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
4220     }
4221     if ( $serviceOptions->{'recordIdOpaque'} ) {
4222         $Zpackage->option(
4223             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
4224     }
4225
4226  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
4227  #if ($serviceType eq 'itemorder') {
4228  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
4229  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
4230  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
4231  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
4232  #}
4233
4234     if ( $serviceOptions->{record} ) {
4235         $Zpackage->option( record => $serviceOptions->{record} );
4236
4237         # can be xml or marc
4238         if ( $serviceOptions->{'syntax'} ) {
4239             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
4240         }
4241     }
4242
4243     # send the request, handle any exception encountered
4244     eval { $Zpackage->send($serviceType) };
4245     if ( $@ && $@->isa("ZOOM::Exception") ) {
4246         return "error:  " . $@->code() . " " . $@->message() . "\n";
4247     }
4248
4249     # free up package resources
4250     $Zpackage->destroy();
4251 }
4252
4253 =head2 set_service_options
4254
4255 my $serviceOptions = set_service_options($serviceType);
4256
4257 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
4258
4259 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
4260
4261 =cut
4262
4263 sub set_service_options {
4264     my ($serviceType) = @_;
4265     my $serviceOptions;
4266
4267 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
4268 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
4269
4270     if ( $serviceType eq 'commit' ) {
4271
4272         # nothing to do
4273     }
4274     if ( $serviceType eq 'create' ) {
4275
4276         # nothing to do
4277     }
4278     if ( $serviceType eq 'drop' ) {
4279         die "ERROR: 'drop' not currently supported (by Zebra)";
4280     }
4281     return $serviceOptions;
4282 }
4283
4284 =head2 GetItemsCount
4285
4286 $count = &GetItemsCount( $biblionumber);
4287 this function return count of item with $biblionumber
4288 =cut
4289
4290 sub GetItemsCount {
4291     my ( $biblionumber ) = @_;
4292     my $dbh = C4::Context->dbh;
4293     my $query = "SELECT count(*)
4294           FROM  items
4295           WHERE biblionumber=?";
4296     my $sth = $dbh->prepare($query);
4297     $sth->execute($biblionumber);
4298     my $count = $sth->fetchrow;
4299     $sth->finish;
4300     return ($count);
4301 }
4302
4303 END { }    # module clean-up code here (global destructor)
4304
4305 1;
4306
4307 __END__
4308
4309 =head1 AUTHOR
4310
4311 Koha Developement team <info@koha.org>
4312
4313 Paul POULAIN paul.poulain@free.fr
4314
4315 Joshua Ferraro jmf@liblime.com
4316
4317 =cut