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