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