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     unless ( $biblio_tag ) { die "can't GetMarcFromKohaField for framework $frameworkcode"; }
3004
3005     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
3006
3007     if ($biblio_tag != $biblioitem_tag) {
3008         # biblionumber & biblioitemnumber are in different fields
3009
3010         # deal with biblionumber
3011         my ($new_field, $old_field);
3012         if ($biblio_tag < 10) {
3013             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3014         } else {
3015             $new_field =
3016               MARC::Field->new( $biblio_tag, '', '',
3017                 "$biblio_subfield" => $biblionumber );
3018         }
3019
3020         # drop old field and create new one...
3021         $old_field = $record->field($biblio_tag);
3022         $record->delete_field($old_field) if $old_field;
3023         $record->append_fields($new_field);
3024
3025         # deal with biblioitemnumber
3026         if ($biblioitem_tag < 10) {
3027             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3028         } else {
3029             $new_field =
3030               MARC::Field->new( $biblioitem_tag, '', '',
3031                 "$biblioitem_subfield" => $biblioitemnumber, );
3032         }
3033         # drop old field and create new one...
3034         $old_field = $record->field($biblioitem_tag);
3035         $record->delete_field($old_field) if $old_field;
3036         $record->insert_fields_ordered($new_field);
3037
3038     } else {
3039         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3040         my $new_field = MARC::Field->new(
3041             $biblio_tag, '', '',
3042             "$biblio_subfield" => $biblionumber,
3043             "$biblioitem_subfield" => $biblioitemnumber
3044         );
3045
3046         # drop old field and create new one...
3047         my $old_field = $record->field($biblio_tag);
3048         $record->delete_field($old_field) if $old_field;
3049         $record->insert_fields_ordered($new_field);
3050     }
3051 }
3052
3053 =head2 _koha_marc_update_biblioitem_cn_sort
3054
3055 =over 4
3056
3057 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3058
3059 =back
3060
3061 Given a MARC bib record and the biblioitem hash, update the
3062 subfield that contains a copy of the value of biblioitems.cn_sort.
3063
3064 =cut
3065
3066 sub _koha_marc_update_biblioitem_cn_sort {
3067     my $marc = shift;
3068     my $biblioitem = shift;
3069     my $frameworkcode= shift;
3070
3071     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.cn_sort",$frameworkcode);
3072     return unless $biblioitem_tag;
3073
3074     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3075
3076     if (my $field = $marc->field($biblioitem_tag)) {
3077         $field->delete_subfield(code => $biblioitem_subfield);
3078         if ($cn_sort ne '') {
3079             $field->add_subfields($biblioitem_subfield => $cn_sort);
3080         }
3081     } else {
3082         # if we get here, no biblioitem tag is present in the MARC record, so
3083         # we'll create it if $cn_sort is not empty -- this would be
3084         # an odd combination of events, however
3085         if ($cn_sort) {
3086             $marc->insert_grouped_field(MARC::Field->new($biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort));
3087         }
3088     }
3089 }
3090
3091 =head2 _koha_add_biblio
3092
3093 =over 4
3094
3095 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3096
3097 Internal function to add a biblio ($biblio is a hash with the values)
3098
3099 =back
3100
3101 =cut
3102
3103 sub _koha_add_biblio {
3104     my ( $dbh, $biblio, $frameworkcode ) = @_;
3105
3106     my $error;
3107
3108     # set the series flag
3109     my $serial = 0;
3110     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3111
3112     my $query =
3113         "INSERT INTO biblio
3114         SET frameworkcode = ?,
3115             author = ?,
3116             title = ?,
3117             unititle =?,
3118             notes = ?,
3119             serial = ?,
3120             seriestitle = ?,
3121             copyrightdate = ?,
3122             datecreated=NOW(),
3123             abstract = ?
3124         ";
3125     my $sth = $dbh->prepare($query);
3126     $sth->execute(
3127         $frameworkcode,
3128         $biblio->{'author'},
3129         $biblio->{'title'},
3130         $biblio->{'unititle'},
3131         $biblio->{'notes'},
3132         $serial,
3133         $biblio->{'seriestitle'},
3134         $biblio->{'copyrightdate'},
3135         $biblio->{'abstract'}
3136     );
3137
3138     my $biblionumber = $dbh->{'mysql_insertid'};
3139     if ( $dbh->errstr ) {
3140         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3141         warn $error;
3142     }
3143
3144     $sth->finish();
3145     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3146     return ($biblionumber,$error);
3147 }
3148
3149 =head2 _koha_modify_biblio
3150
3151 =over 4
3152
3153 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3154
3155 Internal function for updating the biblio table
3156
3157 =back
3158
3159 =cut
3160
3161 sub _koha_modify_biblio {
3162     my ( $dbh, $biblio, $frameworkcode ) = @_;
3163     my $error;
3164
3165     my $query = "
3166         UPDATE biblio
3167         SET    frameworkcode = ?,
3168                author = ?,
3169                title = ?,
3170                unititle = ?,
3171                notes = ?,
3172                serial = ?,
3173                seriestitle = ?,
3174                copyrightdate = ?,
3175                abstract = ?
3176         WHERE  biblionumber = ?
3177         "
3178     ;
3179     my $sth = $dbh->prepare($query);
3180
3181     $sth->execute(
3182         $frameworkcode,
3183         $biblio->{'author'},
3184         $biblio->{'title'},
3185         $biblio->{'unititle'},
3186         $biblio->{'notes'},
3187         $biblio->{'serial'},
3188         $biblio->{'seriestitle'},
3189         $biblio->{'copyrightdate'},
3190         $biblio->{'abstract'},
3191         $biblio->{'biblionumber'}
3192     ) if $biblio->{'biblionumber'};
3193
3194     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3195         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3196         warn $error;
3197     }
3198     return ( $biblio->{'biblionumber'},$error );
3199 }
3200
3201 =head2 _koha_modify_biblioitem_nonmarc
3202
3203 =over 4
3204
3205 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3206
3207 Updates biblioitems row except for marc and marcxml, which should be changed
3208 via ModBiblioMarc
3209
3210 =back
3211
3212 =cut
3213
3214 sub _koha_modify_biblioitem_nonmarc {
3215     my ( $dbh, $biblioitem ) = @_;
3216     my $error;
3217
3218     # re-calculate the cn_sort, it may have changed
3219     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3220
3221     my $query =
3222     "UPDATE biblioitems
3223     SET biblionumber    = ?,
3224         volume          = ?,
3225         number          = ?,
3226         itemtype        = ?,
3227         isbn            = ?,
3228         issn            = ?,
3229         publicationyear = ?,
3230         publishercode   = ?,
3231         volumedate      = ?,
3232         volumedesc      = ?,
3233         collectiontitle = ?,
3234         collectionissn  = ?,
3235         collectionvolume= ?,
3236         editionstatement= ?,
3237         editionresponsibility = ?,
3238         illus           = ?,
3239         pages           = ?,
3240         notes           = ?,
3241         size            = ?,
3242         place           = ?,
3243         lccn            = ?,
3244         url             = ?,
3245         cn_source       = ?,
3246         cn_class        = ?,
3247         cn_item         = ?,
3248         cn_suffix       = ?,
3249         cn_sort         = ?,
3250         totalissues     = ?
3251         where biblioitemnumber = ?
3252         ";
3253     my $sth = $dbh->prepare($query);
3254     $sth->execute(
3255         $biblioitem->{'biblionumber'},
3256         $biblioitem->{'volume'},
3257         $biblioitem->{'number'},
3258         $biblioitem->{'itemtype'},
3259         $biblioitem->{'isbn'},
3260         $biblioitem->{'issn'},
3261         $biblioitem->{'publicationyear'},
3262         $biblioitem->{'publishercode'},
3263         $biblioitem->{'volumedate'},
3264         $biblioitem->{'volumedesc'},
3265         $biblioitem->{'collectiontitle'},
3266         $biblioitem->{'collectionissn'},
3267         $biblioitem->{'collectionvolume'},
3268         $biblioitem->{'editionstatement'},
3269         $biblioitem->{'editionresponsibility'},
3270         $biblioitem->{'illus'},
3271         $biblioitem->{'pages'},
3272         $biblioitem->{'bnotes'},
3273         $biblioitem->{'size'},
3274         $biblioitem->{'place'},
3275         $biblioitem->{'lccn'},
3276         $biblioitem->{'url'},
3277         $biblioitem->{'biblioitems.cn_source'},
3278         $biblioitem->{'cn_class'},
3279         $biblioitem->{'cn_item'},
3280         $biblioitem->{'cn_suffix'},
3281         $cn_sort,
3282         $biblioitem->{'totalissues'},
3283         $biblioitem->{'biblioitemnumber'}
3284     );
3285     if ( $dbh->errstr ) {
3286         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3287         warn $error;
3288     }
3289     return ($biblioitem->{'biblioitemnumber'},$error);
3290 }
3291
3292 =head2 _koha_add_biblioitem
3293
3294 =over 4
3295
3296 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3297
3298 Internal function to add a biblioitem
3299
3300 =back
3301
3302 =cut
3303
3304 sub _koha_add_biblioitem {
3305     my ( $dbh, $biblioitem ) = @_;
3306     my @fields = qw/ biblionumber
3307     cn_class cn_item cn_sort cn_source cn_suffix
3308     collectionissn collectiontitle collectionvolume
3309     editionresponsibility editionstatement
3310     illus isbn issn itemtype lccn marc
3311     notes number pages place
3312     publicationyear publishercode size
3313     totalissues url
3314     volume volumedate volumedesc
3315     /;
3316
3317     ($$biblioitem{cn_sort}) = GetClassSort( @$biblioitem{qw/ biblioitems.cn_source cn_class cn_item /} );
3318
3319     my $query = 'INSERT INTO biblioitems SET '
3320         .  join ( ',', map { "$_ =?" } @fields )
3321         .  ';'
3322     ;
3323
3324     my $sth = $dbh->prepare($query);
3325     $sth->execute( @$biblioitem{@fields} );
3326     my $bibitemnum = $dbh->{'mysql_insertid'};
3327     my $error = '';
3328     $dbh->errstr and warn $error .=
3329         'ERROR in _koha_add_biblioitem '
3330         . $query
3331         . $dbh->errstr
3332     ;
3333     $sth->finish();
3334     return ($bibitemnum,$error);
3335 }
3336
3337 =head2 _koha_delete_biblio
3338
3339 =over 4
3340
3341 $error = _koha_delete_biblio($dbh,$biblionumber);
3342
3343 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3344
3345 C<$dbh> - the database handle
3346 C<$biblionumber> - the biblionumber of the biblio to be deleted
3347
3348 =back
3349
3350 =cut
3351
3352 # FIXME: add error handling
3353
3354 sub _koha_delete_biblio {
3355     my ( $dbh, $biblionumber ) = @_;
3356
3357     # get all the data for this biblio
3358     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3359     $sth->execute($biblionumber);
3360
3361     if ( my $data = $sth->fetchrow_hashref ) {
3362
3363         # save the record in deletedbiblio
3364         # find the fields to save
3365         my $query = "INSERT INTO deletedbiblio SET ";
3366         my @bind  = ();
3367         foreach my $temp ( keys %$data ) {
3368             $query .= "$temp = ?,";
3369             push( @bind, $data->{$temp} );
3370         }
3371
3372         # replace the last , by ",?)"
3373         $query =~ s/\,$//;
3374         my $bkup_sth = $dbh->prepare($query);
3375         $bkup_sth->execute(@bind);
3376         $bkup_sth->finish;
3377
3378         # delete the biblio
3379         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3380         $del_sth->execute($biblionumber);
3381         $del_sth->finish;
3382     }
3383     $sth->finish;
3384     return undef;
3385 }
3386
3387 =head2 _koha_delete_biblioitems
3388
3389 =over 4
3390
3391 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3392
3393 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3394
3395 C<$dbh> - the database handle
3396 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3397
3398 =back
3399
3400 =cut
3401
3402 # FIXME: add error handling
3403
3404 sub _koha_delete_biblioitems {
3405     my ( $dbh, $biblioitemnumber ) = @_;
3406
3407     # get all the data for this biblioitem
3408     my $sth =
3409       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3410     $sth->execute($biblioitemnumber);
3411
3412     if ( my $data = $sth->fetchrow_hashref ) {
3413
3414         # save the record in deletedbiblioitems
3415         # find the fields to save
3416         my $query = "INSERT INTO deletedbiblioitems SET ";
3417         my @bind  = ();
3418         foreach my $temp ( keys %$data ) {
3419             $query .= "$temp = ?,";
3420             push( @bind, $data->{$temp} );
3421         }
3422
3423         # replace the last , by ",?)"
3424         $query =~ s/\,$//;
3425         my $bkup_sth = $dbh->prepare($query);
3426         $bkup_sth->execute(@bind);
3427         $bkup_sth->finish;
3428
3429         # delete the biblioitem
3430         my $del_sth =
3431           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3432         $del_sth->execute($biblioitemnumber);
3433         $del_sth->finish;
3434     }
3435     $sth->finish;
3436     return undef;
3437 }
3438
3439 =head1 UNEXPORTED FUNCTIONS
3440
3441 =head2 ModBiblioMarc
3442
3443     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3444
3445     Add MARC data for a biblio to koha
3446
3447     Function exported, but should NOT be used, unless you really know what you're doing
3448
3449 =cut
3450
3451 sub ModBiblioMarc {
3452
3453 # pass the MARC::Record to this function, and it will create the records in the marc field
3454     my ( $record, $biblionumber, $frameworkcode ) = @_;
3455     my $dbh = C4::Context->dbh;
3456     my @fields = $record->fields();
3457     if ( !$frameworkcode ) {
3458         $frameworkcode = "";
3459     }
3460     my $sth =
3461       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3462     $sth->execute( $frameworkcode, $biblionumber );
3463     $sth->finish;
3464     my $encoding = C4::Context->preference("marcflavour");
3465
3466     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3467     if ( $encoding eq "UNIMARC" ) {
3468         my $string = $record->subfield( 100, "a" );
3469         if ( ($string) && ( length($record->subfield( 100, "a" )) == 35 ) ) {
3470             my $f100 = $record->field(100);
3471             $record->delete_field($f100);
3472         }
3473         else {
3474             $string = POSIX::strftime( "%Y%m%d", localtime );
3475             $string =~ s/\-//g;
3476             $string = sprintf( "%-*s", 35, $string );
3477         }
3478         substr( $string, 22, 6, "frey50" );
3479         unless ( $record->subfield( 100, "a" ) ) {
3480             $record->insert_grouped_field(
3481                 MARC::Field->new( 100, "", "", "a" => $string ) );
3482         }
3483     }
3484     my $oldRecord;
3485     if (C4::Context->preference("NoZebra")) {
3486         # only NoZebra indexing needs to have
3487         # the previous version of the record
3488         $oldRecord = GetMarcBiblio($biblionumber);
3489     }
3490     $sth =
3491       $dbh->prepare(
3492         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3493     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
3494         $biblionumber );
3495     $sth->finish;
3496     ModZebra($biblionumber,"specialUpdate","biblioserver",$oldRecord,$record);
3497     return $biblionumber;
3498 }
3499
3500 =head2 z3950_extended_services
3501
3502 z3950_extended_services($serviceType,$serviceOptions,$record);
3503
3504     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.
3505
3506 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3507
3508 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3509
3510     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3511
3512 and maybe
3513
3514     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3515     syntax => the record syntax (transfer syntax)
3516     databaseName = Database from connection object
3517
3518     To set serviceOptions, call set_service_options($serviceType)
3519
3520 C<$record> the record, if one is needed for the service type
3521
3522     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3523
3524 =cut
3525
3526 sub z3950_extended_services {
3527     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3528
3529     # get our connection object
3530     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3531
3532     # create a new package object
3533     my $Zpackage = $Zconn->package();
3534
3535     # set our options
3536     $Zpackage->option( action => $action );
3537
3538     if ( $serviceOptions->{'databaseName'} ) {
3539         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3540     }
3541     if ( $serviceOptions->{'recordIdNumber'} ) {
3542         $Zpackage->option(
3543             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3544     }
3545     if ( $serviceOptions->{'recordIdOpaque'} ) {
3546         $Zpackage->option(
3547             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3548     }
3549
3550  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3551  #if ($serviceType eq 'itemorder') {
3552  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3553  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3554  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3555  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3556  #}
3557
3558     if ( $serviceOptions->{record} ) {
3559         $Zpackage->option( record => $serviceOptions->{record} );
3560
3561         # can be xml or marc
3562         if ( $serviceOptions->{'syntax'} ) {
3563             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3564         }
3565     }
3566
3567     # send the request, handle any exception encountered
3568     eval { $Zpackage->send($serviceType) };
3569     if ( $@ && $@->isa("ZOOM::Exception") ) {
3570         return "error:  " . $@->code() . " " . $@->message() . "\n";
3571     }
3572
3573     # free up package resources
3574     $Zpackage->destroy();
3575 }
3576
3577 =head2 set_service_options
3578
3579 my $serviceOptions = set_service_options($serviceType);
3580
3581 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3582
3583 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3584
3585 =cut
3586
3587 sub set_service_options {
3588     my ($serviceType) = @_;
3589     my $serviceOptions;
3590
3591 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3592 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3593
3594     if ( $serviceType eq 'commit' ) {
3595
3596         # nothing to do
3597     }
3598     if ( $serviceType eq 'create' ) {
3599
3600         # nothing to do
3601     }
3602     if ( $serviceType eq 'drop' ) {
3603         die "ERROR: 'drop' not currently supported (by Zebra)";
3604     }
3605     return $serviceOptions;
3606 }
3607
3608 =head3 get_biblio_authorised_values
3609
3610   find the types and values for all authorised values assigned to this biblio.
3611
3612   parameters:
3613     biblionumber
3614     MARC::Record of the bib
3615
3616   returns: a hashref mapping the authorised value to the value set for this biblionumber
3617
3618       $authorised_values = {
3619                              'Scent'     => 'flowery',
3620                              'Audience'  => 'Young Adult',
3621                              'itemtypes' => 'SER',
3622                            };
3623
3624   Notes: forlibrarian should probably be passed in, and called something different.
3625
3626
3627 =cut
3628
3629 sub get_biblio_authorised_values {
3630     my $biblionumber = shift;
3631     my $record       = shift;
3632
3633     my $forlibrarian = 1; # are we in staff or opac?
3634     my $frameworkcode = GetFrameworkCode( $biblionumber );
3635
3636     my $authorised_values;
3637
3638     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3639       or return $authorised_values;
3640
3641     # assume that these entries in the authorised_value table are bibliolevel.
3642     # ones that start with 'item%' are item level.
3643     my $query = q(SELECT distinct authorised_value, kohafield
3644                     FROM marc_subfield_structure
3645                     WHERE authorised_value !=''
3646                       AND (kohafield like 'biblio%'
3647                        OR  kohafield like '') );
3648     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3649
3650     foreach my $tag ( keys( %$tagslib ) ) {
3651         foreach my $subfield ( keys( %{$tagslib->{ $tag }} ) ) {
3652             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3653             if ( 'HASH' eq ref $tagslib->{ $tag }{ $subfield } ) {
3654                 if ( defined $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) {
3655                     if ( defined $record->field( $tag ) ) {
3656                         my $this_subfield_value = $record->field( $tag )->subfield( $subfield );
3657                         if ( defined $this_subfield_value ) {
3658                             $authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } = $this_subfield_value;
3659                         }
3660                     }
3661                 }
3662             }
3663         }
3664     }
3665     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3666     return $authorised_values;
3667 }
3668
3669
3670 1;
3671
3672 __END__
3673
3674 =head1 AUTHOR
3675
3676 Koha Developement team <info@koha.org>
3677
3678 Paul POULAIN paul.poulain@free.fr
3679
3680 Joshua Ferraro jmf@liblime.com
3681
3682 =cut