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