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