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