C4/Biblio.pm

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