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