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