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