C4/Biblio.pm

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