C4/Biblio.pm

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