C4/Biblio.pm

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