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