C4/Biblio.pm

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