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