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