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