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 use C4::Charset;
  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 $check_sql = "SELECT COUNT(*) FROM zebraqueue
2099                          WHERE server = ?
2100                          AND   biblio_auth_number = ?
2101                          AND   operation = ?
2102                          AND   done = 0";
2103         my $check_sth = $dbh->prepare_cached($check_sql);
2104         $check_sth->execute($server, $biblionumber, $op);
2105         my ($count) = $check_sth->fetchrow_array;
2106         $check_sth->finish();
2107         if ($count == 0) {
2108             my $sth=$dbh->prepare("INSERT INTO zebraqueue  (biblio_auth_number,server,operation) VALUES(?,?,?)");
2109             $sth->execute($biblionumber,$server,$op);
2110             $sth->finish;
2111         }
2112     }
2113 }
2114
2115 =head2 GetNoZebraIndexes
2116
2117     %indexes = GetNoZebraIndexes;
2118
2119     return the data from NoZebraIndexes syspref.
2120
2121 =cut
2122
2123 sub GetNoZebraIndexes {
2124     my $index = C4::Context->preference('NoZebraIndexes');
2125     my %indexes;
2126     foreach my $line (split /('|"),/,$index) {
2127         $line =~ /(.*)=>(.*)/;
2128         my $index = substr($1,1); # get the index, don't forget to remove initial ' or "
2129         my $fields = $2;
2130         $index =~ s/'|"|\s//g;
2131
2132
2133         $fields =~ s/'|"|\s//g;
2134         $indexes{$index}=$fields;
2135     }
2136     return %indexes;
2137 }
2138
2139 =head1 INTERNAL FUNCTIONS
2140
2141 =head2 _DelBiblioNoZebra($biblionumber,$record,$server);
2142
2143     function to delete a biblio in NoZebra indexes
2144     This function does NOT delete anything in database : it reads all the indexes entries
2145     that have to be deleted & delete them in the hash
2146     The SQL part is done either :
2147     - after the Add if we are modifying a biblio (delete + add again)
2148     - immediatly after this sub if we are doing a true deletion.
2149     $server can be 'biblioserver' or 'authorityserver' : it indexes biblios or authorities (in the same table, $server being part of the table itself
2150
2151 =cut
2152
2153
2154 sub _DelBiblioNoZebra {
2155     my ($biblionumber, $record, $server)=@_;
2156
2157     # Get the indexes
2158     my $dbh = C4::Context->dbh;
2159     # Get the indexes
2160     my %index;
2161     my $title;
2162     if ($server eq 'biblioserver') {
2163         %index=GetNoZebraIndexes;
2164         # get title of the record (to store the 10 first letters with the index)
2165         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2166         $title = lc($record->subfield($titletag,$titlesubfield));
2167     } else {
2168         # for authorities, the "title" is the $a mainentry
2169         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2170         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2171         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2172         $index{'mainmainentry'}= $authref->{'auth_tag_to_report'}.'a';
2173         $index{'mainentry'}    = $authref->{'auth_tag_to_report'}.'*';
2174         $index{'auth_type'}    = '152b';
2175     }
2176
2177     my %result;
2178     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2179     $title =~ s/ |,|;|\[|\]|\(|\)|\*|-|'|=//g;
2180     # limit to 10 char, should be enough, and limit the DB size
2181     $title = substr($title,0,10);
2182     #parse each field
2183     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2184     foreach my $field ($record->fields()) {
2185         #parse each subfield
2186         next if $field->tag <10;
2187         foreach my $subfield ($field->subfields()) {
2188             my $tag = $field->tag();
2189             my $subfieldcode = $subfield->[0];
2190             my $indexed=0;
2191             # check each index to see if the subfield is stored somewhere
2192             # otherwise, store it in __RAW__ index
2193             foreach my $key (keys %index) {
2194 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2195                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2196                     $indexed=1;
2197                     my $line= lc $subfield->[1];
2198                     # remove meaningless value in the field...
2199                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2200                     # ... and split in words
2201                     foreach (split / /,$line) {
2202                         next unless $_; # skip  empty values (multiple spaces)
2203                         # if the entry is already here, do nothing, the biblionumber has already be removed
2204                         unless ($result{$key}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2205                             # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2206                             $sth2->execute($server,$key,$_);
2207                             my $existing_biblionumbers = $sth2->fetchrow;
2208                             # it exists
2209                             if ($existing_biblionumbers) {
2210 #                                 warn " existing for $key $_: $existing_biblionumbers";
2211                                 $result{$key}->{$_} =$existing_biblionumbers;
2212                                 $result{$key}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2213                             }
2214                         }
2215                     }
2216                 }
2217             }
2218             # the subfield is not indexed, store it in __RAW__ index anyway
2219             unless ($indexed) {
2220                 my $line= lc $subfield->[1];
2221                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:/ /g;
2222                 # ... and split in words
2223                 foreach (split / /,$line) {
2224                     next unless $_; # skip  empty values (multiple spaces)
2225                     # if the entry is already here, do nothing, the biblionumber has already be removed
2226                     unless ($result{'__RAW__'}->{$_} =~ /$biblionumber,$title\-(\d);/) {
2227                         # get the index value if it exist in the nozebra table and remove the entry, otherwise, do nothing
2228                         $sth2->execute($server,'__RAW__',$_);
2229                         my $existing_biblionumbers = $sth2->fetchrow;
2230                         # it exists
2231                         if ($existing_biblionumbers) {
2232                             $result{'__RAW__'}->{$_} =$existing_biblionumbers;
2233                             $result{'__RAW__'}->{$_} =~ s/$biblionumber,$title\-(\d);//;
2234                         }
2235                     }
2236                 }
2237             }
2238         }
2239     }
2240     return %result;
2241 }
2242
2243 =head2 _AddBiblioNoZebra($biblionumber, $record, $server, %result);
2244
2245     function to add a biblio in NoZebra indexes
2246
2247 =cut
2248
2249 sub _AddBiblioNoZebra {
2250     my ($biblionumber, $record, $server, %result)=@_;
2251     my $dbh = C4::Context->dbh;
2252     # Get the indexes
2253     my %index;
2254     my $title;
2255     if ($server eq 'biblioserver') {
2256         %index=GetNoZebraIndexes;
2257         # get title of the record (to store the 10 first letters with the index)
2258         my ($titletag,$titlesubfield) = GetMarcFromKohaField('biblio.title');
2259         $title = lc($record->subfield($titletag,$titlesubfield));
2260     } else {
2261         # warn "server : $server";
2262         # for authorities, the "title" is the $a mainentry
2263         my $authref = C4::AuthoritiesMarc::GetAuthType($record->subfield(152,'b'));
2264         warn "ERROR : authtype undefined for ".$record->as_formatted unless $authref;
2265         $title = $record->subfield($authref->{auth_tag_to_report},'a');
2266         $index{'mainmainentry'} = $authref->{auth_tag_to_report}.'a';
2267         $index{'mainentry'}     = $authref->{auth_tag_to_report}.'*';
2268         $index{'auth_type'}     = '152b';
2269     }
2270
2271     # remove blancks comma (that could cause problem when decoding the string for CQL retrieval) and regexp specific values
2272     $title =~ s/ |\.|,|;|\[|\]|\(|\)|\*|-|'|:|=|\r|\n//g;
2273     # limit to 10 char, should be enough, and limit the DB size
2274     $title = substr($title,0,10);
2275     #parse each field
2276     my $sth2=$dbh->prepare('SELECT biblionumbers FROM nozebra WHERE server=? AND indexname=? AND value=?');
2277     foreach my $field ($record->fields()) {
2278         #parse each subfield
2279         next if $field->tag <10;
2280         foreach my $subfield ($field->subfields()) {
2281             my $tag = $field->tag();
2282             my $subfieldcode = $subfield->[0];
2283             my $indexed=0;
2284             warn "INDEXING :".$subfield->[1];
2285             # check each index to see if the subfield is stored somewhere
2286             # otherwise, store it in __RAW__ index
2287             foreach my $key (keys %index) {
2288 #                 warn "examining $key index : ".$index{$key}." for $tag $subfieldcode";
2289                 if ($index{$key} =~ /$tag\*/ or $index{$key} =~ /$tag$subfieldcode/) {
2290                     $indexed=1;
2291                     my $line= lc $subfield->[1];
2292                     # remove meaningless value in the field...
2293                     $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2294                     # ... and split in words
2295                     foreach (split / /,$line) {
2296                         next unless $_; # skip  empty values (multiple spaces)
2297                         # if the entry is already here, improve weight
2298 #                         warn "managing $_";
2299                         if ($result{$key}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) {
2300                             my $weight=$1+1;
2301                             $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
2302                             $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2303                         } else {
2304                             # get the value if it exist in the nozebra table, otherwise, create it
2305                             $sth2->execute($server,$key,$_);
2306                             my $existing_biblionumbers = $sth2->fetchrow;
2307                             # it exists
2308                             if ($existing_biblionumbers) {
2309                                 $result{$key}->{"$_"} =$existing_biblionumbers;
2310                                 my $weight=$1+1;
2311                                 $result{$key}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
2312                                 $result{$key}->{"$_"} .= "$biblionumber,$title-$weight;";
2313                             # create a new ligne for this entry
2314                             } else {
2315 #                             warn "INSERT : $server / $key / $_";
2316                                 $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).', indexname='.$dbh->quote($key).',value='.$dbh->quote($_));
2317                                 $result{$key}->{"$_"}.="$biblionumber,$title-1;";
2318                             }
2319                         }
2320                     }
2321                 }
2322             }
2323             # the subfield is not indexed, store it in __RAW__ index anyway
2324             unless ($indexed) {
2325                 my $line= lc $subfield->[1];
2326                 $line =~ s/-|\.|\?|,|;|!|'|\(|\)|\[|\]|{|}|"|<|>|&|\+|\*|\/|=|:|\r|\n/ /g;
2327                 # ... and split in words
2328                 foreach (split / /,$line) {
2329                     next unless $_; # skip  empty values (multiple spaces)
2330                     # if the entry is already here, improve weight
2331                     if ($result{'__RAW__'}->{"$_"} =~ /$biblionumber,\Q$title\E\-(\d);/) {
2332                         my $weight=$1+1;
2333                         $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
2334                         $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2335                     } else {
2336                         # get the value if it exist in the nozebra table, otherwise, create it
2337                         $sth2->execute($server,'__RAW__',$_);
2338                         my $existing_biblionumbers = $sth2->fetchrow;
2339                         # it exists
2340                         if ($existing_biblionumbers) {
2341                             $result{'__RAW__'}->{"$_"} =$existing_biblionumbers;
2342                             my $weight=$1+1;
2343                             $result{'__RAW__'}->{"$_"} =~ s/$biblionumber,\Q$title\E\-(\d);//;
2344                             $result{'__RAW__'}->{"$_"} .= "$biblionumber,$title-$weight;";
2345                         # create a new ligne for this entry
2346                         } else {
2347                             $dbh->do('INSERT INTO nozebra SET server='.$dbh->quote($server).',  indexname="__RAW__",value='.$dbh->quote($_));
2348                             $result{'__RAW__'}->{"$_"}.="$biblionumber,$title-1;";
2349                         }
2350                     }
2351                 }
2352             }
2353         }
2354     }
2355     return %result;
2356 }
2357
2358
2359 =head2 _find_value
2360
2361 =over 4
2362
2363 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2364
2365 Find the given $subfield in the given $tag in the given
2366 MARC::Record $record.  If the subfield is found, returns
2367 the (indicators, value) pair; otherwise, (undef, undef) is
2368 returned.
2369
2370 PROPOSITION :
2371 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2372 I suggest we export it from this module.
2373
2374 =back
2375
2376 =cut
2377
2378 sub _find_value {
2379     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2380     my @result;
2381     my $indicator;
2382     if ( $tagfield < 10 ) {
2383         if ( $record->field($tagfield) ) {
2384             push @result, $record->field($tagfield)->data();
2385         }
2386         else {
2387             push @result, "";
2388         }
2389     }
2390     else {
2391         foreach my $field ( $record->field($tagfield) ) {
2392             my @subfields = $field->subfields();
2393             foreach my $subfield (@subfields) {
2394                 if ( @$subfield[0] eq $insubfield ) {
2395                     push @result, @$subfield[1];
2396                     $indicator = $field->indicator(1) . $field->indicator(2);
2397                 }
2398             }
2399         }
2400     }
2401     return ( $indicator, @result );
2402 }
2403
2404 =head2 _koha_marc_update_bib_ids
2405
2406 =over 4
2407
2408 _koha_marc_update_bib_ids($record, $frameworkcode, $biblionumber, $biblioitemnumber);
2409
2410 Internal function to add or update biblionumber and biblioitemnumber to
2411 the MARC XML.
2412
2413 =back
2414
2415 =cut
2416
2417 sub _koha_marc_update_bib_ids {
2418     my ($record, $frameworkcode, $biblionumber, $biblioitemnumber) = @_;
2419
2420     # we must add bibnum and bibitemnum in MARC::Record...
2421     # we build the new field with biblionumber and biblioitemnumber
2422     # we drop the original field
2423     # we add the new builded field.
2424     my ($biblio_tag, $biblio_subfield ) = GetMarcFromKohaField("biblio.biblionumber",$frameworkcode);
2425     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.biblioitemnumber",$frameworkcode);
2426
2427     if ($biblio_tag != $biblioitem_tag) {
2428         # biblionumber & biblioitemnumber are in different fields
2429
2430         # deal with biblionumber
2431         my ($new_field, $old_field);
2432         if ($biblio_tag < 10) {
2433             $new_field = MARC::Field->new( $biblio_tag, $biblionumber );
2434         } else {
2435             $new_field =
2436               MARC::Field->new( $biblio_tag, '', '',
2437                 "$biblio_subfield" => $biblionumber );
2438         }
2439
2440         # drop old field and create new one...
2441         $old_field = $record->field($biblio_tag);
2442         $record->delete_field($old_field);
2443         $record->append_fields($new_field);
2444
2445         # deal with biblioitemnumber
2446         if ($biblioitem_tag < 10) {
2447             $new_field = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
2448         } else {
2449             $new_field =
2450               MARC::Field->new( $biblioitem_tag, '', '',
2451                 "$biblioitem_subfield" => $biblioitemnumber, );
2452         }
2453         # drop old field and create new one...
2454         $old_field = $record->field($biblioitem_tag);
2455         $record->delete_field($old_field);
2456         $record->insert_fields_ordered($new_field);
2457
2458     } else {
2459         # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
2460         my $new_field = MARC::Field->new(
2461             $biblio_tag, '', '',
2462             "$biblio_subfield" => $biblionumber,
2463             "$biblioitem_subfield" => $biblioitemnumber
2464         );
2465
2466         # drop old field and create new one...
2467         my $old_field = $record->field($biblio_tag);
2468         $record->delete_field($old_field);
2469         $record->insert_fields_ordered($new_field);
2470     }
2471 }
2472
2473 =head2 _koha_marc_update_biblioitem_cn_sort
2474
2475 =over 4
2476
2477 _koha_marc_update_biblioitem_cn_sort($marc, $biblioitem, $frameworkcode);
2478
2479 =back
2480
2481 Given a MARC bib record and the biblioitem hash, update the
2482 subfield that contains a copy of the value of biblioitems.cn_sort.
2483
2484 =cut
2485
2486 sub _koha_marc_update_biblioitem_cn_sort {
2487     my $marc = shift;
2488     my $biblioitem = shift;
2489     my $frameworkcode= shift;
2490
2491     my ($biblioitem_tag, $biblioitem_subfield ) = GetMarcFromKohaField("biblioitems.cn_sort",$frameworkcode);
2492     return unless $biblioitem_tag;
2493
2494     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2495
2496     if (my $field = $marc->field($biblioitem_tag)) {
2497         $field->delete_subfield(code => $biblioitem_subfield);
2498         if ($cn_sort ne '') {
2499             $field->add_subfields($biblioitem_subfield => $cn_sort);
2500         }
2501     } else {
2502         # if we get here, no biblioitem tag is present in the MARC record, so
2503         # we'll create it if $cn_sort is not empty -- this would be
2504         # an odd combination of events, however
2505         if ($cn_sort) {
2506             $marc->insert_grouped_field(MARC::Field->new($biblioitem_tag, ' ', ' ', $biblioitem_subfield => $cn_sort));
2507         }
2508     }
2509 }
2510
2511 =head2 _koha_add_biblio
2512
2513 =over 4
2514
2515 my ($biblionumber,$error) = _koha_add_biblio($dbh,$biblioitem);
2516
2517 Internal function to add a biblio ($biblio is a hash with the values)
2518
2519 =back
2520
2521 =cut
2522
2523 sub _koha_add_biblio {
2524     my ( $dbh, $biblio, $frameworkcode ) = @_;
2525
2526     my $error;
2527
2528     # set the series flag
2529     my $serial = 0;
2530     if ( $biblio->{'seriestitle'} ) { $serial = 1 };
2531
2532     my $query =
2533         "INSERT INTO biblio
2534         SET frameworkcode = ?,
2535             author = ?,
2536             title = ?,
2537             unititle =?,
2538             notes = ?,
2539             serial = ?,
2540             seriestitle = ?,
2541             copyrightdate = ?,
2542             datecreated=NOW(),
2543             abstract = ?
2544         ";
2545     my $sth = $dbh->prepare($query);
2546     $sth->execute(
2547         $frameworkcode,
2548         $biblio->{'author'},
2549         $biblio->{'title'},
2550         $biblio->{'unititle'},
2551         $biblio->{'notes'},
2552         $serial,
2553         $biblio->{'seriestitle'},
2554         $biblio->{'copyrightdate'},
2555         $biblio->{'abstract'}
2556     );
2557
2558     my $biblionumber = $dbh->{'mysql_insertid'};
2559     if ( $dbh->errstr ) {
2560         $error.="ERROR in _koha_add_biblio $query".$dbh->errstr;
2561         warn $error;
2562     }
2563
2564     $sth->finish();
2565     #warn "LEAVING _koha_add_biblio: ".$biblionumber."\n";
2566     return ($biblionumber,$error);
2567 }
2568
2569 =head2 _koha_modify_biblio
2570
2571 =over 4
2572
2573 my ($biblionumber,$error) == _koha_modify_biblio($dbh,$biblio,$frameworkcode);
2574
2575 Internal function for updating the biblio table
2576
2577 =back
2578
2579 =cut
2580
2581 sub _koha_modify_biblio {
2582     my ( $dbh, $biblio, $frameworkcode ) = @_;
2583     my $error;
2584
2585     my $query = "
2586         UPDATE biblio
2587         SET    frameworkcode = ?,
2588                author = ?,
2589                title = ?,
2590                unititle = ?,
2591                notes = ?,
2592                serial = ?,
2593                seriestitle = ?,
2594                copyrightdate = ?,
2595                abstract = ?
2596         WHERE  biblionumber = ?
2597         "
2598     ;
2599     my $sth = $dbh->prepare($query);
2600
2601     $sth->execute(
2602         $frameworkcode,
2603         $biblio->{'author'},
2604         $biblio->{'title'},
2605         $biblio->{'unititle'},
2606         $biblio->{'notes'},
2607         $biblio->{'serial'},
2608         $biblio->{'seriestitle'},
2609         $biblio->{'copyrightdate'},
2610         $biblio->{'abstract'},
2611         $biblio->{'biblionumber'}
2612     ) if $biblio->{'biblionumber'};
2613
2614     if ( $dbh->errstr || !$biblio->{'biblionumber'} ) {
2615         $error.="ERROR in _koha_modify_biblio $query".$dbh->errstr;
2616         warn $error;
2617     }
2618     return ( $biblio->{'biblionumber'},$error );
2619 }
2620
2621 =head2 _koha_modify_biblioitem_nonmarc
2622
2623 =over 4
2624
2625 my ($biblioitemnumber,$error) = _koha_modify_biblioitem_nonmarc( $dbh, $biblioitem );
2626
2627 Updates biblioitems row except for marc and marcxml, which should be changed
2628 via ModBiblioMarc
2629
2630 =back
2631
2632 =cut
2633
2634 sub _koha_modify_biblioitem_nonmarc {
2635     my ( $dbh, $biblioitem ) = @_;
2636     my $error;
2637
2638     # re-calculate the cn_sort, it may have changed
2639     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2640
2641     my $query =
2642     "UPDATE biblioitems
2643     SET biblionumber    = ?,
2644         volume          = ?,
2645         number          = ?,
2646         itemtype        = ?,
2647         isbn            = ?,
2648         issn            = ?,
2649         publicationyear = ?,
2650         publishercode   = ?,
2651         volumedate      = ?,
2652         volumedesc      = ?,
2653         collectiontitle = ?,
2654         collectionissn  = ?,
2655         collectionvolume= ?,
2656         editionstatement= ?,
2657         editionresponsibility = ?,
2658         illus           = ?,
2659         pages           = ?,
2660         notes           = ?,
2661         size            = ?,
2662         place           = ?,
2663         lccn            = ?,
2664         url             = ?,
2665         cn_source       = ?,
2666         cn_class        = ?,
2667         cn_item         = ?,
2668         cn_suffix       = ?,
2669         cn_sort         = ?,
2670         totalissues     = ?
2671         where biblioitemnumber = ?
2672         ";
2673     my $sth = $dbh->prepare($query);
2674     $sth->execute(
2675         $biblioitem->{'biblionumber'},
2676         $biblioitem->{'volume'},
2677         $biblioitem->{'number'},
2678         $biblioitem->{'itemtype'},
2679         $biblioitem->{'isbn'},
2680         $biblioitem->{'issn'},
2681         $biblioitem->{'publicationyear'},
2682         $biblioitem->{'publishercode'},
2683         $biblioitem->{'volumedate'},
2684         $biblioitem->{'volumedesc'},
2685         $biblioitem->{'collectiontitle'},
2686         $biblioitem->{'collectionissn'},
2687         $biblioitem->{'collectionvolume'},
2688         $biblioitem->{'editionstatement'},
2689         $biblioitem->{'editionresponsibility'},
2690         $biblioitem->{'illus'},
2691         $biblioitem->{'pages'},
2692         $biblioitem->{'bnotes'},
2693         $biblioitem->{'size'},
2694         $biblioitem->{'place'},
2695         $biblioitem->{'lccn'},
2696         $biblioitem->{'url'},
2697         $biblioitem->{'biblioitems.cn_source'},
2698         $biblioitem->{'cn_class'},
2699         $biblioitem->{'cn_item'},
2700         $biblioitem->{'cn_suffix'},
2701         $cn_sort,
2702         $biblioitem->{'totalissues'},
2703         $biblioitem->{'biblioitemnumber'}
2704     );
2705     if ( $dbh->errstr ) {
2706         $error.="ERROR in _koha_modify_biblioitem_nonmarc $query".$dbh->errstr;
2707         warn $error;
2708     }
2709     return ($biblioitem->{'biblioitemnumber'},$error);
2710 }
2711
2712 =head2 _koha_add_biblioitem
2713
2714 =over 4
2715
2716 my ($biblioitemnumber,$error) = _koha_add_biblioitem( $dbh, $biblioitem );
2717
2718 Internal function to add a biblioitem
2719
2720 =back
2721
2722 =cut
2723
2724 sub _koha_add_biblioitem {
2725     my ( $dbh, $biblioitem ) = @_;
2726     my $error;
2727
2728     my ($cn_sort) = GetClassSort($biblioitem->{'biblioitems.cn_source'}, $biblioitem->{'cn_class'}, $biblioitem->{'cn_item'} );
2729     my $query =
2730     "INSERT INTO biblioitems SET
2731         biblionumber    = ?,
2732         volume          = ?,
2733         number          = ?,
2734         itemtype        = ?,
2735         isbn            = ?,
2736         issn            = ?,
2737         publicationyear = ?,
2738         publishercode   = ?,
2739         volumedate      = ?,
2740         volumedesc      = ?,
2741         collectiontitle = ?,
2742         collectionissn  = ?,
2743         collectionvolume= ?,
2744         editionstatement= ?,
2745         editionresponsibility = ?,
2746         illus           = ?,
2747         pages           = ?,
2748         notes           = ?,
2749         size            = ?,
2750         place           = ?,
2751         lccn            = ?,
2752         marc            = ?,
2753         url             = ?,
2754         cn_source       = ?,
2755         cn_class        = ?,
2756         cn_item         = ?,
2757         cn_suffix       = ?,
2758         cn_sort         = ?,
2759         totalissues     = ?
2760         ";
2761     my $sth = $dbh->prepare($query);
2762     $sth->execute(
2763         $biblioitem->{'biblionumber'},
2764         $biblioitem->{'volume'},
2765         $biblioitem->{'number'},
2766         $biblioitem->{'itemtype'},
2767         $biblioitem->{'isbn'},
2768         $biblioitem->{'issn'},
2769         $biblioitem->{'publicationyear'},
2770         $biblioitem->{'publishercode'},
2771         $biblioitem->{'volumedate'},
2772         $biblioitem->{'volumedesc'},
2773         $biblioitem->{'collectiontitle'},
2774         $biblioitem->{'collectionissn'},
2775         $biblioitem->{'collectionvolume'},
2776         $biblioitem->{'editionstatement'},
2777         $biblioitem->{'editionresponsibility'},
2778         $biblioitem->{'illus'},
2779         $biblioitem->{'pages'},
2780         $biblioitem->{'bnotes'},
2781         $biblioitem->{'size'},
2782         $biblioitem->{'place'},
2783         $biblioitem->{'lccn'},
2784         $biblioitem->{'marc'},
2785         $biblioitem->{'url'},
2786         $biblioitem->{'biblioitems.cn_source'},
2787         $biblioitem->{'cn_class'},
2788         $biblioitem->{'cn_item'},
2789         $biblioitem->{'cn_suffix'},
2790         $cn_sort,
2791         $biblioitem->{'totalissues'}
2792     );
2793     my $bibitemnum = $dbh->{'mysql_insertid'};
2794     if ( $dbh->errstr ) {
2795         $error.="ERROR in _koha_add_biblioitem $query".$dbh->errstr;
2796         warn $error;
2797     }
2798     $sth->finish();
2799     return ($bibitemnum,$error);
2800 }
2801
2802 =head2 _koha_delete_biblio
2803
2804 =over 4
2805
2806 $error = _koha_delete_biblio($dbh,$biblionumber);
2807
2808 Internal sub for deleting from biblio table -- also saves to deletedbiblio
2809
2810 C<$dbh> - the database handle
2811 C<$biblionumber> - the biblionumber of the biblio to be deleted
2812
2813 =back
2814
2815 =cut
2816
2817 # FIXME: add error handling
2818
2819 sub _koha_delete_biblio {
2820     my ( $dbh, $biblionumber ) = @_;
2821
2822     # get all the data for this biblio
2823     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
2824     $sth->execute($biblionumber);
2825
2826     if ( my $data = $sth->fetchrow_hashref ) {
2827
2828         # save the record in deletedbiblio
2829         # find the fields to save
2830         my $query = "INSERT INTO deletedbiblio SET ";
2831         my @bind  = ();
2832         foreach my $temp ( keys %$data ) {
2833             $query .= "$temp = ?,";
2834             push( @bind, $data->{$temp} );
2835         }
2836
2837         # replace the last , by ",?)"
2838         $query =~ s/\,$//;
2839         my $bkup_sth = $dbh->prepare($query);
2840         $bkup_sth->execute(@bind);
2841         $bkup_sth->finish;
2842
2843         # delete the biblio
2844         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
2845         $del_sth->execute($biblionumber);
2846         $del_sth->finish;
2847     }
2848     $sth->finish;
2849     return undef;
2850 }
2851
2852 =head2 _koha_delete_biblioitems
2853
2854 =over 4
2855
2856 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
2857
2858 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
2859
2860 C<$dbh> - the database handle
2861 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
2862
2863 =back
2864
2865 =cut
2866
2867 # FIXME: add error handling
2868
2869 sub _koha_delete_biblioitems {
2870     my ( $dbh, $biblioitemnumber ) = @_;
2871
2872     # get all the data for this biblioitem
2873     my $sth =
2874       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
2875     $sth->execute($biblioitemnumber);
2876
2877     if ( my $data = $sth->fetchrow_hashref ) {
2878
2879         # save the record in deletedbiblioitems
2880         # find the fields to save
2881         my $query = "INSERT INTO deletedbiblioitems SET ";
2882         my @bind  = ();
2883         foreach my $temp ( keys %$data ) {
2884             $query .= "$temp = ?,";
2885             push( @bind, $data->{$temp} );
2886         }
2887
2888         # replace the last , by ",?)"
2889         $query =~ s/\,$//;
2890         my $bkup_sth = $dbh->prepare($query);
2891         $bkup_sth->execute(@bind);
2892         $bkup_sth->finish;
2893
2894         # delete the biblioitem
2895         my $del_sth =
2896           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
2897         $del_sth->execute($biblioitemnumber);
2898         $del_sth->finish;
2899     }
2900     $sth->finish;
2901     return undef;
2902 }
2903
2904 =head1 UNEXPORTED FUNCTIONS
2905
2906 =head2 ModBiblioMarc
2907
2908     &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
2909
2910     Add MARC data for a biblio to koha
2911
2912     Function exported, but should NOT be used, unless you really know what you're doing
2913
2914 =cut
2915
2916 sub ModBiblioMarc {
2917
2918 # pass the MARC::Record to this function, and it will create the records in the marc field
2919     my ( $record, $biblionumber, $frameworkcode ) = @_;
2920     my $dbh = C4::Context->dbh;
2921     my @fields = $record->fields();
2922     if ( !$frameworkcode ) {
2923         $frameworkcode = "";
2924     }
2925     my $sth =
2926       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
2927     $sth->execute( $frameworkcode, $biblionumber );
2928     $sth->finish;
2929     my $encoding = C4::Context->preference("marcflavour");
2930
2931     # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
2932     if ( $encoding eq "UNIMARC" ) {
2933         my $string;
2934         if ( length($record->subfield( 100, "a" )) == 35 ) {
2935             $string = $record->subfield( 100, "a" );
2936             my $f100 = $record->field(100);
2937             $record->delete_field($f100);
2938         }
2939         else {
2940             $string = POSIX::strftime( "%Y%m%d", localtime );
2941             $string =~ s/\-//g;
2942             $string = sprintf( "%-*s", 35, $string );
2943         }
2944         substr( $string, 22, 6, "frey50" );
2945         unless ( $record->subfield( 100, "a" ) ) {
2946             $record->insert_grouped_field(
2947                 MARC::Field->new( 100, "", "", "a" => $string ) );
2948         }
2949     }
2950     ModZebra($biblionumber,"specialUpdate","biblioserver",$record);
2951     $sth =
2952       $dbh->prepare(
2953         "UPDATE biblioitems SET marc=?,marcxml=? WHERE biblionumber=?");
2954     $sth->execute( $record->as_usmarc(), $record->as_xml_record($encoding),
2955         $biblionumber );
2956     $sth->finish;
2957     return $biblionumber;
2958 }
2959
2960 =head2 z3950_extended_services
2961
2962 z3950_extended_services($serviceType,$serviceOptions,$record);
2963
2964     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.
2965
2966 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
2967
2968 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
2969
2970     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
2971
2972 and maybe
2973
2974     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
2975     syntax => the record syntax (transfer syntax)
2976     databaseName = Database from connection object
2977
2978     To set serviceOptions, call set_service_options($serviceType)
2979
2980 C<$record> the record, if one is needed for the service type
2981
2982     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
2983
2984 =cut
2985
2986 sub z3950_extended_services {
2987     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
2988
2989     # get our connection object
2990     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
2991
2992     # create a new package object
2993     my $Zpackage = $Zconn->package();
2994
2995     # set our options
2996     $Zpackage->option( action => $action );
2997
2998     if ( $serviceOptions->{'databaseName'} ) {
2999         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3000     }
3001     if ( $serviceOptions->{'recordIdNumber'} ) {
3002         $Zpackage->option(
3003             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3004     }
3005     if ( $serviceOptions->{'recordIdOpaque'} ) {
3006         $Zpackage->option(
3007             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3008     }
3009
3010  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3011  #if ($serviceType eq 'itemorder') {
3012  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3013  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3014  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3015  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3016  #}
3017
3018     if ( $serviceOptions->{record} ) {
3019         $Zpackage->option( record => $serviceOptions->{record} );
3020
3021         # can be xml or marc
3022         if ( $serviceOptions->{'syntax'} ) {
3023             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3024         }
3025     }
3026
3027     # send the request, handle any exception encountered
3028     eval { $Zpackage->send($serviceType) };
3029     if ( $@ && $@->isa("ZOOM::Exception") ) {
3030         return "error:  " . $@->code() . " " . $@->message() . "\n";
3031     }
3032
3033     # free up package resources
3034     $Zpackage->destroy();
3035 }
3036
3037 =head2 set_service_options
3038
3039 my $serviceOptions = set_service_options($serviceType);
3040
3041 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3042
3043 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3044
3045 =cut
3046
3047 sub set_service_options {
3048     my ($serviceType) = @_;
3049     my $serviceOptions;
3050
3051 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3052 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3053
3054     if ( $serviceType eq 'commit' ) {
3055
3056         # nothing to do
3057     }
3058     if ( $serviceType eq 'create' ) {
3059
3060         # nothing to do
3061     }
3062     if ( $serviceType eq 'drop' ) {
3063         die "ERROR: 'drop' not currently supported (by Zebra)";
3064     }
3065     return $serviceOptions;
3066 }
3067
3068 1;
3069
3070 __END__
3071
3072 =head1 AUTHOR
3073
3074 Koha Developement team <info@koha.org>
3075
3076 Paul POULAIN paul.poulain@free.fr
3077
3078 Joshua Ferraro jmf@liblime.com
3079
3080 =cut