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 $tag = $record->field($tagfield);
1810         if ($tag) {
1811             $tag->update( $tagsubfield => $value );
1812             $record->delete_field($tag);
1813             $record->insert_fields_ordered($tag);
1814         }
1815         else {
1816             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1817         }
1818     }
1819     return $record;
1820 }
1821
1822 =head2 TransformHtmlToXml
1823
1824 =over 4
1825
1826 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type )
1827
1828 $auth_type contains :
1829 - nothing : rebuild a biblio, un UNIMARC the encoding is in 100$a pos 26/27
1830 - UNIMARCAUTH : rebuild an authority. In UNIMARC, the encoding is in 100$a pos 13/14
1831 - ITEM : rebuild an item : in UNIMARC, 100$a, it's in the biblio ! (otherwise, we would get 2 100 fields !)
1832
1833 =back
1834
1835 =cut
1836
1837 sub TransformHtmlToXml {
1838     my ( $tags, $subfields, $values, $indicator, $ind_tag, $auth_type ) = @_;
1839     my $xml = MARC::File::XML::header('UTF-8');
1840     $xml .= "<record>\n";
1841     $auth_type = C4::Context->preference('marcflavour') unless $auth_type;
1842     MARC::File::XML->default_record_format($auth_type);
1843     # in UNIMARC, field 100 contains the encoding
1844     # check that there is one, otherwise the
1845     # MARC::Record->new_from_xml will fail (and Koha will die)
1846     my $unimarc_and_100_exist=0;
1847     $unimarc_and_100_exist=1 if $auth_type eq 'ITEM'; # if we rebuild an item, no need of a 100 field
1848     my $prevvalue;
1849     my $prevtag = -1;
1850     my $first   = 1;
1851     my $j       = -1;
1852     for ( my $i = 0 ; $i < @$tags ; $i++ ) {
1853         if (C4::Context->preference('marcflavour') eq 'UNIMARC' and @$tags[$i] eq "100" and @$subfields[$i] eq "a") {
1854             # if we have a 100 field and it's values are not correct, skip them.
1855             # if we don't have any valid 100 field, we will create a default one at the end
1856             my $enc = substr( @$values[$i], 26, 2 );
1857             if ($enc eq '01' or $enc eq '50' or $enc eq '03') {
1858                 $unimarc_and_100_exist=1;
1859             } else {
1860                 next;
1861             }
1862         }
1863         @$values[$i] =~ s/&/&amp;/g;
1864         @$values[$i] =~ s/</&lt;/g;
1865         @$values[$i] =~ s/>/&gt;/g;
1866         @$values[$i] =~ s/"/&quot;/g;
1867         @$values[$i] =~ s/'/&apos;/g;
1868 #         if ( !utf8::is_utf8( @$values[$i] ) ) {
1869 #             utf8::decode( @$values[$i] );
1870 #         }
1871         if ( ( @$tags[$i] ne $prevtag ) ) {
1872             $j++ unless ( @$tags[$i] eq "" );
1873                         my $indicator1=eval{substr( @$indicator[$j], 0, 1 )};
1874                         my $indicator2=eval{substr( @$indicator[$j], 1, 1 )};
1875             my $ind1 = _default_ind_to_space($indicator1);
1876             my $ind2;
1877             if ( @$indicator[$j] ) {
1878                $ind2 = _default_ind_to_space($indicator2);
1879             }
1880             else {
1881                warn "Indicator in @$tags[$i] is empty";
1882                $ind2 = " ";
1883             }
1884             if ( !$first ) {
1885                 $xml .= "</datafield>\n";
1886                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
1887                     && ( @$values[$i] ne "" ) )
1888                 {
1889                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1890                     $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1891                     $first = 0;
1892                 }
1893                 else {
1894                     $first = 1;
1895                 }
1896             }
1897             else {
1898                 if ( @$values[$i] ne "" ) {
1899
1900                     # leader
1901                     if ( @$tags[$i] eq "000" ) {
1902                         $xml .= "<leader>@$values[$i]</leader>\n";
1903                         $first = 1;
1904
1905                         # rest of the fixed fields
1906                     }
1907                     elsif ( @$tags[$i] < 10 ) {
1908                         $xml .= "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
1909                         $first = 1;
1910                     }
1911                     else {
1912                         $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1913                         $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1914                         $first = 0;
1915                     }
1916                 }
1917             }
1918         }
1919         else {    # @$tags[$i] eq $prevtag
1920                         my $indicator1=eval{substr( @$indicator[$j], 0, 1 )};
1921                         my $indicator2=eval{substr( @$indicator[$j], 1, 1 )};
1922             my $ind1 = _default_ind_to_space($indicator1);
1923             my $ind2;
1924             if ( @$indicator[$j] ) {
1925                $ind2 = _default_ind_to_space($indicator2);
1926             }
1927             else {
1928                warn "Indicator in @$tags[$i] is empty";
1929                $ind2 = " ";
1930             }
1931          if ( @$values[$i] eq "" ) {
1932             }
1933             else {
1934                 if ($first) {
1935                     $xml .= "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1936                     $first = 0;
1937                 }
1938                 $xml .= "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1939             }
1940         }
1941         $prevtag = @$tags[$i];
1942     }
1943     $xml .= "</datafield>\n" if @$tags > 0;
1944     if (C4::Context->preference('marcflavour') eq 'UNIMARC' and !$unimarc_and_100_exist) {
1945 #     warn "SETTING 100 for $auth_type";
1946         my $string = strftime( "%Y%m%d", localtime(time) );
1947         # set 50 to position 26 is biblios, 13 if authorities
1948         my $pos=26;
1949         $pos=13 if $auth_type eq 'UNIMARCAUTH';
1950         $string = sprintf( "%-*s", 35, $string );
1951         substr( $string, $pos , 6, "50" );
1952         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1953         $xml .= "<subfield code=\"a\">$string</subfield>\n";
1954         $xml .= "</datafield>\n";
1955     }
1956     $xml .= "</record>\n";
1957     $xml .= MARC::File::XML::footer();
1958     return $xml;
1959 }
1960
1961 =head2 _default_ind_to_space
1962
1963 Passed what should be an indicator returns a space
1964 if its undefined or zero length
1965
1966 =cut
1967
1968 sub _default_ind_to_space {
1969     my $s = shift;
1970     if (!defined $s || $s eq q{}) {
1971         return ' ';
1972     }
1973     return $s;
1974 }
1975
1976 =head2 TransformHtmlToMarc
1977
1978     L<$record> = TransformHtmlToMarc(L<$params>,L<$cgi>)
1979     L<$params> is a ref to an array as below:
1980     {
1981         'tag_010_indicator1_531951' ,
1982         'tag_010_indicator2_531951' ,
1983         'tag_010_code_a_531951_145735' ,
1984         'tag_010_subfield_a_531951_145735' ,
1985         'tag_200_indicator1_873510' ,
1986         'tag_200_indicator2_873510' ,
1987         'tag_200_code_a_873510_673465' ,
1988         'tag_200_subfield_a_873510_673465' ,
1989         'tag_200_code_b_873510_704318' ,
1990         'tag_200_subfield_b_873510_704318' ,
1991         'tag_200_code_e_873510_280822' ,
1992         'tag_200_subfield_e_873510_280822' ,
1993         'tag_200_code_f_873510_110730' ,
1994         'tag_200_subfield_f_873510_110730' ,
1995     }
1996     L<$cgi> is the CGI object which containts the value.
1997     L<$record> is the MARC::Record object.
1998
1999 =cut
2000
2001 sub TransformHtmlToMarc {
2002     my $params = shift;
2003     my $cgi    = shift;
2004
2005     # explicitly turn on the UTF-8 flag for all
2006     # 'tag_' parameters to avoid incorrect character
2007     # conversion later on
2008     my $cgi_params = $cgi->Vars;
2009     foreach my $param_name (keys %$cgi_params) {
2010         if ($param_name =~ /^tag_/) {
2011             my $param_value = $cgi_params->{$param_name};
2012             if (utf8::decode($param_value)) {
2013                 $cgi_params->{$param_name} = $param_value;
2014             }
2015             # FIXME - need to do something if string is not valid UTF-8
2016         }
2017     }
2018
2019     # creating a new record
2020     my $record  = MARC::Record->new();
2021     my $i=0;
2022     my @fields;
2023     while ($params->[$i]){ # browse all CGI params
2024         my $param = $params->[$i];
2025         my $newfield=0;
2026         # if we are on biblionumber, store it in the MARC::Record (it may not be in the edited fields)
2027         if ($param eq 'biblionumber') {
2028             my ( $biblionumbertagfield, $biblionumbertagsubfield ) =
2029                 &GetMarcFromKohaField( "biblio.biblionumber", '' );
2030             if ($biblionumbertagfield < 10) {
2031                 $newfield = MARC::Field->new(
2032                     $biblionumbertagfield,
2033                     $cgi->param($param),
2034                 );
2035             } else {
2036                 $newfield = MARC::Field->new(
2037                     $biblionumbertagfield,
2038                     '',
2039                     '',
2040                     "$biblionumbertagsubfield" => $cgi->param($param),
2041                 );
2042             }
2043             push @fields,$newfield if($newfield);
2044         }
2045         elsif ($param =~ /^tag_(\d*)_indicator1_/){ # new field start when having 'input name="..._indicator1_..."
2046             my $tag  = $1;
2047
2048             my $ind1 = _default_ind_to_space(substr($cgi->param($param),          0, 1));
2049             my $ind2 = _default_ind_to_space(substr($cgi->param($params->[$i+1]), 0, 1));
2050             $newfield=0;
2051             my $j=$i+2;
2052
2053             if($tag < 10){ # no code for theses fields
2054     # in MARC editor, 000 contains the leader.
2055                 if ($tag eq '000' ) {
2056                     $record->leader($cgi->param($params->[$j+1])) if length($cgi->param($params->[$j+1]))==24;
2057     # between 001 and 009 (included)
2058                 } elsif ($cgi->param($params->[$j+1]) ne '') {
2059                     $newfield = MARC::Field->new(
2060                         $tag,
2061                         $cgi->param($params->[$j+1]),
2062                     );
2063                 }
2064     # > 009, deal with subfields
2065             } else {
2066                 while(defined $params->[$j] && $params->[$j] =~ /_code_/){ # browse all it's subfield
2067                     my $inner_param = $params->[$j];
2068                     if ($newfield){
2069                         if($cgi->param($params->[$j+1]) ne ''){  # only if there is a value (code => value)
2070                             $newfield->add_subfields(
2071                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1])
2072                             );
2073                         }
2074                     } else {
2075                         if ( $cgi->param($params->[$j+1]) ne '' ) { # creating only if there is a value (code => value)
2076                             $newfield = MARC::Field->new(
2077                                 $tag,
2078                                 $ind1,
2079                                 $ind2,
2080                                 $cgi->param($inner_param) => $cgi->param($params->[$j+1]),
2081                             );
2082                         }
2083                     }
2084                     $j+=2;
2085                 }
2086             }
2087             push @fields,$newfield if($newfield);
2088         }
2089         $i++;
2090     }
2091
2092     $record->append_fields(@fields);
2093     return $record;
2094 }
2095
2096 # cache inverted MARC field map
2097 our $inverted_field_map;
2098
2099 =head2 TransformMarcToKoha
2100
2101 =over 4
2102
2103     $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
2104
2105 =back
2106
2107 Extract data from a MARC bib record into a hashref representing
2108 Koha biblio, biblioitems, and items fields.
2109
2110 =cut
2111 sub TransformMarcToKoha {
2112     my ( $dbh, $record, $frameworkcode, $limit_table ) = @_;
2113
2114     my $result;
2115     $limit_table=$limit_table||0;
2116     $frameworkcode = '' unless defined $frameworkcode;
2117
2118     unless (defined $inverted_field_map) {
2119         $inverted_field_map = _get_inverted_marc_field_map();
2120     }
2121
2122     my %tables = ();
2123     if ( defined $limit_table && $limit_table eq 'items') {
2124         $tables{'items'} = 1;
2125     } else {
2126         $tables{'items'} = 1;
2127         $tables{'biblio'} = 1;
2128         $tables{'biblioitems'} = 1;
2129     }
2130
2131     # traverse through record
2132     MARCFIELD: foreach my $field ($record->fields()) {
2133         my $tag = $field->tag();
2134         next MARCFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag};
2135         if ($field->is_control_field()) {
2136             my $kohafields = $inverted_field_map->{$frameworkcode}->{$tag}->{list};
2137             ENTRY: foreach my $entry (@{ $kohafields }) {
2138                 my ($subfield, $table, $column) = @{ $entry };
2139                 next ENTRY unless exists $tables{$table};
2140                 my $key = _disambiguate($table, $column);
2141                 if ($result->{$key}) {
2142                     unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($field->data() eq "")) {
2143                         $result->{$key} .= " | " . $field->data();
2144                     }
2145                 } else {
2146                     $result->{$key} = $field->data();
2147                 }
2148             }
2149         } else {
2150             # deal with subfields
2151             MARCSUBFIELD: foreach my $sf ($field->subfields()) {
2152                 my $code = $sf->[0];
2153                 next MARCSUBFIELD unless exists $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code};
2154                 my $value = $sf->[1];
2155                 SFENTRY: foreach my $entry (@{ $inverted_field_map->{$frameworkcode}->{$tag}->{sfs}->{$code} }) {
2156                     my ($table, $column) = @{ $entry };
2157                     next SFENTRY unless exists $tables{$table};
2158                     my $key = _disambiguate($table, $column);
2159                     if ($result->{$key}) {
2160                         unless (($key eq "biblionumber" or $key eq "biblioitemnumber") and ($value eq "")) {
2161                             $result->{$key} .= " | " . $value;
2162                         }
2163                     } else {
2164                         $result->{$key} = $value;
2165                     }
2166                 }
2167             }
2168         }
2169     }
2170
2171     # modify copyrightdate to keep only the 1st year found
2172     if (exists $result->{'copyrightdate'}) {
2173         my $temp = $result->{'copyrightdate'};
2174         $temp =~ m/c(\d\d\d\d)/;
2175         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2176             $result->{'copyrightdate'} = $1;
2177         }
2178         else {                      # if no cYYYY, get the 1st date.
2179             $temp =~ m/(\d\d\d\d)/;
2180             $result->{'copyrightdate'} = $1;
2181         }
2182     }
2183
2184     # modify publicationyear to keep only the 1st year found
2185     if (exists $result->{'publicationyear'}) {
2186         my $temp = $result->{'publicationyear'};
2187         if ( $temp =~ m/c(\d\d\d\d)/ and $1 > 0 ) { # search cYYYY first
2188             $result->{'publicationyear'} = $1;
2189         }
2190         else {                      # if no cYYYY, get the 1st date.
2191             $temp =~ m/(\d\d\d\d)/;
2192             $result->{'publicationyear'} = $1;
2193         }
2194     }
2195
2196     return $result;
2197 }
2198
2199 sub _get_inverted_marc_field_map {
2200     my $field_map = {};
2201     my $relations = C4::Context->marcfromkohafield;
2202
2203     foreach my $frameworkcode (keys %{ $relations }) {
2204         foreach my $kohafield (keys %{ $relations->{$frameworkcode} }) {
2205             next unless @{ $relations->{$frameworkcode}->{$kohafield} }; # not all columns are mapped to MARC tag & subfield
2206             my $tag = $relations->{$frameworkcode}->{$kohafield}->[0];
2207             my $subfield = $relations->{$frameworkcode}->{$kohafield}->[1];
2208             my ($table, $column) = split /[.]/, $kohafield, 2;
2209             push @{ $field_map->{$frameworkcode}->{$tag}->{list} }, [ $subfield, $table, $column ];
2210             push @{ $field_map->{$frameworkcode}->{$tag}->{sfs}->{$subfield} }, [ $table, $column ];
2211         }
2212     }
2213     return $field_map;
2214 }
2215
2216 =head2 _disambiguate
2217
2218 =over 4
2219
2220 $newkey = _disambiguate($table, $field);
2221
2222 This is a temporary hack to distinguish between the
2223 following sets of columns when using TransformMarcToKoha.
2224
2225 items.cn_source & biblioitems.cn_source
2226 items.cn_sort & biblioitems.cn_sort
2227
2228 Columns that are currently NOT distinguished (FIXME
2229 due to lack of time to fully test) are:
2230
2231 biblio.notes and biblioitems.notes
2232 biblionumber
2233 timestamp
2234 biblioitemnumber
2235
2236 FIXME - this is necessary because prefixing each column
2237 name with the table name would require changing lots
2238 of code and templates, and exposing more of the DB
2239 structure than is good to the UI templates, particularly
2240 since biblio and bibloitems may well merge in a future
2241 version.  In the future, it would also be good to
2242 separate DB access and UI presentation field names
2243 more.
2244
2245 =back
2246
2247 =cut
2248
2249 sub CountItemsIssued {
2250   my ( $biblionumber )  = @_;
2251   my $dbh = C4::Context->dbh;
2252   my $sth = $dbh->prepare('SELECT COUNT(*) as issuedCount FROM items, issues WHERE items.itemnumber = issues.itemnumber AND items.biblionumber = ?');
2253   $sth->execute( $biblionumber );
2254   my $row = $sth->fetchrow_hashref();
2255   return $row->{'issuedCount'};
2256 }
2257
2258 sub _disambiguate {
2259     my ($table, $column) = @_;
2260     if ($column eq "cn_sort" or $column eq "cn_source") {
2261         return $table . '.' . $column;
2262     } else {
2263         return $column;
2264     }
2265
2266 }
2267
2268 =head2 get_koha_field_from_marc
2269
2270 =over 4
2271
2272 $result->{_disambiguate($table, $field)} = get_koha_field_from_marc($table,$field,$record,$frameworkcode);
2273
2274 Internal function to map data from the MARC record to a specific non-MARC field.
2275 FIXME: this is meant to replace TransformMarcToKohaOneField after more testing.
2276
2277 =back
2278
2279 =cut
2280
2281 sub get_koha_field_from_marc {
2282     my ($koha_table,$koha_column,$record,$frameworkcode) = @_;
2283     my ( $tagfield, $subfield ) = GetMarcFromKohaField( $koha_table.'.'.$koha_column, $frameworkcode );
2284     my $kohafield;
2285     foreach my $field ( $record->field($tagfield) ) {
2286         if ( $field->tag() < 10 ) {
2287             if ( $kohafield ) {
2288                 $kohafield .= " | " . $field->data();
2289             }
2290             else {
2291                 $kohafield = $field->data();
2292             }
2293         }
2294         else {
2295             if ( $field->subfields ) {
2296                 my @subfields = $field->subfields();
2297                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2298                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2299                         if ( $kohafield ) {
2300                             $kohafield .=
2301                               " | " . $subfields[$subfieldcount][1];
2302                         }
2303                         else {
2304                             $kohafield =
2305                               $subfields[$subfieldcount][1];
2306                         }
2307                     }
2308                 }
2309             }
2310         }
2311     }
2312     return $kohafield;
2313 }
2314
2315
2316 =head2 TransformMarcToKohaOneField
2317
2318 =over 4
2319
2320 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2321
2322 =back
2323
2324 =cut
2325
2326 sub TransformMarcToKohaOneField {
2327
2328     # FIXME ? if a field has a repeatable subfield that is used in old-db,
2329     # only the 1st will be retrieved...
2330     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2331     my $res = "";
2332     my ( $tagfield, $subfield ) =
2333       GetMarcFromKohaField( $kohatable . "." . $kohafield,
2334         $frameworkcode );
2335     foreach my $field ( $record->field($tagfield) ) {
2336         if ( $field->tag() < 10 ) {
2337             if ( $result->{$kohafield} ) {
2338                 $result->{$kohafield} .= " | " . $field->data();
2339             }
2340             else {
2341                 $result->{$kohafield} = $field->data();
2342             }
2343         }
2344         else {
2345             if ( $field->subfields ) {
2346                 my @subfields = $field->subfields();
2347                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2348                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2349                         if ( $result->{$kohafield} ) {
2350                             $result->{$kohafield} .=
2351                               " | " . $subfields[$subfieldcount][1];
2352                         }
2353                         else {
2354                             $result->{$kohafield} =
2355                               $subfields[$subfieldcount][1];
2356                         }
2357                     }
2358                 }
2359             }
2360         }
2361     }
2362     return $result;
2363 }
2364
2365 =head1  OTHER FUNCTIONS
2366
2367
2368 =head2 PrepareItemrecordDisplay
2369
2370 =over 4
2371
2372 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2373
2374 Returns a hash with all the fields for Display a given item data in a template
2375
2376 =back
2377
2378 =cut
2379
2380 sub PrepareItemrecordDisplay {
2381
2382     my ( $bibnum, $itemnum, $defaultvalues ) = @_;
2383
2384     my $dbh = C4::Context->dbh;
2385         my $today_iso = C4::Dates->today('iso');
2386     my $frameworkcode = &GetFrameworkCode( $bibnum );
2387     my ( $itemtagfield, $itemtagsubfield ) =
2388       &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2389     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2390     my $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2391         # FIXME : I'd rather have GetMarcBiblio called out of this.
2392         # Since it gets the whole Biblio record for each item
2393     my $marcrecord = GetMarcBiblio( $bibnum) if ($bibnum);
2394     my @loop_data;
2395     my $authorised_values_sth =
2396       $dbh->prepare(
2397 "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib"
2398       );
2399     foreach my $tag ( sort keys %{$tagslib} ) {
2400         my $previous_tag = '';
2401         if ( $tag ne '' ) {
2402             # loop through each subfield
2403             my $cntsubf;
2404             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2405                 next if ( subfield_is_koha_internal_p($subfield) );
2406                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2407                 my %subfield_data;
2408                 $subfield_data{tag}           = $tag;
2409                 $subfield_data{subfield}      = $subfield;
2410                 $subfield_data{countsubfield} = $cntsubf++;
2411                 $subfield_data{kohafield}     =
2412                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2413
2414          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2415                 $subfield_data{marc_lib} = $tagslib->{$tag}->{$subfield}->{lib};
2416                 $subfield_data{mandatory} =
2417                   $tagslib->{$tag}->{$subfield}->{mandatory};
2418                 $subfield_data{repeatable} =
2419                   $tagslib->{$tag}->{$subfield}->{repeatable};
2420                 $subfield_data{hidden} = "display:none"
2421                   if $tagslib->{$tag}->{$subfield}->{hidden};
2422                   my ( $x, $value );
2423                   if ($itemrecord) {
2424                       ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord );
2425                   }
2426                                   unless ($value) {
2427                                                 $value   = $tagslib->{$tag}->{$subfield}->{defaultvalue};
2428                                                 $value ||= $defaultvalues->{$tagslib->{$tag}->{$subfield}->{'kohafield'}};
2429                                                 # get today date & replace YYYY, MM, DD if provided in the default value
2430                                                 my ( $year, $month, $day ) = split ',', $today_iso;     # FIXME: iso dates don't have commas!
2431                                                 $value =~ s/YYYY/$year/g;
2432                                                 $value =~ s/MM/$month/g;
2433                                                 $value =~ s/DD/$day/g;
2434                                   }
2435                   $value =~ s/"/&quot;/g;
2436
2437                 # search for itemcallnumber if applicable
2438                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2439                     'items.itemcallnumber'
2440                     && C4::Context->preference('itemcallnumber') )
2441                 {
2442                     my $CNtag =
2443                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2444                     my $CNsubfield =
2445                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2446                     my $temp = $marcrecord->field($CNtag) if ($marcrecord);
2447                     if ($temp) {
2448                         $value = $temp->subfield($CNsubfield);
2449                     }
2450                 }
2451                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2452                     'items.itemcallnumber'
2453                     && $defaultvalues->{'callnumber'} )
2454                 {
2455                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2456                     unless ($temp) {
2457                         $value = $defaultvalues->{'callnumber'};
2458                     }
2459                 }
2460                 if ( ($tagslib->{$tag}->{$subfield}->{kohafield} eq
2461                     'items.holdingbranch' ||
2462                     $tagslib->{$tag}->{$subfield}->{kohafield} eq
2463                     'items.homebranch')
2464                     && $defaultvalues->{'branchcode'} )
2465                 {
2466                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2467                     unless ($temp) {
2468                         $value = $defaultvalues->{branchcode};
2469                     }
2470                 }
2471                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2472                     my @authorised_values;
2473                     my %authorised_lib;
2474
2475                     # builds list, depending on authorised value...
2476                     #---- branch
2477                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2478                         "branches" )
2479                     {
2480                         if ( ( C4::Context->preference("IndependantBranches") )
2481                             && ( C4::Context->userenv->{flags} != 1 ) )
2482                         {
2483                             my $sth =
2484                               $dbh->prepare(
2485                                 "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname"
2486                               );
2487                             $sth->execute( C4::Context->userenv->{branch} );
2488                             push @authorised_values, ""
2489                               unless (
2490                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2491                             while ( my ( $branchcode, $branchname ) =
2492                                 $sth->fetchrow_array )
2493                             {
2494                                 push @authorised_values, $branchcode;
2495                                 $authorised_lib{$branchcode} = $branchname;
2496                             }
2497                         }
2498                         else {
2499                             my $sth =
2500                               $dbh->prepare(
2501                                 "SELECT branchcode,branchname FROM branches ORDER BY branchname"
2502                               );
2503                             $sth->execute;
2504                             push @authorised_values, ""
2505                               unless (
2506                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2507                             while ( my ( $branchcode, $branchname ) =
2508                                 $sth->fetchrow_array )
2509                             {
2510                                 push @authorised_values, $branchcode;
2511                                 $authorised_lib{$branchcode} = $branchname;
2512                             }
2513                         }
2514
2515                         #----- itemtypes
2516                     }
2517                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2518                         "itemtypes" )
2519                     {
2520                         my $sth =
2521                           $dbh->prepare(
2522                             "SELECT itemtype,description FROM itemtypes ORDER BY description"
2523                           );
2524                         $sth->execute;
2525                         push @authorised_values, ""
2526                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2527                         while ( my ( $itemtype, $description ) =
2528                             $sth->fetchrow_array )
2529                         {
2530                             push @authorised_values, $itemtype;
2531                             $authorised_lib{$itemtype} = $description;
2532                         }
2533
2534                         #---- "true" authorised value
2535                     }
2536                     else {
2537                         $authorised_values_sth->execute(
2538                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2539                         push @authorised_values, ""
2540                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2541                         while ( my ( $value, $lib ) =
2542                             $authorised_values_sth->fetchrow_array )
2543                         {
2544                             push @authorised_values, $value;
2545                             $authorised_lib{$value} = $lib;
2546                         }
2547                     }
2548                     $subfield_data{marc_value} = CGI::scrolling_list(
2549                         -name     => 'field_value',
2550                         -values   => \@authorised_values,
2551                         -default  => "$value",
2552                         -labels   => \%authorised_lib,
2553                         -size     => 1,
2554                         -tabindex => '',
2555                         -multiple => 0,
2556                     );
2557                 }
2558                 else {
2559                     $subfield_data{marc_value} =
2560 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=\"50\" maxlength=\"255\" />";
2561                 }
2562                 push( @loop_data, \%subfield_data );
2563             }
2564         }
2565     }
2566     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2567       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2568     return {
2569         'itemtagfield'    => $itemtagfield,
2570         'itemtagsubfield' => $itemtagsubfield,
2571         'itemnumber'      => $itemnumber,
2572         'iteminformation' => \@loop_data
2573     };
2574 }
2575 #"
2576
2577 #
2578 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2579 # at the same time
2580 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2581 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2582 # =head2 ModZebrafiles
2583 #
2584 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2585 #
2586 # =cut
2587 #
2588 # sub ModZebrafiles {
2589 #
2590 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2591 #
2592 #     my $op;
2593 #     my $zebradir =
2594 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2595 #     unless ( opendir( DIR, "$zebradir" ) ) {
2596 #         warn "$zebradir not found";
2597 #         return;
2598 #     }
2599 #     closedir DIR;
2600 #     my $filename = $zebradir . $biblionumber;
2601 #
2602 #     if ($record) {
2603 #         open( OUTPUT, ">", $filename . ".xml" );
2604 #         print OUTPUT $record;
2605 #         close OUTPUT;
2606 #     }
2607 # }
2608
2609 =head2 ModZebra
2610
2611 =over 4
2612
2613 ModZebra( $biblionumber, $op, $server, $oldRecord, $newRecord );
2614
2615     $biblionumber is the biblionumber we want to index
2616     $op is specialUpdate or delete, and is used to know what we want to do
2617     $server is the server that we want to update
2618     $oldRecord is the MARC::Record containing the previous version of the record.  This is used only when
2619       NoZebra=1, as NoZebra indexing needs to know the previous version of a record in order to
2620       do an update.
2621     $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.
2622
2623 =back
2624
2625 =cut
2626
2627 sub ModZebra {
2628 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2629     my ( $biblionumber, $op, $server, $oldRecord, $newRecord ) = @_;
2630     my $dbh=C4::Context->dbh;
2631
2632     # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2633     # at the same time
2634     # replaced by a zebraqueue table, that is filled with ModZebra to run.
2635     # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2636
2637     if (C4::Context->preference("NoZebra")) {
2638         # lock the nozebra table : we will read index lines, update them in Perl process
2639         # and write everything in 1 transaction.
2640         # lock the table to avoid someone else overwriting what we are doing
2641         $dbh->do('LOCK TABLES nozebra WRITE,biblio WRITE,biblioitems WRITE, systempreferences WRITE, auth_types WRITE, auth_header WRITE, auth_subfield_structure READ');
2642         my %result; # the result hash that will be built by deletion / add, and written on mySQL at the end, to improve speed
2643         if ($op eq 'specialUpdate') {
2644             # OK, we have to add or update the record
2645             # 1st delete (virtually, in indexes), if record actually exists
2646             if ($oldRecord) {
2647                 %result = _DelBiblioNoZebra($biblionumber,$oldRecord,$server);
2648             }
2649             # ... add the record
2650             %result=_AddBiblioNoZebra($biblionumber,$newRecord, $server, %result);
2651         } else {
2652             # it's a deletion, delete the record...
2653             # warn "DELETE the record $biblionumber on $server".$record->as_formatted;
2654             %result=_DelBiblioNoZebra($biblionumber,$oldRecord,$server);
2655         }
2656         # ok, now update the database...
2657         my $sth = $dbh->prepare("UPDATE nozebra SET biblionumbers=? WHERE server=? AND indexname=? AND value=?");
2658         foreach my $key (keys %result) {
2659             foreach my $index (keys %{$result{$key}}) {
2660                 $sth->execute($result{$key}->{$index}, $server, $key, $index);
2661             }
2662         }
2663         $dbh->do('UNLOCK TABLES');
2664     } else {
2665         #
2666         # we use zebra, just fill zebraqueue table
2667         #
2668         my $check_sql = "SELECT COUNT(*) FROM zebraqueue
2669                          WHERE server = ?
2670                          AND   biblio_auth_number = ?
2671                          AND   operation = ?
2672                          AND   done = 0";
2673         my $check_sth = $dbh->prepare_cached($check_sql);
2674         $check_sth->execute($server, $biblionumber, $op);
2675         my ($count) = $check_sth->fetchrow_array;
2676         $check_sth->finish();
2677         if ($count == 0) {
2678             my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2679             $sth->execute($biblionumber,$server,$op);
2680             $sth->finish;
2681         }
2682     }
2683 }
2684
2685 =head2 GetNoZebraIndexes
2686
2687     %indexes = GetNoZebraIndexes;
2688
2689     return the data from NoZebraIndexes syspref.
2690
2691 =cut
2692
2693 sub GetNoZebraIndexes {
2694     my $no_zebra_indexes = C4::Context->preference('NoZebraIndexes');
2695     my %indexes;
2696     INDEX: foreach my $line (split /['"],[\n\r]*/,$no_zebra_indexes) {
2697         $line =~ /(.*)=>(.*)/;
2698         my $index = $1; # initial ' or " is removed afterwards
2699         my $fields = $2;
2700         $index =~ s/'|"|\s//g;
2701         $fields =~ s/'|"|\s//g;
2702         $indexes{$index}=$fields;
2703     }
2704     return %indexes;
2705 }
2706
2707 =head1 INTERNAL FUNCTIONS
2708
2709 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2710
2711     function to delete a biblio in NoZebra indexes
2712     This function does NOT delete anything in database : it reads all the indexes entries
2713     that have to be deleted & delete them in the hash
2714     The SQL part is done either :
2715     - after the Add if we are modifying a biblio (delete + add again)
2716     - immediatly after this sub if we are doing a true deletion.
2717     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2718
2719 =cut
2720
2721
2722 sub _DelBiblioNoZebra {
2723     my ($biblionumber, $record, $server)=@_;
2724
2725     # Get the indexes
2726     my $dbh = C4::Context->dbh;
2727     # Get the indexes
2728     my %index;
2729     my $title;
2730     if ($server eq 'biblioserver') {
2731         %index=GetNoZebraIndexes;
2732         # get title of the record (to store the 10 first letters with the index)
2733         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title','');
2734         $title = lc($record->subfield($titletag,$titlesubfield));
2735     } else {
2736         # for authorities, the "title" is the $a mainentry
2737         my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
2738         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
2739         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2740         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2741         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
2742         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
2743         $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
2744     }
2745
2746     my %result;
2747     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2748     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2749     # limit to 10 char, should be enough, and limit the DB size
2750     $title = substr($title,0,10);
2751     #parse each field
2752     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2753     foreach my $field ($record->fields()) {
2754         #parse each subfield
2755         next if $field->tag <10;
2756         foreach my $subfield ($field->subfields()) {
2757             my $tag = $field->tag();
2758             my $subfieldcode = $subfield->[0];
2759             my $indexed=0;
2760             # check each index to see if the subfield is stored somewhere
2761             # otherwise, store it in __RAW__ index
2762             foreach my $key (keys %index) {
2763 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2764                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2765                     $indexed=1;
2766                     my $line= lc $subfield->[1];
2767                     # remove meaningless value in the field...
2768                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2769                     # ... and split in words
2770                     foreach (split / /,$line) {
2771                         next unless $_; # skip  empty values (multiple spaces)
2772                         # if the entry is already here, do nothing, the biblionumber has already be removed
2773                         unless ( defined( $result{$key}->{$_} ) && ( $result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) ) {
2774                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2775                             $sth2->execute($server,$key,$_);
2776                             my $existing_biblionumbers = $sth2->fetchrow;
2777                             # it exists
2778                             if ($existing_biblionumbers) {
2779 #                                 warn " existing for $key $_: $existing_biblionumbers";
2780                                 $result{$key}->{$_} =$existing_biblionumbers;
2781                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2782                             }
2783                         }
2784                     }
2785                 }
2786             }
2787             # the subfield is not indexed, store it in __RAW__ index anyway
2788             unless ($indexed) {
2789                 my $line= lc $subfield->[1];
2790                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2791                 # ... and split in words
2792                 foreach (split / /,$line) {
2793                     next unless $_; # skip  empty values (multiple spaces)
2794                     # if the entry is already here, do nothing, the biblionumber has already be removed
2795                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2796                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2797                         $sth2->execute($server,'__RAW__',$_);
2798                         my $existing_biblionumbers = $sth2->fetchrow;
2799                         # it exists
2800                         if ($existing_biblionumbers) {
2801                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2802                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2803                         }
2804                     }
2805                 }
2806             }
2807         }
2808     }
2809     return %result;
2810 }
2811
2812 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2813
2814     function to add a biblio in NoZebra indexes
2815
2816 =cut
2817
2818 sub _AddBiblioNoZebra {
2819     my ($biblionumber, $record, $server, %result)=@_;
2820     my $dbh = C4::Context->dbh;
2821     # Get the indexes
2822     my %index;
2823     my $title;
2824     if ($server eq 'biblioserver') {
2825         %index=GetNoZebraIndexes;
2826         # get title of the record (to store the 10 first letters with the index)
2827         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title','');
2828         $title = lc($record->subfield($titletag,$titlesubfield));
2829     } else {
2830         # warn "server : $server";
2831         # for authorities, the "title" is the $a mainentry
2832         my ($auth_type_tag, $auth_type_sf) = C4::AuthoritiesMarc::get_auth_type_location();
2833         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield($auth_type_tag, $auth_type_sf));
2834         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2835         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2836         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
2837         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
2838         $index{'auth_type'}    = "${auth_type_tag}${auth_type_sf}";
2839     }
2840
2841     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2842     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2843     # limit to 10 char, should be enough, and limit the DB size
2844     $title = substr($title,0,10);
2845     #parse each field
2846     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2847     foreach my $field ($record->fields()) {
2848         #parse each subfield
2849         ###FIXME: impossible to index a 001-009 value with NoZebra
2850         next if $field->tag <10;
2851         foreach my $subfield ($field->subfields()) {
2852             my $tag = $field->tag();
2853             my $subfieldcode = $subfield->[0];
2854             my $indexed=0;
2855 #             warn "INDEXING :".$subfield->[1];
2856             # check each index to see if the subfield is stored somewhere
2857             # otherwise, store it in __RAW__ index
2858             foreach my $key (keys %index) {
2859 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2860                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2861                     $indexed=1;
2862                     my $line= lc $subfield->[1];
2863                     # remove meaningless value in the field...
2864                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2865                     # ... and split in words
2866                     foreach (split / /,$line) {
2867                         next unless $_; # skip  empty values (multiple spaces)
2868                         # if the entry is already here, improve weight
2869 #                         warn "managing $_";
2870                         if ( exists $result{$key}->{$_} && $result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d+);/) {
2871                             my $weight = $1 + 1;
2872                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2873                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2874                         } else {
2875                             # get the value if it exist in the nozebra table, otherwise, create it
2876                             $sth2->execute($server,$key,$_);
2877                             my $existing_biblionumbers = $sth2->fetchrow;
2878                             # it exists
2879                             if ($existing_biblionumbers) {
2880                                 $result{$key}->{"$_"} =$existing_biblionumbers;
2881                                 my $weight = defined $1 ? $1 + 1 : 1;
2882                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//g;
2883                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2884                             # create a new ligne for this entry
2885                             } else {
2886 #                             warn "INSERT : $server / $key / $_";
2887                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
2888                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
2889                             }
2890                         }
2891                     }
2892                 }
2893             }
2894             # the subfield is not indexed, store it in __RAW__ index anyway
2895             unless ($indexed) {
2896                 my $line= lc $subfield->[1];
2897                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2898                 # ... and split in words
2899                 foreach (split / /,$line) {
2900                     next unless $_; # skip  empty values (multiple spaces)
2901                     # if the entry is already here, improve weight
2902                     my $tmpstr = $result{'__RAW__'}->{"$_"} || "";
2903                     if ($tmpstr =~ /$biblionumber,\Q$title\E\-(\d+);/) {
2904                         my $weight=$1+1;
2905                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2906                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2907                     } else {
2908                         # get the value if it exist in the nozebra table, otherwise, create it
2909                         $sth2->execute($server,'__RAW__',$_);
2910                         my $existing_biblionumbers = $sth2->fetchrow;
2911                         # it exists
2912                         if ($existing_biblionumbers) {
2913                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
2914                             my $weight = ($1 ? $1 : 0) + 1;
2915                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d+);//;
2916                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2917                         # create a new ligne for this entry
2918                         } else {
2919                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
2920                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
2921                         }
2922                     }
2923                 }
2924             }
2925         }
2926     }
2927     return %result;
2928 }
2929
2930
2931 =head2 _find_value
2932
2933 =over 4
2934
2935 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2936
2937 Find the given $subfield in the given $tag in the given
2938 MARC::Record $record.  If the subfield is found, returns
2939 the (indicators, value) pair; otherwise, (undef, undef) is
2940 returned.
2941
2942 PROPOSITION :
2943 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2944 I suggest we export it from this module.
2945
2946 =back
2947
2948 =cut
2949
2950 sub _find_value {
2951     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2952     my @result;
2953     my $indicator;
2954     if ( $tagfield < 10 ) {
2955         if ( $record->field($tagfield) ) {
2956             push @result, $record->field($tagfield)->data();
2957         }
2958         else {
2959             push @result, "";
2960         }
2961     }
2962     else {
2963         foreach my $field ( $record->field($tagfield) ) {
2964             my @subfields = $field->subfields();
2965             foreach my $subfield (@subfields) {
2966                 if ( @$subfield[0] eq $insubfield ) {
2967                     push @result, @$subfield[1];
2968                     $indicator = $field->indicator(1) . $field->indicator(2);
2969                 }
2970             }
2971         }
2972     }
2973     return ( $indicator, @result );
2974 }
2975
2976 =head2 _koha_marc_update_bib_ids
2977
2978 =over 4
2979
2980 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2981
2982 Internal function to add or update biblionumber and biblioitemnumber to
2983 the MARC XML.
2984
2985 =back
2986
2987 =cut
2988
2989 sub _koha_marc_update_bib_ids {
2990     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
2991
2992     # we must add bibnum and bibitemnum in MARC::Record...
2993     # we build the new field with biblionumber and biblioitemnumber
2994     # we drop the original field
2995     # we add the new builded field.
2996     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
2997     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
2998
2999     if ($biblio_tag != $biblioitem_tag) {
3000         # biblionumber & biblioitemnumber are in different fields
3001
3002         # deal with biblionumber
3003         my ($new_field, $old_field);
3004         if ($biblio_tag < 10) {
3005             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
3006         } else {
3007             $new_field =
3008               MARC::Field->new( $biblio_tag, '', '',
3009                 "$biblio_subfield" => $biblionumber );
3010         }
3011
3012         # drop old field and create new one...
3013         $old_field = $record->field($biblio_tag);
3014         $record->delete_field($old_field) if $old_field;
3015         $record->append_fields($new_field);
3016
3017         # deal with biblioitemnumber
3018         if ($biblioitem_tag < 10) {
3019             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
3020         } else {
3021             $new_field =
3022               MARC::Field->new( $biblioitem_tag, '', '',
3023                 "$biblioitem_subfield" => $biblioitemnumber, );
3024         }
3025         # drop old field and create new one...
3026         $old_field = $record->field($biblioitem_tag);
3027         $record->delete_field($old_field) if $old_field;
3028         $record->insert_fields_ordered($new_field);
3029
3030     } else {
3031         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
3032         my $new_field = MARC::Field->new(
3033             $biblio_tag, '', '',
3034             "$biblio_subfield" => $biblionumber,
3035             "$biblioitem_subfield" => $biblioitemnumber
3036         );
3037
3038         # drop old field and create new one...
3039         my $old_field = $record->field($biblio_tag);
3040         $record->delete_field($old_field) if $old_field;
3041         $record->insert_fields_ordered($new_field);
3042     }
3043 }
3044
3045 =head2 _koha_marc_update_biblioitem_cn_sort
3046
3047 =over 4
3048
3049 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
3050
3051 =back
3052
3053 Given a MARC bib record and the biblioitem hash, update the
3054 subfield that contains a copy of the value of biblioitems.cn_sort.
3055
3056 =cut
3057
3058 sub _koha_marc_update_biblioitem_cn_sort {
3059     my $marc = shift;
3060     my $biblioitem = shift;
3061     my $frameworkcode= shift;
3062
3063     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.cn_sort",$frameworkcode);
3064     return unless $biblioitem_tag;
3065
3066     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3067
3068     if (my $field = $marc->field($biblioitem_tag)) {
3069         $field->delete_subfield(code => $biblioitem_subfield);
3070         if ($cn_sort ne '') {
3071             $field->add_subfields($biblioitem_subfield => $cn_sort);
3072         }
3073     } else {
3074         # if we get here, no biblioitem tag is present in the MARC record, so
3075         # we'll create it if $cn_sort is not empty -- this would be
3076         # an odd combination of events, however
3077         if ($cn_sort) {
3078             $marc->insert_grouped_field(MARC::Field->new($biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort));
3079         }
3080     }
3081 }
3082
3083 =head2 _koha_add_biblio
3084
3085 =over 4
3086
3087 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
3088
3089 Internal function to add a biblio ($biblio is a hash with the values)
3090
3091 =back
3092
3093 =cut
3094
3095 sub _koha_add_biblio {
3096     my ( $dbh, $biblio, $frameworkcode ) = @_;
3097
3098     my $error;
3099
3100     # set the series flag
3101     my $serial = 0;
3102     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
3103
3104     my $query =
3105         "INSERT INTO biblio
3106         SET frameworkcode = ?,
3107             author = ?,
3108             title = ?,
3109             unititle =?,
3110             notes = ?,
3111             serial = ?,
3112             seriestitle = ?,
3113             copyrightdate = ?,
3114             datecreated=NOW(),
3115             abstract = ?
3116         ";
3117     my $sth = $dbh->prepare($query);
3118     $sth->execute(
3119         $frameworkcode,
3120         $biblio->{'author'},
3121         $biblio->{'title'},
3122         $biblio->{'unititle'},
3123         $biblio->{'notes'},
3124         $serial,
3125         $biblio->{'seriestitle'},
3126         $biblio->{'copyrightdate'},
3127         $biblio->{'abstract'}
3128     );
3129
3130     my $biblionumber = $dbh->{'mysql_insertid'};
3131     if ( $dbh->errstr ) {
3132         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
3133         warn $error;
3134     }
3135
3136     $sth->finish();
3137     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
3138     return ($biblionumber,$error);
3139 }
3140
3141 =head2 _koha_modify_biblio
3142
3143 =over 4
3144
3145 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
3146
3147 Internal function for updating the biblio table
3148
3149 =back
3150
3151 =cut
3152
3153 sub _koha_modify_biblio {
3154     my ( $dbh, $biblio, $frameworkcode ) = @_;
3155     my $error;
3156
3157     my $query = "
3158         UPDATE biblio
3159         SET    frameworkcode = ?,
3160                author = ?,
3161                title = ?,
3162                unititle = ?,
3163                notes = ?,
3164                serial = ?,
3165                seriestitle = ?,
3166                copyrightdate = ?,
3167                abstract = ?
3168         WHERE  biblionumber = ?
3169         "
3170     ;
3171     my $sth = $dbh->prepare($query);
3172
3173     $sth->execute(
3174         $frameworkcode,
3175         $biblio->{'author'},
3176         $biblio->{'title'},
3177         $biblio->{'unititle'},
3178         $biblio->{'notes'},
3179         $biblio->{'serial'},
3180         $biblio->{'seriestitle'},
3181         $biblio->{'copyrightdate'},
3182         $biblio->{'abstract'},
3183         $biblio->{'biblionumber'}
3184     ) if $biblio->{'biblionumber'};
3185
3186     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
3187         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
3188         warn $error;
3189     }
3190     return ( $biblio->{'biblionumber'},$error );
3191 }
3192
3193 =head2 _koha_modify_biblioitem_nonmarc
3194
3195 =over 4
3196
3197 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
3198
3199 Updates biblioitems row except for marc and marcxml, which should be changed
3200 via ModBiblioMarc
3201
3202 =back
3203
3204 =cut
3205
3206 sub _koha_modify_biblioitem_nonmarc {
3207     my ( $dbh, $biblioitem ) = @_;
3208     my $error;
3209
3210     # re-calculate the cn_sort, it may have changed
3211     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
3212
3213     my $query =
3214     "UPDATE biblioitems
3215     SET biblionumber    = ?,
3216         volume          = ?,
3217         number          = ?,
3218         itemtype        = ?,
3219         isbn            = ?,
3220         issn            = ?,
3221         publicationyear = ?,
3222         publishercode   = ?,
3223         volumedate      = ?,
3224         volumedesc      = ?,
3225         collectiontitle = ?,
3226         collectionissn  = ?,
3227         collectionvolume= ?,
3228         editionstatement= ?,
3229         editionresponsibility = ?,
3230         illus           = ?,
3231         pages           = ?,
3232         notes           = ?,
3233         size            = ?,
3234         place           = ?,
3235         lccn            = ?,
3236         url             = ?,
3237         cn_source       = ?,
3238         cn_class        = ?,
3239         cn_item         = ?,
3240         cn_suffix       = ?,
3241         cn_sort         = ?,
3242         totalissues     = ?
3243         where biblioitemnumber = ?
3244         ";
3245     my $sth = $dbh->prepare($query);
3246     $sth->execute(
3247         $biblioitem->{'biblionumber'},
3248         $biblioitem->{'volume'},
3249         $biblioitem->{'number'},
3250         $biblioitem->{'itemtype'},
3251         $biblioitem->{'isbn'},
3252         $biblioitem->{'issn'},
3253         $biblioitem->{'publicationyear'},
3254         $biblioitem->{'publishercode'},
3255         $biblioitem->{'volumedate'},
3256         $biblioitem->{'volumedesc'},
3257         $biblioitem->{'collectiontitle'},
3258         $biblioitem->{'collectionissn'},
3259         $biblioitem->{'collectionvolume'},
3260         $biblioitem->{'editionstatement'},
3261         $biblioitem->{'editionresponsibility'},
3262         $biblioitem->{'illus'},
3263         $biblioitem->{'pages'},
3264         $biblioitem->{'bnotes'},
3265         $biblioitem->{'size'},
3266         $biblioitem->{'place'},
3267         $biblioitem->{'lccn'},
3268         $biblioitem->{'url'},
3269         $biblioitem->{'biblioitems.cn_source'},
3270         $biblioitem->{'cn_class'},
3271         $biblioitem->{'cn_item'},
3272         $biblioitem->{'cn_suffix'},
3273         $cn_sort,
3274         $biblioitem->{'totalissues'},
3275         $biblioitem->{'biblioitemnumber'}
3276     );
3277     if ( $dbh->errstr ) {
3278         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
3279         warn $error;
3280     }
3281     return ($biblioitem->{'biblioitemnumber'},$error);
3282 }
3283
3284 =head2 _koha_add_biblioitem
3285
3286 =over 4
3287
3288 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
3289
3290 Internal function to add a biblioitem
3291
3292 =back
3293
3294 =cut
3295
3296 sub _koha_add_biblioitem {
3297     my ( $dbh, $biblioitem ) = @_;
3298     my @fields = qw/ biblionumber
3299     cn_class cn_item cn_sort cn_source cn_suffix
3300     collectionissn collectiontitle collectionvolume
3301     editionresponsibility editionstatement
3302     illus isbn issn itemtype lccn marc
3303     notes number pages place
3304     publicationyear publishercode size
3305     totalissues url
3306     volume volumedate volumedesc
3307     /;
3308
3309     ($$biblioitem{cn_sort}) = GetClassSort( @$biblioitem{qw/ biblioitems.cn_source cn_class cn_item /} );
3310
3311     my $query = 'INSERT INTO biblioitems SET '
3312         .  join ( ',', map { "$_ =?" } @fields )
3313         .  ';'
3314     ;
3315
3316     my $sth = $dbh->prepare($query);
3317     $sth->execute( @$biblioitem{@fields} );
3318     my $bibitemnum = $dbh->{'mysql_insertid'};
3319     my $error = '';
3320     $dbh->errstr and warn $error .=
3321         'ERROR in _koha_add_biblioitem '
3322         . $query
3323         . $dbh->errstr
3324     ;
3325     $sth->finish();
3326     return ($bibitemnum,$error);
3327 }
3328
3329 =head2 _koha_delete_biblio
3330
3331 =over 4
3332
3333 $error = _koha_delete_biblio($dbh,$biblionumber);
3334
3335 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3336
3337 C<$dbh> - the database handle
3338 C<$biblionumber> - the biblionumber of the biblio to be deleted
3339
3340 =back
3341
3342 =cut
3343
3344 # FIXME: add error handling
3345
3346 sub _koha_delete_biblio {
3347     my ( $dbh, $biblionumber ) = @_;
3348
3349     # get all the data for this biblio
3350     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3351     $sth->execute($biblionumber);
3352
3353     if ( my $data = $sth->fetchrow_hashref ) {
3354
3355         # save the record in deletedbiblio
3356         # find the fields to save
3357         my $query = "INSERT INTO deletedbiblio SET ";
3358         my @bind  = ();
3359         foreach my $temp ( keys %$data ) {
3360             $query .= "$temp = ?,";
3361             push( @bind, $data->{$temp} );
3362         }
3363
3364         # replace the last , by ",?)"
3365         $query =~ s/\,$//;
3366         my $bkup_sth = $dbh->prepare($query);
3367         $bkup_sth->execute(@bind);
3368         $bkup_sth->finish;
3369
3370         # delete the biblio
3371         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3372         $del_sth->execute($biblionumber);
3373         $del_sth->finish;
3374     }
3375     $sth->finish;
3376     return undef;
3377 }
3378
3379 =head2 _koha_delete_biblioitems
3380
3381 =over 4
3382
3383 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3384
3385 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3386
3387 C<$dbh> - the database handle
3388 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3389
3390 =back
3391
3392 =cut
3393
3394 # FIXME: add error handling
3395
3396 sub _koha_delete_biblioitems {
3397     my ( $dbh, $biblioitemnumber ) = @_;
3398
3399     # get all the data for this biblioitem
3400     my $sth =
3401       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3402     $sth->execute($biblioitemnumber);
3403
3404     if ( my $data = $sth->fetchrow_hashref ) {
3405
3406         # save the record in deletedbiblioitems
3407         # find the fields to save
3408         my $query = "INSERT INTO deletedbiblioitems SET ";
3409         my @bind  = ();
3410         foreach my $temp ( keys %$data ) {
3411             $query .= "$temp = ?,";
3412             push( @bind, $data->{$temp} );
3413         }
3414
3415         # replace the last , by ",?)"
3416         $query =~ s/\,$//;
3417         my $bkup_sth = $dbh->prepare($query);
3418         $bkup_sth->execute(@bind);
3419         $bkup_sth->finish;
3420
3421         # delete the biblioitem
3422         my $del_sth =
3423           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3424         $del_sth->execute($biblioitemnumber);
3425         $del_sth->finish;
3426     }
3427     $sth->finish;
3428     return undef;
3429 }
3430
3431 =head1 UNEXPORTED FUNCTIONS
3432
3433 =head2 ModBiblioMarc
3434
3435     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3436
3437     Add MARC data for a biblio to koha
3438
3439     Function exported, but should NOT be used, unless you really know what you're doing
3440
3441 =cut
3442
3443 sub ModBiblioMarc {
3444
3445 # pass the MARC::Record to this function, and it will create the records in the marc field
3446     my ( $record, $biblionumber, $frameworkcode ) = @_;
3447     my $dbh = C4::Context->dbh;
3448     my @fields = $record->fields();
3449     if ( !$frameworkcode ) {
3450         $frameworkcode = "";
3451     }
3452     my $sth =
3453       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3454     $sth->execute( $frameworkcode, $biblionumber );
3455     $sth->finish;
3456     my $encoding = C4::Context->preference("marcflavour");
3457
3458     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3459     if ( $encoding eq "UNIMARC" ) {
3460         my $string = $record->subfield( 100, "a" );
3461         if ( ($string) && ( length($record->subfield( 100, "a" )) == 35 ) ) {
3462             my $f100 = $record->field(100);
3463             $record->delete_field($f100);
3464         }
3465         else {
3466             $string = POSIX::strftime( "%Y%m%d", localtime );
3467             $string =~ s/\-//g;
3468             $string = sprintf( "%-*s", 35, $string );
3469         }
3470         substr( $string, 22, 6, "frey50" );
3471         unless ( $record->subfield( 100, "a" ) ) {
3472             $record->insert_grouped_field(
3473                 MARC::Field->new( 100, "", "", "a" => $string ) );
3474         }
3475     }
3476     my $oldRecord;
3477     if (C4::Context->preference("NoZebra")) {
3478         # only NoZebra indexing needs to have
3479         # the previous version of the record
3480         $oldRecord = GetMarcBiblio($biblionumber);
3481     }
3482     $sth =
3483       $dbh->prepare(
3484         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
3485     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
3486         $biblionumber );
3487     $sth->finish;
3488     ModZebra($biblionumber,"specialUpdate","biblioserver",$oldRecord,$record);
3489     return $biblionumber;
3490 }
3491
3492 =head2 z3950_extended_services
3493
3494 z3950_extended_services($serviceType,$serviceOptions,$record);
3495
3496     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.
3497
3498 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3499
3500 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3501
3502     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3503
3504 and maybe
3505
3506     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3507     syntax => the record syntax (transfer syntax)
3508     databaseName = Database from connection object
3509
3510     To set serviceOptions, call set_service_options($serviceType)
3511
3512 C<$record> the record, if one is needed for the service type
3513
3514     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3515
3516 =cut
3517
3518 sub z3950_extended_services {
3519     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3520
3521     # get our connection object
3522     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3523
3524     # create a new package object
3525     my $Zpackage = $Zconn->package();
3526
3527     # set our options
3528     $Zpackage->option( action => $action );
3529
3530     if ( $serviceOptions->{'databaseName'} ) {
3531         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3532     }
3533     if ( $serviceOptions->{'recordIdNumber'} ) {
3534         $Zpackage->option(
3535             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3536     }
3537     if ( $serviceOptions->{'recordIdOpaque'} ) {
3538         $Zpackage->option(
3539             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3540     }
3541
3542  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3543  #if ($serviceType eq 'itemorder') {
3544  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3545  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3546  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3547  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3548  #}
3549
3550     if ( $serviceOptions->{record} ) {
3551         $Zpackage->option( record => $serviceOptions->{record} );
3552
3553         # can be xml or marc
3554         if ( $serviceOptions->{'syntax'} ) {
3555             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3556         }
3557     }
3558
3559     # send the request, handle any exception encountered
3560     eval { $Zpackage->send($serviceType) };
3561     if ( $@ && $@->isa("ZOOM::Exception") ) {
3562         return "error:  " . $@->code() . " " . $@->message() . "\n";
3563     }
3564
3565     # free up package resources
3566     $Zpackage->destroy();
3567 }
3568
3569 =head2 set_service_options
3570
3571 my $serviceOptions = set_service_options($serviceType);
3572
3573 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3574
3575 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3576
3577 =cut
3578
3579 sub set_service_options {
3580     my ($serviceType) = @_;
3581     my $serviceOptions;
3582
3583 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3584 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3585
3586     if ( $serviceType eq 'commit' ) {
3587
3588         # nothing to do
3589     }
3590     if ( $serviceType eq 'create' ) {
3591
3592         # nothing to do
3593     }
3594     if ( $serviceType eq 'drop' ) {
3595         die "ERROR: 'drop' not currently supported (by Zebra)";
3596     }
3597     return $serviceOptions;
3598 }
3599
3600 =head3 get_biblio_authorised_values
3601
3602   find the types and values for all authorised values assigned to this biblio.
3603
3604   parameters:
3605     biblionumber
3606     MARC::Record of the bib
3607
3608   returns: a hashref mapping the authorised value to the value set for this biblionumber
3609
3610       $authorised_values = {
3611                              'Scent'     => 'flowery',
3612                              'Audience'  => 'Young Adult',
3613                              'itemtypes' => 'SER',
3614                            };
3615
3616   Notes: forlibrarian should probably be passed in, and called something different.
3617
3618
3619 =cut
3620
3621 sub get_biblio_authorised_values {
3622     my $biblionumber = shift;
3623     my $record       = shift;
3624
3625     my $forlibrarian = 1; # are we in staff or opac?
3626     my $frameworkcode = GetFrameworkCode( $biblionumber );
3627
3628     my $authorised_values;
3629
3630     my $tagslib = GetMarcStructure( $forlibrarian, $frameworkcode )
3631       or return $authorised_values;
3632
3633     # assume that these entries in the authorised_value table are bibliolevel.
3634     # ones that start with 'item%' are item level.
3635     my $query = q(SELECT distinct authorised_value, kohafield
3636                     FROM marc_subfield_structure
3637                     WHERE authorised_value !=''
3638                       AND (kohafield like 'biblio%'
3639                        OR  kohafield like '') );
3640     my $bibliolevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
3641
3642     foreach my $tag ( keys( %$tagslib ) ) {
3643         foreach my $subfield ( keys( %{$tagslib->{ $tag }} ) ) {
3644             # warn "checking $subfield. type is: " . ref $tagslib->{ $tag }{ $subfield };
3645             if ( 'HASH' eq ref $tagslib->{ $tag }{ $subfield } ) {
3646                 if ( defined $tagslib->{ $tag }{ $subfield }{'authorised_value'} && exists $bibliolevel_authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } ) {
3647                     if ( defined $record->field( $tag ) ) {
3648                         my $this_subfield_value = $record->field( $tag )->subfield( $subfield );
3649                         if ( defined $this_subfield_value ) {
3650                             $authorised_values->{ $tagslib->{ $tag }{ $subfield }{'authorised_value'} } = $this_subfield_value;
3651                         }
3652                     }
3653                 }
3654             }
3655         }
3656     }
3657     # warn ( Data::Dumper->Dump( [ $authorised_values ], [ 'authorised_values' ] ) );
3658     return $authorised_values;
3659 }
3660
3661
3662 1;
3663
3664 __END__
3665
3666 =head1 AUTHOR
3667
3668 Koha Developement team <info@koha.org>
3669
3670 Paul POULAIN paul.poulain@free.fr
3671
3672 Joshua Ferraro jmf@liblime.com
3673
3674 =cut