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   = $record->field('008') || '';
1223             $pubyear   = substr($pubyear->data(), 7, 4) if $pubyear;
1224             $isbn      = $record->subfield( '773', 'z' ) || '';
1225             $issn      = $record->subfield( '773', 'x' ) || '';
1226             if ($mtx eq 'journal') {
1227                 $title    .= "&amp;rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1228             } else {
1229                 $title    .= "&amp;rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1230             }
1231             foreach my $rel ($record->subfield( '773', 'g' )) {
1232                 if ($pages) {
1233                     $pages .= ', ';
1234                 }
1235                 $pages .= $rel;
1236             }
1237         } else {
1238             $pubyear   = $record->subfield( '260', 'c' ) || '';
1239             $publisher = $record->subfield( '260', 'b' ) || '';
1240             $isbn      = $record->subfield( '020', 'a' ) || '';
1241             $issn      = $record->subfield( '022', 'a' ) || '';
1242         }
1243
1244     }
1245     my $coins_value =
1246 "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";
1247     $coins_value =~ s/(\ |&[^a])/\+/g;
1248     $coins_value =~ s/\"/\&quot\;/g;
1249
1250 #<!-- 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="
1251
1252     return $coins_value;
1253 }
1254
1255
1256 =head2 GetMarcPrice
1257
1258 return the prices in accordance with the Marc format.
1259 =cut
1260
1261 sub GetMarcPrice {
1262     my ( $record, $marcflavour ) = @_;
1263     my @listtags;
1264     my $subfield;
1265
1266     if ( $marcflavour eq "MARC21" ) {
1267         @listtags = ('345', '020');
1268         $subfield="c";
1269     } elsif ( $marcflavour eq "UNIMARC" ) {
1270         @listtags = ('345', '010');
1271         $subfield="d";
1272     } else {
1273         return;
1274     }
1275
1276     for my $field ( $record->field(@listtags) ) {
1277         for my $subfield_value  ($field->subfield($subfield)){
1278             #check value
1279             return $subfield_value if ($subfield_value);
1280         }
1281     }
1282     return 0; # no price found
1283 }
1284
1285 =head2 GetMarcQuantity
1286
1287 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1288 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1289
1290 =cut
1291
1292 sub GetMarcQuantity {
1293     my ( $record, $marcflavour ) = @_;
1294     my @listtags;
1295     my $subfield;
1296
1297     if ( $marcflavour eq "MARC21" ) {
1298         return 0
1299     } elsif ( $marcflavour eq "UNIMARC" ) {
1300         @listtags = ('969');
1301         $subfield="a";
1302     } else {
1303         return;
1304     }
1305
1306     for my $field ( $record->field(@listtags) ) {
1307         for my $subfield_value  ($field->subfield($subfield)){
1308             #check value
1309             if ($subfield_value) {
1310                  # in France, the cents separator is the , but sometimes, ppl use a .
1311                  # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1312                 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1313                 return $subfield_value;
1314             }
1315         }
1316     }
1317     return 0; # no price found
1318 }
1319
1320
1321 =head2 GetAuthorisedValueDesc
1322
1323   my $subfieldvalue =get_authorised_value_desc(
1324     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1325
1326 Retrieve the complete description for a given authorised value.
1327
1328 Now takes $category and $value pair too.
1329
1330   my $auth_value_desc =GetAuthorisedValueDesc(
1331     '','', 'DVD' ,'','','CCODE');
1332
1333 If the optional $opac parameter is set to a true value, displays OPAC
1334 descriptions rather than normal ones when they exist.
1335
1336 =cut
1337
1338 sub GetAuthorisedValueDesc {
1339     my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1340     my $dbh = C4::Context->dbh;
1341
1342     if ( !$category ) {
1343
1344         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1345
1346         #---- branch
1347         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1348             return C4::Branch::GetBranchName($value);
1349         }
1350
1351         #---- itemtypes
1352         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1353             return getitemtypeinfo($value)->{description};
1354         }
1355
1356         #---- "true" authorized value
1357         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1358     }
1359
1360     if ( $category ne "" ) {
1361         my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1362         $sth->execute( $category, $value );
1363         my $data = $sth->fetchrow_hashref;
1364         return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1365     } else {
1366         return $value;    # if nothing is found return the original value
1367     }
1368 }
1369
1370 =head2 GetMarcControlnumber
1371
1372   $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1373
1374 Get the control number / record Identifier from the MARC record and return it.
1375
1376 =cut
1377
1378 sub GetMarcControlnumber {
1379     my ( $record, $marcflavour ) = @_;
1380     my $controlnumber = "";
1381     # Control number or Record identifier are the same field in MARC21 and UNIMARC
1382     # Keep $marcflavour for possible later use
1383     if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC") {
1384         my $controlnumberField = $record->field('001');
1385         if ($controlnumberField) {
1386             $controlnumber = $controlnumberField->data();
1387         }
1388     }
1389     return $controlnumber;
1390 }
1391
1392 =head2 GetMarcISBN
1393
1394   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1395
1396 Get all ISBNs from the MARC record and returns them in an array.
1397 ISBNs stored in differents places depending on MARC flavour
1398
1399 =cut
1400
1401 sub GetMarcISBN {
1402     my ( $record, $marcflavour ) = @_;
1403     my $scope;
1404     if ( $marcflavour eq "UNIMARC" ) {
1405         $scope = '010';
1406     } else {    # assume marc21 if not unimarc
1407         $scope = '020';
1408     }
1409     my @marcisbns;
1410     my $isbn = "";
1411     my $tag  = "";
1412     my $marcisbn;
1413     foreach my $field ( $record->field($scope) ) {
1414         my $value = $field->as_string();
1415         if ( $isbn ne "" ) {
1416             $marcisbn = { marcisbn => $isbn, };
1417             push @marcisbns, $marcisbn;
1418             $isbn = $value;
1419         }
1420         if ( $isbn ne $value ) {
1421             $isbn = $isbn . " " . $value;
1422         }
1423     }
1424
1425     if ($isbn) {
1426         $marcisbn = { marcisbn => $isbn };
1427         push @marcisbns, $marcisbn;    #load last tag into array
1428     }
1429     return \@marcisbns;
1430 }    # end GetMarcISBN
1431
1432 =head2 GetMarcNotes
1433
1434   $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1435
1436 Get all notes from the MARC record and returns them in an array.
1437 The note are stored in differents places depending on MARC flavour
1438
1439 =cut
1440
1441 sub GetMarcNotes {
1442     my ( $record, $marcflavour ) = @_;
1443     my $scope;
1444     if ( $marcflavour eq "UNIMARC" ) {
1445         $scope = '3..';
1446     } else {    # assume marc21 if not unimarc
1447         $scope = '5..';
1448     }
1449     my @marcnotes;
1450     my $note = "";
1451     my $tag  = "";
1452     my $marcnote;
1453     foreach my $field ( $record->field($scope) ) {
1454         my $value = $field->as_string();
1455         if ( $note ne "" ) {
1456             $marcnote = { marcnote => $note, };
1457             push @marcnotes, $marcnote;
1458             $note = $value;
1459         }
1460         if ( $note ne $value ) {
1461             $note = $note . " " . $value;
1462         }
1463     }
1464
1465     if ($note) {
1466         $marcnote = { marcnote => $note };
1467         push @marcnotes, $marcnote;    #load last tag into array
1468     }
1469     return \@marcnotes;
1470 }    # end GetMarcNotes
1471
1472 =head2 GetMarcSubjects
1473
1474   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1475
1476 Get all subjects from the MARC record and returns them in an array.
1477 The subjects are stored in differents places depending on MARC flavour
1478
1479 =cut
1480
1481 sub GetMarcSubjects {
1482     my ( $record, $marcflavour ) = @_;
1483     my ( $mintag, $maxtag );
1484     if ( $marcflavour eq "UNIMARC" ) {
1485         $mintag = "600";
1486         $maxtag = "611";
1487     } else {    # assume marc21 if not unimarc
1488         $mintag = "600";
1489         $maxtag = "699";
1490     }
1491
1492     my @marcsubjects;
1493     my $subject  = "";
1494     my $subfield = "";
1495     my $marcsubject;
1496
1497     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1498
1499     foreach my $field ( $record->field('6..') ) {
1500         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1501         my @subfields_loop;
1502         my @subfields = $field->subfields();
1503         my $counter   = 0;
1504         my @link_loop;
1505
1506         # if there is an authority link, build the link with an= subfield9
1507         my $found9 = 0;
1508         for my $subject_subfield (@subfields) {
1509
1510             # don't load unimarc subfields 3,4,5
1511             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1512
1513             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1514             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1515             my $code      = $subject_subfield->[0];
1516             my $value     = $subject_subfield->[1];
1517             my $linkvalue = $value;
1518             $linkvalue =~ s/(\(|\))//g;
1519             my $operator;
1520             if ( $counter != 0 ) {
1521                 $operator = ' and ';
1522             }
1523             if ( $code eq 9 ) {
1524                 $found9 = 1;
1525                 @link_loop = ( { 'limit' => 'an', link => "$linkvalue" } );
1526             }
1527             if ( not $found9 ) {
1528                 push @link_loop, { 'limit' => $subject_limit, link => $linkvalue, operator => $operator };
1529             }
1530             my $separator;
1531             if ( $counter != 0 ) {
1532                 $separator = C4::Context->preference('authoritysep');
1533             }
1534
1535             # ignore $9
1536             my @this_link_loop = @link_loop;
1537             push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 );
1538             $counter++;
1539         }
1540
1541         push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1542
1543     }
1544     return \@marcsubjects;
1545 }    #end getMARCsubjects
1546
1547 =head2 GetMarcAuthors
1548
1549   authors = GetMarcAuthors($record,$marcflavour);
1550
1551 Get all authors from the MARC record and returns them in an array.
1552 The authors are stored in differents places depending on MARC flavour
1553
1554 =cut
1555
1556 sub GetMarcAuthors {
1557     my ( $record, $marcflavour ) = @_;
1558     my ( $mintag, $maxtag );
1559
1560     # tagslib useful for UNIMARC author reponsabilities
1561     my $tagslib =
1562       &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.
1563     if ( $marcflavour eq "UNIMARC" ) {
1564         $mintag = "700";
1565         $maxtag = "712";
1566     } elsif ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { # assume marc21 or normarc if not unimarc
1567         $mintag = "700";
1568         $maxtag = "720";
1569     } else {
1570         return;
1571     }
1572     my @marcauthors;
1573
1574     foreach my $field ( $record->fields ) {
1575         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1576         my @subfields_loop;
1577         my @link_loop;
1578         my @subfields  = $field->subfields();
1579         my $count_auth = 0;
1580
1581         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1582         my $subfield9 = $field->subfield('9');
1583         for my $authors_subfield (@subfields) {
1584
1585             # don't load unimarc subfields 3, 5
1586             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1587             my $subfieldcode = $authors_subfield->[0];
1588             my $value        = $authors_subfield->[1];
1589             my $linkvalue    = $value;
1590             $linkvalue =~ s/(\(|\))//g;
1591             my $operator;
1592             if ( $count_auth != 0 ) {
1593                 $operator = ' and ';
1594             }
1595
1596             # if we have an authority link, use that as the link, otherwise use standard searching
1597             if ($subfield9) {
1598                 @link_loop = ( { 'limit' => 'an', link => "$subfield9" } );
1599             } else {
1600
1601                 # reset $linkvalue if UNIMARC author responsibility
1602                 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] eq "4" ) ) {
1603                     $linkvalue = "(" . GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) . ")";
1604                 }
1605                 push @link_loop, { 'limit' => 'au', link => $linkvalue, operator => $operator };
1606             }
1607             $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib )
1608               if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /4/ ) );
1609             my @this_link_loop = @link_loop;
1610             my $separator;
1611             if ( $count_auth != 0 ) {
1612                 $separator = C4::Context->preference('authoritysep');
1613             }
1614             push @subfields_loop,
1615               { code      => $subfieldcode,
1616                 value     => $value,
1617                 link_loop => \@this_link_loop,
1618                 separator => $separator
1619               }
1620               unless ( $authors_subfield->[0] eq '9' );
1621             $count_auth++;
1622         }
1623         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1624     }
1625     return \@marcauthors;
1626 }
1627
1628 =head2 GetMarcUrls
1629
1630   $marcurls = GetMarcUrls($record,$marcflavour);
1631
1632 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1633 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1634
1635 =cut
1636
1637 sub GetMarcUrls {
1638     my ( $record, $marcflavour ) = @_;
1639
1640     my @marcurls;
1641     for my $field ( $record->field('856') ) {
1642         my @notes;
1643         for my $note ( $field->subfield('z') ) {
1644             push @notes, { note => $note };
1645         }
1646         my @urls = $field->subfield('u');
1647         foreach my $url (@urls) {
1648             my $marcurl;
1649             if ( $marcflavour eq 'MARC21' ) {
1650                 my $s3   = $field->subfield('3');
1651                 my $link = $field->subfield('y');
1652                 unless ( $url =~ /^\w+:/ ) {
1653                     if ( $field->indicator(1) eq '7' ) {
1654                         $url = $field->subfield('2') . "://" . $url;
1655                     } elsif ( $field->indicator(1) eq '1' ) {
1656                         $url = 'ftp://' . $url;
1657                     } else {
1658
1659                         #  properly, this should be if ind1=4,
1660                         #  however we will assume http protocol since we're building a link.
1661                         $url = 'http://' . $url;
1662                     }
1663                 }
1664
1665                 # TODO handle ind 2 (relationship)
1666                 $marcurl = {
1667                     MARCURL => $url,
1668                     notes   => \@notes,
1669                 };
1670                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1671                 $marcurl->{'part'} = $s3 if ($link);
1672                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1673             } else {
1674                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1675                 $marcurl->{'MARCURL'} = $url;
1676             }
1677             push @marcurls, $marcurl;
1678         }
1679     }
1680     return \@marcurls;
1681 }
1682
1683 =head2 GetMarcSeries
1684
1685   $marcseriesarray = GetMarcSeries($record,$marcflavour);
1686
1687 Get all series from the MARC record and returns them in an array.
1688 The series are stored in differents places depending on MARC flavour
1689
1690 =cut
1691
1692 sub GetMarcSeries {
1693     my ( $record, $marcflavour ) = @_;
1694     my ( $mintag, $maxtag );
1695     if ( $marcflavour eq "UNIMARC" ) {
1696         $mintag = "600";
1697         $maxtag = "619";
1698     } else {    # assume marc21 if not unimarc
1699         $mintag = "440";
1700         $maxtag = "490";
1701     }
1702
1703     my @marcseries;
1704     my $subjct   = "";
1705     my $subfield = "";
1706     my $marcsubjct;
1707
1708     foreach my $field ( $record->field('440'), $record->field('490') ) {
1709         my @subfields_loop;
1710
1711         #my $value = $field->subfield('a');
1712         #$marcsubjct = {MARCSUBJCT => $value,};
1713         my @subfields = $field->subfields();
1714
1715         #warn "subfields:".join " ", @$subfields;
1716         my $counter = 0;
1717         my @link_loop;
1718         for my $series_subfield (@subfields) {
1719             my $volume_number;
1720             undef $volume_number;
1721
1722             # see if this is an instance of a volume
1723             if ( $series_subfield->[0] eq 'v' ) {
1724                 $volume_number = 1;
1725             }
1726
1727             my $code      = $series_subfield->[0];
1728             my $value     = $series_subfield->[1];
1729             my $linkvalue = $value;
1730             $linkvalue =~ s/(\(|\))//g;
1731             if ( $counter != 0 ) {
1732                 push @link_loop, { link => $linkvalue, operator => ' and ', };
1733             } else {
1734                 push @link_loop, { link => $linkvalue, operator => undef, };
1735             }
1736             my $separator;
1737             if ( $counter != 0 ) {
1738                 $separator = C4::Context->preference('authoritysep');
1739             }
1740             if ($volume_number) {
1741                 push @subfields_loop, { volumenum => $value };
1742             } else {
1743                 if ( $series_subfield->[0] ne '9' ) {
1744                     push @subfields_loop, {
1745                         code      => $code,
1746                         value     => $value,
1747                         link_loop => \@link_loop,
1748                         separator => $separator,
1749                         volumenum => $volume_number,
1750                     };
1751                 }
1752             }
1753             $counter++;
1754         }
1755         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1756
1757         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1758         #push @marcsubjcts, $marcsubjct;
1759         #$subjct = $value;
1760
1761     }
1762     my $marcseriessarray = \@marcseries;
1763     return $marcseriessarray;
1764 }    #end getMARCseriess
1765
1766 =head2 GetMarcHosts
1767
1768   $marchostsarray = GetMarcHosts($record,$marcflavour);
1769
1770 Get all host records (773s MARC21, 461 UNIMARC) from the MARC record and returns them in an array.
1771
1772 =cut
1773
1774 sub GetMarcHosts {
1775     my ( $record, $marcflavour ) = @_;
1776     my ( $tag,$title_subf,$bibnumber_subf,$itemnumber_subf);
1777     $marcflavour ||="MARC21";
1778     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1779         $tag = "773";
1780         $title_subf = "t";
1781         $bibnumber_subf ="0";
1782         $itemnumber_subf='9';
1783     }
1784     elsif ($marcflavour eq "UNIMARC") {
1785         $tag = "461";
1786         $title_subf = "t";
1787         $bibnumber_subf ="0";
1788         $itemnumber_subf='9';
1789     };
1790
1791     my @marchosts;
1792
1793     foreach my $field ( $record->field($tag)) {
1794
1795         my @fields_loop;
1796
1797         my $hostbiblionumber = $field->subfield("$bibnumber_subf");
1798         my $hosttitle = $field->subfield($title_subf);
1799         my $hostitemnumber=$field->subfield($itemnumber_subf);
1800         push @fields_loop, { hostbiblionumber => $hostbiblionumber, hosttitle => $hosttitle, hostitemnumber => $hostitemnumber};
1801         push @marchosts, { MARCHOSTS_FIELDS_LOOP => \@fields_loop };
1802
1803         }
1804     my $marchostsarray = \@marchosts;
1805     return $marchostsarray;
1806 }
1807
1808 =head2 GetFrameworkCode
1809
1810   $frameworkcode = GetFrameworkCode( $biblionumber )
1811
1812 =cut
1813
1814 sub GetFrameworkCode {
1815     my ($biblionumber) = @_;
1816     my $dbh            = C4::Context->dbh;
1817     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1818     $sth->execute($biblionumber);
1819     my ($frameworkcode) = $sth->fetchrow;
1820     return $frameworkcode;
1821 }
1822
1823 =head2 TransformKohaToMarc
1824
1825     $record = TransformKohaToMarc( $hash )
1826
1827 This function builds partial MARC::Record from a hash
1828 Hash entries can be from biblio or biblioitems.
1829
1830 This function is called in acquisition module, to create a basic catalogue entry from user entry
1831
1832 =cut
1833
1834 sub TransformKohaToMarc {
1835     my ($hash) = @_;
1836     my $sth    = C4::Context->dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
1837     my $record = MARC::Record->new();
1838     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1839     foreach ( keys %{$hash} ) {
1840         &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' );
1841     }
1842     return $record;
1843 }
1844
1845 =head2 PrepHostMarcField
1846
1847     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
1848
1849 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
1850
1851 =cut
1852
1853 sub PrepHostMarcField {
1854     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
1855     $marcflavour ||="MARC21";
1856
1857     my $hostrecord = GetMarcBiblio($hostbiblionumber);
1858         my $item = C4::Items::GetItem($hostitemnumber);
1859
1860         my $hostmarcfield;
1861     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1862
1863         #main entry
1864         my $mainentry;
1865         if ($hostrecord->subfield('100','a')){
1866             $mainentry = $hostrecord->subfield('100','a');
1867         } elsif ($hostrecord->subfield('110','a')){
1868             $mainentry = $hostrecord->subfield('110','a');
1869         } else {
1870             $mainentry = $hostrecord->subfield('111','a');
1871         }
1872
1873         # qualification info
1874         my $qualinfo;
1875         if (my $field260 = $hostrecord->field('260')){
1876             $qualinfo =  $field260->as_string( 'abc' );
1877         }
1878
1879
1880         #other fields
1881         my $ed = $hostrecord->subfield('250','a');
1882         my $barcode = $item->{'barcode'};
1883         my $title = $hostrecord->subfield('245','a');
1884
1885         # record control number, 001 with 003 and prefix
1886         my $recctrlno;
1887         if ($hostrecord->field('001')){
1888             $recctrlno = $hostrecord->field('001')->data();
1889             if ($hostrecord->field('003')){
1890                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
1891             }
1892         }
1893
1894         # issn/isbn
1895         my $issn = $hostrecord->subfield('022','a');
1896         my $isbn = $hostrecord->subfield('020','a');
1897
1898
1899         $hostmarcfield = MARC::Field->new(
1900                 773, '0', '',
1901                 '0' => $hostbiblionumber,
1902                 '9' => $hostitemnumber,
1903                 'a' => $mainentry,
1904                 'b' => $ed,
1905                 'd' => $qualinfo,
1906                 'o' => $barcode,
1907                 't' => $title,
1908                 'w' => $recctrlno,
1909                 'x' => $issn,
1910                 'z' => $isbn
1911                 );
1912     } elsif ($marcflavour eq "UNIMARC") {
1913         $hostmarcfield = MARC::Field->new(
1914             461, '', '',
1915             '0' => $hostbiblionumber,
1916             't' => $hostrecord->subfield('200','a'),
1917             '9' => $hostitemnumber
1918         );
1919     };
1920
1921     return $hostmarcfield;
1922 }
1923
1924
1925 =head2 TransformKohaToMarcOneField
1926
1927     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1928
1929 =cut
1930
1931 sub TransformKohaToMarcOneField {
1932     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1933     $frameworkcode = '' unless $frameworkcode;
1934     my $tagfield;
1935     my $tagsubfield;
1936
1937     if ( !defined $sth ) {
1938         my $dbh = C4::Context->dbh;
1939         $sth = $dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
1940     }
1941     $sth->execute( $frameworkcode, $kohafieldname );
1942     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1943         my @values = split(/\s?\|\s?/, $value, -1);
1944
1945         foreach my $itemvalue (@values){
1946         my $tag = $record->field($tagfield);
1947         if ($tag) {
1948                 $tag->add_subfields( $tagsubfield => $itemvalue );
1949             $record->delete_field($tag);
1950             $record->insert_fields_ordered($tag);
1951             }
1952             else {
1953                 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $itemvalue );
1954             }
1955         }
1956     }
1957     return $record;
1958 }
1959
1960 =head2 TransformHtmlToXml
1961
1962   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
1963                              $ind_tag, $auth_type )
1964
1965 $auth_type contains :
1966
1967 =over
1968
1969 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
1970
1971 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1972
1973 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1974
1975 =back
1976
1977 =cut
1978
1979 sub TransformHtmlToXml {
1980     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1981     my $xml = MARC::File::XML::header('UTF-8');
1982     $xml .= "<record>\n";
1983     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1984     MARC::File::XML->default_record_format($auth_type);
1985
1986     # in UNIMARC, field 100 contains the encoding
1987     # check that there is one, otherwise the
1988     # MARC::Record->new_from_xml will fail (and Koha will die)
1989     my $unimarc_and_100_exist = 0;
1990     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
1991     my $prevvalue;
1992     my $prevtag = -1;
1993     my $first   = 1;
1994     my $j       = -1;
1995     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1996
1997         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
1998
1999             # if we have a 100 field and it's values are not correct, skip them.
2000             # if we don't have any valid 100 field, we will create a default one at the end
2001             my $enc = substr( @$values[$i], 26, 2 );
2002             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
2003                 $unimarc_and_100_exist = 1;
2004             } else {
2005                 next;
2006             }
2007         }
2008         @$values[$i] =~ s/&/&amp;/g;
2009         @$values[$i] =~ s/</&lt;/g;
2010         @$values[$i] =~ s/>/&gt;/g;
2011         @$values[$i] =~ s/"/&quot;/g;
2012         @$values[$i] =~ s/'/&apos;/g;
2013
2014         #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2015         #             utf8::decode( @$values[$i] );
2016         #         }
2017         if ( ( @$tags[$i] ne $prevtag ) ) {
2018             $j++ unless ( @$tags[$i] eq "" );
2019             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2020             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2021             my $ind1       = _default_ind_to_space($indicator1);
2022             my $ind2;
2023             if ( @$indicator[$j] ) {
2024                 $ind2 = _default_ind_to_space($indicator2);
2025             } else {
2026                 warn "Indicator in @$tags[$i] is empty";
2027                 $ind2 = " ";
2028             }
2029             if ( !$first ) {
2030                 $xml .= "</datafield>\n";
2031                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2032                     && ( @$values[$i] ne "" ) ) {
2033                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2034                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2035                     $first = 0;
2036                 } else {
2037                     $first = 1;
2038                 }
2039             } else {
2040                 if ( @$values[$i] ne "" ) {
2041
2042                     # leader
2043                     if ( @$tags[$i] eq "000" ) {
2044                         $xml .= "<leader>@$values[$i]</leader>\n";
2045                         $first = 1;
2046
2047                         # rest of the fixed fields
2048                     } elsif ( @$tags[$i] < 10 ) {
2049                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2050                         $first = 1;
2051                     } else {
2052                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2053                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2054                         $first = 0;
2055                     }
2056                 }
2057             }
2058         } else {    # @$tags[$i] eq $prevtag
2059             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2060             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2061             my $ind1       = _default_ind_to_space($indicator1);
2062             my $ind2;
2063             if ( @$indicator[$j] ) {
2064                 $ind2 = _default_ind_to_space($indicator2);
2065             } else {
2066                 warn "Indicator in @$tags[$i] is empty";
2067                 $ind2 = " ";
2068             }
2069             if ( @$values[$i] eq "" ) {
2070             } else {
2071                 if ($first) {
2072                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2073                     $first = 0;
2074                 }
2075                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2076             }
2077         }
2078         $prevtag = @$tags[$i];
2079     }
2080     $xml .= "</datafield>\n" if @$tags > 0;
2081     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2082
2083         #     warn "SETTING 100 for $auth_type";
2084         my $string = strftime( "%Y%m%d", localtime(time) );
2085
2086         # set 50 to position 26 is biblios, 13 if authorities
2087         my $pos = 26;
2088         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2089         $string = sprintf( "%-*s", 35, $string );
2090         substr( $string, $pos, 6, "50" );
2091         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2092         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2093         $xml .= "</datafield>\n";
2094     }
2095     $xml .= "</record>\n";
2096     $xml .= MARC::File::XML::footer();
2097     return $xml;
2098 }
2099
2100 =head2 _default_ind_to_space
2101
2102 Passed what should be an indicator returns a space
2103 if its undefined or zero length
2104
2105 =cut
2106
2107 sub _default_ind_to_space {
2108     my $s = shift;
2109     if ( !defined $s || $s eq q{} ) {
2110         return ' ';
2111     }
2112     return $s;
2113 }
2114
2115 =head2 TransformHtmlToMarc
2116
2117     L<$record> = TransformHtmlToMarc(L<$cgi>)
2118     L<$cgi> is the CGI object which containts the values for subfields
2119     {
2120         'tag_010_indicator1_531951' ,
2121         'tag_010_indicator2_531951' ,
2122         'tag_010_code_a_531951_145735' ,
2123         'tag_010_subfield_a_531951_145735' ,
2124         'tag_200_indicator1_873510' ,
2125         'tag_200_indicator2_873510' ,
2126         'tag_200_code_a_873510_673465' ,
2127         'tag_200_subfield_a_873510_673465' ,
2128         'tag_200_code_b_873510_704318' ,
2129         'tag_200_subfield_b_873510_704318' ,
2130         'tag_200_code_e_873510_280822' ,
2131         'tag_200_subfield_e_873510_280822' ,
2132         'tag_200_code_f_873510_110730' ,
2133         'tag_200_subfield_f_873510_110730' ,
2134     }
2135     L<$record> is the MARC::Record object.
2136
2137 =cut
2138
2139 sub TransformHtmlToMarc {
2140     my $cgi    = shift;
2141
2142     my @params = $cgi->param();
2143
2144     # explicitly turn on the UTF-8 flag for all
2145     # 'tag_' parameters to avoid incorrect character
2146     # conversion later on
2147     my $cgi_params = $cgi->Vars;
2148     foreach my $param_name ( keys %$cgi_params ) {
2149         if ( $param_name =~ /^tag_/ ) {
2150             my $param_value = $cgi_params->{$param_name};
2151             if ( utf8::decode($param_value) ) {
2152                 $cgi_params->{$param_name} = $param_value;
2153             }
2154
2155             # FIXME - need to do something if string is not valid UTF-8
2156         }
2157     }
2158
2159     # creating a new record
2160     my $record = MARC::Record->new();
2161     my $i      = 0;
2162     my @fields;
2163     while ( $params[$i] ) {    # browse all CGI params
2164         my $param    = $params[$i];
2165         my $newfield = 0;
2166
2167         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2168         if ( $param eq 'biblionumber' ) {
2169             my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2170             if ( $biblionumbertagfield < 10 ) {
2171                 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2172             } else {
2173                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2174             }
2175             push @fields, $newfield if ($newfield);
2176         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2177             my $tag = $1;
2178
2179             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2180             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2181             $newfield = 0;
2182             my $j = $i + 2;
2183
2184             if ( $tag < 10 ) {                              # no code for theses fields
2185                                                             # in MARC editor, 000 contains the leader.
2186                 if ( $tag eq '000' ) {
2187                     # Force a fake leader even if not provided to avoid crashing
2188                     # during decoding MARC record containing UTF-8 characters
2189                     $record->leader(
2190                         length( $cgi->param($params[$j+1]) ) == 24
2191                         ? $cgi->param( $params[ $j + 1 ] )
2192                         : '     nam a22        4500'
2193                         )
2194                     ;
2195                     # between 001 and 009 (included)
2196                 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2197                     $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2198                 }
2199
2200                 # > 009, deal with subfields
2201             } else {
2202                 while ( defined $params[$j] && $params[$j] =~ /_code_/ ) {    # browse all it's subfield
2203                     my $inner_param = $params[$j];
2204                     if ($newfield) {
2205                         if ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {         # only if there is a value (code => value)
2206                             $newfield->add_subfields( $cgi->param($inner_param) => $cgi->param( $params[ $j + 1 ] ) );
2207                         }
2208                     } else {
2209                         if ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {         # creating only if there is a value (code => value)
2210                             $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($inner_param) => $cgi->param( $params[ $j + 1 ] ), );
2211                         }
2212                     }
2213                     $j += 2;
2214                 }
2215             }
2216             push @fields, $newfield if ($newfield);
2217         }
2218         $i++;
2219     }
2220
2221     $record->append_fields(@fields);
2222     return $record;
2223 }
2224
2225 # cache inverted MARC field map
2226 our $inverted_field_map;
2227
2228 =head2 TransformMarcToKoha
2229
2230   $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2231
2232 Extract data from a MARC bib record into a hashref representing
2233 Koha biblio, biblioitems, and items fields.
2234
2235 =cut
2236
2237 sub TransformMarcToKoha {
2238     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2239
2240     my $result;
2241     $limit_table = $limit_table || 0;
2242     $frameworkcode = '' unless defined $frameworkcode;
2243
2244     unless ( defined $inverted_field_map ) {
2245         $inverted_field_map = _get_inverted_marc_field_map();
2246     }
2247
2248     my %tables = ();
2249     if ( defined $limit_table && $limit_table eq 'items' ) {
2250         $tables{'items'} = 1;
2251     } else {
2252         $tables{'items'}       = 1;
2253         $tables{'biblio'}      = 1;
2254         $tables{'biblioitems'} = 1;
2255     }
2256
2257     # traverse through record
2258   MARCFIELD: foreach my $field ( $record->fields() ) {
2259         my $tag = $field->tag();
2260         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2261         if ( $field->is_control_field() ) {
2262             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2263           ENTRY: foreach my $entry ( @{$kohafields} ) {
2264                 my ( $subfield, $table, $column ) = @{$entry};
2265                 next ENTRY unless exists $tables{$table};
2266                 my $key = _disambiguate( $table, $column );
2267                 if ( $result->{$key} ) {
2268                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2269                         $result->{$key} .= " | " . $field->data();
2270                     }
2271                 } else {
2272                     $result->{$key} = $field->data();
2273                 }
2274             }
2275         } else {
2276
2277             # deal with subfields
2278           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2279                 my $code = $sf->[0];
2280                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2281                 my $value = $sf->[1];
2282               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2283                     my ( $table, $column ) = @{$entry};
2284                     next SFENTRY unless exists $tables{$table};
2285                     my $key = _disambiguate( $table, $column );
2286                     if ( $result->{$key} ) {
2287                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2288                             $result->{$key} .= " | " . $value;
2289                         }
2290                     } else {
2291                         $result->{$key} = $value;
2292                     }
2293                 }
2294             }
2295         }
2296     }
2297
2298     # modify copyrightdate to keep only the 1st year found
2299     if ( exists $result->{'copyrightdate'} ) {
2300         my $temp = $result->{'copyrightdate'};
2301         $temp =~ m/c(\d\d\d\d)/;
2302         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2303             $result->{'copyrightdate'} = $1;
2304         } else {                                       # if no cYYYY, get the 1st date.
2305             $temp =~ m/(\d\d\d\d)/;
2306             $result->{'copyrightdate'} = $1;
2307         }
2308     }
2309
2310     # modify publicationyear to keep only the 1st year found
2311     if ( exists $result->{'publicationyear'} ) {
2312         my $temp = $result->{'publicationyear'};
2313         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2314             $result->{'publicationyear'} = $1;
2315         } else {                                       # if no cYYYY, get the 1st date.
2316             $temp =~ m/(\d\d\d\d)/;
2317             $result->{'publicationyear'} = $1;
2318         }
2319     }
2320
2321     return $result;
2322 }
2323
2324 sub _get_inverted_marc_field_map {
2325     my $field_map = {};
2326     my $relations = C4::Context->marcfromkohafield;
2327
2328     foreach my $frameworkcode ( keys %{$relations} ) {
2329         foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2330             next unless @{ $relations->{$frameworkcode}->{$kohafield} };    # not all columns are mapped to MARC tag & subfield
2331             my $tag      = $relations->{$frameworkcode}->{$kohafield}->[0];
2332             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2333             my ( $table, $column ) = split /[.]/, $kohafield, 2;
2334             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2335             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2336         }
2337     }
2338     return $field_map;
2339 }
2340
2341 =head2 _disambiguate
2342
2343   $newkey = _disambiguate($table, $field);
2344
2345 This is a temporary hack to distinguish between the
2346 following sets of columns when using TransformMarcToKoha.
2347
2348   items.cn_source & biblioitems.cn_source
2349   items.cn_sort & biblioitems.cn_sort
2350
2351 Columns that are currently NOT distinguished (FIXME
2352 due to lack of time to fully test) are:
2353
2354   biblio.notes and biblioitems.notes
2355   biblionumber
2356   timestamp
2357   biblioitemnumber
2358
2359 FIXME - this is necessary because prefixing each column
2360 name with the table name would require changing lots
2361 of code and templates, and exposing more of the DB
2362 structure than is good to the UI templates, particularly
2363 since biblio and bibloitems may well merge in a future
2364 version.  In the future, it would also be good to
2365 separate DB access and UI presentation field names
2366 more.
2367
2368 =cut
2369
2370 sub CountItemsIssued {
2371     my ($biblionumber) = @_;
2372     my $dbh            = C4::Context->dbh;
2373     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2374     $sth->execute($biblionumber);
2375     my $row = $sth->fetchrow_hashref();
2376     return $row->{'issuedCount'};
2377 }
2378
2379 sub _disambiguate {
2380     my ( $table, $column ) = @_;
2381     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2382         return $table . '.' . $column;
2383     } else {
2384         return $column;
2385     }
2386
2387 }
2388
2389 =head2 get_koha_field_from_marc
2390
2391   $result->{_disambiguate($table, $field)} =
2392      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2393
2394 Internal function to map data from the MARC record to a specific non-MARC field.
2395 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2396
2397 =cut
2398
2399 sub get_koha_field_from_marc {
2400     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2401     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2402     my $kohafield;
2403     foreach my $field ( $record->field($tagfield) ) {
2404         if ( $field->tag() < 10 ) {
2405             if ($kohafield) {
2406                 $kohafield .= " | " . $field->data();
2407             } else {
2408                 $kohafield = $field->data();
2409             }
2410         } else {
2411             if ( $field->subfields ) {
2412                 my @subfields = $field->subfields();
2413                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2414                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2415                         if ($kohafield) {
2416                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2417                         } else {
2418                             $kohafield = $subfields[$subfieldcount][1];
2419                         }
2420                     }
2421                 }
2422             }
2423         }
2424     }
2425     return $kohafield;
2426 }
2427
2428 =head2 TransformMarcToKohaOneField
2429
2430   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2431
2432 =cut
2433
2434 sub TransformMarcToKohaOneField {
2435
2436     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2437     # only the 1st will be retrieved...
2438     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2439     my $res = "";
2440     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2441     foreach my $field ( $record->field($tagfield) ) {
2442         if ( $field->tag() < 10 ) {
2443             if ( $result->{$kohafield} ) {
2444                 $result->{$kohafield} .= " | " . $field->data();
2445             } else {
2446                 $result->{$kohafield} = $field->data();
2447             }
2448         } else {
2449             if ( $field->subfields ) {
2450                 my @subfields = $field->subfields();
2451                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2452                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2453                         if ( $result->{$kohafield} ) {
2454                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2455                         } else {
2456                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2457                         }
2458                     }
2459                 }
2460             }
2461         }
2462     }
2463     return $result;
2464 }
2465
2466 =head1  OTHER FUNCTIONS
2467
2468
2469 =head2 PrepareItemrecordDisplay
2470
2471   PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode);
2472
2473 Returns a hash with all the fields for Display a given item data in a template
2474
2475 The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided
2476
2477 =cut
2478
2479 sub PrepareItemrecordDisplay {
2480
2481     my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_;
2482
2483     my $dbh = C4::Context->dbh;
2484     $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum;
2485     my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2486     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2487
2488     # return nothing if we don't have found an existing framework.
2489     return q{} unless $tagslib;
2490     my $itemrecord;
2491     if ($itemnum) {
2492         $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum );
2493     }
2494     my @loop_data;
2495     my $authorised_values_sth = $dbh->prepare( "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib" );
2496     foreach my $tag ( sort keys %{$tagslib} ) {
2497         my $previous_tag = '';
2498         if ( $tag ne '' ) {
2499
2500             # loop through each subfield
2501             my $cntsubf;
2502             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2503                 next if ( subfield_is_koha_internal_p($subfield) );
2504                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2505                 my %subfield_data;
2506                 $subfield_data{tag}           = $tag;
2507                 $subfield_data{subfield}      = $subfield;
2508                 $subfield_data{countsubfield} = $cntsubf++;
2509                 $subfield_data{kohafield}     = $tagslib->{$tag}->{$subfield}->{'kohafield'};
2510
2511                 #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2512                 $subfield_data{marc_lib}   = $tagslib->{$tag}->{$subfield}->{lib};
2513                 $subfield_data{mandatory}  = $tagslib->{$tag}->{$subfield}->{mandatory};
2514                 $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable};
2515                 $subfield_data{hidden}     = "display:none"
2516                   if $tagslib->{$tag}->{$subfield}->{hidden};
2517                 my ( $x, $defaultvalue );
2518                 if ($itemrecord) {
2519                     ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord );
2520                 }
2521                 $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue;
2522                 if ( !defined $defaultvalue ) {
2523                     $defaultvalue = q||;
2524                 }
2525                 $defaultvalue =~ s/"/&quot;/g;
2526
2527                 # search for itemcallnumber if applicable
2528                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2529                     && C4::Context->preference('itemcallnumber') ) {
2530                     my $CNtag      = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2531                     my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2532                     if ($itemrecord) {
2533                         my $temp = $itemrecord->field($CNtag);
2534                         if ($temp) {
2535                             $defaultvalue = $temp->subfield($CNsubfield);
2536                         }
2537                     }
2538                 }
2539                 if (   $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2540                     && $defaultvalues
2541                     && $defaultvalues->{'callnumber'} ) {
2542                     my $temp;
2543                     if ($itemrecord) {
2544                         $temp = $itemrecord->field($subfield);
2545                     }
2546                     unless ($temp) {
2547                         $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues;
2548                     }
2549                 }
2550                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
2551                     && $defaultvalues
2552                     && $defaultvalues->{'branchcode'} ) {
2553                     my $temp;
2554                     if ($itemrecord) {
2555                         $temp = $itemrecord->field($subfield);
2556                     }
2557                     unless ($temp) {
2558                         $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues;
2559                     }
2560                 }
2561                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.location' )
2562                     && $defaultvalues
2563                     && $defaultvalues->{'location'} ) {
2564                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2565                     unless ($temp) {
2566                         $defaultvalue = $defaultvalues->{location} if $defaultvalues;
2567                     }
2568                 }
2569                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2570                     my @authorised_values;
2571                     my %authorised_lib;
2572
2573                     # builds list, depending on authorised value...
2574                     #---- branch
2575                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
2576                         if (   ( C4::Context->preference("IndependantBranches") )
2577                             && ( C4::Context->userenv->{flags} % 2 != 1 ) ) {
2578                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" );
2579                             $sth->execute( C4::Context->userenv->{branch} );
2580                             push @authorised_values, ""
2581                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2582                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2583                                 push @authorised_values, $branchcode;
2584                                 $authorised_lib{$branchcode} = $branchname;
2585                             }
2586                         } else {
2587                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" );
2588                             $sth->execute;
2589                             push @authorised_values, ""
2590                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2591                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2592                                 push @authorised_values, $branchcode;
2593                                 $authorised_lib{$branchcode} = $branchname;
2594                             }
2595                         }
2596
2597                         #----- itemtypes
2598                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
2599                         my $sth = $dbh->prepare( "SELECT itemtype,description FROM itemtypes ORDER BY description" );
2600                         $sth->execute;
2601                         push @authorised_values, ""
2602                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2603                         while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
2604                             push @authorised_values, $itemtype;
2605                             $authorised_lib{$itemtype} = $description;
2606                         }
2607                         #---- class_sources
2608                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
2609                         push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2610
2611                         my $class_sources = GetClassSources();
2612                         my $default_source = C4::Context->preference("DefaultClassificationSource");
2613
2614                         foreach my $class_source (sort keys %$class_sources) {
2615                             next unless $class_sources->{$class_source}->{'used'} or
2616                                         ($class_source eq $default_source);
2617                             push @authorised_values, $class_source;
2618                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
2619                         }
2620
2621                         #---- "true" authorised value
2622                     } else {
2623                         $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} );
2624                         push @authorised_values, ""
2625                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2626                         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
2627                             push @authorised_values, $value;
2628                             $authorised_lib{$value} = $lib;
2629                         }
2630                     }
2631                     $subfield_data{marc_value} = CGI::scrolling_list(
2632                         -name     => 'field_value',
2633                         -values   => \@authorised_values,
2634                         -default  => "$defaultvalue",
2635                         -labels   => \%authorised_lib,
2636                         -size     => 1,
2637                         -tabindex => '',
2638                         -multiple => 0,
2639                     );
2640                 } elsif ( $tagslib->{$tag}->{$subfield}->{value_builder} ) {
2641                         # opening plugin
2642                         my $plugin = C4::Context->intranetdir . "/cataloguing/value_builder/" . $tagslib->{$tag}->{$subfield}->{'value_builder'};
2643                         if (do $plugin) {
2644                             my $temp;
2645                             my $extended_param = plugin_parameters( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
2646                             my ( $function_name, $javascript ) = plugin_javascript( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
2647                             $subfield_data{random}     = int(rand(1000000));    # why do we need 2 different randoms?
2648                             my $index_subfield = int(rand(1000000));
2649                             $subfield_data{id} = "tag_".$tag."_subfield_".$subfield."_".$index_subfield;
2650                             $subfield_data{marc_value} = qq[<input tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255"
2651                                 onfocus="Focus$function_name($subfield_data{random}, '$subfield_data{id}');"
2652                                  onblur=" Blur$function_name($subfield_data{random}, '$subfield_data{id}');" />
2653                                 <a href="#" class="buttonDot" onclick="Clic$function_name('$subfield_data{id}'); return false;" title="Tag Editor">...</a>
2654                                 $javascript];
2655                         } else {
2656                             warn "Plugin Failed: $plugin";
2657                             $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
2658                         }
2659                 }
2660                 elsif ( $tag eq '' ) {       # it's an hidden field
2661                     $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" />);
2662                 }
2663                 elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {   # FIXME: shouldn't input type be "hidden" ?
2664                     $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" />);
2665                 }
2666                 elsif ( length($defaultvalue) > 100
2667                             or (C4::Context->preference("marcflavour") eq "UNIMARC" and
2668                                   300 <= $tag && $tag < 400 && $subfield eq 'a' )
2669                             or (C4::Context->preference("marcflavour") eq "MARC21"  and
2670                                   500 <= $tag && $tag < 600                     )
2671                           ) {
2672                     # oversize field (textarea)
2673                     $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");
2674                 } else {
2675                     $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
2676                 }
2677                 push( @loop_data, \%subfield_data );
2678             }
2679         }
2680     }
2681     my $itemnumber;
2682     if ( $itemrecord && $itemrecord->field($itemtagfield) ) {
2683         $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield );
2684     }
2685     return {
2686         'itemtagfield'    => $itemtagfield,
2687         'itemtagsubfield' => $itemtagsubfield,
2688         'itemnumber'      => $itemnumber,
2689         'iteminformation' => \@loop_data
2690     };
2691 }
2692
2693 #"
2694
2695 #
2696 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2697 # at the same time
2698 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2699 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2700 # =head2 ModZebrafiles
2701 #
2702 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2703 #
2704 # =cut
2705 #
2706 # sub ModZebrafiles {
2707 #
2708 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2709 #
2710 #     my $op;
2711 #     my $zebradir =
2712 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2713 #     unless ( opendir( DIR, "$zebradir" ) ) {
2714 #         warn "$zebradir not found";
2715 #         return;
2716 #     }
2717 #     closedir DIR;
2718 #     my $filename = $zebradir . $biblionumber;
2719 #
2720 #     if ($record) {
2721 #         open( OUTPUT, ">", $filename . ".xml" );
2722 #         print OUTPUT $record;
2723 #         close OUTPUT;
2724 #     }
2725 # }
2726
2727 =head2 ModZebra
2728
2729   ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2730
2731 $biblionumber is the biblionumber we want to index
2732
2733 $op is specialUpdate or delete, and is used to know what we want to do
2734
2735 $server is the server that we want to update
2736
2737 $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when
2738 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2739 do an update.
2740
2741 $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.
2742
2743 =cut
2744
2745 sub ModZebra {
2746 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2747     my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2748     my $dbh = C4::Context->dbh;
2749
2750     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2751     # at the same time
2752     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2753     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2754
2755     if ( C4::Context->preference("NoZebra") ) {
2756
2757         # lock the nozebra table : we will read index lines, update them in Perl process
2758         # and write everything in 1 transaction.
2759         # lock the table to avoid someone else overwriting what we are doing
2760         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2761         my %result;    # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2762         if ( $op eq 'specialUpdate' ) {
2763
2764             # OK, we have to add or update the record
2765             # 1st delete (virtually, in indexes), if record actually exists
2766             if ($oldRecord) {
2767                 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2768             }
2769
2770             # ... add the record
2771             %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2772         } else {
2773
2774             # it's a deletion, delete the record...
2775             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2776             %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2777         }
2778
2779         # ok, now update the database...
2780         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2781         foreach my $key ( keys %result ) {
2782             foreach my $index ( keys %{ $result{$key} } ) {
2783                 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2784             }
2785         }
2786         $dbh->do('UNLOCK TABLES');
2787     } else {
2788
2789         #
2790         # we use zebra, just fill zebraqueue table
2791         #
2792         my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2793                          WHERE server = ?
2794                          AND   biblio_auth_number = ?
2795                          AND   operation = ?
2796                          AND   done = 0";
2797         my $check_sth = $dbh->prepare_cached($check_sql);
2798         $check_sth->execute( $server, $biblionumber, $op );
2799         my ($count) = $check_sth->fetchrow_array;
2800         $check_sth->finish();
2801         if ( $count == 0 ) {
2802             my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2803             $sth->execute( $biblionumber, $server, $op );
2804             $sth->finish;
2805         }
2806     }
2807 }
2808
2809 =head2 GetNoZebraIndexes
2810
2811   %indexes = GetNoZebraIndexes;
2812
2813 return the data from NoZebraIndexes syspref.
2814
2815 =cut
2816
2817 sub GetNoZebraIndexes {
2818     my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2819     my %indexes;
2820   INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2821         $line =~ /(.*)=>(.*)/;
2822         my $index  = $1;    # initial ' or " is removed afterwards
2823         my $fields = $2;
2824         $index  =~ s/'|"|\s//g;
2825         $fields =~ s/'|"|\s//g;
2826         $indexes{$index} = $fields;
2827     }
2828     return %indexes;
2829 }
2830
2831 =head2 EmbedItemsInMarcBiblio
2832
2833     EmbedItemsInMarcBiblio($marc, $biblionumber);
2834
2835 Given a MARC::Record object containing a bib record,
2836 modify it to include the items attached to it as 9XX
2837 per the bib's MARC framework.
2838
2839 =cut
2840
2841 sub EmbedItemsInMarcBiblio {
2842     my ($marc, $biblionumber) = @_;
2843     croak "No MARC record" unless $marc;
2844
2845     my $frameworkcode = GetFrameworkCode($biblionumber);
2846     _strip_item_fields($marc, $frameworkcode);
2847
2848     # ... and embed the current items
2849     my $dbh = C4::Context->dbh;
2850     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2851     $sth->execute($biblionumber);
2852     my @item_fields;
2853     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2854     while (my ($itemnumber) = $sth->fetchrow_array) {
2855         my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2856         push @item_fields, $item_marc->field($itemtag);
2857     }
2858     $marc->insert_fields_ordered(@item_fields);
2859 }
2860
2861 =head1 INTERNAL FUNCTIONS
2862
2863 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2864
2865 function to delete a biblio in NoZebra indexes
2866 This function does NOT delete anything in database : it reads all the indexes entries
2867 that have to be deleted & delete them in the hash
2868
2869 The SQL part is done either :
2870  - after the Add if we are modifying a biblio (delete + add again)
2871  - immediatly after this sub if we are doing a true deletion.
2872
2873 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2874
2875 =cut
2876
2877 sub _DelBiblioNoZebra {
2878     my ( $biblionumber, $record, $server ) = @_;
2879
2880     # Get the indexes
2881     my $dbh = C4::Context->dbh;
2882
2883     # Get the indexes
2884     my %index;
2885     my $title;
2886     if ( $server eq 'biblioserver' ) {
2887         %index = GetNoZebraIndexes;
2888
2889         # get title of the record (to store the 10 first letters with the index)
2890         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
2891         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2892     } else {
2893
2894         # for authorities, the "title" is the $a mainentry
2895         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2896         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2897         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2898         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2899         $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2900         $index{'mainentry'}     = $authref->{'auth_tag_to_report'} . '*';
2901         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
2902     }
2903
2904     my %result;
2905
2906     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2907     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2908
2909     # limit to 10 char, should be enough, and limit the DB size
2910     $title = substr( $title, 0, 10 );
2911
2912     #parse each field
2913     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2914     foreach my $field ( $record->fields() ) {
2915
2916         #parse each subfield
2917         next if $field->tag < 10;
2918         foreach my $subfield ( $field->subfields() ) {
2919             my $tag          = $field->tag();
2920             my $subfieldcode = $subfield->[0];
2921             my $indexed      = 0;
2922
2923             # check each index to see if the subfield is stored somewhere
2924             # otherwise, store it in __RAW__ index
2925             foreach my $key ( keys %index ) {
2926
2927                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2928                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2929                     $indexed = 1;
2930                     my $line = lc $subfield->[1];
2931
2932                     # remove meaningless value in the field...
2933                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2934
2935                     # ... and split in words
2936                     foreach ( split / /, $line ) {
2937                         next unless $_;    # skip  empty values (multiple spaces)
2938                                            # if the entry is already here, do nothing, the biblionumber has already be removed
2939                         unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2940
2941                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2942                             $sth2->execute( $server, $key, $_ );
2943                             my $existing_biblionumbers = $sth2->fetchrow;
2944
2945                             # it exists
2946                             if ($existing_biblionumbers) {
2947
2948                                 #                                 warn " existing for $key $_: $existing_biblionumbers";
2949                                 $result{$key}->{$_} = $existing_biblionumbers;
2950                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2951                             }
2952                         }
2953                     }
2954                 }
2955             }
2956
2957             # the subfield is not indexed, store it in __RAW__ index anyway
2958             unless ($indexed) {
2959                 my $line = lc $subfield->[1];
2960                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2961
2962                 # ... and split in words
2963                 foreach ( split / /, $line ) {
2964                     next unless $_;    # skip  empty values (multiple spaces)
2965                                        # if the entry is already here, do nothing, the biblionumber has already be removed
2966                     unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2967
2968                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2969                         $sth2->execute( $server, '__RAW__', $_ );
2970                         my $existing_biblionumbers = $sth2->fetchrow;
2971
2972                         # it exists
2973                         if ($existing_biblionumbers) {
2974                             $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2975                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2976                         }
2977                     }
2978                 }
2979             }
2980         }
2981     }
2982     return %result;
2983 }
2984
2985 =head2 _AddBiblioNoZebra
2986
2987   _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2988
2989 function to add a biblio in NoZebra indexes
2990
2991 =cut
2992
2993 sub _AddBiblioNoZebra {
2994     my ( $biblionumber, $record, $server, %result ) = @_;
2995     my $dbh = C4::Context->dbh;
2996
2997     # Get the indexes
2998     my %index;
2999     my $title;
3000     if ( $server eq 'biblioserver' ) {
3001         %index = GetNoZebraIndexes;
3002
3003         # get title of the record (to store the 10 first letters with the index)
3004         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
3005         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
3006     } else {
3007
3008         # warn "server : $server";
3009         # for authorities, the "title" is the $a mainentry
3010         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
3011         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
3012         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
3013         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
3014         $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
3015         $index{'mainentry'}     = $authref->{auth_tag_to_report} . '*';
3016         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
3017     }
3018
3019     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3020     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
3021
3022     # limit to 10 char, should be enough, and limit the DB size
3023     $title = substr( $title, 0, 10 );
3024
3025     #parse each field
3026     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3027     foreach my $field ( $record->fields() ) {
3028
3029         #parse each subfield
3030         ###FIXME: impossible to index a 001-009 value with NoZebra
3031         next if $field->tag < 10;
3032         foreach my $subfield ( $field->subfields() ) {
3033             my $tag          = $field->tag();
3034             my $subfieldcode = $subfield->[0];
3035             my $indexed      = 0;
3036
3037             #             warn "INDEXING :".$subfield->[1];
3038             # check each index to see if the subfield is stored somewhere
3039             # otherwise, store it in __RAW__ index
3040             foreach my $key ( keys %index ) {
3041
3042                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3043                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
3044                     $indexed = 1;
3045                     my $line = lc $subfield->[1];
3046
3047                     # remove meaningless value in the field...
3048                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3049
3050                     # ... and split in words
3051                     foreach ( split / /, $line ) {
3052                         next unless $_;    # skip  empty values (multiple spaces)
3053                                            # if the entry is already here, improve weight
3054
3055                         #                         warn "managing $_";
3056                         if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3057                             my $weight = $1 + 1;
3058                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3059                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3060                         } else {
3061
3062                             # get the value if it exist in the nozebra table, otherwise, create it
3063                             $sth2->execute( $server, $key, $_ );
3064                             my $existing_biblionumbers = $sth2->fetchrow;
3065
3066                             # it exists
3067                             if ($existing_biblionumbers) {
3068                                 $result{$key}->{"$_"} = $existing_biblionumbers;
3069                                 my $weight = defined $1 ? $1 + 1 : 1;
3070                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3071                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3072
3073                                 # create a new ligne for this entry
3074                             } else {
3075
3076                                 #                             warn "INSERT : $server / $key / $_";
3077                                 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
3078                                 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
3079                             }
3080                         }
3081                     }
3082                 }
3083             }
3084
3085             # the subfield is not indexed, store it in __RAW__ index anyway
3086             unless ($indexed) {
3087                 my $line = lc $subfield->[1];
3088                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3089
3090                 # ... and split in words
3091                 foreach ( split / /, $line ) {
3092                     next unless $_;    # skip  empty values (multiple spaces)
3093                                        # if the entry is already here, improve weight
3094                     my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
3095                     if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3096                         my $weight = $1 + 1;
3097                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3098                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3099                     } else {
3100
3101                         # get the value if it exist in the nozebra table, otherwise, create it
3102                         $sth2->execute( $server, '__RAW__', $_ );
3103                         my $existing_biblionumbers = $sth2->fetchrow;
3104
3105                         # it exists
3106                         if ($existing_biblionumbers) {
3107                             $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
3108                             my $weight = ( $1 ? $1 : 0 ) + 1;
3109                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3110                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3111
3112                             # create a new ligne for this entry
3113                         } else {
3114                             $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ',  indexname="__RAW__",value=' . $dbh->quote($_) );
3115                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
3116                         }
3117                     }
3118                 }
3119             }
3120         }
3121     }
3122     return %result;
3123 }
3124
3125 =head2 _find_value
3126
3127   ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3128
3129 Find the given $subfield in the given $tag in the given
3130 MARC::Record $record.  If the subfield is found, returns
3131 the (indicators, value) pair; otherwise, (undef, undef) is
3132 returned.
3133
3134 PROPOSITION :
3135 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3136 I suggest we export it from this module.
3137
3138 =cut
3139
3140 sub _find_value {
3141     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3142     my @result;
3143     my $indicator;
3144     if ( $tagfield < 10 ) {
3145         if ( $record->field($tagfield) ) {
3146             push @result, $record->field($tagfield)->data();
3147         } else {
3148             push @result, "";
3149         }
3150     } else {
3151         foreach my $field ( $record->field($tagfield) ) {
3152             my @subfields = $field->subfields();
3153             foreach my $subfield (@subfields) {
3154                 if ( @$subfield[0] eq $insubfield ) {
3155                     push @result, @$subfield[1];
3156                     $indicator = $field->indicator(1) . $field->indicator(2);
3157                 }
3158             }
3159         }
3160     }
3161     return ( $indicator, @result );
3162 }
3163
3164 =head2 _koha_marc_update_bib_ids
3165
3166
3167   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3168
3169 Internal function to add or update biblionumber and biblioitemnumber to
3170 the MARC XML.
3171
3172 =cut
3173
3174 sub _koha_marc_update_bib_ids {
3175     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3176
3177     # we must add bibnum and bibitemnum in MARC::Record...
3178     # we build the new field with biblionumber and biblioitemnumber
3179     # we drop the original field
3180     # we add the new builded field.
3181     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
3182     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3183
3184     if ( $biblio_tag != $biblioitem_tag ) {
3185
3186         # biblionumber & biblioitemnumber are in different fields
3187
3188         # deal with biblionumber
3189         my ( $new_field, $old_field );
3190         if ( $biblio_tag < 10 ) {
3191             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3192         } else {
3193             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3194         }
3195
3196         # drop old field and create new one...
3197         $old_field = $record->field($biblio_tag);
3198         $record->delete_field($old_field) if $old_field;
3199         $record->insert_fields_ordered($new_field);
3200
3201         # deal with biblioitemnumber
3202         if ( $biblioitem_tag < 10 ) {
3203             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3204         } else {
3205             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3206         }
3207
3208         # drop old field and create new one...
3209         $old_field = $record->field($biblioitem_tag);
3210         $record->delete_field($old_field) if $old_field;
3211         $record->insert_fields_ordered($new_field);
3212
3213     } else {
3214
3215         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3216         my $new_field = MARC::Field->new(
3217             $biblio_tag, '', '',
3218             "$biblio_subfield"     => $biblionumber,
3219             "$biblioitem_subfield" => $biblioitemnumber
3220         );
3221
3222         # drop old field and create new one...
3223         my $old_field = $record->field($biblio_tag);
3224         $record->delete_field($old_field) if $old_field;
3225         $record->insert_fields_ordered($new_field);
3226     }
3227 }
3228
3229 =head2 _koha_marc_update_biblioitem_cn_sort
3230
3231   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3232
3233 Given a MARC bib record and the biblioitem hash, update the
3234 subfield that contains a copy of the value of biblioitems.cn_sort.
3235
3236 =cut
3237
3238 sub _koha_marc_update_biblioitem_cn_sort {
3239     my $marc          = shift;
3240     my $biblioitem    = shift;
3241     my $frameworkcode = shift;
3242
3243     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3244     return unless $biblioitem_tag;
3245
3246     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3247
3248     if ( my $field = $marc->field($biblioitem_tag) ) {
3249         $field->delete_subfield( code => $biblioitem_subfield );
3250         if ( $cn_sort ne '' ) {
3251             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3252         }
3253     } else {
3254
3255         # if we get here, no biblioitem tag is present in the MARC record, so
3256         # we'll create it if $cn_sort is not empty -- this would be
3257         # an odd combination of events, however
3258         if ($cn_sort) {
3259             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3260         }
3261     }
3262 }
3263
3264 =head2 _koha_add_biblio
3265
3266   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3267
3268 Internal function to add a biblio ($biblio is a hash with the values)
3269
3270 =cut
3271
3272 sub _koha_add_biblio {
3273     my ( $dbh, $biblio, $frameworkcode ) = @_;
3274
3275     my $error;
3276
3277     # set the series flag
3278     unless (defined $biblio->{'serial'}){
3279         $biblio->{'serial'} = 0;
3280         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3281     }
3282
3283     my $query = "INSERT INTO biblio
3284         SET frameworkcode = ?,
3285             author = ?,
3286             title = ?,
3287             unititle =?,
3288             notes = ?,
3289             serial = ?,
3290             seriestitle = ?,
3291             copyrightdate = ?,
3292             datecreated=NOW(),
3293             abstract = ?
3294         ";
3295     my $sth = $dbh->prepare($query);
3296     $sth->execute(
3297         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3298         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3299     );
3300
3301     my $biblionumber = $dbh->{'mysql_insertid'};
3302     if ( $dbh->errstr ) {
3303         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3304         warn $error;
3305     }
3306
3307     $sth->finish();
3308
3309     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3310     return ( $biblionumber, $error );
3311 }
3312
3313 =head2 _koha_modify_biblio
3314
3315   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3316
3317 Internal function for updating the biblio table
3318
3319 =cut
3320
3321 sub _koha_modify_biblio {
3322     my ( $dbh, $biblio, $frameworkcode ) = @_;
3323     my $error;
3324
3325     my $query = "
3326         UPDATE biblio
3327         SET    frameworkcode = ?,
3328                author = ?,
3329                title = ?,
3330                unititle = ?,
3331                notes = ?,
3332                serial = ?,
3333                seriestitle = ?,
3334                copyrightdate = ?,
3335                abstract = ?
3336         WHERE  biblionumber = ?
3337         "
3338       ;
3339     my $sth = $dbh->prepare($query);
3340
3341     $sth->execute(
3342         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3343         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3344     ) if $biblio->{'biblionumber'};
3345
3346     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3347         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3348         warn $error;
3349     }
3350     return ( $biblio->{'biblionumber'}, $error );
3351 }
3352
3353 =head2 _koha_modify_biblioitem_nonmarc
3354
3355   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3356
3357 Updates biblioitems row except for marc and marcxml, which should be changed
3358 via ModBiblioMarc
3359
3360 =cut
3361
3362 sub _koha_modify_biblioitem_nonmarc {
3363     my ( $dbh, $biblioitem ) = @_;
3364     my $error;
3365
3366     # re-calculate the cn_sort, it may have changed
3367     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3368
3369     my $query = "UPDATE biblioitems
3370     SET biblionumber    = ?,
3371         volume          = ?,
3372         number          = ?,
3373         itemtype        = ?,
3374         isbn            = ?,
3375         issn            = ?,
3376         publicationyear = ?,
3377         publishercode   = ?,
3378         volumedate      = ?,
3379         volumedesc      = ?,
3380         collectiontitle = ?,
3381         collectionissn  = ?,
3382         collectionvolume= ?,
3383         editionstatement= ?,
3384         editionresponsibility = ?,
3385         illus           = ?,
3386         pages           = ?,
3387         notes           = ?,
3388         size            = ?,
3389         place           = ?,
3390         lccn            = ?,
3391         url             = ?,
3392         cn_source       = ?,
3393         cn_class        = ?,
3394         cn_item         = ?,
3395         cn_suffix       = ?,
3396         cn_sort         = ?,
3397         totalissues     = ?
3398         where biblioitemnumber = ?
3399         ";
3400     my $sth = $dbh->prepare($query);
3401     $sth->execute(
3402         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3403         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3404         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3405         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3406         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3407         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3408         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3409         $biblioitem->{'biblioitemnumber'}
3410     );
3411     if ( $dbh->errstr ) {
3412         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3413         warn $error;
3414     }
3415     return ( $biblioitem->{'biblioitemnumber'}, $error );
3416 }
3417
3418 =head2 _koha_add_biblioitem
3419
3420   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3421
3422 Internal function to add a biblioitem
3423
3424 =cut
3425
3426 sub _koha_add_biblioitem {
3427     my ( $dbh, $biblioitem ) = @_;
3428     my $error;
3429
3430     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3431     my $query = "INSERT INTO biblioitems SET
3432         biblionumber    = ?,
3433         volume          = ?,
3434         number          = ?,
3435         itemtype        = ?,
3436         isbn            = ?,
3437         issn            = ?,
3438         publicationyear = ?,
3439         publishercode   = ?,
3440         volumedate      = ?,
3441         volumedesc      = ?,
3442         collectiontitle = ?,
3443         collectionissn  = ?,
3444         collectionvolume= ?,
3445         editionstatement= ?,
3446         editionresponsibility = ?,
3447         illus           = ?,
3448         pages           = ?,
3449         notes           = ?,
3450         size            = ?,
3451         place           = ?,
3452         lccn            = ?,
3453         marc            = ?,
3454         url             = ?,
3455         cn_source       = ?,
3456         cn_class        = ?,
3457         cn_item         = ?,
3458         cn_suffix       = ?,
3459         cn_sort         = ?,
3460         totalissues     = ?
3461         ";
3462     my $sth = $dbh->prepare($query);
3463     $sth->execute(
3464         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3465         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3466         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3467         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3468         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3469         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3470         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3471         $biblioitem->{'totalissues'}
3472     );
3473     my $bibitemnum = $dbh->{'mysql_insertid'};
3474
3475     if ( $dbh->errstr ) {
3476         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3477         warn $error;
3478     }
3479     $sth->finish();
3480     return ( $bibitemnum, $error );
3481 }
3482
3483 =head2 _koha_delete_biblio
3484
3485   $error = _koha_delete_biblio($dbh,$biblionumber);
3486
3487 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3488
3489 C<$dbh> - the database handle
3490
3491 C<$biblionumber> - the biblionumber of the biblio to be deleted
3492
3493 =cut
3494
3495 # FIXME: add error handling
3496
3497 sub _koha_delete_biblio {
3498     my ( $dbh, $biblionumber ) = @_;
3499
3500     # get all the data for this biblio
3501     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3502     $sth->execute($biblionumber);
3503
3504     if ( my $data = $sth->fetchrow_hashref ) {
3505
3506         # save the record in deletedbiblio
3507         # find the fields to save
3508         my $query = "INSERT INTO deletedbiblio SET ";
3509         my @bind  = ();
3510         foreach my $temp ( keys %$data ) {
3511             $query .= "$temp = ?,";
3512             push( @bind, $data->{$temp} );
3513         }
3514
3515         # replace the last , by ",?)"
3516         $query =~ s/\,$//;
3517         my $bkup_sth = $dbh->prepare($query);
3518         $bkup_sth->execute(@bind);
3519         $bkup_sth->finish;
3520
3521         # delete the biblio
3522         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3523         $del_sth->execute($biblionumber);
3524         $del_sth->finish;
3525     }
3526     $sth->finish;
3527     return undef;
3528 }
3529
3530 =head2 _koha_delete_biblioitems
3531
3532   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3533
3534 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3535
3536 C<$dbh> - the database handle
3537 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3538
3539 =cut
3540
3541 # FIXME: add error handling
3542
3543 sub _koha_delete_biblioitems {
3544     my ( $dbh, $biblioitemnumber ) = @_;
3545
3546     # get all the data for this biblioitem
3547     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3548     $sth->execute($biblioitemnumber);
3549
3550     if ( my $data = $sth->fetchrow_hashref ) {
3551
3552         # save the record in deletedbiblioitems
3553         # find the fields to save
3554         my $query = "INSERT INTO deletedbiblioitems SET ";
3555         my @bind  = ();
3556         foreach my $temp ( keys %$data ) {
3557             $query .= "$temp = ?,";
3558             push( @bind, $data->{$temp} );
3559         }
3560
3561         # replace the last , by ",?)"
3562         $query =~ s/\,$//;
3563         my $bkup_sth = $dbh->prepare($query);
3564         $bkup_sth->execute(@bind);
3565         $bkup_sth->finish;
3566
3567         # delete the biblioitem
3568         my $del_sth = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3569         $del_sth->execute($biblioitemnumber);
3570         $del_sth->finish;
3571     }
3572     $sth->finish;
3573     return undef;
3574 }
3575
3576 =head1 UNEXPORTED FUNCTIONS
3577
3578 =head2 ModBiblioMarc
3579
3580   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3581
3582 Add MARC data for a biblio to koha
3583
3584 Function exported, but should NOT be used, unless you really know what you're doing
3585
3586 =cut
3587
3588 sub ModBiblioMarc {
3589
3590     # pass the MARC::Record to this function, and it will create the records in the marc field
3591     my ( $record, $biblionumber, $frameworkcode ) = @_;
3592     my $dbh    = C4::Context->dbh;
3593     my @fields = $record->fields();
3594     if ( !$frameworkcode ) {
3595         $frameworkcode = "";
3596     }
3597     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3598     $sth->execute( $frameworkcode, $biblionumber );
3599     $sth->finish;
3600     my $encoding = C4::Context->preference("marcflavour");
3601
3602     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3603     if ( $encoding eq "UNIMARC" ) {
3604         my $string = $record->subfield( 100, "a" );
3605         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3606             my $f100 = $record->field(100);
3607             $record->delete_field($f100);
3608         } else {
3609             $string = POSIX::strftime( "%Y%m%d", localtime );
3610             $string =~ s/\-//g;
3611             $string = sprintf( "%-*s", 35, $string );
3612         }
3613         substr( $string, 22, 6, "frey50" );
3614         unless ( $record->subfield( 100, "a" ) ) {
3615             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3616         }
3617     }
3618
3619     #enhancement 5374: update transaction date (005) for marc21/unimarc
3620     if($encoding =~ /MARC21|UNIMARC/) {
3621       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3622         # YY MM DD HH MM SS (update year and month)
3623       my $f005= $record->field('005');
3624       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3625     }
3626
3627     my $oldRecord;
3628     if ( C4::Context->preference("NoZebra") ) {
3629
3630         # only NoZebra indexing needs to have
3631         # the previous version of the record
3632         $oldRecord = GetMarcBiblio($biblionumber);
3633     }
3634     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3635     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3636     $sth->finish;
3637     ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3638     return $biblionumber;
3639 }
3640
3641 =head2 z3950_extended_services
3642
3643   z3950_extended_services($serviceType,$serviceOptions,$record);
3644
3645 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.
3646
3647 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3648
3649 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3650
3651  action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3652
3653 and maybe
3654
3655   recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3656   syntax => the record syntax (transfer syntax)
3657   databaseName = Database from connection object
3658
3659 To set serviceOptions, call set_service_options($serviceType)
3660
3661 C<$record> the record, if one is needed for the service type
3662
3663 A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3664
3665 =cut
3666
3667 sub z3950_extended_services {
3668     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3669
3670     # get our connection object
3671     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3672
3673     # create a new package object
3674     my $Zpackage = $Zconn->package();
3675
3676     # set our options
3677     $Zpackage->option( action => $action );
3678
3679     if ( $serviceOptions->{'databaseName'} ) {
3680         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3681     }
3682     if ( $serviceOptions->{'recordIdNumber'} ) {
3683         $Zpackage->option( recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3684     }
3685     if ( $serviceOptions->{'recordIdOpaque'} ) {
3686         $Zpackage->option( recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3687     }
3688
3689     # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3690     #if ($serviceType eq 'itemorder') {
3691     #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3692     #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3693     #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3694     #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3695     #}
3696
3697     if ( $serviceOptions->{record} ) {
3698         $Zpackage->option( record => $serviceOptions->{record} );
3699
3700         # can be xml or marc
3701         if ( $serviceOptions->{'syntax'} ) {
3702             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3703         }
3704     }
3705
3706     # send the request, handle any exception encountered
3707     eval { $Zpackage->send($serviceType) };
3708     if ( $@ && $@->isa("ZOOM::Exception") ) {
3709         return "error:  " . $@->code() . " " . $@->message() . "\n";
3710     }
3711
3712     # free up package resources
3713     $Zpackage->destroy();
3714 }
3715
3716 =head2 set_service_options
3717
3718   my $serviceOptions = set_service_options($serviceType);
3719
3720 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3721
3722 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3723
3724 =cut
3725
3726 sub set_service_options {
3727     my ($serviceType) = @_;
3728     my $serviceOptions;
3729
3730     # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3731     #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3732
3733     if ( $serviceType eq 'commit' ) {
3734
3735         # nothing to do
3736     }
3737     if ( $serviceType eq 'create' ) {
3738
3739         # nothing to do
3740     }
3741     if ( $serviceType eq 'drop' ) {
3742         die "ERROR: 'drop' not currently supported (by Zebra)";
3743     }
3744     return $serviceOptions;
3745 }
3746
3747 =head2 get_biblio_authorised_values
3748
3749 find the types and values for all authorised values assigned to this biblio.
3750
3751 parameters:
3752     biblionumber
3753     MARC::Record of the bib
3754
3755 returns: a hashref mapping the authorised value to the value set for this biblionumber
3756
3757   $authorised_values = {
3758                        'Scent'     => 'flowery',
3759                        'Audience'  => 'Young Adult',
3760                        'itemtypes' => 'SER',
3761                         };
3762
3763 Notes: forlibrarian should probably be passed in, and called something different.
3764
3765 =cut
3766
3767 sub get_biblio_authorised_values {
3768     my $biblionumber = shift;
3769     my $record       = shift;
3770
3771     my $forlibrarian  = 1;                                 # are we in staff or opac?
3772     my $frameworkcode = GetFrameworkCode($biblionumber);
3773
3774     my $authorised_values;
3775
3776     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3777       or return $authorised_values;
3778
3779     # assume that these entries in the authorised_value table are bibliolevel.
3780     # ones that start with 'item%' are item level.
3781     my $query = q(SELECT distinct authorised_value, kohafield
3782                     FROM marc_subfield_structure
3783                     WHERE authorised_value !=''
3784                       AND (kohafield like 'biblio%'
3785                        OR  kohafield like '') );
3786     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3787
3788     foreach my $tag ( keys(%$tagslib) ) {
3789         foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3790
3791             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3792             if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3793                 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3794                     if ( defined $record->field($tag) ) {
3795                         my $this_subfield_value = $record->field($tag)->subfield($subfield);
3796                         if ( defined $this_subfield_value ) {
3797                             $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3798                         }
3799                     }
3800                 }
3801             }
3802         }
3803     }
3804
3805     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3806     return $authorised_values;
3807 }
3808
3809 1;
3810
3811 __END__
3812
3813 =head1 AUTHOR
3814
3815 Koha Development Team <http://koha-community.org/>
3816
3817 Paul POULAIN paul.poulain@free.fr
3818
3819 Joshua Ferraro jmf@liblime.com
3820
3821 =cut