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