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