C4/Biblio.pm

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