C4/Biblio.pm

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