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