C4/Biblio.pm

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