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