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