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