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