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