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::EmbedItemsInMarcBiblio($record, $biblionumber) if ($embeditems);
1074
1075         #      $record = MARC::Record::new_from_usmarc( $marc) if $marc;
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   = substr $record->field('008')->data(), 7, 4;
1221             $isbn      = $record->subfield( '773', 'z' ) || '';
1222             $issn      = $record->subfield( '773', 'x' ) || '';
1223             if ($mtx eq 'journal') {
1224                 $title    .= "&amp;rft.title=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')));
1225             } else {
1226                 $title    .= "&amp;rft.btitle=" . (($record->subfield( '773', 't' ) || $record->subfield( '773', 'a')) || '');
1227             }
1228             foreach my $rel ($record->subfield( '773', 'g' )) {
1229                 if ($pages) {
1230                     $pages .= ', ';
1231                 }
1232                 $pages .= $rel;
1233             }
1234         } else {
1235             $pubyear   = $record->subfield( '260', 'c' ) || '';
1236             $publisher = $record->subfield( '260', 'b' ) || '';
1237             $isbn      = $record->subfield( '020', 'a' ) || '';
1238             $issn      = $record->subfield( '022', 'a' ) || '';
1239         }
1240
1241     }
1242     my $coins_value =
1243 "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";
1244     $coins_value =~ s/(\ |&[^a])/\+/g;
1245     $coins_value =~ s/\"/\&quot\;/g;
1246
1247 #<!-- 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="
1248
1249     return $coins_value;
1250 }
1251
1252
1253 =head2 GetMarcPrice
1254
1255 return the prices in accordance with the Marc format.
1256 =cut
1257
1258 sub GetMarcPrice {
1259     my ( $record, $marcflavour ) = @_;
1260     my @listtags;
1261     my $subfield;
1262
1263     if ( $marcflavour eq "MARC21" ) {
1264         @listtags = ('345', '020');
1265         $subfield="c";
1266     } elsif ( $marcflavour eq "UNIMARC" ) {
1267         @listtags = ('345', '010');
1268         $subfield="d";
1269     } else {
1270         return;
1271     }
1272
1273     for my $field ( $record->field(@listtags) ) {
1274         for my $subfield_value  ($field->subfield($subfield)){
1275             #check value
1276             return $subfield_value if ($subfield_value);
1277         }
1278     }
1279     return 0; # no price found
1280 }
1281
1282 =head2 GetMarcQuantity
1283
1284 return the quantity of a book. Used in acquisition only, when importing a file an iso2709 from a bookseller
1285 Warning : this is not really in the marc standard. In Unimarc, Electre (the most widely used bookseller) use the 969$a
1286
1287 =cut
1288
1289 sub GetMarcQuantity {
1290     my ( $record, $marcflavour ) = @_;
1291     my @listtags;
1292     my $subfield;
1293
1294     if ( $marcflavour eq "MARC21" ) {
1295         return 0
1296     } elsif ( $marcflavour eq "UNIMARC" ) {
1297         @listtags = ('969');
1298         $subfield="a";
1299     } else {
1300         return;
1301     }
1302
1303     for my $field ( $record->field(@listtags) ) {
1304         for my $subfield_value  ($field->subfield($subfield)){
1305             #check value
1306             if ($subfield_value) {
1307                  # in France, the cents separator is the , but sometimes, ppl use a .
1308                  # in this case, the price will be x100 when unformatted ! Replace the . by a , to get a proper price calculation
1309                 $subfield_value =~ s/\./,/ if C4::Context->preference("CurrencyFormat") eq "FR";
1310                 return $subfield_value;
1311             }
1312         }
1313     }
1314     return 0; # no price found
1315 }
1316
1317
1318 =head2 GetAuthorisedValueDesc
1319
1320   my $subfieldvalue =get_authorised_value_desc(
1321     $tag, $subf[$i][0],$subf[$i][1], '', $taglib, $category, $opac);
1322
1323 Retrieve the complete description for a given authorised value.
1324
1325 Now takes $category and $value pair too.
1326
1327   my $auth_value_desc =GetAuthorisedValueDesc(
1328     '','', 'DVD' ,'','','CCODE');
1329
1330 If the optional $opac parameter is set to a true value, displays OPAC
1331 descriptions rather than normal ones when they exist.
1332
1333 =cut
1334
1335 sub GetAuthorisedValueDesc {
1336     my ( $tag, $subfield, $value, $framework, $tagslib, $category, $opac ) = @_;
1337     my $dbh = C4::Context->dbh;
1338
1339     if ( !$category ) {
1340
1341         return $value unless defined $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1342
1343         #---- branch
1344         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1345             return C4::Branch::GetBranchName($value);
1346         }
1347
1348         #---- itemtypes
1349         if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1350             return getitemtypeinfo($value)->{description};
1351         }
1352
1353         #---- "true" authorized value
1354         $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1355     }
1356
1357     if ( $category ne "" ) {
1358         my $sth = $dbh->prepare( "SELECT lib, lib_opac FROM authorised_values WHERE category = ? AND authorised_value = ?" );
1359         $sth->execute( $category, $value );
1360         my $data = $sth->fetchrow_hashref;
1361         return ( $opac && $data->{'lib_opac'} ) ? $data->{'lib_opac'} : $data->{'lib'};
1362     } else {
1363         return $value;    # if nothing is found return the original value
1364     }
1365 }
1366
1367 =head2 GetMarcControlnumber
1368
1369   $marccontrolnumber = GetMarcControlnumber($record,$marcflavour);
1370
1371 Get the control number / record Identifier from the MARC record and return it.
1372
1373 =cut
1374
1375 sub GetMarcControlnumber {
1376     my ( $record, $marcflavour ) = @_;
1377     my $controlnumber = "";
1378     # Control number or Record identifier are the same field in MARC21 and UNIMARC
1379     # Keep $marcflavour for possible later use
1380     if ($marcflavour eq "MARC21" || $marcflavour eq "UNIMARC") {
1381         my $controlnumberField = $record->field('001');
1382         if ($controlnumberField) {
1383             $controlnumber = $controlnumberField->data();
1384         }
1385     }
1386     return $controlnumber;
1387 }
1388
1389 =head2 GetMarcISBN
1390
1391   $marcisbnsarray = GetMarcISBN( $record, $marcflavour );
1392
1393 Get all ISBNs from the MARC record and returns them in an array.
1394 ISBNs stored in differents places depending on MARC flavour
1395
1396 =cut
1397
1398 sub GetMarcISBN {
1399     my ( $record, $marcflavour ) = @_;
1400     my $scope;
1401     if ( $marcflavour eq "UNIMARC" ) {
1402         $scope = '010';
1403     } else {    # assume marc21 if not unimarc
1404         $scope = '020';
1405     }
1406     my @marcisbns;
1407     my $isbn = "";
1408     my $tag  = "";
1409     my $marcisbn;
1410     foreach my $field ( $record->field($scope) ) {
1411         my $value = $field->as_string();
1412         if ( $isbn ne "" ) {
1413             $marcisbn = { marcisbn => $isbn, };
1414             push @marcisbns, $marcisbn;
1415             $isbn = $value;
1416         }
1417         if ( $isbn ne $value ) {
1418             $isbn = $isbn . " " . $value;
1419         }
1420     }
1421
1422     if ($isbn) {
1423         $marcisbn = { marcisbn => $isbn };
1424         push @marcisbns, $marcisbn;    #load last tag into array
1425     }
1426     return \@marcisbns;
1427 }    # end GetMarcISBN
1428
1429 =head2 GetMarcNotes
1430
1431   $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1432
1433 Get all notes from the MARC record and returns them in an array.
1434 The note are stored in differents places depending on MARC flavour
1435
1436 =cut
1437
1438 sub GetMarcNotes {
1439     my ( $record, $marcflavour ) = @_;
1440     my $scope;
1441     if ( $marcflavour eq "UNIMARC" ) {
1442         $scope = '3..';
1443     } else {    # assume marc21 if not unimarc
1444         $scope = '5..';
1445     }
1446     my @marcnotes;
1447     my $note = "";
1448     my $tag  = "";
1449     my $marcnote;
1450     foreach my $field ( $record->field($scope) ) {
1451         my $value = $field->as_string();
1452         if ( $note ne "" ) {
1453             $marcnote = { marcnote => $note, };
1454             push @marcnotes, $marcnote;
1455             $note = $value;
1456         }
1457         if ( $note ne $value ) {
1458             $note = $note . " " . $value;
1459         }
1460     }
1461
1462     if ($note) {
1463         $marcnote = { marcnote => $note };
1464         push @marcnotes, $marcnote;    #load last tag into array
1465     }
1466     return \@marcnotes;
1467 }    # end GetMarcNotes
1468
1469 =head2 GetMarcSubjects
1470
1471   $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1472
1473 Get all subjects from the MARC record and returns them in an array.
1474 The subjects are stored in differents places depending on MARC flavour
1475
1476 =cut
1477
1478 sub GetMarcSubjects {
1479     my ( $record, $marcflavour ) = @_;
1480     my ( $mintag, $maxtag );
1481     if ( $marcflavour eq "UNIMARC" ) {
1482         $mintag = "600";
1483         $maxtag = "611";
1484     } else {    # assume marc21 if not unimarc
1485         $mintag = "600";
1486         $maxtag = "699";
1487     }
1488
1489     my @marcsubjects;
1490     my $subject  = "";
1491     my $subfield = "";
1492     my $marcsubject;
1493
1494     my $subject_limit = C4::Context->preference("TraceCompleteSubfields") ? 'su,complete-subfield' : 'su';
1495
1496     foreach my $field ( $record->field('6..') ) {
1497         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1498         my @subfields_loop;
1499         my @subfields = $field->subfields();
1500         my $counter   = 0;
1501         my @link_loop;
1502
1503         # if there is an authority link, build the link with an= subfield9
1504         my $found9 = 0;
1505         for my $subject_subfield (@subfields) {
1506
1507             # don't load unimarc subfields 3,4,5
1508             next if ( ( $marcflavour eq "UNIMARC" ) and ( $subject_subfield->[0] =~ /2|3|4|5/ ) );
1509
1510             # don't load MARC21 subfields 2 (FIXME: any more subfields??)
1511             next if ( ( $marcflavour eq "MARC21" ) and ( $subject_subfield->[0] =~ /2/ ) );
1512             my $code      = $subject_subfield->[0];
1513             my $value     = $subject_subfield->[1];
1514             my $linkvalue = $value;
1515             $linkvalue =~ s/(\(|\))//g;
1516             my $operator = " and " unless $counter == 0;
1517             if ( $code eq 9 ) {
1518                 $found9 = 1;
1519                 @link_loop = ( { 'limit' => 'an', link => "$linkvalue" } );
1520             }
1521             if ( not $found9 ) {
1522                 push @link_loop, { 'limit' => $subject_limit, link => $linkvalue, operator => $operator };
1523             }
1524             my $separator = C4::Context->preference("authoritysep") unless $counter == 0;
1525
1526             # ignore $9
1527             my @this_link_loop = @link_loop;
1528             push @subfields_loop, { code => $code, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $subject_subfield->[0] eq 9 );
1529             $counter++;
1530         }
1531
1532         push @marcsubjects, { MARCSUBJECT_SUBFIELDS_LOOP => \@subfields_loop };
1533
1534     }
1535     return \@marcsubjects;
1536 }    #end getMARCsubjects
1537
1538 =head2 GetMarcAuthors
1539
1540   authors = GetMarcAuthors($record,$marcflavour);
1541
1542 Get all authors from the MARC record and returns them in an array.
1543 The authors are stored in differents places depending on MARC flavour
1544
1545 =cut
1546
1547 sub GetMarcAuthors {
1548     my ( $record, $marcflavour ) = @_;
1549     my ( $mintag, $maxtag );
1550
1551     # tagslib useful for UNIMARC author reponsabilities
1552     my $tagslib =
1553       &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.
1554     if ( $marcflavour eq "UNIMARC" ) {
1555         $mintag = "700";
1556         $maxtag = "712";
1557     } elsif ( $marcflavour eq "MARC21" || $marcflavour eq "NORMARC" ) { # assume marc21 or normarc if not unimarc
1558         $mintag = "700";
1559         $maxtag = "720";
1560     } else {
1561         return;
1562     }
1563     my @marcauthors;
1564
1565     foreach my $field ( $record->fields ) {
1566         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1567         my @subfields_loop;
1568         my @link_loop;
1569         my @subfields  = $field->subfields();
1570         my $count_auth = 0;
1571
1572         # if there is an authority link, build the link with Koha-Auth-Number: subfield9
1573         my $subfield9 = $field->subfield('9');
1574         for my $authors_subfield (@subfields) {
1575
1576             # don't load unimarc subfields 3, 5
1577             next if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /3|5/ ) );
1578             my $subfieldcode = $authors_subfield->[0];
1579             my $value        = $authors_subfield->[1];
1580             my $linkvalue    = $value;
1581             $linkvalue =~ s/(\(|\))//g;
1582             my $operator = " and " unless $count_auth == 0;
1583
1584             # if we have an authority link, use that as the link, otherwise use standard searching
1585             if ($subfield9) {
1586                 @link_loop = ( { 'limit' => 'an', link => "$subfield9" } );
1587             } else {
1588
1589                 # reset $linkvalue if UNIMARC author responsibility
1590                 if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] eq "4" ) ) {
1591                     $linkvalue = "(" . GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib ) . ")";
1592                 }
1593                 push @link_loop, { 'limit' => 'au', link => $linkvalue, operator => $operator };
1594             }
1595             $value = GetAuthorisedValueDesc( $field->tag(), $authors_subfield->[0], $authors_subfield->[1], '', $tagslib )
1596               if ( $marcflavour eq 'UNIMARC' and ( $authors_subfield->[0] =~ /4/ ) );
1597             my @this_link_loop = @link_loop;
1598             my $separator = C4::Context->preference("authoritysep") unless $count_auth == 0;
1599             push @subfields_loop, { code => $subfieldcode, value => $value, link_loop => \@this_link_loop, separator => $separator } unless ( $authors_subfield->[0] eq '9' );
1600             $count_auth++;
1601         }
1602         push @marcauthors, { MARCAUTHOR_SUBFIELDS_LOOP => \@subfields_loop };
1603     }
1604     return \@marcauthors;
1605 }
1606
1607 =head2 GetMarcUrls
1608
1609   $marcurls = GetMarcUrls($record,$marcflavour);
1610
1611 Returns arrayref of URLs from MARC data, suitable to pass to tmpl loop.
1612 Assumes web resources (not uncommon in MARC21 to omit resource type ind)
1613
1614 =cut
1615
1616 sub GetMarcUrls {
1617     my ( $record, $marcflavour ) = @_;
1618
1619     my @marcurls;
1620     for my $field ( $record->field('856') ) {
1621         my @notes;
1622         for my $note ( $field->subfield('z') ) {
1623             push @notes, { note => $note };
1624         }
1625         my @urls = $field->subfield('u');
1626         foreach my $url (@urls) {
1627             my $marcurl;
1628             if ( $marcflavour eq 'MARC21' ) {
1629                 my $s3   = $field->subfield('3');
1630                 my $link = $field->subfield('y');
1631                 unless ( $url =~ /^\w+:/ ) {
1632                     if ( $field->indicator(1) eq '7' ) {
1633                         $url = $field->subfield('2') . "://" . $url;
1634                     } elsif ( $field->indicator(1) eq '1' ) {
1635                         $url = 'ftp://' . $url;
1636                     } else {
1637
1638                         #  properly, this should be if ind1=4,
1639                         #  however we will assume http protocol since we're building a link.
1640                         $url = 'http://' . $url;
1641                     }
1642                 }
1643
1644                 # TODO handle ind 2 (relationship)
1645                 $marcurl = {
1646                     MARCURL => $url,
1647                     notes   => \@notes,
1648                 };
1649                 $marcurl->{'linktext'} = $link || $s3 || C4::Context->preference('URLLinkText') || $url;
1650                 $marcurl->{'part'} = $s3 if ($link);
1651                 $marcurl->{'toc'} = 1 if ( defined($s3) && $s3 =~ /^[Tt]able/ );
1652             } else {
1653                 $marcurl->{'linktext'} = $field->subfield('2') || C4::Context->preference('URLLinkText') || $url;
1654                 $marcurl->{'MARCURL'} = $url;
1655             }
1656             push @marcurls, $marcurl;
1657         }
1658     }
1659     return \@marcurls;
1660 }
1661
1662 =head2 GetMarcSeries
1663
1664   $marcseriesarray = GetMarcSeries($record,$marcflavour);
1665
1666 Get all series from the MARC record and returns them in an array.
1667 The series are stored in differents places depending on MARC flavour
1668
1669 =cut
1670
1671 sub GetMarcSeries {
1672     my ( $record, $marcflavour ) = @_;
1673     my ( $mintag, $maxtag );
1674     if ( $marcflavour eq "UNIMARC" ) {
1675         $mintag = "600";
1676         $maxtag = "619";
1677     } else {    # assume marc21 if not unimarc
1678         $mintag = "440";
1679         $maxtag = "490";
1680     }
1681
1682     my @marcseries;
1683     my $subjct   = "";
1684     my $subfield = "";
1685     my $marcsubjct;
1686
1687     foreach my $field ( $record->field('440'), $record->field('490') ) {
1688         my @subfields_loop;
1689
1690         #my $value = $field->subfield('a');
1691         #$marcsubjct = {MARCSUBJCT => $value,};
1692         my @subfields = $field->subfields();
1693
1694         #warn "subfields:".join " ", @$subfields;
1695         my $counter = 0;
1696         my @link_loop;
1697         for my $series_subfield (@subfields) {
1698             my $volume_number;
1699             undef $volume_number;
1700
1701             # see if this is an instance of a volume
1702             if ( $series_subfield->[0] eq 'v' ) {
1703                 $volume_number = 1;
1704             }
1705
1706             my $code      = $series_subfield->[0];
1707             my $value     = $series_subfield->[1];
1708             my $linkvalue = $value;
1709             $linkvalue =~ s/(\(|\))//g;
1710             my $operator = " and " unless $counter == 0;
1711             push @link_loop, { link => $linkvalue, operator => $operator };
1712             my $separator = C4::Context->preference("authoritysep") unless $counter == 0;
1713             if ($volume_number) {
1714                 push @subfields_loop, { volumenum => $value };
1715             } else {
1716                 push @subfields_loop, { code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number } unless ( $series_subfield->[0] eq '9' );
1717             }
1718             $counter++;
1719         }
1720         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1721
1722         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1723         #push @marcsubjcts, $marcsubjct;
1724         #$subjct = $value;
1725
1726     }
1727     my $marcseriessarray = \@marcseries;
1728     return $marcseriessarray;
1729 }    #end getMARCseriess
1730
1731 =head2 GetFrameworkCode
1732
1733   $frameworkcode = GetFrameworkCode( $biblionumber )
1734
1735 =cut
1736
1737 sub GetFrameworkCode {
1738     my ($biblionumber) = @_;
1739     my $dbh            = C4::Context->dbh;
1740     my $sth            = $dbh->prepare("SELECT frameworkcode FROM biblio WHERE biblionumber=?");
1741     $sth->execute($biblionumber);
1742     my ($frameworkcode) = $sth->fetchrow;
1743     return $frameworkcode;
1744 }
1745
1746 =head2 TransformKohaToMarc
1747
1748     $record = TransformKohaToMarc( $hash )
1749
1750 This function builds partial MARC::Record from a hash
1751 Hash entries can be from biblio or biblioitems.
1752
1753 This function is called in acquisition module, to create a basic catalogue entry from user entry
1754
1755 =cut
1756
1757 sub TransformKohaToMarc {
1758     my ($hash) = @_;
1759     my $sth    = C4::Context->dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
1760     my $record = MARC::Record->new();
1761     SetMarcUnicodeFlag( $record, C4::Context->preference("marcflavour") );
1762     foreach ( keys %{$hash} ) {
1763         &TransformKohaToMarcOneField( $sth, $record, $_, $hash->{$_}, '' );
1764     }
1765     return $record;
1766 }
1767
1768 =head2 TransformKohaToMarcOneField
1769
1770     $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1771
1772 =cut
1773
1774 sub TransformKohaToMarcOneField {
1775     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1776     $frameworkcode = '' unless $frameworkcode;
1777     my $tagfield;
1778     my $tagsubfield;
1779
1780     if ( !defined $sth ) {
1781         my $dbh = C4::Context->dbh;
1782         $sth = $dbh->prepare( "SELECT tagfield,tagsubfield FROM marc_subfield_structure WHERE frameworkcode=? AND kohafield=?" );
1783     }
1784     $sth->execute( $frameworkcode, $kohafieldname );
1785     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1786         my @values = split(/\s?\|\s?/, $value, -1);
1787
1788         foreach my $itemvalue (@values){
1789         my $tag = $record->field($tagfield);
1790         if ($tag) {
1791                 $tag->add_subfields( $tagsubfield => $itemvalue );
1792             $record->delete_field($tag);
1793             $record->insert_fields_ordered($tag);
1794             }
1795             else {
1796                 $record->add_fields( $tagfield, " ", " ", $tagsubfield => $itemvalue );
1797             }
1798         }
1799     }
1800     return $record;
1801 }
1802
1803 =head2 TransformHtmlToXml
1804
1805   $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator,
1806                              $ind_tag, $auth_type )
1807
1808 $auth_type contains :
1809
1810 =over
1811
1812 =item - nothing : rebuild a biblio. In UNIMARC the encoding is in 100$a pos 26/27
1813
1814 =item - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1815
1816 =item - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1817
1818 =back
1819
1820 =cut
1821
1822 sub TransformHtmlToXml {
1823     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1824     my $xml = MARC::File::XML::header('UTF-8');
1825     $xml .= "<record>\n";
1826     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1827     MARC::File::XML->default_record_format($auth_type);
1828
1829     # in UNIMARC, field 100 contains the encoding
1830     # check that there is one, otherwise the
1831     # MARC::Record->new_from_xml will fail (and Koha will die)
1832     my $unimarc_and_100_exist = 0;
1833     $unimarc_and_100_exist = 1 if $auth_type eq 'ITEM';    # if we rebuild an item, no need of a 100 field
1834     my $prevvalue;
1835     my $prevtag = -1;
1836     my $first   = 1;
1837     my $j       = -1;
1838     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1839
1840         if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a" ) {
1841
1842             # if we have a 100 field and it's values are not correct, skip them.
1843             # if we don't have any valid 100 field, we will create a default one at the end
1844             my $enc = substr( @$values[$i], 26, 2 );
1845             if ( $enc eq '01' or $enc eq '50' or $enc eq '03' ) {
1846                 $unimarc_and_100_exist = 1;
1847             } else {
1848                 next;
1849             }
1850         }
1851         @$values[$i] =~ s/&/&amp;/g;
1852         @$values[$i] =~ s/</&lt;/g;
1853         @$values[$i] =~ s/>/&gt;/g;
1854         @$values[$i] =~ s/"/&quot;/g;
1855         @$values[$i] =~ s/'/&apos;/g;
1856
1857         #         if ( !utf8::is_utf8( @$values[$i] ) ) {
1858         #             utf8::decode( @$values[$i] );
1859         #         }
1860         if ( ( @$tags[$i] ne $prevtag ) ) {
1861             $j++ unless ( @$tags[$i] eq "" );
1862             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
1863             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
1864             my $ind1       = _default_ind_to_space($indicator1);
1865             my $ind2;
1866             if ( @$indicator[$j] ) {
1867                 $ind2 = _default_ind_to_space($indicator2);
1868             } else {
1869                 warn "Indicator in @$tags[$i] is empty";
1870                 $ind2 = " ";
1871             }
1872             if ( !$first ) {
1873                 $xml .= "</datafield>\n";
1874                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
1875                     && ( @$values[$i] ne "" ) ) {
1876                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1877                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1878                     $first = 0;
1879                 } else {
1880                     $first = 1;
1881                 }
1882             } else {
1883                 if ( @$values[$i] ne "" ) {
1884
1885                     # leader
1886                     if ( @$tags[$i] eq "000" ) {
1887                         $xml .= "<leader>@$values[$i]</leader>\n";
1888                         $first = 1;
1889
1890                         # rest of the fixed fields
1891                     } elsif ( @$tags[$i] < 10 ) {
1892                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
1893                         $first = 1;
1894                     } else {
1895                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1896                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1897                         $first = 0;
1898                     }
1899                 }
1900             }
1901         } else {    # @$tags[$i] eq $prevtag
1902             my $indicator1 = eval { substr( @$indicator[$j], 0, 1 ) };
1903             my $indicator2 = eval { substr( @$indicator[$j], 1, 1 ) };
1904             my $ind1       = _default_ind_to_space($indicator1);
1905             my $ind2;
1906             if ( @$indicator[$j] ) {
1907                 $ind2 = _default_ind_to_space($indicator2);
1908             } else {
1909                 warn "Indicator in @$tags[$i] is empty";
1910                 $ind2 = " ";
1911             }
1912             if ( @$values[$i] eq "" ) {
1913             } else {
1914                 if ($first) {
1915                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1916                     $first = 0;
1917                 }
1918                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1919             }
1920         }
1921         $prevtag = @$tags[$i];
1922     }
1923     $xml .= "</datafield>\n" if @$tags > 0;
1924     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist ) {
1925
1926         #     warn "SETTING 100 for $auth_type";
1927         my $string = strftime( "%Y%m%d", localtime(time) );
1928
1929         # set 50 to position 26 is biblios, 13 if authorities
1930         my $pos = 26;
1931         $pos = 13 if $auth_type eq 'UNIMARCAUTH';
1932         $string = sprintf( "%-*s", 35, $string );
1933         substr( $string, $pos, 6, "50" );
1934         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1935         $xml .= "<subfield code=\"a\">$string</subfield>\n";
1936         $xml .= "</datafield>\n";
1937     }
1938     $xml .= "</record>\n";
1939     $xml .= MARC::File::XML::footer();
1940     return $xml;
1941 }
1942
1943 =head2 _default_ind_to_space
1944
1945 Passed what should be an indicator returns a space
1946 if its undefined or zero length
1947
1948 =cut
1949
1950 sub _default_ind_to_space {
1951     my $s = shift;
1952     if ( !defined $s || $s eq q{} ) {
1953         return ' ';
1954     }
1955     return $s;
1956 }
1957
1958 =head2 TransformHtmlToMarc
1959
1960     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
1961     L<$params> is a ref to an array as below:
1962     {
1963         'tag_010_indicator1_531951' ,
1964         'tag_010_indicator2_531951' ,
1965         'tag_010_code_a_531951_145735' ,
1966         'tag_010_subfield_a_531951_145735' ,
1967         'tag_200_indicator1_873510' ,
1968         'tag_200_indicator2_873510' ,
1969         'tag_200_code_a_873510_673465' ,
1970         'tag_200_subfield_a_873510_673465' ,
1971         'tag_200_code_b_873510_704318' ,
1972         'tag_200_subfield_b_873510_704318' ,
1973         'tag_200_code_e_873510_280822' ,
1974         'tag_200_subfield_e_873510_280822' ,
1975         'tag_200_code_f_873510_110730' ,
1976         'tag_200_subfield_f_873510_110730' ,
1977     }
1978     L<$cgi> is the CGI object which containts the value.
1979     L<$record> is the MARC::Record object.
1980
1981 =cut
1982
1983 sub TransformHtmlToMarc {
1984     my $params = shift;
1985     my $cgi    = shift;
1986
1987     # explicitly turn on the UTF-8 flag for all
1988     # 'tag_' parameters to avoid incorrect character
1989     # conversion later on
1990     my $cgi_params = $cgi->Vars;
1991     foreach my $param_name ( keys %$cgi_params ) {
1992         if ( $param_name =~ /^tag_/ ) {
1993             my $param_value = $cgi_params->{$param_name};
1994             if ( utf8::decode($param_value) ) {
1995                 $cgi_params->{$param_name} = $param_value;
1996             }
1997
1998             # FIXME - need to do something if string is not valid UTF-8
1999         }
2000     }
2001
2002     # creating a new record
2003     my $record = MARC::Record->new();
2004     my $i      = 0;
2005     my @fields;
2006     while ( $params->[$i] ) {    # browse all CGI params
2007         my $param    = $params->[$i];
2008         my $newfield = 0;
2009
2010         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2011         if ( $param eq 'biblionumber' ) {
2012             my ( $biblionumbertagfield, $biblionumbertagsubfield ) = &GetMarcFromKohaField( "biblio.biblionumber", '' );
2013             if ( $biblionumbertagfield < 10 ) {
2014                 $newfield = MARC::Field->new( $biblionumbertagfield, $cgi->param($param), );
2015             } else {
2016                 $newfield = MARC::Field->new( $biblionumbertagfield, '', '', "$biblionumbertagsubfield" => $cgi->param($param), );
2017             }
2018             push @fields, $newfield if ($newfield);
2019         } elsif ( $param =~ /^tag_(\d*)_indicator1_/ ) {    # new field start when having 'input name="..._indicator1_..."
2020             my $tag = $1;
2021
2022             my $ind1 = _default_ind_to_space( substr( $cgi->param($param), 0, 1 ) );
2023             my $ind2 = _default_ind_to_space( substr( $cgi->param( $params->[ $i + 1 ] ), 0, 1 ) );
2024             $newfield = 0;
2025             my $j = $i + 2;
2026
2027             if ( $tag < 10 ) {                              # no code for theses fields
2028                                                             # in MARC editor, 000 contains the leader.
2029                 if ( $tag eq '000' ) {
2030                     # Force a fake leader even if not provided to avoid crashing
2031                     # during decoding MARC record containing UTF-8 characters
2032                     $record->leader(
2033                         length( $cgi->param($params->[$j+1]) ) == 24
2034                         ? $cgi->param( $params->[ $j + 1 ] )
2035                         : '     nam a22        4500'
2036                         )
2037                     ;
2038                     # between 001 and 009 (included)
2039                 } elsif ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) {
2040                     $newfield = MARC::Field->new( $tag, $cgi->param( $params->[ $j + 1 ] ), );
2041                 }
2042
2043                 # > 009, deal with subfields
2044             } else {
2045                 while ( defined $params->[$j] && $params->[$j] =~ /_code_/ ) {    # browse all it's subfield
2046                     my $inner_param = $params->[$j];
2047                     if ($newfield) {
2048                         if ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) {         # only if there is a value (code => value)
2049                             $newfield->add_subfields( $cgi->param($inner_param) => $cgi->param( $params->[ $j + 1 ] ) );
2050                         }
2051                     } else {
2052                         if ( $cgi->param( $params->[ $j + 1 ] ) ne '' ) {         # creating only if there is a value (code => value)
2053                             $newfield = MARC::Field->new( $tag, $ind1, $ind2, $cgi->param($inner_param) => $cgi->param( $params->[ $j + 1 ] ), );
2054                         }
2055                     }
2056                     $j += 2;
2057                 }
2058             }
2059             push @fields, $newfield if ($newfield);
2060         }
2061         $i++;
2062     }
2063
2064     $record->append_fields(@fields);
2065     return $record;
2066 }
2067
2068 # cache inverted MARC field map
2069 our $inverted_field_map;
2070
2071 =head2 TransformMarcToKoha
2072
2073   $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2074
2075 Extract data from a MARC bib record into a hashref representing
2076 Koha biblio, biblioitems, and items fields.
2077
2078 =cut
2079
2080 sub TransformMarcToKoha {
2081     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2082
2083     my $result;
2084     $limit_table = $limit_table || 0;
2085     $frameworkcode = '' unless defined $frameworkcode;
2086
2087     unless ( defined $inverted_field_map ) {
2088         $inverted_field_map = _get_inverted_marc_field_map();
2089     }
2090
2091     my %tables = ();
2092     if ( defined $limit_table && $limit_table eq 'items' ) {
2093         $tables{'items'} = 1;
2094     } else {
2095         $tables{'items'}       = 1;
2096         $tables{'biblio'}      = 1;
2097         $tables{'biblioitems'} = 1;
2098     }
2099
2100     # traverse through record
2101   MARCFIELD: foreach my $field ( $record->fields() ) {
2102         my $tag = $field->tag();
2103         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2104         if ( $field->is_control_field() ) {
2105             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2106           ENTRY: foreach my $entry ( @{$kohafields} ) {
2107                 my ( $subfield, $table, $column ) = @{$entry};
2108                 next ENTRY unless exists $tables{$table};
2109                 my $key = _disambiguate( $table, $column );
2110                 if ( $result->{$key} ) {
2111                     unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $field->data() eq "" ) ) {
2112                         $result->{$key} .= " | " . $field->data();
2113                     }
2114                 } else {
2115                     $result->{$key} = $field->data();
2116                 }
2117             }
2118         } else {
2119
2120             # deal with subfields
2121           MARCSUBFIELD: foreach my $sf ( $field->subfields() ) {
2122                 my $code = $sf->[0];
2123                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2124                 my $value = $sf->[1];
2125               SFENTRY: foreach my $entry ( @{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} } ) {
2126                     my ( $table, $column ) = @{$entry};
2127                     next SFENTRY unless exists $tables{$table};
2128                     my $key = _disambiguate( $table, $column );
2129                     if ( $result->{$key} ) {
2130                         unless ( ( $key eq "biblionumber" or $key eq "biblioitemnumber" ) and ( $value eq "" ) ) {
2131                             $result->{$key} .= " | " . $value;
2132                         }
2133                     } else {
2134                         $result->{$key} = $value;
2135                     }
2136                 }
2137             }
2138         }
2139     }
2140
2141     # modify copyrightdate to keep only the 1st year found
2142     if ( exists $result->{'copyrightdate'} ) {
2143         my $temp = $result->{'copyrightdate'};
2144         $temp =~ m/c(\d\d\d\d)/;
2145         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2146             $result->{'copyrightdate'} = $1;
2147         } else {                                       # if no cYYYY, get the 1st date.
2148             $temp =~ m/(\d\d\d\d)/;
2149             $result->{'copyrightdate'} = $1;
2150         }
2151     }
2152
2153     # modify publicationyear to keep only the 1st year found
2154     if ( exists $result->{'publicationyear'} ) {
2155         my $temp = $result->{'publicationyear'};
2156         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) {    # search cYYYY first
2157             $result->{'publicationyear'} = $1;
2158         } else {                                       # if no cYYYY, get the 1st date.
2159             $temp =~ m/(\d\d\d\d)/;
2160             $result->{'publicationyear'} = $1;
2161         }
2162     }
2163
2164     return $result;
2165 }
2166
2167 sub _get_inverted_marc_field_map {
2168     my $field_map = {};
2169     my $relations = C4::Context->marcfromkohafield;
2170
2171     foreach my $frameworkcode ( keys %{$relations} ) {
2172         foreach my $kohafield ( keys %{ $relations->{$frameworkcode} } ) {
2173             next unless @{ $relations->{$frameworkcode}->{$kohafield} };    # not all columns are mapped to MARC tag & subfield
2174             my $tag      = $relations->{$frameworkcode}->{$kohafield}->[0];
2175             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2176             my ( $table, $column ) = split /[.]/, $kohafield, 2;
2177             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2178             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2179         }
2180     }
2181     return $field_map;
2182 }
2183
2184 =head2 _disambiguate
2185
2186   $newkey = _disambiguate($table, $field);
2187
2188 This is a temporary hack to distinguish between the
2189 following sets of columns when using TransformMarcToKoha.
2190
2191   items.cn_source & biblioitems.cn_source
2192   items.cn_sort & biblioitems.cn_sort
2193
2194 Columns that are currently NOT distinguished (FIXME
2195 due to lack of time to fully test) are:
2196
2197   biblio.notes and biblioitems.notes
2198   biblionumber
2199   timestamp
2200   biblioitemnumber
2201
2202 FIXME - this is necessary because prefixing each column
2203 name with the table name would require changing lots
2204 of code and templates, and exposing more of the DB
2205 structure than is good to the UI templates, particularly
2206 since biblio and bibloitems may well merge in a future
2207 version.  In the future, it would also be good to
2208 separate DB access and UI presentation field names
2209 more.
2210
2211 =cut
2212
2213 sub CountItemsIssued {
2214     my ($biblionumber) = @_;
2215     my $dbh            = C4::Context->dbh;
2216     my $sth            = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2217     $sth->execute($biblionumber);
2218     my $row = $sth->fetchrow_hashref();
2219     return $row->{'issuedCount'};
2220 }
2221
2222 sub _disambiguate {
2223     my ( $table, $column ) = @_;
2224     if ( $column eq "cn_sort" or $column eq "cn_source" ) {
2225         return $table . '.' . $column;
2226     } else {
2227         return $column;
2228     }
2229
2230 }
2231
2232 =head2 get_koha_field_from_marc
2233
2234   $result->{_disambiguate($table, $field)} =
2235      get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2236
2237 Internal function to map data from the MARC record to a specific non-MARC field.
2238 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2239
2240 =cut
2241
2242 sub get_koha_field_from_marc {
2243     my ( $koha_table, $koha_column, $record, $frameworkcode ) = @_;
2244     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table . '.' . $koha_column, $frameworkcode );
2245     my $kohafield;
2246     foreach my $field ( $record->field($tagfield) ) {
2247         if ( $field->tag() < 10 ) {
2248             if ($kohafield) {
2249                 $kohafield .= " | " . $field->data();
2250             } else {
2251                 $kohafield = $field->data();
2252             }
2253         } else {
2254             if ( $field->subfields ) {
2255                 my @subfields = $field->subfields();
2256                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2257                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2258                         if ($kohafield) {
2259                             $kohafield .= " | " . $subfields[$subfieldcount][1];
2260                         } else {
2261                             $kohafield = $subfields[$subfieldcount][1];
2262                         }
2263                     }
2264                 }
2265             }
2266         }
2267     }
2268     return $kohafield;
2269 }
2270
2271 =head2 TransformMarcToKohaOneField
2272
2273   $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2274
2275 =cut
2276
2277 sub TransformMarcToKohaOneField {
2278
2279     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2280     # only the 1st will be retrieved...
2281     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2282     my $res = "";
2283     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $kohatable . "." . $kohafield, $frameworkcode );
2284     foreach my $field ( $record->field($tagfield) ) {
2285         if ( $field->tag() < 10 ) {
2286             if ( $result->{$kohafield} ) {
2287                 $result->{$kohafield} .= " | " . $field->data();
2288             } else {
2289                 $result->{$kohafield} = $field->data();
2290             }
2291         } else {
2292             if ( $field->subfields ) {
2293                 my @subfields = $field->subfields();
2294                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2295                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2296                         if ( $result->{$kohafield} ) {
2297                             $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
2298                         } else {
2299                             $result->{$kohafield} = $subfields[$subfieldcount][1];
2300                         }
2301                     }
2302                 }
2303             }
2304         }
2305     }
2306     return $result;
2307 }
2308
2309 =head1  OTHER FUNCTIONS
2310
2311
2312 =head2 PrepareItemrecordDisplay
2313
2314   PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode);
2315
2316 Returns a hash with all the fields for Display a given item data in a template
2317
2318 The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided
2319
2320 =cut
2321
2322 sub PrepareItemrecordDisplay {
2323
2324     my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_;
2325
2326     my $dbh = C4::Context->dbh;
2327     $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum;
2328     my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2329     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2330
2331     # return nothing if we don't have found an existing framework.
2332     return "" unless $tagslib;
2333     my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum ) if ($itemnum);
2334     my @loop_data;
2335     my $authorised_values_sth = $dbh->prepare( "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib" );
2336     foreach my $tag ( sort keys %{$tagslib} ) {
2337         my $previous_tag = '';
2338         if ( $tag ne '' ) {
2339
2340             # loop through each subfield
2341             my $cntsubf;
2342             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2343                 next if ( subfield_is_koha_internal_p($subfield) );
2344                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2345                 my %subfield_data;
2346                 $subfield_data{tag}           = $tag;
2347                 $subfield_data{subfield}      = $subfield;
2348                 $subfield_data{countsubfield} = $cntsubf++;
2349                 $subfield_data{kohafield}     = $tagslib->{$tag}->{$subfield}->{'kohafield'};
2350
2351                 #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2352                 $subfield_data{marc_lib}   = $tagslib->{$tag}->{$subfield}->{lib};
2353                 $subfield_data{mandatory}  = $tagslib->{$tag}->{$subfield}->{mandatory};
2354                 $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable};
2355                 $subfield_data{hidden}     = "display:none"
2356                   if $tagslib->{$tag}->{$subfield}->{hidden};
2357                 my ( $x, $defaultvalue );
2358                 if ($itemrecord) {
2359                     ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord );
2360                 }
2361                 $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue;
2362                 if ( !defined $defaultvalue ) {
2363                     $defaultvalue = q||;
2364                 }
2365                 $defaultvalue =~ s/"/&quot;/g;
2366
2367                 # search for itemcallnumber if applicable
2368                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2369                     && C4::Context->preference('itemcallnumber') ) {
2370                     my $CNtag      = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2371                     my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2372                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2373                     if ($temp) {
2374                         $defaultvalue = $temp->subfield($CNsubfield);
2375                     }
2376                 }
2377                 if (   $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2378                     && $defaultvalues
2379                     && $defaultvalues->{'callnumber'} ) {
2380                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2381                     unless ($temp) {
2382                         $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues;
2383                     }
2384                 }
2385                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
2386                     && $defaultvalues
2387                     && $defaultvalues->{'branchcode'} ) {
2388                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2389                     unless ($temp) {
2390                         $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues;
2391                     }
2392                 }
2393                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.location' )
2394                     && $defaultvalues
2395                     && $defaultvalues->{'location'} ) {
2396                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2397                     unless ($temp) {
2398                         $defaultvalue = $defaultvalues->{location} if $defaultvalues;
2399                     }
2400                 }
2401                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2402                     my @authorised_values;
2403                     my %authorised_lib;
2404
2405                     # builds list, depending on authorised value...
2406                     #---- branch
2407                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
2408                         if (   ( C4::Context->preference("IndependantBranches") )
2409                             && ( C4::Context->userenv->{flags} % 2 != 1 ) ) {
2410                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" );
2411                             $sth->execute( C4::Context->userenv->{branch} );
2412                             push @authorised_values, ""
2413                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2414                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2415                                 push @authorised_values, $branchcode;
2416                                 $authorised_lib{$branchcode} = $branchname;
2417                             }
2418                         } else {
2419                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" );
2420                             $sth->execute;
2421                             push @authorised_values, ""
2422                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2423                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2424                                 push @authorised_values, $branchcode;
2425                                 $authorised_lib{$branchcode} = $branchname;
2426                             }
2427                         }
2428
2429                         #----- itemtypes
2430                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
2431                         my $sth = $dbh->prepare( "SELECT itemtype,description FROM itemtypes ORDER BY description" );
2432                         $sth->execute;
2433                         push @authorised_values, ""
2434                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2435                         while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
2436                             push @authorised_values, $itemtype;
2437                             $authorised_lib{$itemtype} = $description;
2438                         }
2439                         #---- class_sources
2440                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
2441                         push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2442
2443                         my $class_sources = GetClassSources();
2444                         my $default_source = C4::Context->preference("DefaultClassificationSource");
2445
2446                         foreach my $class_source (sort keys %$class_sources) {
2447                             next unless $class_sources->{$class_source}->{'used'} or
2448                                         ($class_source eq $default_source);
2449                             push @authorised_values, $class_source;
2450                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
2451                         }
2452
2453                         #---- "true" authorised value
2454                     } else {
2455                         $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} );
2456                         push @authorised_values, ""
2457                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2458                         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
2459                             push @authorised_values, $value;
2460                             $authorised_lib{$value} = $lib;
2461                         }
2462                     }
2463                     $subfield_data{marc_value} = CGI::scrolling_list(
2464                         -name     => 'field_value',
2465                         -values   => \@authorised_values,
2466                         -default  => "$defaultvalue",
2467                         -labels   => \%authorised_lib,
2468                         -size     => 1,
2469                         -tabindex => '',
2470                         -multiple => 0,
2471                     );
2472                 } elsif ( $tagslib->{$tag}->{$subfield}->{value_builder} ) {
2473                         # opening plugin
2474                         my $plugin = C4::Context->intranetdir . "/cataloguing/value_builder/" . $tagslib->{$tag}->{$subfield}->{'value_builder'};
2475                         if (do $plugin) {
2476                             my $temp;
2477                             my $extended_param = plugin_parameters( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
2478                             my ( $function_name, $javascript ) = plugin_javascript( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
2479                             $subfield_data{random}     = int(rand(1000000));    # why do we need 2 different randoms?
2480                             my $index_subfield = int(rand(1000000));
2481                             $subfield_data{id} = "tag_".$tag."_subfield_".$subfield."_".$index_subfield;
2482                             $subfield_data{marc_value} = qq[<input tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255"
2483                                 onfocus="Focus$function_name($subfield_data{random}, '$subfield_data{id}');"
2484                                  onblur=" Blur$function_name($subfield_data{random}, '$subfield_data{id}');" />
2485                                 <a href="#" class="buttonDot" onclick="Clic$function_name('$subfield_data{id}'); return false;" title="Tag Editor">...</a>
2486                                 $javascript];
2487                         } else {
2488                             warn "Plugin Failed: $plugin";
2489                             $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
2490                         }
2491                 }
2492                 elsif ( $tag eq '' ) {       # it's an hidden field
2493                     $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" />);
2494                 }
2495                 elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {   # FIXME: shouldn't input type be "hidden" ?
2496                     $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" />);
2497                 }
2498                 elsif ( length($defaultvalue) > 100
2499                             or (C4::Context->preference("marcflavour") eq "UNIMARC" and
2500                                   300 <= $tag && $tag < 400 && $subfield eq 'a' )
2501                             or (C4::Context->preference("marcflavour") eq "MARC21"  and
2502                                   500 <= $tag && $tag < 600                     )
2503                           ) {
2504                     # oversize field (textarea)
2505                     $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");
2506                 } else {
2507                     $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
2508                 }
2509                 push( @loop_data, \%subfield_data );
2510             }
2511         }
2512     }
2513     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2514       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2515     return {
2516         'itemtagfield'    => $itemtagfield,
2517         'itemtagsubfield' => $itemtagsubfield,
2518         'itemnumber'      => $itemnumber,
2519         'iteminformation' => \@loop_data
2520     };
2521 }
2522
2523 #"
2524
2525 #
2526 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2527 # at the same time
2528 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2529 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2530 # =head2 ModZebrafiles
2531 #
2532 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2533 #
2534 # =cut
2535 #
2536 # sub ModZebrafiles {
2537 #
2538 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2539 #
2540 #     my $op;
2541 #     my $zebradir =
2542 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2543 #     unless ( opendir( DIR, "$zebradir" ) ) {
2544 #         warn "$zebradir not found";
2545 #         return;
2546 #     }
2547 #     closedir DIR;
2548 #     my $filename = $zebradir . $biblionumber;
2549 #
2550 #     if ($record) {
2551 #         open( OUTPUT, ">", $filename . ".xml" );
2552 #         print OUTPUT $record;
2553 #         close OUTPUT;
2554 #     }
2555 # }
2556
2557 =head2 ModZebra
2558
2559   ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2560
2561 $biblionumber is the biblionumber we want to index
2562
2563 $op is specialUpdate or delete, and is used to know what we want to do
2564
2565 $server is the server that we want to update
2566
2567 $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when
2568 NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2569 do an update.
2570
2571 $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.
2572
2573 =cut
2574
2575 sub ModZebra {
2576 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2577     my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2578     my $dbh = C4::Context->dbh;
2579
2580     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2581     # at the same time
2582     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2583     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2584
2585     if ( C4::Context->preference("NoZebra") ) {
2586
2587         # lock the nozebra table : we will read index lines, update them in Perl process
2588         # and write everything in 1 transaction.
2589         # lock the table to avoid someone else overwriting what we are doing
2590         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2591         my %result;    # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2592         if ( $op eq 'specialUpdate' ) {
2593
2594             # OK, we have to add or update the record
2595             # 1st delete (virtually, in indexes), if record actually exists
2596             if ($oldRecord) {
2597                 %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2598             }
2599
2600             # ... add the record
2601             %result = _AddBiblioNoZebra( $biblionumber, $newRecord, $server, %result );
2602         } else {
2603
2604             # it's a deletion, delete the record...
2605             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2606             %result = _DelBiblioNoZebra( $biblionumber, $oldRecord, $server );
2607         }
2608
2609         # ok, now update the database...
2610         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2611         foreach my $key ( keys %result ) {
2612             foreach my $index ( keys %{ $result{$key} } ) {
2613                 $sth->execute( $result{$key}->{$index}, $server, $key, $index );
2614             }
2615         }
2616         $dbh->do('UNLOCK TABLES');
2617     } else {
2618
2619         #
2620         # we use zebra, just fill zebraqueue table
2621         #
2622         my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2623                          WHERE server = ?
2624                          AND   biblio_auth_number = ?
2625                          AND   operation = ?
2626                          AND   done = 0";
2627         my $check_sth = $dbh->prepare_cached($check_sql);
2628         $check_sth->execute( $server, $biblionumber, $op );
2629         my ($count) = $check_sth->fetchrow_array;
2630         $check_sth->finish();
2631         if ( $count == 0 ) {
2632             my $sth = $dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2633             $sth->execute( $biblionumber, $server, $op );
2634             $sth->finish;
2635         }
2636     }
2637 }
2638
2639 =head2 GetNoZebraIndexes
2640
2641   %indexes = GetNoZebraIndexes;
2642
2643 return the data from NoZebraIndexes syspref.
2644
2645 =cut
2646
2647 sub GetNoZebraIndexes {
2648     my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2649     my %indexes;
2650   INDEX: foreach my $line ( split /['"],[\n\r]*/, $no_zebra_indexes ) {
2651         $line =~ /(.*)=>(.*)/;
2652         my $index  = $1;    # initial ' or " is removed afterwards
2653         my $fields = $2;
2654         $index  =~ s/'|"|\s//g;
2655         $fields =~ s/'|"|\s//g;
2656         $indexes{$index} = $fields;
2657     }
2658     return %indexes;
2659 }
2660
2661 =head2 EmbedItemsInMarcBiblio
2662
2663     EmbedItemsInMarcBiblio($marc, $biblionumber);
2664
2665 Given a MARC::Record object containing a bib record,
2666 modify it to include the items attached to it as 9XX
2667 per the bib's MARC framework.
2668
2669 =cut
2670
2671 sub EmbedItemsInMarcBiblio {
2672     my ($marc, $biblionumber) = @_;
2673     croak "No MARC record" unless $marc;
2674
2675     my $frameworkcode = GetFrameworkCode($biblionumber);
2676     _strip_item_fields($marc, $frameworkcode);
2677
2678     # ... and embed the current items
2679     my $dbh = C4::Context->dbh;
2680     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
2681     $sth->execute($biblionumber);
2682     my @item_fields;
2683     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2684     while (my ($itemnumber) = $sth->fetchrow_array) {
2685         my $item_marc = C4::Items::GetMarcItem($biblionumber, $itemnumber);
2686         push @item_fields, $item_marc->field($itemtag);
2687     }
2688     $marc->insert_fields_ordered(@item_fields);
2689 }
2690
2691 =head1 INTERNAL FUNCTIONS
2692
2693 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2694
2695 function to delete a biblio in NoZebra indexes
2696 This function does NOT delete anything in database : it reads all the indexes entries
2697 that have to be deleted & delete them in the hash
2698
2699 The SQL part is done either :
2700  - after the Add if we are modifying a biblio (delete + add again)
2701  - immediatly after this sub if we are doing a true deletion.
2702
2703 $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2704
2705 =cut
2706
2707 sub _DelBiblioNoZebra {
2708     my ( $biblionumber, $record, $server ) = @_;
2709
2710     # Get the indexes
2711     my $dbh = C4::Context->dbh;
2712
2713     # Get the indexes
2714     my %index;
2715     my $title;
2716     if ( $server eq 'biblioserver' ) {
2717         %index = GetNoZebraIndexes;
2718
2719         # get title of the record (to store the 10 first letters with the index)
2720         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
2721         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2722     } else {
2723
2724         # for authorities, the "title" is the $a mainentry
2725         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2726         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2727         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2728         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2729         $index{'mainmainentry'} = $authref->{'auth_tag_to_report'} . 'a';
2730         $index{'mainentry'}     = $authref->{'auth_tag_to_report'} . '*';
2731         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
2732     }
2733
2734     my %result;
2735
2736     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2737     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2738
2739     # limit to 10 char, should be enough, and limit the DB size
2740     $title = substr( $title, 0, 10 );
2741
2742     #parse each field
2743     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2744     foreach my $field ( $record->fields() ) {
2745
2746         #parse each subfield
2747         next if $field->tag < 10;
2748         foreach my $subfield ( $field->subfields() ) {
2749             my $tag          = $field->tag();
2750             my $subfieldcode = $subfield->[0];
2751             my $indexed      = 0;
2752
2753             # check each index to see if the subfield is stored somewhere
2754             # otherwise, store it in __RAW__ index
2755             foreach my $key ( keys %index ) {
2756
2757                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2758                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2759                     $indexed = 1;
2760                     my $line = lc $subfield->[1];
2761
2762                     # remove meaningless value in the field...
2763                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2764
2765                     # ... and split in words
2766                     foreach ( split / /, $line ) {
2767                         next unless $_;    # skip  empty values (multiple spaces)
2768                                            # if the entry is already here, do nothing, the biblionumber has already be removed
2769                         unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/ ) ) {
2770
2771                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2772                             $sth2->execute( $server, $key, $_ );
2773                             my $existing_biblionumbers = $sth2->fetchrow;
2774
2775                             # it exists
2776                             if ($existing_biblionumbers) {
2777
2778                                 #                                 warn " existing for $key $_: $existing_biblionumbers";
2779                                 $result{$key}->{$_} = $existing_biblionumbers;
2780                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2781                             }
2782                         }
2783                     }
2784                 }
2785             }
2786
2787             # the subfield is not indexed, store it in __RAW__ index anyway
2788             unless ($indexed) {
2789                 my $line = lc $subfield->[1];
2790                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2791
2792                 # ... and split in words
2793                 foreach ( split / /, $line ) {
2794                     next unless $_;    # skip  empty values (multiple spaces)
2795                                        # if the entry is already here, do nothing, the biblionumber has already be removed
2796                     unless ( $result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/ ) {
2797
2798                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2799                         $sth2->execute( $server, '__RAW__', $_ );
2800                         my $existing_biblionumbers = $sth2->fetchrow;
2801
2802                         # it exists
2803                         if ($existing_biblionumbers) {
2804                             $result{'__RAW__'}->{$_} = $existing_biblionumbers;
2805                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2806                         }
2807                     }
2808                 }
2809             }
2810         }
2811     }
2812     return %result;
2813 }
2814
2815 =head2 _AddBiblioNoZebra
2816
2817   _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2818
2819 function to add a biblio in NoZebra indexes
2820
2821 =cut
2822
2823 sub _AddBiblioNoZebra {
2824     my ( $biblionumber, $record, $server, %result ) = @_;
2825     my $dbh = C4::Context->dbh;
2826
2827     # Get the indexes
2828     my %index;
2829     my $title;
2830     if ( $server eq 'biblioserver' ) {
2831         %index = GetNoZebraIndexes;
2832
2833         # get title of the record (to store the 10 first letters with the index)
2834         my ( $titletag, $titlesubfield ) = GetMarcFromKohaField( 'biblio.title', '' );    # FIXME: should be GetFrameworkCode($biblionumber) ??
2835         $title = lc( $record->subfield( $titletag, $titlesubfield ) );
2836     } else {
2837
2838         # warn "server : $server";
2839         # for authorities, the "title" is the $a mainentry
2840         my ( $auth_type_tag, $auth_type_sf ) = C4::AuthoritiesMarc::get_auth_type_location();
2841         my $authref = C4::AuthoritiesMarc::GetAuthType( $record->subfield( $auth_type_tag, $auth_type_sf ) );
2842         warn "ERROR : authtype undefined for " . $record->as_formatted unless $authref;
2843         $title = $record->subfield( $authref->{auth_tag_to_report}, 'a' );
2844         $index{'mainmainentry'} = $authref->{auth_tag_to_report} . 'a';
2845         $index{'mainentry'}     = $authref->{auth_tag_to_report} . '*';
2846         $index{'auth_type'}     = "${auth_type_tag}${auth_type_sf}";
2847     }
2848
2849     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2850     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2851
2852     # limit to 10 char, should be enough, and limit the DB size
2853     $title = substr( $title, 0, 10 );
2854
2855     #parse each field
2856     my $sth2 = $dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2857     foreach my $field ( $record->fields() ) {
2858
2859         #parse each subfield
2860         ###FIXME: impossible to index a 001-009 value with NoZebra
2861         next if $field->tag < 10;
2862         foreach my $subfield ( $field->subfields() ) {
2863             my $tag          = $field->tag();
2864             my $subfieldcode = $subfield->[0];
2865             my $indexed      = 0;
2866
2867             #             warn "INDEXING :".$subfield->[1];
2868             # check each index to see if the subfield is stored somewhere
2869             # otherwise, store it in __RAW__ index
2870             foreach my $key ( keys %index ) {
2871
2872                 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2873                 if ( $index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/ ) {
2874                     $indexed = 1;
2875                     my $line = lc $subfield->[1];
2876
2877                     # remove meaningless value in the field...
2878                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2879
2880                     # ... and split in words
2881                     foreach ( split / /, $line ) {
2882                         next unless $_;    # skip  empty values (multiple spaces)
2883                                            # if the entry is already here, improve weight
2884
2885                         #                         warn "managing $_";
2886                         if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2887                             my $weight = $1 + 1;
2888                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2889                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2890                         } else {
2891
2892                             # get the value if it exist in the nozebra table, otherwise, create it
2893                             $sth2->execute( $server, $key, $_ );
2894                             my $existing_biblionumbers = $sth2->fetchrow;
2895
2896                             # it exists
2897                             if ($existing_biblionumbers) {
2898                                 $result{$key}->{"$_"} = $existing_biblionumbers;
2899                                 my $weight = defined $1 ? $1 + 1 : 1;
2900                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2901                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2902
2903                                 # create a new ligne for this entry
2904                             } else {
2905
2906                                 #                             warn "INSERT : $server / $key / $_";
2907                                 $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ', indexname=' . $dbh->quote($key) . ',value=' . $dbh->quote($_) );
2908                                 $result{$key}->{"$_"} .= "$biblionumber,$title-1;";
2909                             }
2910                         }
2911                     }
2912                 }
2913             }
2914
2915             # the subfield is not indexed, store it in __RAW__ index anyway
2916             unless ($indexed) {
2917                 my $line = lc $subfield->[1];
2918                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2919
2920                 # ... and split in words
2921                 foreach ( split / /, $line ) {
2922                     next unless $_;    # skip  empty values (multiple spaces)
2923                                        # if the entry is already here, improve weight
2924                     my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
2925                     if ( $tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/ ) {
2926                         my $weight = $1 + 1;
2927                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2928                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2929                     } else {
2930
2931                         # get the value if it exist in the nozebra table, otherwise, create it
2932                         $sth2->execute( $server, '__RAW__', $_ );
2933                         my $existing_biblionumbers = $sth2->fetchrow;
2934
2935                         # it exists
2936                         if ($existing_biblionumbers) {
2937                             $result{'__RAW__'}->{"$_"} = $existing_biblionumbers;
2938                             my $weight = ( $1 ? $1 : 0 ) + 1;
2939                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2940                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2941
2942                             # create a new ligne for this entry
2943                         } else {
2944                             $dbh->do( 'INSERT INTO nozebra SET server=' . $dbh->quote($server) . ',  indexname="__RAW__",value=' . $dbh->quote($_) );
2945                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-1;";
2946                         }
2947                     }
2948                 }
2949             }
2950         }
2951     }
2952     return %result;
2953 }
2954
2955 =head2 _find_value
2956
2957   ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2958
2959 Find the given $subfield in the given $tag in the given
2960 MARC::Record $record.  If the subfield is found, returns
2961 the (indicators, value) pair; otherwise, (undef, undef) is
2962 returned.
2963
2964 PROPOSITION :
2965 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2966 I suggest we export it from this module.
2967
2968 =cut
2969
2970 sub _find_value {
2971     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2972     my @result;
2973     my $indicator;
2974     if ( $tagfield < 10 ) {
2975         if ( $record->field($tagfield) ) {
2976             push @result, $record->field($tagfield)->data();
2977         } else {
2978             push @result, "";
2979         }
2980     } else {
2981         foreach my $field ( $record->field($tagfield) ) {
2982             my @subfields = $field->subfields();
2983             foreach my $subfield (@subfields) {
2984                 if ( @$subfield[0] eq $insubfield ) {
2985                     push @result, @$subfield[1];
2986                     $indicator = $field->indicator(1) . $field->indicator(2);
2987                 }
2988             }
2989         }
2990     }
2991     return ( $indicator, @result );
2992 }
2993
2994 =head2 _koha_marc_update_bib_ids
2995
2996
2997   _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2998
2999 Internal function to add or update biblionumber and biblioitemnumber to
3000 the MARC XML.
3001
3002 =cut
3003
3004 sub _koha_marc_update_bib_ids {
3005     my ( $record, $frameworkcode, $biblionumber, $biblioitemnumber ) = @_;
3006
3007     # we must add bibnum and bibitemnum in MARC::Record...
3008     # we build the new field with biblionumber and biblioitemnumber
3009     # we drop the original field
3010     # we add the new builded field.
3011     my ( $biblio_tag,     $biblio_subfield )     = GetMarcFromKohaField( "biblio.biblionumber",          $frameworkcode );
3012     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.biblioitemnumber", $frameworkcode );
3013
3014     if ( $biblio_tag != $biblioitem_tag ) {
3015
3016         # biblionumber & biblioitemnumber are in different fields
3017
3018         # deal with biblionumber
3019         my ( $new_field, $old_field );
3020         if ( $biblio_tag < 10 ) {
3021             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3022         } else {
3023             $new_field = MARC::Field->new( $biblio_tag, '', '', "$biblio_subfield" => $biblionumber );
3024         }
3025
3026         # drop old field and create new one...
3027         $old_field = $record->field($biblio_tag);
3028         $record->delete_field($old_field) if $old_field;
3029         $record->append_fields($new_field);
3030
3031         # deal with biblioitemnumber
3032         if ( $biblioitem_tag < 10 ) {
3033             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3034         } else {
3035             $new_field = MARC::Field->new( $biblioitem_tag, '', '', "$biblioitem_subfield" => $biblioitemnumber, );
3036         }
3037
3038         # drop old field and create new one...
3039         $old_field = $record->field($biblioitem_tag);
3040         $record->delete_field($old_field) if $old_field;
3041         $record->insert_fields_ordered($new_field);
3042
3043     } else {
3044
3045         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3046         my $new_field = MARC::Field->new(
3047             $biblio_tag, '', '',
3048             "$biblio_subfield"     => $biblionumber,
3049             "$biblioitem_subfield" => $biblioitemnumber
3050         );
3051
3052         # drop old field and create new one...
3053         my $old_field = $record->field($biblio_tag);
3054         $record->delete_field($old_field) if $old_field;
3055         $record->insert_fields_ordered($new_field);
3056     }
3057 }
3058
3059 =head2 _koha_marc_update_biblioitem_cn_sort
3060
3061   _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3062
3063 Given a MARC bib record and the biblioitem hash, update the
3064 subfield that contains a copy of the value of biblioitems.cn_sort.
3065
3066 =cut
3067
3068 sub _koha_marc_update_biblioitem_cn_sort {
3069     my $marc          = shift;
3070     my $biblioitem    = shift;
3071     my $frameworkcode = shift;
3072
3073     my ( $biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField( "biblioitems.cn_sort", $frameworkcode );
3074     return unless $biblioitem_tag;
3075
3076     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3077
3078     if ( my $field = $marc->field($biblioitem_tag) ) {
3079         $field->delete_subfield( code => $biblioitem_subfield );
3080         if ( $cn_sort ne '' ) {
3081             $field->add_subfields( $biblioitem_subfield => $cn_sort );
3082         }
3083     } else {
3084
3085         # if we get here, no biblioitem tag is present in the MARC record, so
3086         # we'll create it if $cn_sort is not empty -- this would be
3087         # an odd combination of events, however
3088         if ($cn_sort) {
3089             $marc->insert_grouped_field( MARC::Field->new( $biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort ) );
3090         }
3091     }
3092 }
3093
3094 =head2 _koha_add_biblio
3095
3096   my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3097
3098 Internal function to add a biblio ($biblio is a hash with the values)
3099
3100 =cut
3101
3102 sub _koha_add_biblio {
3103     my ( $dbh, $biblio, $frameworkcode ) = @_;
3104
3105     my $error;
3106
3107     # set the series flag
3108     unless (defined $biblio->{'serial'}){
3109         $biblio->{'serial'} = 0;
3110         if ( $biblio->{'seriestitle'} ) { $biblio->{'serial'} = 1 }
3111     }
3112
3113     my $query = "INSERT INTO biblio
3114         SET frameworkcode = ?,
3115             author = ?,
3116             title = ?,
3117             unititle =?,
3118             notes = ?,
3119             serial = ?,
3120             seriestitle = ?,
3121             copyrightdate = ?,
3122             datecreated=NOW(),
3123             abstract = ?
3124         ";
3125     my $sth = $dbh->prepare($query);
3126     $sth->execute(
3127         $frameworkcode, $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3128         $biblio->{'serial'},        $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}
3129     );
3130
3131     my $biblionumber = $dbh->{'mysql_insertid'};
3132     if ( $dbh->errstr ) {
3133         $error .= "ERROR in _koha_add_biblio $query" . $dbh->errstr;
3134         warn $error;
3135     }
3136
3137     $sth->finish();
3138
3139     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3140     return ( $biblionumber, $error );
3141 }
3142
3143 =head2 _koha_modify_biblio
3144
3145   my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3146
3147 Internal function for updating the biblio table
3148
3149 =cut
3150
3151 sub _koha_modify_biblio {
3152     my ( $dbh, $biblio, $frameworkcode ) = @_;
3153     my $error;
3154
3155     my $query = "
3156         UPDATE biblio
3157         SET    frameworkcode = ?,
3158                author = ?,
3159                title = ?,
3160                unititle = ?,
3161                notes = ?,
3162                serial = ?,
3163                seriestitle = ?,
3164                copyrightdate = ?,
3165                abstract = ?
3166         WHERE  biblionumber = ?
3167         "
3168       ;
3169     my $sth = $dbh->prepare($query);
3170
3171     $sth->execute(
3172         $frameworkcode,      $biblio->{'author'},      $biblio->{'title'},         $biblio->{'unititle'}, $biblio->{'notes'},
3173         $biblio->{'serial'}, $biblio->{'seriestitle'}, $biblio->{'copyrightdate'}, $biblio->{'abstract'}, $biblio->{'biblionumber'}
3174     ) if $biblio->{'biblionumber'};
3175
3176     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3177         $error .= "ERROR in _koha_modify_biblio $query" . $dbh->errstr;
3178         warn $error;
3179     }
3180     return ( $biblio->{'biblionumber'}, $error );
3181 }
3182
3183 =head2 _koha_modify_biblioitem_nonmarc
3184
3185   my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3186
3187 Updates biblioitems row except for marc and marcxml, which should be changed
3188 via ModBiblioMarc
3189
3190 =cut
3191
3192 sub _koha_modify_biblioitem_nonmarc {
3193     my ( $dbh, $biblioitem ) = @_;
3194     my $error;
3195
3196     # re-calculate the cn_sort, it may have changed
3197     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3198
3199     my $query = "UPDATE biblioitems
3200     SET biblionumber    = ?,
3201         volume          = ?,
3202         number          = ?,
3203         itemtype        = ?,
3204         isbn            = ?,
3205         issn            = ?,
3206         publicationyear = ?,
3207         publishercode   = ?,
3208         volumedate      = ?,
3209         volumedesc      = ?,
3210         collectiontitle = ?,
3211         collectionissn  = ?,
3212         collectionvolume= ?,
3213         editionstatement= ?,
3214         editionresponsibility = ?,
3215         illus           = ?,
3216         pages           = ?,
3217         notes           = ?,
3218         size            = ?,
3219         place           = ?,
3220         lccn            = ?,
3221         url             = ?,
3222         cn_source       = ?,
3223         cn_class        = ?,
3224         cn_item         = ?,
3225         cn_suffix       = ?,
3226         cn_sort         = ?,
3227         totalissues     = ?
3228         where biblioitemnumber = ?
3229         ";
3230     my $sth = $dbh->prepare($query);
3231     $sth->execute(
3232         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3233         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3234         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3235         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3236         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3237         $biblioitem->{'lccn'},             $biblioitem->{'url'},              $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'},
3238         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},        $cn_sort,                               $biblioitem->{'totalissues'},
3239         $biblioitem->{'biblioitemnumber'}
3240     );
3241     if ( $dbh->errstr ) {
3242         $error .= "ERROR in _koha_modify_biblioitem_nonmarc $query" . $dbh->errstr;
3243         warn $error;
3244     }
3245     return ( $biblioitem->{'biblioitemnumber'}, $error );
3246 }
3247
3248 =head2 _koha_add_biblioitem
3249
3250   my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3251
3252 Internal function to add a biblioitem
3253
3254 =cut
3255
3256 sub _koha_add_biblioitem {
3257     my ( $dbh, $biblioitem ) = @_;
3258     my $error;
3259
3260     my ($cn_sort) = GetClassSort( $biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3261     my $query = "INSERT INTO biblioitems SET
3262         biblionumber    = ?,
3263         volume          = ?,
3264         number          = ?,
3265         itemtype        = ?,
3266         isbn            = ?,
3267         issn            = ?,
3268         publicationyear = ?,
3269         publishercode   = ?,
3270         volumedate      = ?,
3271         volumedesc      = ?,
3272         collectiontitle = ?,
3273         collectionissn  = ?,
3274         collectionvolume= ?,
3275         editionstatement= ?,
3276         editionresponsibility = ?,
3277         illus           = ?,
3278         pages           = ?,
3279         notes           = ?,
3280         size            = ?,
3281         place           = ?,
3282         lccn            = ?,
3283         marc            = ?,
3284         url             = ?,
3285         cn_source       = ?,
3286         cn_class        = ?,
3287         cn_item         = ?,
3288         cn_suffix       = ?,
3289         cn_sort         = ?,
3290         totalissues     = ?
3291         ";
3292     my $sth = $dbh->prepare($query);
3293     $sth->execute(
3294         $biblioitem->{'biblionumber'},     $biblioitem->{'volume'},           $biblioitem->{'number'},                $biblioitem->{'itemtype'},
3295         $biblioitem->{'isbn'},             $biblioitem->{'issn'},             $biblioitem->{'publicationyear'},       $biblioitem->{'publishercode'},
3296         $biblioitem->{'volumedate'},       $biblioitem->{'volumedesc'},       $biblioitem->{'collectiontitle'},       $biblioitem->{'collectionissn'},
3297         $biblioitem->{'collectionvolume'}, $biblioitem->{'editionstatement'}, $biblioitem->{'editionresponsibility'}, $biblioitem->{'illus'},
3298         $biblioitem->{'pages'},            $biblioitem->{'bnotes'},           $biblioitem->{'size'},                  $biblioitem->{'place'},
3299         $biblioitem->{'lccn'},             $biblioitem->{'marc'},             $biblioitem->{'url'},                   $biblioitem->{'biblioitems.cn_source'},
3300         $biblioitem->{'cn_class'},         $biblioitem->{'cn_item'},          $biblioitem->{'cn_suffix'},             $cn_sort,
3301         $biblioitem->{'totalissues'}
3302     );
3303     my $bibitemnum = $dbh->{'mysql_insertid'};
3304
3305     if ( $dbh->errstr ) {
3306         $error .= "ERROR in _koha_add_biblioitem $query" . $dbh->errstr;
3307         warn $error;
3308     }
3309     $sth->finish();
3310     return ( $bibitemnum, $error );
3311 }
3312
3313 =head2 _koha_delete_biblio
3314
3315   $error = _koha_delete_biblio($dbh,$biblionumber);
3316
3317 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3318
3319 C<$dbh> - the database handle
3320
3321 C<$biblionumber> - the biblionumber of the biblio to be deleted
3322
3323 =cut
3324
3325 # FIXME: add error handling
3326
3327 sub _koha_delete_biblio {
3328     my ( $dbh, $biblionumber ) = @_;
3329
3330     # get all the data for this biblio
3331     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3332     $sth->execute($biblionumber);
3333
3334     if ( my $data = $sth->fetchrow_hashref ) {
3335
3336         # save the record in deletedbiblio
3337         # find the fields to save
3338         my $query = "INSERT INTO deletedbiblio SET ";
3339         my @bind  = ();
3340         foreach my $temp ( keys %$data ) {
3341             $query .= "$temp = ?,";
3342             push( @bind, $data->{$temp} );
3343         }
3344
3345         # replace the last , by ",?)"
3346         $query =~ s/\,$//;
3347         my $bkup_sth = $dbh->prepare($query);
3348         $bkup_sth->execute(@bind);
3349         $bkup_sth->finish;
3350
3351         # delete the biblio
3352         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3353         $del_sth->execute($biblionumber);
3354         $del_sth->finish;
3355     }
3356     $sth->finish;
3357     return undef;
3358 }
3359
3360 =head2 _koha_delete_biblioitems
3361
3362   $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3363
3364 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3365
3366 C<$dbh> - the database handle
3367 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3368
3369 =cut
3370
3371 # FIXME: add error handling
3372
3373 sub _koha_delete_biblioitems {
3374     my ( $dbh, $biblioitemnumber ) = @_;
3375
3376     # get all the data for this biblioitem
3377     my $sth = $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3378     $sth->execute($biblioitemnumber);
3379
3380     if ( my $data = $sth->fetchrow_hashref ) {
3381
3382         # save the record in deletedbiblioitems
3383         # find the fields to save
3384         my $query = "INSERT INTO deletedbiblioitems SET ";
3385         my @bind  = ();
3386         foreach my $temp ( keys %$data ) {
3387             $query .= "$temp = ?,";
3388             push( @bind, $data->{$temp} );
3389         }
3390
3391         # replace the last , by ",?)"
3392         $query =~ s/\,$//;
3393         my $bkup_sth = $dbh->prepare($query);
3394         $bkup_sth->execute(@bind);
3395         $bkup_sth->finish;
3396
3397         # delete the biblioitem
3398         my $del_sth = $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3399         $del_sth->execute($biblioitemnumber);
3400         $del_sth->finish;
3401     }
3402     $sth->finish;
3403     return undef;
3404 }
3405
3406 =head1 UNEXPORTED FUNCTIONS
3407
3408 =head2 ModBiblioMarc
3409
3410   &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3411
3412 Add MARC data for a biblio to koha
3413
3414 Function exported, but should NOT be used, unless you really know what you're doing
3415
3416 =cut
3417
3418 sub ModBiblioMarc {
3419
3420     # pass the MARC::Record to this function, and it will create the records in the marc field
3421     my ( $record, $biblionumber, $frameworkcode ) = @_;
3422     my $dbh    = C4::Context->dbh;
3423     my @fields = $record->fields();
3424     if ( !$frameworkcode ) {
3425         $frameworkcode = "";
3426     }
3427     my $sth = $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3428     $sth->execute( $frameworkcode, $biblionumber );
3429     $sth->finish;
3430     my $encoding = C4::Context->preference("marcflavour");
3431
3432     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3433     if ( $encoding eq "UNIMARC" ) {
3434         my $string = $record->subfield( 100, "a" );
3435         if ( ($string) && ( length( $record->subfield( 100, "a" ) ) == 36 ) ) {
3436             my $f100 = $record->field(100);
3437             $record->delete_field($f100);
3438         } else {
3439             $string = POSIX::strftime( "%Y%m%d", localtime );
3440             $string =~ s/\-//g;
3441             $string = sprintf( "%-*s", 35, $string );
3442         }
3443         substr( $string, 22, 6, "frey50" );
3444         unless ( $record->subfield( 100, "a" ) ) {
3445             $record->insert_grouped_field( MARC::Field->new( 100, "", "", "a" => $string ) );
3446         }
3447     }
3448
3449     #enhancement 5374: update transaction date (005) for marc21/unimarc
3450     if($encoding =~ /MARC21|UNIMARC/) {
3451       my @a= (localtime) [5,4,3,2,1,0]; $a[0]+=1900; $a[1]++;
3452         # YY MM DD HH MM SS (update year and month)
3453       my $f005= $record->field('005');
3454       $f005->update(sprintf("%4d%02d%02d%02d%02d%04.1f",@a)) if $f005;
3455     }
3456
3457     my $oldRecord;
3458     if ( C4::Context->preference("NoZebra") ) {
3459
3460         # only NoZebra indexing needs to have
3461         # the previous version of the record
3462         $oldRecord = GetMarcBiblio($biblionumber);
3463     }
3464     $sth = $dbh->prepare("UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3465     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding), $biblionumber );
3466     $sth->finish;
3467     ModZebra( $biblionumber, "specialUpdate", "biblioserver", $oldRecord, $record );
3468     return $biblionumber;
3469 }
3470
3471 =head2 z3950_extended_services
3472
3473   z3950_extended_services($serviceType,$serviceOptions,$record);
3474
3475 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.
3476
3477 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3478
3479 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3480
3481  action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3482
3483 and maybe
3484
3485   recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3486   syntax => the record syntax (transfer syntax)
3487   databaseName = Database from connection object
3488
3489 To set serviceOptions, call set_service_options($serviceType)
3490
3491 C<$record> the record, if one is needed for the service type
3492
3493 A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3494
3495 =cut
3496
3497 sub z3950_extended_services {
3498     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3499
3500     # get our connection object
3501     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3502
3503     # create a new package object
3504     my $Zpackage = $Zconn->package();
3505
3506     # set our options
3507     $Zpackage->option( action => $action );
3508
3509     if ( $serviceOptions->{'databaseName'} ) {
3510         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3511     }
3512     if ( $serviceOptions->{'recordIdNumber'} ) {
3513         $Zpackage->option( recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3514     }
3515     if ( $serviceOptions->{'recordIdOpaque'} ) {
3516         $Zpackage->option( recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3517     }
3518
3519     # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3520     #if ($serviceType eq 'itemorder') {
3521     #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3522     #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3523     #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3524     #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3525     #}
3526
3527     if ( $serviceOptions->{record} ) {
3528         $Zpackage->option( record => $serviceOptions->{record} );
3529
3530         # can be xml or marc
3531         if ( $serviceOptions->{'syntax'} ) {
3532             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3533         }
3534     }
3535
3536     # send the request, handle any exception encountered
3537     eval { $Zpackage->send($serviceType) };
3538     if ( $@ && $@->isa("ZOOM::Exception") ) {
3539         return "error:  " . $@->code() . " " . $@->message() . "\n";
3540     }
3541
3542     # free up package resources
3543     $Zpackage->destroy();
3544 }
3545
3546 =head2 set_service_options
3547
3548   my $serviceOptions = set_service_options($serviceType);
3549
3550 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3551
3552 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3553
3554 =cut
3555
3556 sub set_service_options {
3557     my ($serviceType) = @_;
3558     my $serviceOptions;
3559
3560     # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3561     #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3562
3563     if ( $serviceType eq 'commit' ) {
3564
3565         # nothing to do
3566     }
3567     if ( $serviceType eq 'create' ) {
3568
3569         # nothing to do
3570     }
3571     if ( $serviceType eq 'drop' ) {
3572         die "ERROR: 'drop' not currently supported (by Zebra)";
3573     }
3574     return $serviceOptions;
3575 }
3576
3577 =head2 get_biblio_authorised_values
3578
3579 find the types and values for all authorised values assigned to this biblio.
3580
3581 parameters:
3582     biblionumber
3583     MARC::Record of the bib
3584
3585 returns: a hashref mapping the authorised value to the value set for this biblionumber
3586
3587   $authorised_values = {
3588                        'Scent'     => 'flowery',
3589                        'Audience'  => 'Young Adult',
3590                        'itemtypes' => 'SER',
3591                         };
3592
3593 Notes: forlibrarian should probably be passed in, and called something different.
3594
3595 =cut
3596
3597 sub get_biblio_authorised_values {
3598     my $biblionumber = shift;
3599     my $record       = shift;
3600
3601     my $forlibrarian  = 1;                                 # are we in staff or opac?
3602     my $frameworkcode = GetFrameworkCode($biblionumber);
3603
3604     my $authorised_values;
3605
3606     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3607       or return $authorised_values;
3608
3609     # assume that these entries in the authorised_value table are bibliolevel.
3610     # ones that start with 'item%' are item level.
3611     my $query = q(SELECT distinct authorised_value, kohafield
3612                     FROM marc_subfield_structure
3613                     WHERE authorised_value !=''
3614                       AND (kohafield like 'biblio%'
3615                        OR  kohafield like '') );
3616     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3617
3618     foreach my $tag ( keys(%$tagslib) ) {
3619         foreach my $subfield ( keys( %{ $tagslib->{$tag} } ) ) {
3620
3621             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3622             if ( 'HASH' eq ref $tagslib->{$tag}{$subfield} ) {
3623                 if ( defined $tagslib->{$tag}{$subfield}{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } ) {
3624                     if ( defined $record->field($tag) ) {
3625                         my $this_subfield_value = $record->field($tag)->subfield($subfield);
3626                         if ( defined $this_subfield_value ) {
3627                             $authorised_values->{ $tagslib->{$tag}{$subfield}{'authorised_value'} } = $this_subfield_value;
3628                         }
3629                     }
3630                 }
3631             }
3632         }
3633     }
3634
3635     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3636     return $authorised_values;
3637 }
3638
3639 1;
3640
3641 __END__
3642
3643 =head1 AUTHOR
3644
3645 Koha Development Team <http://koha-community.org/>
3646
3647 Paul POULAIN paul.poulain@free.fr
3648
3649 Joshua Ferraro jmf@liblime.com
3650
3651 =cut