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
1831 entry from user entry
1832
1833 =cut
1834
1835
1836 sub TransformKohaToMarc {
1837     my $hash = shift;
1838     my $record = MARC::Record->new();
1839     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1840     my $db_to_marc = C4::Context->marcfromkohafield;
1841     while ( my ($name, $value) = each %$hash ) {
1842         next unless my $dtm = $db_to_marc->{''}->{$name};
1843         my ($tag, $letter) = @$dtm;
1844         foreach my $value ( split(/\s?\|\s?/, $value, -1) ) {
1845             if ( my $field = $record->field($tag) ) {
1846                 $field->add_subfields( $letter => $value );
1847             }
1848             else {
1849                 $record->insert_fields_ordered( MARC::Field->new(
1850                     $tag, " ", " ", $letter => $value ) );
1851             }
1852         }
1853
1854     }
1855     return $record;
1856 }
1857
1858 =head2 PrepHostMarcField
1859
1860     $hostfield = PrepHostMarcField ( $hostbiblionumber,$hostitemnumber,$marcflavour )
1861
1862 This function returns a host field populated with data from the host record, the field can then be added to an analytical record
1863
1864 =cut
1865
1866 sub PrepHostMarcField {
1867     my ($hostbiblionumber,$hostitemnumber, $marcflavour) = @_;
1868     $marcflavour ||="MARC21";
1869
1870     my $hostrecord = GetMarcBiblio($hostbiblionumber);
1871         my $item = C4::Items::GetItem($hostitemnumber);
1872
1873         my $hostmarcfield;
1874     if ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) {
1875
1876         #main entry
1877         my $mainentry;
1878         if ($hostrecord->subfield('100','a')){
1879             $mainentry = $hostrecord->subfield('100','a');
1880         } elsif ($hostrecord->subfield('110','a')){
1881             $mainentry = $hostrecord->subfield('110','a');
1882         } else {
1883             $mainentry = $hostrecord->subfield('111','a');
1884         }
1885
1886         # qualification info
1887         my $qualinfo;
1888         if (my $field260 = $hostrecord->field('260')){
1889             $qualinfo =  $field260->as_string( 'abc' );
1890         }
1891
1892
1893         #other fields
1894         my $ed = $hostrecord->subfield('250','a');
1895         my $barcode = $item->{'barcode'};
1896         my $title = $hostrecord->subfield('245','a');
1897
1898         # record control number, 001 with 003 and prefix
1899         my $recctrlno;
1900         if ($hostrecord->field('001')){
1901             $recctrlno = $hostrecord->field('001')->data();
1902             if ($hostrecord->field('003')){
1903                 $recctrlno = '('.$hostrecord->field('003')->data().')'.$recctrlno;
1904             }
1905         }
1906
1907         # issn/isbn
1908         my $issn = $hostrecord->subfield('022','a');
1909         my $isbn = $hostrecord->subfield('020','a');
1910
1911
1912         $hostmarcfield = MARC::Field->new(
1913                 773, '0', '',
1914                 '0' => $hostbiblionumber,
1915                 '9' => $hostitemnumber,
1916                 'a' => $mainentry,
1917                 'b' => $ed,
1918                 'd' => $qualinfo,
1919                 'o' => $barcode,
1920                 't' => $title,
1921                 'w' => $recctrlno,
1922                 'x' => $issn,
1923                 'z' => $isbn
1924                 );
1925     } elsif ($marcflavour eq "UNIMARC") {
1926         $hostmarcfield = MARC::Field->new(
1927             461, '', '',
1928             '0' => $hostbiblionumber,
1929             't' => $hostrecord->subfield('200','a'),
1930             '9' => $hostitemnumber
1931         );
1932     };
1933
1934     return $hostmarcfield;
1935 }
1936
1937
1938 =head2 TransformKohaToMarcOneField
1939
1940     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1941
1942 =cut
1943
1944
1945 =head2 TransformHtmlToXml
1946
1947   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
1948                              $ind_tag, $auth_type )
1949
1950 $auth_type contains :
1951
1952 =over
1953
1954 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
1955
1956 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1957
1958 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1959
1960 =back
1961
1962 =cut
1963
1964 sub TransformHtmlToXml {
1965     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1966     my $xml = MARC::File::XML::header('UTF-8');
1967     $xml .= "<record>\n";
1968     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1969     MARC::File::XML->default_record_format($auth_type);
1970
1971     # in UNIMARC, field 100 contains the encoding
1972     # check that there is one, otherwise the
1973     # MARC::Record->new_from_xml will fail (and Koha will die)
1974     my $unimarc_and_100_exist = 0;
1975     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
1976     my $prevvalue;
1977     my $prevtag = -1;
1978     my $first   = 1;
1979     my $j       = -1;
1980     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1981
1982         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
1983
1984             # if we have a 100 field and it's values are not correct, skip them.
1985             # if we don't have any valid 100 field, we will create a default one at the end
1986             my $enc = substr( @$values[$i], 26, 2 );
1987             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
1988                 $unimarc_and_100_exist = 1;
1989             } else {
1990                 next;
1991             }
1992         }
1993         @$values[$i] =~ s/&/&amp;/g;
1994         @$values[$i] =~ s/</&lt;/g;
1995         @$values[$i] =~ s/>/&gt;/g;
1996         @$values[$i] =~ s/"/&quot;/g;
1997         @$values[$i] =~ s/'/&apos;/g;
1998
1999         #         if ( !utf8::is_utf8( @$values[$i] ) ) {
2000         #             utf8::decode( @$values[$i] );
2001         #         }
2002         if ( ( @$tags[$i] ne $prevtag ) ) {
2003             $j++ unless ( @$tags[$i] eq "" );
2004             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2005             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2006             my $ind1       = _default_ind_to_space($indicator1);
2007             my $ind2;
2008             if ( @$indicator[$j] ) {
2009                 $ind2 = _default_ind_to_space($indicator2);
2010             } else {
2011                 warn "Indicator in @$tags[$i] is empty";
2012                 $ind2 = " ";
2013             }
2014             if ( !$first ) {
2015                 $xml .= "</datafield>\n";
2016                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
2017                     && ( @$values[$i] ne "" ) ) {
2018                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2019                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2020                     $first = 0;
2021                 } else {
2022                     $first = 1;
2023                 }
2024             } else {
2025                 if ( @$values[$i] ne "" ) {
2026
2027                     # leader
2028                     if ( @$tags[$i] eq "000" ) {
2029                         $xml .= "<leader>@$values[$i]</leader>\n";
2030                         $first = 1;
2031
2032                         # rest of the fixed fields
2033                     } elsif ( @$tags[$i] < 10 ) {
2034                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
2035                         $first = 1;
2036                     } else {
2037                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2038                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2039                         $first = 0;
2040                     }
2041                 }
2042             }
2043         } else {    # @$tags[$i] eq $prevtag
2044             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
2045             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
2046             my $ind1       = _default_ind_to_space($indicator1);
2047             my $ind2;
2048             if ( @$indicator[$j] ) {
2049                 $ind2 = _default_ind_to_space($indicator2);
2050             } else {
2051                 warn "Indicator in @$tags[$i] is empty";
2052                 $ind2 = " ";
2053             }
2054             if ( @$values[$i] eq "" ) {
2055             } else {
2056                 if ($first) {
2057                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
2058                     $first = 0;
2059                 }
2060                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
2061             }
2062         }
2063         $prevtag = @$tags[$i];
2064     }
2065     $xml .= "</datafield>\n" if $xml =~ m/<datafield/;
2066     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
2067
2068         #     warn "SETTING 100 for $auth_type";
2069         my $string = strftime( "%Y%m%d", localtime(time) );
2070
2071         # set 50 to position 26 is biblios, 13 if authorities
2072         my $pos = 26;
2073         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
2074         $string = sprintf( "%-*s", 35, $string );
2075         substr( $string, $pos, 6, "50" );
2076         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
2077         $xml .= "<subfield code=\"a\">$string</subfield>\n";
2078         $xml .= "</datafield>\n";
2079     }
2080     $xml .= "</record>\n";
2081     $xml .= MARC::File::XML::footer();
2082     return $xml;
2083 }
2084
2085 =head2 _default_ind_to_space
2086
2087 Passed what should be an indicator returns a space
2088 if its undefined or zero length
2089
2090 =cut
2091
2092 sub _default_ind_to_space {
2093     my $s = shift;
2094     if ( !defined $s || $s eq q{} ) {
2095         return ' ';
2096     }
2097     return $s;
2098 }
2099
2100 =head2 TransformHtmlToMarc
2101
2102     L<$record> = TransformHtmlToMarc(L<$cgi>)
2103     L<$cgi> is the CGI object which containts the values for subfields
2104     {
2105         'tag_010_indicator1_531951' ,
2106         'tag_010_indicator2_531951' ,
2107         'tag_010_code_a_531951_145735' ,
2108         'tag_010_subfield_a_531951_145735' ,
2109         'tag_200_indicator1_873510' ,
2110         'tag_200_indicator2_873510' ,
2111         'tag_200_code_a_873510_673465' ,
2112         'tag_200_subfield_a_873510_673465' ,
2113         'tag_200_code_b_873510_704318' ,
2114         'tag_200_subfield_b_873510_704318' ,
2115         'tag_200_code_e_873510_280822' ,
2116         'tag_200_subfield_e_873510_280822' ,
2117         'tag_200_code_f_873510_110730' ,
2118         'tag_200_subfield_f_873510_110730' ,
2119     }
2120     L<$record> is the MARC::Record object.
2121
2122 =cut
2123
2124 sub TransformHtmlToMarc {
2125     my $cgi    = shift;
2126
2127     my @params = $cgi->param();
2128
2129     # explicitly turn on the UTF-8 flag for all
2130     # 'tag_' parameters to avoid incorrect character
2131     # conversion later on
2132     my $cgi_params = $cgi->Vars;
2133     foreach my $param_name ( keys %$cgi_params ) {
2134         if ( $param_name =~ /^tag_/ ) {
2135             my $param_value = $cgi_params->{$param_name};
2136             if ( utf8::decode($param_value) ) {
2137                 $cgi_params->{$param_name} = $param_value;
2138             }
2139
2140             # FIXME - need to do something if string is not valid UTF-8
2141         }
2142     }
2143
2144     # creating a new record
2145     my $record = MARC::Record->new();
2146     my $i      = 0;
2147     my @fields;
2148     while ( $params[$i] ) {    # browse all CGI params
2149         my $param    = $params[$i];
2150         my $newfield = 0;
2151
2152         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2153         if ( $param eq 'biblionumber' ) {
2154             my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2155             if ( $biblionumbertagfield < 10 ) {
2156                 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2157             } else {
2158                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2159             }
2160             push @fields, $newfield if ($newfield);
2161         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2162             my $tag = $1;
2163
2164             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2165             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params[ $i + 1 ] ), 0, 1 ) );
2166             $newfield = 0;
2167             my $j = $i + 2;
2168
2169             if ( $tag < 10 ) {                              # no code for theses fields
2170                                                             # in MARC editor, 000 contains the leader.
2171                 if ( $tag eq '000' ) {
2172                     # Force a fake leader even if not provided to avoid crashing
2173                     # during decoding MARC record containing UTF-8 characters
2174                     $record->leader(
2175                         length( $cgi->param($params[$j+1]) ) == 24
2176                         ? $cgi->param( $params[ $j + 1 ] )
2177                         : '     nam a22        4500'
2178                         )
2179                     ;
2180                     # between 001 and 009 (included)
2181                 } elsif ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {
2182                     $newfield = MARC::Field->new( $tag, $cgi->param( $params[ $j + 1 ] ), );
2183                 }
2184
2185                 # > 009, deal with subfields
2186             } else {
2187                 while ( defined $params[$j] && $params[$j] =~ /_code_/ ) {    # browse all it's subfield
2188                     my $inner_param = $params[$j];
2189                     if ($newfield) {
2190                         if ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {         # only if there is a value (code => value)
2191                             $newfield->add_subfields( $cgi->param($inner_param) => $cgi->param( $params[ $j + 1 ] ) );
2192                         }
2193                     } else {
2194                         if ( $cgi->param( $params[ $j + 1 ] ) ne '' ) {         # creating only if there is a value (code => value)
2195                             $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($inner_param) => $cgi->param( $params[ $j + 1 ] ), );
2196                         }
2197                     }
2198                     $j += 2;
2199                 }
2200             }
2201             push @fields, $newfield if ($newfield);
2202         }
2203         $i++;
2204     }
2205
2206     $record->append_fields(@fields);
2207     return $record;
2208 }
2209
2210 # cache inverted MARC field map
2211 our $inverted_field_map;
2212
2213 =head2 TransformMarcToKoha
2214
2215   $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2216
2217 Extract data from a MARC bib record into a hashref representing
2218 Koha biblio, biblioitems, and items fields.
2219
2220 =cut
2221
2222 sub TransformMarcToKoha {
2223     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2224
2225     my $result;
2226     $limit_table = $limit_table || 0;
2227     $frameworkcode = '' unless defined $frameworkcode;
2228
2229     unless ( defined $inverted_field_map ) {
2230         $inverted_field_map = _get_inverted_marc_field_map();
2231     }
2232
2233     my %tables = ();
2234     if ( defined $limit_table && $limit_table eq 'items' ) {
2235         $tables{'items'} = 1;
2236     } else {
2237         $tables{'items'}       = 1;
2238         $tables{'biblio'}      = 1;
2239         $tables{'biblioitems'} = 1;
2240     }
2241
2242     # traverse through record
2243   MARCFIELD: foreach my $field ( $record->fields() ) {
2244         my $tag = $field->tag();
2245         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2246         if ( $field->is_control_field() ) {
2247             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2248           ENTRY: foreach my $entry ( @{$kohafields} ) {
2249                 my ( $subfield, $table, $column ) = @{$entry};
2250                 next ENTRY unless exists $tables{$table};
2251                 my $key = _disambiguate( $table, $column );
2252                 if ( $result->{$key} ) {
2253                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2254                         $result->{$key} .= " | " . $field->data();
2255                     }
2256                 } else {
2257                     $result->{$key} = $field->data();
2258                 }
2259             }
2260         } else {
2261
2262             # deal with subfields
2263           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2264                 my $code = $sf->[0];
2265                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2266                 my $value = $sf->[1];
2267               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2268                     my ( $table, $column ) = @{$entry};
2269                     next SFENTRY unless exists $tables{$table};
2270                     my $key = _disambiguate( $table, $column );
2271                     if ( $result->{$key} ) {
2272                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2273                             $result->{$key} .= " | " . $value;
2274                         }
2275                     } else {
2276                         $result->{$key} = $value;
2277                     }
2278                 }
2279             }
2280         }
2281     }
2282
2283     # modify copyrightdate to keep only the 1st year found
2284     if ( exists $result->{'copyrightdate'} ) {
2285         my $temp = $result->{'copyrightdate'};
2286         $temp =~ m/c(\d\d\d\d)/;
2287         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2288             $result->{'copyrightdate'} = $1;
2289         } else {                                       # if no cYYYY, get the 1st date.
2290             $temp =~ m/(\d\d\d\d)/;
2291             $result->{'copyrightdate'} = $1;
2292         }
2293     }
2294
2295     # modify publicationyear to keep only the 1st year found
2296     if ( exists $result->{'publicationyear'} ) {
2297         my $temp = $result->{'publicationyear'};
2298         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2299             $result->{'publicationyear'} = $1;
2300         } else {                                       # if no cYYYY, get the 1st date.
2301             $temp =~ m/(\d\d\d\d)/;
2302             $result->{'publicationyear'} = $1;
2303         }
2304     }
2305
2306     return $result;
2307 }
2308
2309 sub _get_inverted_marc_field_map {
2310     my $field_map = {};
2311     my $relations = C4::Context->marcfromkohafield;
2312
2313     foreach my $frameworkcode ( keys %{$relations} ) {
2314         foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2315             next unless @{ $relations->{$frameworkcode}->{$kohafield} };    # not all columns are mapped to MARC tag & subfield
2316             my $tag      = $relations->{$frameworkcode}->{$kohafield}->[0];
2317             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2318             my ( $table, $column ) = split /[.]/, $kohafield, 2;
2319             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2320             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2321         }
2322     }
2323     return $field_map;
2324 }
2325
2326 =head2 _disambiguate
2327
2328   $newkey = _disambiguate($table, $field);
2329
2330 This is a temporary hack to distinguish between the
2331 following sets of columns when using TransformMarcToKoha.
2332
2333   items.cn_source & biblioitems.cn_source
2334   items.cn_sort & biblioitems.cn_sort
2335
2336 Columns that are currently NOT distinguished (FIXME
2337 due to lack of time to fully test) are:
2338
2339   biblio.notes and biblioitems.notes
2340   biblionumber
2341   timestamp
2342   biblioitemnumber
2343
2344 FIXME - this is necessary because prefixing each column
2345 name with the table name would require changing lots
2346 of code and templates, and exposing more of the DB
2347 structure than is good to the UI templates, particularly
2348 since biblio and bibloitems may well merge in a future
2349 version.  In the future, it would also be good to
2350 separate DB access and UI presentation field names
2351 more.
2352
2353 =cut
2354
2355 sub CountItemsIssued {
2356     my ($biblionumber) = @_;
2357     my $dbh            = C4::Context->dbh;
2358     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2359     $sth->execute($biblionumber);
2360     my $row = $sth->fetchrow_hashref();
2361     return $row->{'issuedCount'};
2362 }
2363
2364 sub _disambiguate {
2365     my ( $table, $column ) = @_;
2366     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2367         return $table . '.' . $column;
2368     } else {
2369         return $column;
2370     }
2371
2372 }
2373
2374 =head2 get_koha_field_from_marc
2375
2376   $result->{_disambiguate($table, $field)} =
2377      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2378
2379 Internal function to map data from the MARC record to a specific non-MARC field.
2380 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2381
2382 =cut
2383
2384 sub get_koha_field_from_marc {
2385     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2386     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2387     my $kohafield;
2388     foreach my $field ( $record->field($tagfield) ) {
2389         if ( $field->tag() < 10 ) {
2390             if ($kohafield) {
2391                 $kohafield .= " | " . $field->data();
2392             } else {
2393                 $kohafield = $field->data();
2394             }
2395         } else {
2396             if ( $field->subfields ) {
2397                 my @subfields = $field->subfields();
2398                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2399                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2400                         if ($kohafield) {
2401                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2402                         } else {
2403                             $kohafield = $subfields[$subfieldcount][1];
2404                         }
2405                     }
2406                 }
2407             }
2408         }
2409     }
2410     return $kohafield;
2411 }
2412
2413 =head2 TransformMarcToKohaOneField
2414
2415   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2416
2417 =cut
2418
2419 sub TransformMarcToKohaOneField {
2420
2421     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2422     # only the 1st will be retrieved...
2423     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2424     my $res = "";
2425     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2426     foreach my $field ( $record->field($tagfield) ) {
2427         if ( $field->tag() < 10 ) {
2428             if ( $result->{$kohafield} ) {
2429                 $result->{$kohafield} .= " | " . $field->data();
2430             } else {
2431                 $result->{$kohafield} = $field->data();
2432             }
2433         } else {
2434             if ( $field->subfields ) {
2435                 my @subfields = $field->subfields();
2436                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2437                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2438                         if ( $result->{$kohafield} ) {
2439                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2440                         } else {
2441                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2442                         }
2443                     }
2444                 }
2445             }
2446         }
2447     }
2448     return $result;
2449 }
2450
2451 =head1  OTHER FUNCTIONS
2452
2453
2454 =head2 PrepareItemrecordDisplay
2455
2456   PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode);
2457
2458 Returns a hash with all the fields for Display a given item data in a template
2459
2460 The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided
2461
2462 =cut
2463
2464 sub PrepareItemrecordDisplay {
2465
2466     my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_;
2467
2468     my $dbh = C4::Context->dbh;
2469     $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum;
2470     my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2471     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2472
2473     # return nothing if we don't have found an existing framework.
2474     return q{} unless $tagslib;
2475     my $itemrecord;
2476     if ($itemnum) {
2477         $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum );
2478     }
2479     my @loop_data;
2480     my $authorised_values_sth = $dbh->prepare( "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib" );
2481     foreach my $tag ( sort keys %{$tagslib} ) {
2482         my $previous_tag = '';
2483         if ( $tag ne '' ) {
2484
2485             # loop through each subfield
2486             my $cntsubf;
2487             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2488                 next if ( subfield_is_koha_internal_p($subfield) );
2489                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2490                 my %subfield_data;
2491                 $subfield_data{tag}           = $tag;
2492                 $subfield_data{subfield}      = $subfield;
2493                 $subfield_data{countsubfield} = $cntsubf++;
2494                 $subfield_data{kohafield}     = $tagslib->{$tag}->{$subfield}->{'kohafield'};
2495
2496                 #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2497                 $subfield_data{marc_lib}   = $tagslib->{$tag}->{$subfield}->{lib};
2498                 $subfield_data{mandatory}  = $tagslib->{$tag}->{$subfield}->{mandatory};
2499                 $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable};
2500                 $subfield_data{hidden}     = "display:none"
2501                   if $tagslib->{$tag}->{$subfield}->{hidden};
2502                 my ( $x, $defaultvalue );
2503                 if ($itemrecord) {
2504                     ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord );
2505                 }
2506                 $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue;
2507                 if ( !defined $defaultvalue ) {
2508                     $defaultvalue = q||;
2509                 }
2510                 $defaultvalue =~ s/"/&quot;/g;
2511
2512                 # search for itemcallnumber if applicable
2513                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2514                     && C4::Context->preference('itemcallnumber') ) {
2515                     my $CNtag      = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2516                     my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2517                     if ($itemrecord) {
2518                         my $temp = $itemrecord->field($CNtag);
2519                         if ($temp) {
2520                             $defaultvalue = $temp->subfield($CNsubfield);
2521                         }
2522                     }
2523                 }
2524                 if (   $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2525                     && $defaultvalues
2526                     && $defaultvalues->{'callnumber'} ) {
2527                     my $temp;
2528                     if ($itemrecord) {
2529                         $temp = $itemrecord->field($subfield);
2530                     }
2531                     unless ($temp) {
2532                         $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues;
2533                     }
2534                 }
2535                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
2536                     && $defaultvalues
2537                     && $defaultvalues->{'branchcode'} ) {
2538                     my $temp;
2539                     if ($itemrecord) {
2540                         $temp = $itemrecord->field($subfield);
2541                     }
2542                     unless ($temp) {
2543                         $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues;
2544                     }
2545                 }
2546                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.location' )
2547                     && $defaultvalues
2548                     && $defaultvalues->{'location'} ) {
2549                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2550                     unless ($temp) {
2551                         $defaultvalue = $defaultvalues->{location} if $defaultvalues;
2552                     }
2553                 }
2554                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2555                     my @authorised_values;
2556                     my %authorised_lib;
2557
2558                     # builds list, depending on authorised value...
2559                     #---- branch
2560                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
2561                         if (   ( C4::Context->preference("IndependantBranches") )
2562                             && ( C4::Context->userenv->{flags} % 2 != 1 ) ) {
2563                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" );
2564                             $sth->execute( C4::Context->userenv->{branch} );
2565                             push @authorised_values, ""
2566                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2567                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2568                                 push @authorised_values, $branchcode;
2569                                 $authorised_lib{$branchcode} = $branchname;
2570                             }
2571                         } else {
2572                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" );
2573                             $sth->execute;
2574                             push @authorised_values, ""
2575                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2576                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2577                                 push @authorised_values, $branchcode;
2578                                 $authorised_lib{$branchcode} = $branchname;
2579                             }
2580                         }
2581
2582                         #----- itemtypes
2583                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
2584                         my $sth = $dbh->prepare( "SELECT itemtype,description FROM itemtypes ORDER BY description" );
2585                         $sth->execute;
2586                         push @authorised_values, ""
2587                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2588                         while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
2589                             push @authorised_values, $itemtype;
2590                             $authorised_lib{$itemtype} = $description;
2591                         }
2592                         #---- class_sources
2593                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
2594                         push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2595
2596                         my $class_sources = GetClassSources();
2597                         my $default_source = C4::Context->preference("DefaultClassificationSource");
2598
2599                         foreach my $class_source (sort keys %$class_sources) {
2600                             next unless $class_sources->{$class_source}->{'used'} or
2601                                         ($class_source eq $default_source);
2602                             push @authorised_values, $class_source;
2603                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
2604                         }
2605
2606                         #---- "true" authorised value
2607                     } else {
2608                         $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} );
2609                         push @authorised_values, ""
2610                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2611                         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
2612                             push @authorised_values, $value;
2613                             $authorised_lib{$value} = $lib;
2614                         }
2615                     }
2616                     $subfield_data{marc_value} = CGI::scrolling_list(
2617                         -name     => 'field_value',
2618                         -values   => \@authorised_values,
2619                         -default  => "$defaultvalue",
2620                         -labels   => \%authorised_lib,
2621                         -size     => 1,
2622                         -tabindex => '',
2623                         -multiple => 0,
2624                     );
2625                 } elsif ( $tagslib->{$tag}->{$subfield}->{value_builder} ) {
2626                         # opening plugin
2627                         my $plugin = C4::Context->intranetdir . "/cataloguing/value_builder/" . $tagslib->{$tag}->{$subfield}->{'value_builder'};
2628                         if (do $plugin) {
2629                             my $temp;
2630                             my $extended_param = plugin_parameters( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
2631                             my ( $function_name, $javascript ) = plugin_javascript( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
2632                             $subfield_data{random}     = int(rand(1000000));    # why do we need 2 different randoms?
2633                             my $index_subfield = int(rand(1000000));
2634                             $subfield_data{id} = "tag_".$tag."_subfield_".$subfield."_".$index_subfield;
2635                             $subfield_data{marc_value} = qq[<input tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255"
2636                                 onfocus="Focus$function_name($subfield_data{random}, '$subfield_data{id}');"
2637                                  onblur=" Blur$function_name($subfield_data{random}, '$subfield_data{id}');" />
2638                                 <a href="#" class="buttonDot" onclick="Clic$function_name('$subfield_data{id}'); return false;" title="Tag Editor">...</a>
2639                                 $javascript];
2640                         } else {
2641                             warn "Plugin Failed: $plugin";
2642                             $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
2643                         }
2644                 }
2645                 elsif ( $tag eq '' ) {       # it's an hidden field
2646                     $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" />);
2647                 }
2648                 elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {   # FIXME: shouldn't input type be "hidden" ?
2649                     $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" />);
2650                 }
2651                 elsif ( length($defaultvalue) > 100
2652                             or (C4::Context->preference("marcflavour") eq "UNIMARC" and
2653                                   300 <= $tag && $tag < 400 && $subfield eq 'a' )
2654                             or (C4::Context->preference("marcflavour") eq "MARC21"  and
2655                                   500 <= $tag && $tag < 600                     )
2656                           ) {
2657                     # oversize field (textarea)
2658                     $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");
2659                 } else {
2660                     $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
2661                 }
2662                 push( @loop_data, \%subfield_data );
2663             }
2664         }
2665     }
2666     my $itemnumber;
2667     if ( $itemrecord && $itemrecord->field($itemtagfield) ) {
2668         $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield );
2669     }
2670     return {
2671         'itemtagfield'    => $itemtagfield,
2672         'itemtagsubfield' => $itemtagsubfield,
2673         'itemnumber'      => $itemnumber,
2674         'iteminformation' => \@loop_data
2675     };
2676 }
2677
2678 #"
2679
2680 #
2681 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2682 # at the same time
2683 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2684 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2685 # =head2 ModZebrafiles
2686 #
2687 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2688 #
2689 # =cut
2690 #
2691 # sub ModZebrafiles {
2692 #
2693 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2694 #
2695 #     my $op;
2696 #     my $zebradir =
2697 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2698 #     unless ( opendir( DIR, "$zebradir" ) ) {
2699 #         warn "$zebradir not found";
2700 #         return;
2701 #     }
2702 #     closedir DIR;
2703 #     my $filename = $zebradir . $biblionumber;
2704 #
2705 #     if ($record) {
2706 #         open( OUTPUT, ">", $filename . ".xml" );
2707 #         print OUTPUT $record;
2708 #         close OUTPUT;
2709 #     }
2710 # }
2711
2712 =head2 ModZebra
2713
2714   ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2715
2716 $biblionumber is the biblionumber we want to index
2717
2718 $op is specialUpdate or delete, and is used to know what we want to do
2719
2720 $server is the server that we want to update
2721
2722 $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when
2723 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2724 do an update.
2725
2726 $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.
2727
2728 =cut
2729
2730 sub ModZebra {
2731 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2732     my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2733     my $dbh = C4::Context->dbh;
2734
2735     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2736     # at the same time
2737     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2738     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2739
2740     if ( C4::Context->preference("NoZebra") ) {
2741
2742         # lock the nozebra table : we will read index lines, update them in Perl process
2743         # and write everything in 1 transaction.
2744         # lock the table to avoid someone else overwriting what we are doing
2745         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2746         my %result;    # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2747         if ( $op eq 'specialUpdate' ) {
2748
2749             # OK, we have to add or update the record
2750             # 1st delete (virtually, in indexes), if record actually exists
2751             if ($oldRecord) {
2752                 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2753             }
2754
2755             # ... add the record
2756             %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2757         } else {
2758
2759             # it's a deletion, delete the record...
2760             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2761             %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2762         }
2763
2764         # ok, now update the database...
2765         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2766         foreach my $key ( keys %result ) {
2767             foreach my $index ( keys %{ $result{$key} } ) {
2768                 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2769             }
2770         }
2771         $dbh->do('UNLOCK TABLES');
2772     } else {
2773
2774         #
2775         # we use zebra, just fill zebraqueue table
2776         #
2777         my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2778                          WHERE server = ?
2779                          AND   biblio_auth_number = ?
2780                          AND   operation = ?
2781                          AND   done = 0";
2782         my $check_sth = $dbh->prepare_cached($check_sql);
2783         $check_sth->execute( $server, $biblionumber, $op );
2784         my ($count) = $check_sth->fetchrow_array;
2785         $check_sth->finish();
2786         if ( $count == 0 ) {
2787             my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2788             $sth->execute( $biblionumber, $server, $op );
2789             $sth->finish;
2790         }
2791     }
2792 }
2793
2794 =head2 GetNoZebraIndexes
2795
2796   %indexes = GetNoZebraIndexes;
2797
2798 return the data from NoZebraIndexes syspref.
2799
2800 =cut
2801
2802 sub GetNoZebraIndexes {
2803     my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2804     my %indexes;
2805   INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2806         $line =~ /(.*)=>(.*)/;
2807         my $index  = $1;    # initial ' or " is removed afterwards
2808         my $fields = $2;
2809         $index  =~ s/'|"|\s//g;
2810         $fields =~ s/'|"|\s//g;
2811         $indexes{$index} = $fields;
2812     }
2813     return %indexes;
2814 }
2815
2816 =head2 EmbedItemsInMarcBiblio
2817
2818     EmbedItemsInMarcBiblio($marc, $biblionumber);
2819
2820 Given a MARC::Record object containing a bib record,
2821 modify it to include the items attached to it as 9XX
2822 per the bib's MARC framework.
2823
2824 =cut
2825
2826 sub EmbedItemsInMarcBiblio {
2827     my ($marc, $biblionumber) = @_;
2828     croak "No MARC record" unless $marc;
2829
2830     my $frameworkcode = GetFrameworkCode($biblionumber);
2831     _strip_item_fields($marc, $frameworkcode);
2832
2833     # ... and embed the current items
2834     my $dbh = C4::Context->dbh;
2835     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2836     $sth->execute($biblionumber);
2837     my @item_fields;
2838     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2839     while (my ($itemnumber) = $sth->fetchrow_array) {
2840         my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2841         push @item_fields, $item_marc->field($itemtag);
2842     }
2843     $marc->append_fields(@item_fields);
2844 }
2845
2846 =head1 INTERNAL FUNCTIONS
2847
2848 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2849
2850 function to delete a biblio in NoZebra indexes
2851 This function does NOT delete anything in database : it reads all the indexes entries
2852 that have to be deleted & delete them in the hash
2853
2854 The SQL part is done either :
2855  - after the Add if we are modifying a biblio (delete + add again)
2856  - immediatly after this sub if we are doing a true deletion.
2857
2858 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2859
2860 =cut
2861
2862 sub _DelBiblioNoZebra {
2863     my ( $biblionumber, $record, $server ) = @_;
2864
2865     # Get the indexes
2866     my $dbh = C4::Context->dbh;
2867
2868     # Get the indexes
2869     my %index;
2870     my $title;
2871     if ( $server eq 'biblioserver' ) {
2872         %index = GetNoZebraIndexes;
2873
2874         # get title of the record (to store the 10 first letters with the index)
2875         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
2876         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2877     } else {
2878
2879         # for authorities, the "title" is the $a mainentry
2880         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2881         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2882         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2883         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2884         $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2885         $index{'mainentry'}     = $authref->{'auth_tag_to_report'} . '*';
2886         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
2887     }
2888
2889     my %result;
2890
2891     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2892     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2893
2894     # limit to 10 char, should be enough, and limit the DB size
2895     $title = substr( $title, 0, 10 );
2896
2897     #parse each field
2898     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2899     foreach my $field ( $record->fields() ) {
2900
2901         #parse each subfield
2902         next if $field->tag < 10;
2903         foreach my $subfield ( $field->subfields() ) {
2904             my $tag          = $field->tag();
2905             my $subfieldcode = $subfield->[0];
2906             my $indexed      = 0;
2907
2908             # check each index to see if the subfield is stored somewhere
2909             # otherwise, store it in __RAW__ index
2910             foreach my $key ( keys %index ) {
2911
2912                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2913                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2914                     $indexed = 1;
2915                     my $line = lc $subfield->[1];
2916
2917                     # remove meaningless value in the field...
2918                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2919
2920                     # ... and split in words
2921                     foreach ( split / /, $line ) {
2922                         next unless $_;    # skip  empty values (multiple spaces)
2923                                            # if the entry is already here, do nothing, the biblionumber has already be removed
2924                         unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2925
2926                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2927                             $sth2->execute( $server, $key, $_ );
2928                             my $existing_biblionumbers = $sth2->fetchrow;
2929
2930                             # it exists
2931                             if ($existing_biblionumbers) {
2932
2933                                 #                                 warn " existing for $key $_: $existing_biblionumbers";
2934                                 $result{$key}->{$_} = $existing_biblionumbers;
2935                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2936                             }
2937                         }
2938                     }
2939                 }
2940             }
2941
2942             # the subfield is not indexed, store it in __RAW__ index anyway
2943             unless ($indexed) {
2944                 my $line = lc $subfield->[1];
2945                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2946
2947                 # ... and split in words
2948                 foreach ( split / /, $line ) {
2949                     next unless $_;    # skip  empty values (multiple spaces)
2950                                        # if the entry is already here, do nothing, the biblionumber has already be removed
2951                     unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2952
2953                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2954                         $sth2->execute( $server, '__RAW__', $_ );
2955                         my $existing_biblionumbers = $sth2->fetchrow;
2956
2957                         # it exists
2958                         if ($existing_biblionumbers) {
2959                             $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2960                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2961                         }
2962                     }
2963                 }
2964             }
2965         }
2966     }
2967     return %result;
2968 }
2969
2970 =head2 _AddBiblioNoZebra
2971
2972   _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2973
2974 function to add a biblio in NoZebra indexes
2975
2976 =cut
2977
2978 sub _AddBiblioNoZebra {
2979     my ( $biblionumber, $record, $server, %result ) = @_;
2980     my $dbh = C4::Context->dbh;
2981
2982     # Get the indexes
2983     my %index;
2984     my $title;
2985     if ( $server eq 'biblioserver' ) {
2986         %index = GetNoZebraIndexes;
2987
2988         # get title of the record (to store the 10 first letters with the index)
2989         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
2990         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2991     } else {
2992
2993         # warn "server : $server";
2994         # for authorities, the "title" is the $a mainentry
2995         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2996         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2997         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2998         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2999         $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
3000         $index{'mainentry'}     = $authref->{auth_tag_to_report} . '*';
3001         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
3002     }
3003
3004     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
3005     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
3006
3007     # limit to 10 char, should be enough, and limit the DB size
3008     $title = substr( $title, 0, 10 );
3009
3010     #parse each field
3011     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
3012     foreach my $field ( $record->fields() ) {
3013
3014         #parse each subfield
3015         ###FIXME: impossible to index a 001-009 value with NoZebra
3016         next if $field->tag < 10;
3017         foreach my $subfield ( $field->subfields() ) {
3018             my $tag          = $field->tag();
3019             my $subfieldcode = $subfield->[0];
3020             my $indexed      = 0;
3021
3022             #             warn "INDEXING :".$subfield->[1];
3023             # check each index to see if the subfield is stored somewhere
3024             # otherwise, store it in __RAW__ index
3025             foreach my $key ( keys %index ) {
3026
3027                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
3028                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
3029                     $indexed = 1;
3030                     my $line = lc $subfield->[1];
3031
3032                     # remove meaningless value in the field...
3033                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3034
3035                     # ... and split in words
3036                     foreach ( split / /, $line ) {
3037                         next unless $_;    # skip  empty values (multiple spaces)
3038                                            # if the entry is already here, improve weight
3039
3040                         #                         warn "managing $_";
3041                         if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3042                             my $weight = $1 + 1;
3043                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3044                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3045                         } else {
3046
3047                             # get the value if it exist in the nozebra table, otherwise, create it
3048                             $sth2->execute( $server, $key, $_ );
3049                             my $existing_biblionumbers = $sth2->fetchrow;
3050
3051                             # it exists
3052                             if ($existing_biblionumbers) {
3053                                 $result{$key}->{"$_"} = $existing_biblionumbers;
3054                                 my $weight = defined $1 ? $1 + 1 : 1;
3055                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
3056                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
3057
3058                                 # create a new ligne for this entry
3059                             } else {
3060
3061                                 #                             warn "INSERT : $server / $key / $_";
3062                                 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
3063                                 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
3064                             }
3065                         }
3066                     }
3067                 }
3068             }
3069
3070             # the subfield is not indexed, store it in __RAW__ index anyway
3071             unless ($indexed) {
3072                 my $line = lc $subfield->[1];
3073                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
3074
3075                 # ... and split in words
3076                 foreach ( split / /, $line ) {
3077                     next unless $_;    # skip  empty values (multiple spaces)
3078                                        # if the entry is already here, improve weight
3079                     my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
3080                     if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
3081                         my $weight = $1 + 1;
3082                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3083                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3084                     } else {
3085
3086                         # get the value if it exist in the nozebra table, otherwise, create it
3087                         $sth2->execute( $server, '__RAW__', $_ );
3088                         my $existing_biblionumbers = $sth2->fetchrow;
3089
3090                         # it exists
3091                         if ($existing_biblionumbers) {
3092                             $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
3093                             my $weight = ( $1 ? $1 : 0 ) + 1;
3094                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
3095                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
3096
3097                             # create a new ligne for this entry
3098                         } else {
3099                             $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ',  indexname="__RAW__",value=' . $dbh->quote($_) );
3100                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
3101                         }
3102                     }
3103                 }
3104             }
3105         }
3106     }
3107     return %result;
3108 }
3109
3110 =head2 _find_value
3111
3112   ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
3113
3114 Find the given $subfield in the given $tag in the given
3115 MARC::Record $record.  If the subfield is found, returns
3116 the (indicators, value) pair; otherwise, (undef, undef) is
3117 returned.
3118
3119 PROPOSITION :
3120 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
3121 I suggest we export it from this module.
3122
3123 =cut
3124
3125 sub _find_value {
3126     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
3127     my @result;
3128     my $indicator;
3129     if ( $tagfield < 10 ) {
3130         if ( $record->field($tagfield) ) {
3131             push @result, $record->field($tagfield)->data();
3132         } else {
3133             push @result, "";
3134         }
3135     } else {
3136         foreach my $field ( $record->field($tagfield) ) {
3137             my @subfields = $field->subfields();
3138             foreach my $subfield (@subfields) {
3139                 if ( @$subfield[0] eq $insubfield ) {
3140                     push @result, @$subfield[1];
3141                     $indicator = $field->indicator(1) . $field->indicator(2);
3142                 }
3143             }
3144         }
3145     }
3146     return ( $indicator, @result );
3147 }
3148
3149 =head2 _koha_marc_update_bib_ids
3150
3151
3152   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
3153
3154 Internal function to add or update biblionumber and biblioitemnumber to
3155 the MARC XML.
3156
3157 =cut
3158
3159 sub _koha_marc_update_bib_ids {
3160     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3161
3162     # we must add bibnum and bibitemnum in MARC::Record...
3163     # we build the new field with biblionumber and biblioitemnumber
3164     # we drop the original field
3165     # we add the new builded field.
3166     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
3167     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3168
3169     if ( $biblio_tag != $biblioitem_tag ) {
3170
3171         # biblionumber & biblioitemnumber are in different fields
3172
3173         # deal with biblionumber
3174         my ( $new_field, $old_field );
3175         if ( $biblio_tag < 10 ) {
3176             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3177         } else {
3178             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3179         }
3180
3181         # drop old field and create new one...
3182         $old_field = $record->field($biblio_tag);
3183         $record->delete_field($old_field) if $old_field;
3184         $record->insert_fields_ordered($new_field);
3185
3186         # deal with biblioitemnumber
3187         if ( $biblioitem_tag < 10 ) {
3188             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3189         } else {
3190             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3191         }
3192
3193         # drop old field and create new one...
3194         $old_field = $record->field($biblioitem_tag);
3195         $record->delete_field($old_field) if $old_field;
3196         $record->insert_fields_ordered($new_field);
3197
3198     } else {
3199
3200         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3201         my $new_field = MARC::Field->new(
3202             $biblio_tag, '', '',
3203             "$biblio_subfield"     => $biblionumber,
3204             "$biblioitem_subfield" => $biblioitemnumber
3205         );
3206
3207         # drop old field and create new one...
3208         my $old_field = $record->field($biblio_tag);
3209         $record->delete_field($old_field) if $old_field;
3210         $record->insert_fields_ordered($new_field);
3211     }
3212 }
3213
3214 =head2 _koha_marc_update_biblioitem_cn_sort
3215
3216   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3217
3218 Given a MARC bib record and the biblioitem hash, update the
3219 subfield that contains a copy of the value of biblioitems.cn_sort.
3220
3221 =cut
3222
3223 sub _koha_marc_update_biblioitem_cn_sort {
3224     my $marc          = shift;
3225     my $biblioitem    = shift;
3226     my $frameworkcode = shift;
3227
3228     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3229     return unless $biblioitem_tag;
3230
3231     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3232
3233     if ( my $field = $marc->field($biblioitem_tag) ) {
3234         $field->delete_subfield( code => $biblioitem_subfield );
3235         if ( $cn_sort ne '' ) {
3236             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3237         }
3238     } else {
3239
3240         # if we get here, no biblioitem tag is present in the MARC record, so
3241         # we'll create it if $cn_sort is not empty -- this would be
3242         # an odd combination of events, however
3243         if ($cn_sort) {
3244             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3245         }
3246     }
3247 }
3248
3249 =head2 _koha_add_biblio
3250
3251   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3252
3253 Internal function to add a biblio ($biblio is a hash with the values)
3254
3255 =cut
3256
3257 sub _koha_add_biblio {
3258     my ( $dbh, $biblio, $frameworkcode ) = @_;
3259
3260     my $error;
3261
3262     # set the series flag
3263     unless (defined $biblio->{'serial'}){
3264         $biblio->{'serial'} = 0;
3265         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3266     }
3267
3268     my $query = "INSERT INTO biblio
3269         SET frameworkcode = ?,
3270             author = ?,
3271             title = ?,
3272             unititle =?,
3273             notes = ?,
3274             serial = ?,
3275             seriestitle = ?,
3276             copyrightdate = ?,
3277             datecreated=NOW(),
3278             abstract = ?
3279         ";
3280     my $sth = $dbh->prepare($query);
3281     $sth->execute(
3282         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3283         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3284     );
3285
3286     my $biblionumber = $dbh->{'mysql_insertid'};
3287     if ( $dbh->errstr ) {
3288         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3289         warn $error;
3290     }
3291
3292     $sth->finish();
3293
3294     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3295     return ( $biblionumber, $error );
3296 }
3297
3298 =head2 _koha_modify_biblio
3299
3300   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3301
3302 Internal function for updating the biblio table
3303
3304 =cut
3305
3306 sub _koha_modify_biblio {
3307     my ( $dbh, $biblio, $frameworkcode ) = @_;
3308     my $error;
3309
3310     my $query = "
3311         UPDATE biblio
3312         SET    frameworkcode = ?,
3313                author = ?,
3314                title = ?,
3315                unititle = ?,
3316                notes = ?,
3317                serial = ?,
3318                seriestitle = ?,
3319                copyrightdate = ?,
3320                abstract = ?
3321         WHERE  biblionumber = ?
3322         "
3323       ;
3324     my $sth = $dbh->prepare($query);
3325
3326     $sth->execute(
3327         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3328         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3329     ) if $biblio->{'biblionumber'};
3330
3331     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3332         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3333         warn $error;
3334     }
3335     return ( $biblio->{'biblionumber'}, $error );
3336 }
3337
3338 =head2 _koha_modify_biblioitem_nonmarc
3339
3340   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3341
3342 Updates biblioitems row except for marc and marcxml, which should be changed
3343 via ModBiblioMarc
3344
3345 =cut
3346
3347 sub _koha_modify_biblioitem_nonmarc {
3348     my ( $dbh, $biblioitem ) = @_;
3349     my $error;
3350
3351     # re-calculate the cn_sort, it may have changed
3352     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3353
3354     my $query = "UPDATE biblioitems
3355     SET biblionumber    = ?,
3356         volume          = ?,
3357         number          = ?,
3358         itemtype        = ?,
3359         isbn            = ?,
3360         issn            = ?,
3361         publicationyear = ?,
3362         publishercode   = ?,
3363         volumedate      = ?,
3364         volumedesc      = ?,
3365         collectiontitle = ?,
3366         collectionissn  = ?,
3367         collectionvolume= ?,
3368         editionstatement= ?,
3369         editionresponsibility = ?,
3370         illus           = ?,
3371         pages           = ?,
3372         notes           = ?,
3373         size            = ?,
3374         place           = ?,
3375         lccn            = ?,
3376         url             = ?,
3377         cn_source       = ?,
3378         cn_class        = ?,
3379         cn_item         = ?,
3380         cn_suffix       = ?,
3381         cn_sort         = ?,
3382         totalissues     = ?
3383         where biblioitemnumber = ?
3384         ";
3385     my $sth = $dbh->prepare($query);
3386     $sth->execute(
3387         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3388         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3389         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3390         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3391         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3392         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3393         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3394         $biblioitem->{'biblioitemnumber'}
3395     );
3396     if ( $dbh->errstr ) {
3397         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3398         warn $error;
3399     }
3400     return ( $biblioitem->{'biblioitemnumber'}, $error );
3401 }
3402
3403 =head2 _koha_add_biblioitem
3404
3405   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3406
3407 Internal function to add a biblioitem
3408
3409 =cut
3410
3411 sub _koha_add_biblioitem {
3412     my ( $dbh, $biblioitem ) = @_;
3413     my $error;
3414
3415     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3416     my $query = "INSERT INTO biblioitems SET
3417         biblionumber    = ?,
3418         volume          = ?,
3419         number          = ?,
3420         itemtype        = ?,
3421         isbn            = ?,
3422         issn            = ?,
3423         publicationyear = ?,
3424         publishercode   = ?,
3425         volumedate      = ?,
3426         volumedesc      = ?,
3427         collectiontitle = ?,
3428         collectionissn  = ?,
3429         collectionvolume= ?,
3430         editionstatement= ?,
3431         editionresponsibility = ?,
3432         illus           = ?,
3433         pages           = ?,
3434         notes           = ?,
3435         size            = ?,
3436         place           = ?,
3437         lccn            = ?,
3438         marc            = ?,
3439         url             = ?,
3440         cn_source       = ?,
3441         cn_class        = ?,
3442         cn_item         = ?,
3443         cn_suffix       = ?,
3444         cn_sort         = ?,
3445         totalissues     = ?
3446         ";
3447     my $sth = $dbh->prepare($query);
3448     $sth->execute(
3449         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3450         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3451         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3452         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3453         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3454         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3455         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3456         $biblioitem->{'totalissues'}
3457     );
3458     my $bibitemnum = $dbh->{'mysql_insertid'};
3459
3460     if ( $dbh->errstr ) {
3461         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3462         warn $error;
3463     }
3464     $sth->finish();
3465     return ( $bibitemnum, $error );
3466 }
3467
3468 =head2 _koha_delete_biblio
3469
3470   $error = _koha_delete_biblio($dbh,$biblionumber);
3471
3472 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3473
3474 C<$dbh> - the database handle
3475
3476 C<$biblionumber> - the biblionumber of the biblio to be deleted
3477
3478 =cut
3479
3480 # FIXME: add error handling
3481
3482 sub _koha_delete_biblio {
3483     my ( $dbh, $biblionumber ) = @_;
3484
3485     # get all the data for this biblio
3486     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3487     $sth->execute($biblionumber);
3488
3489     if ( my $data = $sth->fetchrow_hashref ) {
3490
3491         # save the record in deletedbiblio
3492         # find the fields to save
3493         my $query = "INSERT INTO deletedbiblio SET ";
3494         my @bind  = ();
3495         foreach my $temp ( keys %$data ) {
3496             $query .= "$temp = ?,";
3497             push( @bind, $data->{$temp} );
3498         }
3499
3500         # replace the last , by ",?)"
3501         $query =~ s/\,$//;
3502         my $bkup_sth = $dbh->prepare($query);
3503         $bkup_sth->execute(@bind);
3504         $bkup_sth->finish;
3505
3506         # delete the biblio
3507         my $sth2 = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3508         $sth2->execute($biblionumber);
3509         # update the timestamp (Bugzilla 7146)
3510         $sth2= $dbh->prepare("UPDATE deletedbiblio SET timestamp=NOW() WHERE biblionumber=?");
3511         $sth2->execute($biblionumber);
3512         $sth2->finish;
3513     }
3514     $sth->finish;
3515     return undef;
3516 }
3517
3518 =head2 _koha_delete_biblioitems
3519
3520   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3521
3522 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3523
3524 C<$dbh> - the database handle
3525 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3526
3527 =cut
3528
3529 # FIXME: add error handling
3530
3531 sub _koha_delete_biblioitems {
3532     my ( $dbh, $biblioitemnumber ) = @_;
3533
3534     # get all the data for this biblioitem
3535     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3536     $sth->execute($biblioitemnumber);
3537
3538     if ( my $data = $sth->fetchrow_hashref ) {
3539
3540         # save the record in deletedbiblioitems
3541         # find the fields to save
3542         my $query = "INSERT INTO deletedbiblioitems SET ";
3543         my @bind  = ();
3544         foreach my $temp ( keys %$data ) {
3545             $query .= "$temp = ?,";
3546             push( @bind, $data->{$temp} );
3547         }
3548
3549         # replace the last , by ",?)"
3550         $query =~ s/\,$//;
3551         my $bkup_sth = $dbh->prepare($query);
3552         $bkup_sth->execute(@bind);
3553         $bkup_sth->finish;
3554
3555         # delete the biblioitem
3556         my $sth2 = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3557         $sth2->execute($biblioitemnumber);
3558         # update the timestamp (Bugzilla 7146)
3559         $sth2= $dbh->prepare("UPDATE deletedbiblioitems SET timestamp=NOW() WHERE biblioitemnumber=?");
3560         $sth2->execute($biblioitemnumber);
3561         $sth2->finish;
3562     }
3563     $sth->finish;
3564     return undef;
3565 }
3566
3567 =head1 UNEXPORTED FUNCTIONS
3568
3569 =head2 ModBiblioMarc
3570
3571   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3572
3573 Add MARC data for a biblio to koha
3574
3575 Function exported, but should NOT be used, unless you really know what you're doing
3576
3577 =cut
3578
3579 sub ModBiblioMarc {
3580
3581     # pass the MARC::Record to this function, and it will create the records in the marc field
3582     my ( $record, $biblionumber, $frameworkcode ) = @_;
3583     my $dbh    = C4::Context->dbh;
3584     my @fields = $record->fields();
3585     if ( !$frameworkcode ) {
3586         $frameworkcode = "";
3587     }
3588     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3589     $sth->execute( $frameworkcode, $biblionumber );
3590     $sth->finish;
3591     my $encoding = C4::Context->preference("marcflavour");
3592
3593     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3594     if ( $encoding eq "UNIMARC" ) {
3595         my $string = $record->subfield( 100, "a" );
3596         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3597             my $f100 = $record->field(100);
3598             $record->delete_field($f100);
3599         } else {
3600             $string = POSIX::strftime( "%Y%m%d", localtime );
3601             $string =~ s/\-//g;
3602             $string = sprintf( "%-*s", 35, $string );
3603         }
3604         substr( $string, 22, 6, "frey50" );
3605         unless ( $record->subfield( 100, "a" ) ) {
3606             $record->insert_fields_ordered( MARC::Field->new( 100, "", "", "a" => $string ) );
3607         }
3608     }
3609
3610     #enhancement 5374: update transaction date (005) for marc21/unimarc
3611     if($encoding =~ /MARC21|UNIMARC/) {
3612       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3613         # YY MM DD HH MM SS (update year and month)
3614       my $f005= $record->field('005');
3615       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3616     }
3617
3618     my $oldRecord;
3619     if ( C4::Context->preference("NoZebra") ) {
3620
3621         # only NoZebra indexing needs to have
3622         # the previous version of the record
3623         $oldRecord = GetMarcBiblio($biblionumber);
3624     }
3625     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3626     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3627     $sth->finish;
3628     ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3629     return $biblionumber;
3630 }
3631
3632 =head2 z3950_extended_services
3633
3634   z3950_extended_services($serviceType,$serviceOptions,$record);
3635
3636 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.
3637
3638 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3639
3640 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3641
3642  action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3643
3644 and maybe
3645
3646   recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3647   syntax => the record syntax (transfer syntax)
3648   databaseName = Database from connection object
3649
3650 To set serviceOptions, call set_service_options($serviceType)
3651
3652 C<$record> the record, if one is needed for the service type
3653
3654 A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3655
3656 =cut
3657
3658 sub z3950_extended_services {
3659     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3660
3661     # get our connection object
3662     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3663
3664     # create a new package object
3665     my $Zpackage = $Zconn->package();
3666
3667     # set our options
3668     $Zpackage->option( action => $action );
3669
3670     if ( $serviceOptions->{'databaseName'} ) {
3671         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3672     }
3673     if ( $serviceOptions->{'recordIdNumber'} ) {
3674         $Zpackage->option( recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3675     }
3676     if ( $serviceOptions->{'recordIdOpaque'} ) {
3677         $Zpackage->option( recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3678     }
3679
3680     # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3681     #if ($serviceType eq 'itemorder') {
3682     #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3683     #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3684     #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3685     #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3686     #}
3687
3688     if ( $serviceOptions->{record} ) {
3689         $Zpackage->option( record => $serviceOptions->{record} );
3690
3691         # can be xml or marc
3692         if ( $serviceOptions->{'syntax'} ) {
3693             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3694         }
3695     }
3696
3697     # send the request, handle any exception encountered
3698     eval { $Zpackage->send($serviceType) };
3699     if ( $@ && $@->isa("ZOOM::Exception") ) {
3700         return "error:  " . $@->code() . " " . $@->message() . "\n";
3701     }
3702
3703     # free up package resources
3704     $Zpackage->destroy();
3705 }
3706
3707 =head2 set_service_options
3708
3709   my $serviceOptions = set_service_options($serviceType);
3710
3711 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3712
3713 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3714
3715 =cut
3716
3717 sub set_service_options {
3718     my ($serviceType) = @_;
3719     my $serviceOptions;
3720
3721     # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3722     #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3723
3724     if ( $serviceType eq 'commit' ) {
3725
3726         # nothing to do
3727     }
3728     if ( $serviceType eq 'create' ) {
3729
3730         # nothing to do
3731     }
3732     if ( $serviceType eq 'drop' ) {
3733         die "ERROR: 'drop' not currently supported (by Zebra)";
3734     }
3735     return $serviceOptions;
3736 }
3737
3738 =head2 get_biblio_authorised_values
3739
3740 find the types and values for all authorised values assigned to this biblio.
3741
3742 parameters:
3743     biblionumber
3744     MARC::Record of the bib
3745
3746 returns: a hashref mapping the authorised value to the value set for this biblionumber
3747
3748   $authorised_values = {
3749                        'Scent'     => 'flowery',
3750                        'Audience'  => 'Young Adult',
3751                        'itemtypes' => 'SER',
3752                         };
3753
3754 Notes: forlibrarian should probably be passed in, and called something different.
3755
3756 =cut
3757
3758 sub get_biblio_authorised_values {
3759     my $biblionumber = shift;
3760     my $record       = shift;
3761
3762     my $forlibrarian  = 1;                                 # are we in staff or opac?
3763     my $frameworkcode = GetFrameworkCode($biblionumber);
3764
3765     my $authorised_values;
3766
3767     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3768       or return $authorised_values;
3769
3770     # assume that these entries in the authorised_value table are bibliolevel.
3771     # ones that start with 'item%' are item level.
3772     my $query = q(SELECT distinct authorised_value, kohafield
3773                     FROM marc_subfield_structure
3774                     WHERE authorised_value !=''
3775                       AND (kohafield like 'biblio%'
3776                        OR  kohafield like '') );
3777     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3778
3779     foreach my $tag ( keys(%$tagslib) ) {
3780         foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3781
3782             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3783             if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3784                 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3785                     if ( defined $record->field($tag) ) {
3786                         my $this_subfield_value = $record->field($tag)->subfield($subfield);
3787                         if ( defined $this_subfield_value ) {
3788                             $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3789                         }
3790                     }
3791                 }
3792             }
3793         }
3794     }
3795
3796     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3797     return $authorised_values;
3798 }
3799
3800 =head2 CountBiblioInOrders
3801
3802 =over 4
3803 $count = &CountBiblioInOrders( $biblionumber);
3804
3805 =back
3806
3807 This function return count of biblios in orders with $biblionumber
3808
3809 =cut
3810
3811 sub CountBiblioInOrders {
3812  my ($biblionumber) = @_;
3813     my $dbh            = C4::Context->dbh;
3814     my $query          = "SELECT count(*)
3815           FROM  aqorders
3816           WHERE biblionumber=? AND (datecancellationprinted IS NULL OR datecancellationprinted='0000-00-00')";
3817     my $sth = $dbh->prepare($query);
3818     $sth->execute($biblionumber);
3819     my $count = $sth->fetchrow;
3820     return ($count);
3821 }
3822
3823 =head2 GetSubscriptionsId
3824
3825 =over 4
3826 $subscriptions = &GetSubscriptionsId($biblionumber);
3827
3828 =back
3829
3830 This function return an array of subscriptionid with $biblionumber
3831
3832 =cut
3833
3834 sub GetSubscriptionsId {
3835  my ($biblionumber) = @_;
3836     my $dbh            = C4::Context->dbh;
3837     my $query          = "SELECT subscriptionid
3838           FROM  subscription
3839           WHERE biblionumber=?";
3840     my $sth = $dbh->prepare($query);
3841     $sth->execute($biblionumber);
3842     my @subscriptions = $sth->fetchrow_array;
3843     return (@subscriptions);
3844 }
3845
3846 =head2 GetHolds
3847
3848 =over 4
3849 $holds = &GetHolds($biblionumber);
3850
3851 =back
3852
3853 This function return the count of holds with $biblionumber
3854
3855 =cut
3856
3857 sub GetHolds {
3858  my ($biblionumber) = @_;
3859     my $dbh            = C4::Context->dbh;
3860     my $query          = "SELECT count(*)
3861           FROM  reserves
3862           WHERE biblionumber=?";
3863     my $sth = $dbh->prepare($query);
3864     $sth->execute($biblionumber);
3865     my $holds = $sth->fetchrow;
3866     return ($holds);
3867 }
3868
3869
3870 1;
3871
3872 __END__
3873
3874 =head1 AUTHOR
3875
3876 Koha Development Team <http://koha-community.org/>
3877
3878 Paul POULAIN paul.poulain@free.fr
3879
3880 Joshua Ferraro jmf@liblime.com
3881
3882 =cut