C4/Biblio.pm

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