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