C4/Biblio.pm

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