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