C4/Biblio.pm

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