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