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