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