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