C4/Biblio.pm

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