C4/Biblio.pm

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