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