C4/Biblio.pm

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