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