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