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