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