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