C4/Biblio.pm

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