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