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