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