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