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