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