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