C4/Biblio.pm

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