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