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