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