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