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