C4/Biblio.pm

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