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