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
  22 require Exporter;
  23 use C4::Context;
  24 use MARC::Record;
  25 use MARC::File::USMARC;
  26 use MARC::File::XML;
  27 use ZOOM;
  28 use C4::Koha;
  29 use C4::Date;
  30 use utf8;
  31 use C4::Log; # logaction
  32
  33 use vars qw($VERSION @ISA @EXPORT);
  34
  35 # set the version for version checking
  36 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
  37
  38 @ISA = qw( Exporter );
  39
  40 # EXPORTED FUNCTIONS.
  41
  42 # to add biblios or items
  43 push @EXPORT, qw( &AddBiblio &AddItem );
  44
  45 # to get something
  46 push @EXPORT, qw(
  47   &GetBiblio
  48   &GetBiblioData
  49   &GetBiblioItemData
  50   &GetBiblioItemInfosOf
  51   &GetBiblioItemByBiblioNumber
  52   &GetBiblioFromItemNumber
  53
  54   &GetMarcItem
  55   &GetItemInfosOf
  56   &GetItemStatus
  57   &GetItemLocation
  58
  59   &GetMarcNotes
  60   &GetMarcSubjects
  61   &GetMarcBiblio
  62   &GetMarcAuthors
  63   &GetMarcSeries
  64
  65   &GetItemsInfo
  66   &GetItemFromBarcode
  67   &get_itemnumbers_of
  68   &GetXmlBiblio
  69
  70   &GetAuthorisedValueDesc
  71   &GetMarcStructure
  72   &GetMarcFromKohaField
  73   &GetFrameworkCode
  74   &TransformKohaToMarc
  75 );
  76
  77 # To modify something
  78 push @EXPORT, qw(
  79   &ModBiblio
  80   &ModItem
  81   &ModBiblioframework
  82   &ModZebra
  83   &ModItemInMarc
  84   &ModItemInMarconefield
  85 );
  86
  87 # To delete something
  88 push @EXPORT, qw(
  89   &DelBiblio
  90   &DelItem
  91 );
  92
  93 # Internal functions
  94 # those functions are exported but should not be used
  95 # they are usefull is few circumstances, so are exported.
  96 # but don't use them unless you're a core developer ;-)
  97 push @EXPORT, qw(
  98   &ModBiblioMarc
  99   &AddItemInMarc
 100   &calculatelc
 101   &itemcalculator
 102 );
 103
 104 # Others functions
 105 push @EXPORT, qw(
 106   &TransformMarcToKoha
 107   &TransformHtmlToMarc
 108   &TransformHtmlToXml
 109   &PrepareItemrecordDisplay
 110   &char_decode
 111 );
 112
 113 =head1 NAME
 114
 115 C4::Biblio - cataloging management functions
 116
 117 =head1 DESCRIPTION
 118
 119 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:
 120
 121 =over 4
 122
 123 =item 1. in the biblio,biblioitems,items, etc tables, which are limited to a one-to-one mapping to underlying MARC data
 124
 125 =item 2. as raw MARC in the Zebra index and storage engine
 126
 127 =item 3. as raw MARC the biblioitems.marc and biblioitems.marcxml
 128
 129 =back
 130
 131 In the 3.0 version of Koha, the authoritative record-level information is in biblioitems.marcxml
 132
 133 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.
 134
 135 =over 4
 136
 137 =item 1. Compared with MySQL, Zebra is slow to update an index for small data changes -- especially for proc-intensive operations like circulation
 138
 139 =item 2. Zebra's index has been known to crash and a backup of the data is necessary to rebuild it in such cases
 140
 141 =back
 142
 143 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:
 144
 145 =over 4
 146
 147 =item 1. Add*/Mod*/Del*/ - high-level external functions suitable for being called from external scripts to manage the collection
 148
 149 =item 2. _koha_* - low-level internal functions for managing the koha tables
 150
 151 =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.
 152
 153 =item 4. Zebra functions used to update the Zebra index
 154
 155 =item 5. internal helper functions such as char_decode, checkitems, etc. Some of these probably belong in Koha.pm
 156
 157 =back
 158
 159 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 :
 160
 161 =over 4
 162
 163 =item 1. save datas in biblio and biblioitems table, that gives us a biblionumber and a biblioitemnumber
 164
 165 =item 2. add the biblionumber and biblioitemnumber into the MARC records
 166
 167 =item 3. save the marc record
 168
 169 =back
 170
 171 When dealing with items, we must :
 172
 173 =over 4
 174
 175 =item 1. save the item in items table, that gives us an itemnumber
 176
 177 =item 2. add the itemnumber to the item MARC field
 178
 179 =item 3. overwrite the MARC record (with the added item) into biblioitems.marc(xml)
 180
 181 When modifying a biblio or an item, the behaviour is quite similar.
 182
 183 =back
 184
 185 =head1 EXPORTED FUNCTIONS
 186
 187 =head2 AddBiblio
 188
 189 =over 4
 190
 191 ($biblionumber,$biblioitemnumber) = AddBiblio($record,$frameworkcode);
 192 Exported function (core API) for adding a new biblio to koha.
 193
 194 =back
 195
 196 =cut
 197
 198 sub AddBiblio {
 199     my ( $record, $frameworkcode ) = @_;
 200     my $biblionumber;
 201     my $biblioitemnumber;
 202     my $dbh = C4::Context->dbh;
 203     # transform the data into koha-table style data
 204     my $olddata = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 205     $biblionumber = _koha_add_biblio( $dbh, $olddata, $frameworkcode );
 206     $olddata->{'biblionumber'} = $biblionumber;
 207     $biblioitemnumber = _koha_add_biblioitem( $dbh, $olddata );
 208
 209     # we must add bibnum and bibitemnum in MARC::Record...
 210     # we build the new field with biblionumber and biblioitemnumber
 211     # we drop the original field
 212     # we add the new builded field.
 213     ( my $biblio_tag, my $biblio_subfield ) = GetMarcFromKohaField($dbh,"biblio.biblionumber",$frameworkcode);
 214     ( my $biblioitem_tag, my $biblioitem_subfield ) = GetMarcFromKohaField($dbh,"biblioitems.biblioitemnumber",$frameworkcode);
 215
 216     my $newfield;
 217
 218     # biblionumber & biblioitemnumber are in different fields
 219     if ( $biblio_tag != $biblioitem_tag ) {
 220
 221         # deal with biblionumber
 222         if ( $biblio_tag < 10 ) {
 223             $newfield = MARC::Field->new( $biblio_tag, $biblionumber );
 224         }
 225         else {
 226             $newfield =
 227               MARC::Field->new( $biblio_tag, '', '',
 228                 "$biblio_subfield" => $biblionumber );
 229         }
 230
 231         # drop old field and create new one...
 232         my $old_field = $record->field($biblio_tag);
 233         $record->delete_field($old_field);
 234         $record->append_fields($newfield);
 235
 236         # deal with biblioitemnumber
 237         if ( $biblioitem_tag < 10 ) {
 238             $newfield = MARC::Field->new( $biblioitem_tag, $biblioitemnumber, );
 239         }
 240         else {
 241             $newfield =
 242               MARC::Field->new( $biblioitem_tag, '', '',
 243                 "$biblioitem_subfield" => $biblioitemnumber, );
 244         }
 245         # drop old field and create new one...
 246         $old_field = $record->field($biblioitem_tag);
 247         $record->delete_field($old_field);
 248         $record->insert_fields_ordered($newfield);
 249
 250 # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
 251     }
 252     else {
 253         my $newfield = MARC::Field->new(
 254             $biblio_tag, '', '',
 255             "$biblio_subfield" => $biblionumber,
 256             "$biblioitem_subfield" => $biblioitemnumber
 257         );
 258
 259         # drop old field and create new one...
 260         my $old_field = $record->field($biblio_tag);
 261         $record->delete_field($old_field);
 262         $record->insert_fields_ordered($newfield);
 263     }
 264
 265     # now add the record
 266     my $biblionumber =
 267       ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 268
 269     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$biblionumber,"biblio")
 270         if C4::Context->preference("CataloguingLog");
 271
 272     return ( $biblionumber, $biblioitemnumber );
 273 }
 274
 275 =head2 AddItem
 276
 277 =over
 278
 279 $biblionumber = AddItem( $record, $biblionumber)
 280 Exported function (core API) for adding a new item to Koha
 281
 282 =back
 283
 284 =cut
 285
 286 sub AddItem {
 287     my ( $record, $biblionumber ) = @_;
 288     my $dbh = C4::Context->dbh;
 289
 290     # add item in old-DB
 291     my $frameworkcode = GetFrameworkCode( $biblionumber );
 292     my $item = &TransformMarcToKoha( $dbh, $record, $frameworkcode );
 293
 294     # needs old biblionumber and biblioitemnumber
 295     $item->{'biblionumber'} = $biblionumber;
 296     my $sth =
 297       $dbh->prepare(
 298         "select biblioitemnumber,itemtype from biblioitems where biblionumber=?"
 299       );
 300     $sth->execute( $item->{'biblionumber'} );
 301     my $itemtype;
 302     ( $item->{'biblioitemnumber'}, $itemtype ) = $sth->fetchrow;
 303     $sth =
 304       $dbh->prepare(
 305         "select notforloan from itemtypes where itemtype='$itemtype'");
 306     $sth->execute();
 307     my $notforloan = $sth->fetchrow;
 308     ##Change the notforloan field if $notforloan found
 309     if ( $notforloan > 0 ) {
 310         $item->{'notforloan'} = $notforloan;
 311         &MARCitemchange( $record, "items.notforloan", $notforloan );
 312     }
 313     if ( !$item->{'dateaccessioned'} || $item->{'dateaccessioned'} eq '' ) {
 314
 315         # find today's date
 316         my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
 317           localtime(time);
 318         $year += 1900;
 319         $mon  += 1;
 320         my $date =
 321           "$year-" . sprintf( "%0.2d", $mon ) . "-" . sprintf( "%0.2d", $mday );
 322         $item->{'dateaccessioned'} = $date;
 323         &MARCitemchange( $record, "items.dateaccessioned", $date );
 324     }
 325     my ( $itemnumber, $error ) =
 326       &_koha_new_items( $dbh, $item, $item->{barcode} );
 327
 328     # add itemnumber to MARC::Record before adding the item.
 329     $sth =
 330       $dbh->prepare(
 331 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
 332       );
 333     &TransformKohaToMarcOneField( $sth, $record, "items.itemnumber", $itemnumber,
 334         $frameworkcode );
 335
 336     # add the item
 337     &AddItemInMarc( $record, $item->{'biblionumber'},$frameworkcode );
 338
 339     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","ADD",$itemnumber,"item")
 340         if C4::Context->preference("CataloguingLog");
 341
 342     return ($item->{biblionumber}, $item->{biblioitemnumber},$itemnumber);
 343 }
 344
 345 =head2 ModBiblio
 346
 347 =over
 348
 349 ModBiblio( $record,$biblionumber,$frameworkcode);
 350 Exported function (core API) to modify a biblio
 351
 352 =back
 353
 354 =cut
 355
 356 sub ModBiblio {
 357     my ( $record, $biblionumber, $frameworkcode ) = @_;
 358
 359     if (C4::Context->preference("CataloguingLog")) {
 360         my $newrecord = GetMarcBiblio($biblionumber);
 361         &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$biblionumber,$newrecord->as_formatted)
 362     }
 363
 364     my $dbh = C4::Context->dbh;
 365
 366     $frameworkcode = "" unless $frameworkcode;
 367
 368     # update the MARC record with the new record data
 369     &ModBiblioMarc($record, $biblionumber, $frameworkcode );
 370
 371     # load the koha-table data object
 372     my $oldbiblio = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 373
 374     # modify the other koha tables
 375     my $biblionumber = _koha_modify_biblio( $dbh, $oldbiblio );
 376     _koha_modify_biblioitem( $dbh, $oldbiblio );
 377
 378     return 1;
 379 }
 380
 381 =head2 ModItem
 382
 383 =over
 384
 385 Exported function (core API) for modifying an item in Koha.
 386
 387 =back
 388
 389 =cut
 390
 391 sub ModItem {
 392     my ( $record, $biblionumber, $itemnumber, $delete, $new_item_hashref )
 393       = @_;
 394
 395     #logging
 396     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","MODIFY",$itemnumber,$record->as_formatted)
 397         if C4::Context->preference("CataloguingLog");
 398
 399     my $dbh = C4::Context->dbh;
 400
 401     # if we have a MARC record, we're coming from cataloging and so
 402     # we do the whole routine: update the MARC and zebra, then update the koha
 403     # tables
 404     if ($record) {
 405         my $frameworkcode = GetFrameworkCode( $biblionumber );
 406         ModItemInMarc( $record, $biblionumber, $itemnumber, $frameworkcode );
 407         my $olditem       = TransformMarcToKoha( $dbh, $record, $frameworkcode );
 408         _koha_modify_item( $dbh, $olditem );
 409         return $biblionumber;
 410     }
 411
 412     # otherwise, we're just looking to modify something quickly
 413     # (like a status) so we just update the koha tables
 414     elsif ($new_item_hashref) {
 415         _koha_modify_item( $dbh, $new_item_hashref );
 416     }
 417 }
 418
 419 =head2 ModBiblioframework
 420
 421 =over
 422
 423 ModBiblioframework($biblionumber,$frameworkcode);
 424 Exported function to modify a biblio framework
 425
 426 =back
 427
 428 =cut
 429
 430 sub ModBiblioframework {
 431     my ( $biblionumber, $frameworkcode ) = @_;
 432     my $dbh = C4::Context->dbh;
 433     my $sth =
 434       $dbh->prepare(
 435         "UPDATE biblio SET frameworkcode=? WHERE biblionumber=$biblionumber");
 436     $sth->execute($frameworkcode);
 437     return 1;
 438 }
 439
 440 =head2 ModItemInMarconefield
 441
 442 =over
 443
 444 modify only 1 field in a MARC item (mainly used for holdingbranch, but could also be used for status modif - moving a book to "lost" on a long overdu for example)
 445 &ModItemInMarconefield( $biblionumber, $itemnumber, $itemfield, $newvalue )
 446
 447 =back
 448
 449 =cut
 450
 451 sub ModItemInMarconefield {
 452     my ( $biblionumber, $itemnumber, $itemfield, $newvalue ) = @_;
 453     my $dbh = C4::Context->dbh;
 454     if ( !defined $newvalue ) {
 455         $newvalue = "";
 456     }
 457
 458     my $record = GetMarcItem( $biblionumber, $itemnumber );
 459     my ($tagfield, $tagsubfield) = GetMarcFromKohaField($dbh, $itemfield,'');
 460     if ($tagfield && $tagsubfield) {
 461         my $tag = $record->field($tagfield);
 462         if ($tag) {
 463 #             my $tagsubs = $record->field($tagfield)->subfield($tagsubfield);
 464             $tag->update( $tagsubfield => $newvalue );
 465             $record->delete_field($tag);
 466             $record->insert_fields_ordered($tag);
 467             &ModItemInMarc( $record, $biblionumber, $itemnumber, 0 );
 468         }
 469     }
 470 }
 471
 472 =head2 ModItemInMarc
 473
 474 =over
 475
 476 &ModItemInMarc( $record, $biblionumber, $itemnumber )
 477
 478 =back
 479
 480 =cut
 481
 482 sub ModItemInMarc {
 483     my ( $ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
 484     my $dbh = C4::Context->dbh;
 485
 486     # get complete MARC record & replace the item field by the new one
 487     my $completeRecord = GetMarcBiblio($biblionumber);
 488     my ($itemtag,$itemsubfield) = GetMarcFromKohaField($dbh,"items.itemnumber",$frameworkcode);
 489     my $itemField = $ItemRecord->field($itemtag);
 490     my @items = $completeRecord->field($itemtag);
 491     foreach (@items) {
 492         if ($_->subfield($itemsubfield) eq $itemnumber) {
 493 #             $completeRecord->delete_field($_);
 494             $_->replace_with($itemField);
 495         }
 496     }
 497     # save the record
 498     my $sth = $dbh->prepare("update biblioitems set marc=?,marcxml=?  where biblionumber=?");
 499     $sth->execute( $completeRecord->as_usmarc(), $completeRecord->as_xml_record(),$biblionumber );
 500     $sth->finish;
 501     ModZebra($biblionumber,"specialUpdate","biblioserver");
 502 }
 503
 504 =head2 DelBiblio
 505
 506 =over
 507
 508 my $error = &DelBiblio($dbh,$biblionumber);
 509 Exported function (core API) for deleting a biblio in koha.
 510 Deletes biblio record from Zebra and Koha tables (biblio,biblioitems,items)
 511 Also backs it up to deleted* tables
 512 Checks to make sure there are not issues on any of the items
 513 return:
 514 C<$error> : undef unless an error occurs
 515
 516 =back
 517
 518 =cut
 519
 520 sub DelBiblio {
 521     my ( $biblionumber ) = @_;
 522     my $dbh = C4::Context->dbh;
 523     my $error;    # for error handling
 524
 525     # First make sure there are no items with issues are still attached
 526     my $sth =
 527       $dbh->prepare(
 528         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 529     $sth->execute($biblionumber);
 530     while ( my $biblioitemnumber = $sth->fetchrow ) {
 531         my @issues = C4::Circulation::Circ2::itemissues($biblioitemnumber);
 532         foreach my $issue (@issues) {
 533             if (   ( $issue->{date_due} )
 534                 && ( $issue->{date_due} ne "Available" ) )
 535             {
 536
 537 #FIXME: we need a status system in Biblio like in Circ to return standard codes and messages
 538 # instead of hard-coded strings
 539                 $error .=
 540 "Item is checked out to a patron -- you must return it before deleting the Biblio";
 541             }
 542         }
 543     }
 544     return $error if $error;
 545
 546     # Delete in Zebra
 547     ModZebra($biblionumber,"delete_record","biblioserver");
 548
 549     # delete biblio from Koha tables and save in deletedbiblio
 550     $error = &_koha_delete_biblio( $dbh, $biblionumber );
 551
 552     # delete biblioitems and items from Koha tables and save in deletedbiblioitems,deleteditems
 553     $sth =
 554       $dbh->prepare(
 555         "SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 556     $sth->execute($biblionumber);
 557     while ( my $biblioitemnumber = $sth->fetchrow ) {
 558
 559         # delete this biblioitem
 560         $error = &_koha_delete_biblioitems( $dbh, $biblioitemnumber );
 561         return $error if $error;
 562
 563         # delete items
 564         my $items_sth =
 565           $dbh->prepare(
 566             "SELECT itemnumber FROM items WHERE biblioitemnumber=?");
 567         $items_sth->execute($biblioitemnumber);
 568         while ( my $itemnumber = $items_sth->fetchrow ) {
 569             $error = &_koha_delete_item( $dbh, $itemnumber );
 570             return $error if $error;
 571         }
 572     }
 573     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$biblionumber,"")
 574         if C4::Context->preference("CataloguingLog");
 575     return;
 576 }
 577
 578 =head2 DelItem
 579
 580 =over
 581
 582 DelItem( $biblionumber, $itemnumber );
 583 Exported function (core API) for deleting an item record in Koha.
 584
 585 =back
 586
 587 =cut
 588
 589 sub DelItem {
 590     my ( $biblionumber, $itemnumber ) = @_;
 591     my $dbh = C4::Context->dbh;
 592     &_koha_delete_item( $dbh, $itemnumber );
 593     # get the MARC record
 594     my $record = GetMarcBiblio($biblionumber);
 595     my $frameworkcode = GetFrameworkCode($biblionumber);
 596
 597     # backup the record
 598     my $copy2deleted =
 599       $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
 600     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 601
 602     #search item field code
 603     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField($dbh,"items.itemnumber",$frameworkcode);
 604     my @fields = $record->field($itemtag);
 605     # delete the item specified
 606     foreach my $field (@fields) {
 607         if ( $field->subfield($itemsubfield) eq $itemnumber ) {
 608             $record->delete_field($field);
 609         }
 610     }
 611     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 612     &logaction(C4::Context->userenv->{'number'},"CATALOGUING","DELETE",$itemnumber,"item")
 613         if C4::Context->preference("CataloguingLog");
 614 }
 615
 616 =head2 GetBiblioData
 617
 618 =over 4
 619
 620 $data = &GetBiblioData($biblionumber);
 621 Returns information about the book with the given biblionumber.
 622 C<&GetBiblioData> returns a reference-to-hash. The keys are the fields in
 623 the C<biblio> and C<biblioitems> tables in the
 624 Koha database.
 625 In addition, C<$data-E<gt>{subject}> is the list of the book's
 626 subjects, separated by C<" , "> (space, comma, space).
 627 If there are multiple biblioitems with the given biblionumber, only
 628 the first one is considered.
 629
 630 =back
 631
 632 =cut
 633
 634 sub GetBiblioData {
 635     my ( $bibnum ) = @_;
 636     my $dbh = C4::Context->dbh;
 637
 638     my $query = "
 639         SELECT * , biblioitems.notes AS bnotes, biblio.notes
 640         FROM biblio
 641             LEFT JOIN biblioitems ON biblio.biblionumber = biblioitems.biblionumber
 642             LEFT JOIN itemtypes ON biblioitems.itemtype = itemtypes.itemtype
 643         WHERE biblio.biblionumber = ?
 644             AND biblioitems.biblionumber = biblio.biblionumber
 645     ";
 646     my $sth = $dbh->prepare($query);
 647     $sth->execute($bibnum);
 648     my $data;
 649     $data = $sth->fetchrow_hashref;
 650     $sth->finish;
 651
 652     return ($data);
 653 }    # sub GetBiblioData
 654
 655
 656 =head2 GetItemsInfo
 657
 658 =over 4
 659
 660   @results = &GetItemsInfo($biblionumber, $type);
 661
 662 Returns information about books with the given biblionumber.
 663
 664 C<$type> may be either C<intra> or anything else. If it is not set to
 665 C<intra>, then the search will exclude lost, very overdue, and
 666 withdrawn items.
 667
 668 C<&GetItemsInfo> returns a list of references-to-hash. Each element
 669 contains a number of keys. Most of them are table items from the
 670 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
 671 Koha database. Other keys include:
 672
 673 =over 4
 674
 675 =item C<$data-E<gt>{branchname}>
 676
 677 The name (not the code) of the branch to which the book belongs.
 678
 679 =item C<$data-E<gt>{datelastseen}>
 680
 681 This is simply C<items.datelastseen>, except that while the date is
 682 stored in YYYY-MM-DD format in the database, here it is converted to
 683 DD/MM/YYYY format. A NULL date is returned as C<//>.
 684
 685 =item C<$data-E<gt>{datedue}>
 686
 687 =item C<$data-E<gt>{class}>
 688
 689 This is the concatenation of C<biblioitems.classification>, the book's
 690 Dewey code, and C<biblioitems.subclass>.
 691
 692 =item C<$data-E<gt>{ocount}>
 693
 694 I think this is the number of copies of the book available.
 695
 696 =item C<$data-E<gt>{order}>
 697
 698 If this is set, it is set to C<One Order>.
 699
 700 =back
 701
 702 =back
 703
 704 =cut
 705
 706 sub GetItemsInfo {
 707     my ( $biblionumber, $type ) = @_;
 708     my $dbh   = C4::Context->dbh;
 709     my $query = "SELECT *,items.notforloan as itemnotforloan
 710                  FROM items, biblio, biblioitems
 711                  LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype
 712                 WHERE items.biblionumber = ?
 713                     AND biblioitems.biblioitemnumber = items.biblioitemnumber
 714                     AND biblio.biblionumber = items.biblionumber
 715                 ORDER BY items.dateaccessioned desc
 716                  ";
 717     my $sth = $dbh->prepare($query);
 718     $sth->execute($biblionumber);
 719     my $i = 0;
 720     my @results;
 721     my ( $date_due, $count_reserves );
 722
 723     while ( my $data = $sth->fetchrow_hashref ) {
 724         my $datedue = '';
 725         my $isth    = $dbh->prepare(
 726             "SELECT issues.*,borrowers.cardnumber
 727             FROM   issues, borrowers
 728             WHERE  itemnumber = ?
 729                 AND returndate IS NULL
 730                 AND issues.borrowernumber=borrowers.borrowernumber"
 731         );
 732         $isth->execute( $data->{'itemnumber'} );
 733         if ( my $idata = $isth->fetchrow_hashref ) {
 734             $data->{borrowernumber} = $idata->{borrowernumber};
 735             $data->{cardnumber}     = $idata->{cardnumber};
 736             $datedue                = format_date( $idata->{'date_due'} );
 737         }
 738         if ( $datedue eq '' ) {
 739             #$datedue="Available";
 740             my ( $restype, $reserves ) =
 741               C4::Reserves2::CheckReserves( $data->{'itemnumber'} );
 742             if ($restype) {
 743
 744                 #$datedue=$restype;
 745                 $count_reserves = $restype;
 746             }
 747         }
 748         $isth->finish;
 749
 750         #get branch information.....
 751         my $bsth = $dbh->prepare(
 752             "SELECT * FROM branches WHERE branchcode = ?
 753         "
 754         );
 755         $bsth->execute( $data->{'holdingbranch'} );
 756         if ( my $bdata = $bsth->fetchrow_hashref ) {
 757             $data->{'branchname'} = $bdata->{'branchname'};
 758         }
 759         my $date = format_date( $data->{'datelastseen'} );
 760         $data->{'datelastseen'}   = $date;
 761         $data->{'datedue'}        = $datedue;
 762         $data->{'count_reserves'} = $count_reserves;
 763
 764         # get notforloan complete status if applicable
 765         my $sthnflstatus = $dbh->prepare(
 766             'SELECT authorised_value
 767             FROM   marc_subfield_structure
 768             WHERE  kohafield="items.notforloan"
 769         '
 770         );
 771
 772         $sthnflstatus->execute;
 773         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
 774         if ($authorised_valuecode) {
 775             $sthnflstatus = $dbh->prepare(
 776                 "SELECT lib FROM authorised_values
 777                  WHERE  category=?
 778                  AND authorised_value=?"
 779             );
 780             $sthnflstatus->execute( $authorised_valuecode,
 781                 $data->{itemnotforloan} );
 782             my ($lib) = $sthnflstatus->fetchrow;
 783             $data->{notforloan} = $lib;
 784         }
 785
 786         # my stack procedures
 787         my $stackstatus = $dbh->prepare(
 788             'SELECT authorised_value
 789              FROM   marc_subfield_structure
 790              WHERE  kohafield="items.stack"
 791         '
 792         );
 793         $stackstatus->execute;
 794
 795         ($authorised_valuecode) = $stackstatus->fetchrow;
 796         if ($authorised_valuecode) {
 797             $stackstatus = $dbh->prepare(
 798                 "SELECT lib
 799                  FROM   authorised_values
 800                  WHERE  category=?
 801                  AND    authorised_value=?
 802             "
 803             );
 804             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
 805             my ($lib) = $stackstatus->fetchrow;
 806             $data->{stack} = $lib;
 807         }
 808         $results[$i] = $data;
 809         $i++;
 810     }
 811     $sth->finish;
 812
 813     return (@results);
 814 }
 815
 816 =head2 getitemstatus
 817
 818 =over 4
 819
 820 $itemstatushash = &getitemstatus($fwkcode);
 821 returns information about status.
 822 Can be MARC dependant.
 823 fwkcode is optional.
 824 But basically could be can be loan or not
 825 Create a status selector with the following code
 826
 827 =head3 in PERL SCRIPT
 828
 829 my $itemstatushash = getitemstatus;
 830 my @itemstatusloop;
 831 foreach my $thisstatus (keys %$itemstatushash) {
 832     my %row =(value => $thisstatus,
 833                 statusname => $itemstatushash->{$thisstatus}->{'statusname'},
 834             );
 835     push @itemstatusloop, \%row;
 836 }
 837 $template->param(statusloop=>\@itemstatusloop);
 838
 839
 840 =head3 in TEMPLATE
 841
 842             <select name="statusloop">
 843                 <option value="">Default</option>
 844             <!-- TMPL_LOOP name="statusloop" -->
 845                 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
 846             <!-- /TMPL_LOOP -->
 847             </select>
 848
 849 =cut
 850
 851 sub GetItemStatus {
 852
 853     # returns a reference to a hash of references to status...
 854     my ($fwk) = @_;
 855     my %itemstatus;
 856     my $dbh = C4::Context->dbh;
 857     my $sth;
 858     $fwk = '' unless ($fwk);
 859     my ( $tag, $subfield ) =
 860       GetMarcFromKohaField( $dbh, "items.notforloan", $fwk );
 861     if ( $tag and $subfield ) {
 862         my $sth =
 863           $dbh->prepare(
 864 "select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
 865           );
 866         $sth->execute( $tag, $subfield, $fwk );
 867         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 868             my $authvalsth =
 869               $dbh->prepare(
 870 "select authorised_value, lib from authorised_values where category=? order by lib"
 871               );
 872             $authvalsth->execute($authorisedvaluecat);
 873             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 874                 $itemstatus{$authorisedvalue} = $lib;
 875             }
 876             $authvalsth->finish;
 877             return \%itemstatus;
 878             exit 1;
 879         }
 880         else {
 881
 882             #No authvalue list
 883             # build default
 884         }
 885         $sth->finish;
 886     }
 887
 888     #No authvalue list
 889     #build default
 890     $itemstatus{"1"} = "Not For Loan";
 891     return \%itemstatus;
 892 }
 893
 894 =head2 getitemlocation
 895
 896 =over 4
 897
 898 $itemlochash = &getitemlocation($fwk);
 899 returns informations about location.
 900 where fwk stands for an optional framework code.
 901 Create a location selector with the following code
 902
 903 =head3 in PERL SCRIPT
 904
 905 my $itemlochash = getitemlocation;
 906 my @itemlocloop;
 907 foreach my $thisloc (keys %$itemlochash) {
 908     my $selected = 1 if $thisbranch eq $branch;
 909     my %row =(locval => $thisloc,
 910                 selected => $selected,
 911                 locname => $itemlochash->{$thisloc},
 912             );
 913     push @itemlocloop, \%row;
 914 }
 915 $template->param(itemlocationloop => \@itemlocloop);
 916
 917 =head3 in TEMPLATE
 918
 919 <select name="location">
 920     <option value="">Default</option>
 921 <!-- TMPL_LOOP name="itemlocationloop" -->
 922     <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
 923 <!-- /TMPL_LOOP -->
 924 </select>
 925
 926 =back
 927
 928 =cut
 929
 930 sub GetItemLocation {
 931
 932     # returns a reference to a hash of references to location...
 933     my ($fwk) = @_;
 934     my %itemlocation;
 935     my $dbh = C4::Context->dbh;
 936     my $sth;
 937     $fwk = '' unless ($fwk);
 938     my ( $tag, $subfield ) =
 939       GetMarcFromKohaField( $dbh, "items.location", $fwk );
 940     if ( $tag and $subfield ) {
 941         my $sth =
 942           $dbh->prepare(
 943 "select authorised_value from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
 944           );
 945         $sth->execute( $tag, $subfield, $fwk );
 946         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 947             my $authvalsth =
 948               $dbh->prepare(
 949 "select authorised_value, lib from authorised_values where category=? order by lib"
 950               );
 951             $authvalsth->execute($authorisedvaluecat);
 952             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 953                 $itemlocation{$authorisedvalue} = $lib;
 954             }
 955             $authvalsth->finish;
 956             return \%itemlocation;
 957             exit 1;
 958         }
 959         else {
 960
 961             #No authvalue list
 962             # build default
 963         }
 964         $sth->finish;
 965     }
 966
 967     #No authvalue list
 968     #build default
 969     $itemlocation{"1"} = "Not For Loan";
 970     return \%itemlocation;
 971 }
 972
 973 =head2 &GetBiblioItemData
 974
 975 =over 4
 976
 977 $itemdata = &GetBiblioItemData($biblioitemnumber);
 978
 979 Looks up the biblioitem with the given biblioitemnumber. Returns a
 980 reference-to-hash. The keys are the fields from the C<biblio>,
 981 C<biblioitems>, and C<itemtypes> tables in the Koha database, except
 982 that C<biblioitems.notes> is given as C<$itemdata-E<gt>{bnotes}>.
 983
 984 =back
 985
 986 =cut
 987
 988 #'
 989 sub GetBiblioItemData {
 990     my ($bibitem) = @_;
 991     my $dbh       = C4::Context->dbh;
 992     my $sth       =
 993       $dbh->prepare(
 994 "Select *,biblioitems.notes as bnotes from biblioitems, biblio,itemtypes where biblio.biblionumber = biblioitems.biblionumber and biblioitemnumber = ? and biblioitems.itemtype = itemtypes.itemtype"
 995       );
 996     my $data;
 997
 998     $sth->execute($bibitem);
 999
1000     $data = $sth->fetchrow_hashref;
1001
1002     $sth->finish;
1003     return ($data);
1004 }    # sub &GetBiblioItemData
1005
1006 =head2 GetItemFromBarcode
1007
1008 =over 4
1009
1010 $result = GetItemFromBarcode($barcode);
1011
1012 =back
1013
1014 =cut
1015
1016 sub GetItemFromBarcode {
1017     my ($barcode) = @_;
1018     my $dbh = C4::Context->dbh;
1019
1020     my $rq =
1021       $dbh->prepare("SELECT itemnumber from items where items.barcode=?");
1022     $rq->execute($barcode);
1023     my ($result) = $rq->fetchrow;
1024     return ($result);
1025 }
1026
1027 =head2 GetBiblioItemByBiblioNumber
1028
1029 =over 4
1030
1031 NOTE : This function has been copy/paste from C4/Biblio.pm from head before zebra integration.
1032
1033 =back
1034
1035 =cut
1036
1037 sub GetBiblioItemByBiblioNumber {
1038     my ($biblionumber) = @_;
1039     my $dbh = C4::Context->dbh;
1040     my $sth = $dbh->prepare("Select * from biblioitems where biblionumber = ?");
1041     my $count = 0;
1042     my @results;
1043
1044     $sth->execute($biblionumber);
1045
1046     while ( my $data = $sth->fetchrow_hashref ) {
1047         push @results, $data;
1048     }
1049
1050     $sth->finish;
1051     return @results;
1052 }
1053
1054 =head2 GetBiblioFromItemNumber
1055
1056 =over 4
1057
1058 $item = &GetBiblioFromItemNumber($itemnumber);
1059
1060 Looks up the item with the given itemnumber.
1061
1062 C<&itemnodata> returns a reference-to-hash whose keys are the fields
1063 from the C<biblio>, C<biblioitems>, and C<items> tables in the Koha
1064 database.
1065
1066 =back
1067
1068 =cut
1069
1070 #'
1071 sub GetBiblioFromItemNumber {
1072     my ( $itemnumber ) = @_;
1073     my $dbh = C4::Context->dbh;
1074     my $env;
1075     my $sth = $dbh->prepare(
1076         "SELECT * FROM biblio,items,biblioitems
1077          WHERE items.itemnumber = ?
1078            AND biblio.biblionumber = items.biblionumber
1079            AND biblioitems.biblioitemnumber = items.biblioitemnumber"
1080     );
1081
1082     $sth->execute($itemnumber);
1083     my $data = $sth->fetchrow_hashref;
1084     $sth->finish;
1085     return ($data);
1086 }
1087
1088 =head2 GetBiblio
1089
1090 =over 4
1091
1092 ( $count, @results ) = &GetBiblio($biblionumber);
1093
1094 =back
1095
1096 =cut
1097
1098 sub GetBiblio {
1099     my ($biblionumber) = @_;
1100     my $dbh = C4::Context->dbh;
1101     my $sth = $dbh->prepare("Select * from biblio where biblionumber = ?");
1102     my $count = 0;
1103     my @results;
1104     $sth->execute($biblionumber);
1105     while ( my $data = $sth->fetchrow_hashref ) {
1106         $results[$count] = $data;
1107         $count++;
1108     }    # while
1109     $sth->finish;
1110     return ( $count, @results );
1111 }    # sub GetBiblio
1112
1113 =head2 get_itemnumbers_of
1114
1115 =over 4
1116
1117 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1118
1119 Given a list of biblionumbers, return the list of corresponding itemnumbers
1120 for each biblionumber.
1121
1122 Return a reference on a hash where keys are biblionumbers and values are
1123 references on array of itemnumbers.
1124
1125 =back
1126
1127 =cut
1128
1129 sub get_itemnumbers_of {
1130     my @biblionumbers = @_;
1131
1132     my $dbh = C4::Context->dbh;
1133
1134     my $query = '
1135         SELECT itemnumber,
1136             biblionumber
1137         FROM items
1138         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1139     ';
1140     my $sth = $dbh->prepare($query);
1141     $sth->execute(@biblionumbers);
1142
1143     my %itemnumbers_of;
1144
1145     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1146         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1147     }
1148
1149     return \%itemnumbers_of;
1150 }
1151
1152 =head2 GetItemInfosOf
1153
1154 =over 4
1155
1156 GetItemInfosOf(@itemnumbers);
1157
1158 =back
1159
1160 =cut
1161
1162 sub GetItemInfosOf {
1163     my @itemnumbers = @_;
1164
1165     my $query = '
1166         SELECT *
1167         FROM items
1168         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
1169     ';
1170     return get_infos_of( $query, 'itemnumber' );
1171 }
1172
1173 =head2 GetBiblioItemInfosOf
1174
1175 =over 4
1176
1177 GetBiblioItemInfosOf(@biblioitemnumbers);
1178
1179 =back
1180
1181 =cut
1182
1183 sub GetBiblioItemInfosOf {
1184     my @biblioitemnumbers = @_;
1185
1186     my $query = '
1187         SELECT biblioitemnumber,
1188             publicationyear,
1189             itemtype
1190         FROM biblioitems
1191         WHERE biblioitemnumber IN (' . join( ',', @biblioitemnumbers ) . ')
1192     ';
1193     return get_infos_of( $query, 'biblioitemnumber' );
1194 }
1195
1196 =head1 FUNCTIONS FOR HANDLING MARC MANAGEMENT
1197
1198 =head2 GetMarcStructure
1199
1200 =over 4
1201
1202 $res = GetMarcStructure($dbh,$forlibrarian,$frameworkcode);
1203
1204 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1205 $dbh : DB handler
1206 $forlibrarian  :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1207 $frameworkcode : the framework code to read
1208
1209 =back
1210
1211 =back
1212
1213 =cut
1214
1215 sub GetMarcStructure {
1216     my ( $dbh, $forlibrarian, $frameworkcode ) = @_;
1217     $frameworkcode = "" unless $frameworkcode;
1218     my $sth;
1219     my $libfield = ( $forlibrarian eq 1 ) ? 'liblibrarian' : 'libopac';
1220
1221     # check that framework exists
1222     $sth =
1223       $dbh->prepare(
1224         "select count(*) from marc_tag_structure where frameworkcode=?");
1225     $sth->execute($frameworkcode);
1226     my ($total) = $sth->fetchrow;
1227     $frameworkcode = "" unless ( $total > 0 );
1228     $sth =
1229       $dbh->prepare(
1230 "select tagfield,liblibrarian,libopac,mandatory,repeatable from marc_tag_structure where frameworkcode=? order by tagfield"
1231       );
1232     $sth->execute($frameworkcode);
1233     my ( $liblibrarian, $libopac, $tag, $res, $tab, $mandatory, $repeatable );
1234
1235     while ( ( $tag, $liblibrarian, $libopac, $mandatory, $repeatable ) =
1236         $sth->fetchrow )
1237     {
1238         $res->{$tag}->{lib} =
1239           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1240         $res->{$tab}->{tab}        = "";            # XXX
1241         $res->{$tag}->{mandatory}  = $mandatory;
1242         $res->{$tag}->{repeatable} = $repeatable;
1243     }
1244
1245     $sth =
1246       $dbh->prepare(
1247 "select tagfield,tagsubfield,liblibrarian,libopac,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl,link,defaultvalue from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield"
1248       );
1249     $sth->execute($frameworkcode);
1250
1251     my $subfield;
1252     my $authorised_value;
1253     my $authtypecode;
1254     my $value_builder;
1255     my $kohafield;
1256     my $seealso;
1257     my $hidden;
1258     my $isurl;
1259     my $link;
1260     my $defaultvalue;
1261
1262     while (
1263         (
1264             $tag,          $subfield,      $liblibrarian,
1265             ,              $libopac,       $tab,
1266             $mandatory,    $repeatable,    $authorised_value,
1267             $authtypecode, $value_builder, $kohafield,
1268             $seealso,      $hidden,        $isurl,
1269             $link,$defaultvalue
1270         )
1271         = $sth->fetchrow
1272       )
1273     {
1274         $res->{$tag}->{$subfield}->{lib} =
1275           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1276         $res->{$tag}->{$subfield}->{tab}              = $tab;
1277         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1278         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1279         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1280         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1281         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1282         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1283         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1284         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1285         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1286         $res->{$tag}->{$subfield}->{link}             = $link;
1287         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1288     }
1289     return $res;
1290 }
1291
1292 =head2 GetMarcFromKohaField
1293
1294 =over 4
1295
1296 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($dbh,$kohafield,$frameworkcode);
1297 Returns the MARC fields & subfields mapped to the koha field
1298 for the given frameworkcode
1299
1300 =back
1301
1302 =cut
1303
1304 sub GetMarcFromKohaField {
1305     my ( $dbh, $kohafield, $frameworkcode ) = @_;
1306     return 0, 0 unless $kohafield;
1307     my $relations = C4::Context->marcfromkohafield;
1308     return (
1309         $relations->{$frameworkcode}->{$kohafield}->[0],
1310         $relations->{$frameworkcode}->{$kohafield}->[1]
1311     );
1312 }
1313
1314 =head2 GetMarcBiblio
1315
1316 =over 4
1317
1318 Returns MARC::Record of the biblionumber passed in parameter.
1319 the marc record contains both biblio & item datas
1320
1321 =back
1322
1323 =cut
1324
1325 sub GetMarcBiblio {
1326     my $biblionumber = shift;
1327     my $dbh          = C4::Context->dbh;
1328     my $sth          =
1329       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1330     $sth->execute($biblionumber);
1331     my ($marcxml) = $sth->fetchrow;
1332 #     warn "marcxml : $marcxml";
1333     MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1334     $marcxml =~ s/\x1e//g;
1335     $marcxml =~ s/\x1f//g;
1336     $marcxml =~ s/\x1d//g;
1337     $marcxml =~ s/\x0f//g;
1338     $marcxml =~ s/\x0c//g;
1339     my $record = MARC::Record->new();
1340     $record = MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour')) if $marcxml;
1341     return $record;
1342 }
1343
1344 =head2 GetXmlBiblio
1345
1346 =over 4
1347
1348 my $marcxml = GetXmlBiblio($biblionumber);
1349
1350 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1351 The XML contains both biblio & item datas
1352
1353 =back
1354
1355 =cut
1356
1357 sub GetXmlBiblio {
1358     my ( $biblionumber ) = @_;
1359     my $dbh = C4::Context->dbh;
1360     my $sth =
1361       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1362     $sth->execute($biblionumber);
1363     my ($marcxml) = $sth->fetchrow;
1364     return $marcxml;
1365 }
1366
1367 =head2 GetAuthorisedValueDesc
1368
1369 =over 4
1370
1371 my $subfieldvalue =get_authorised_value_desc(
1372     $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
1373 Retrieve the complete description for a given authorised value.
1374
1375 =back
1376
1377 =cut
1378
1379 sub GetAuthorisedValueDesc {
1380     my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
1381     my $dbh = C4::Context->dbh;
1382
1383     #---- branch
1384     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1385         return C4::Branch::GetBranchName($value);
1386     }
1387
1388     #---- itemtypes
1389     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1390         return getitemtypeinfo($value);
1391     }
1392
1393     #---- "true" authorized value
1394     my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1395
1396     if ( $category ne "" ) {
1397         my $sth =
1398           $dbh->prepare(
1399             "select lib from authorised_values where category = ? and authorised_value = ?"
1400           );
1401         $sth->execute( $category, $value );
1402         my $data = $sth->fetchrow_hashref;
1403         return $data->{'lib'};
1404     }
1405     else {
1406         return $value;    # if nothing is found return the original value
1407     }
1408 }
1409
1410 =head2 GetMarcItem
1411
1412 =over 4
1413
1414 Returns MARC::Record of the item passed in parameter.
1415
1416 =back
1417
1418 =cut
1419
1420 sub GetMarcItem {
1421     my ( $biblionumber, $itemnumber ) = @_;
1422     my $dbh = C4::Context->dbh;
1423     my $newrecord = MARC::Record->new();
1424     my $marcflavour = C4::Context->preference('marcflavour');
1425
1426     my $marcxml = GetXmlBiblio($biblionumber);
1427     my $record = MARC::Record->new();
1428 #     warn "marcxml :$marcxml";
1429     $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
1430 #     warn "record :".$record->as_formatted;
1431     # now, find where the itemnumber is stored & extract only the item
1432     my ( $itemnumberfield, $itemnumbersubfield ) =
1433       GetMarcFromKohaField( $dbh, 'items.itemnumber', '' );
1434     my @fields = $record->field($itemnumberfield);
1435     foreach my $field (@fields) {
1436         if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
1437             $newrecord->insert_fields_ordered($field);
1438         }
1439     }
1440     return $newrecord;
1441 }
1442
1443 =head2 GetMarcNotes
1444
1445 =over 4
1446
1447 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1448 Get all notes from the MARC record and returns them in an array.
1449 The note are stored in differents places depending on MARC flavour
1450
1451 =back
1452
1453 =cut
1454
1455 sub GetMarcNotes {
1456     my ( $record, $marcflavour ) = @_;
1457     my $scope;
1458     if ( $marcflavour eq "MARC21" ) {
1459         $scope = '5..';
1460     }
1461     else {    # assume unimarc if not marc21
1462         $scope = '3..';
1463     }
1464     my @marcnotes;
1465     my $note = "";
1466     my $tag  = "";
1467     my $marcnote;
1468     foreach my $field ( $record->field($scope) ) {
1469         my $value = $field->as_string();
1470         if ( $note ne "" ) {
1471             $marcnote = { marcnote => $note, };
1472             push @marcnotes, $marcnote;
1473             $note = $value;
1474         }
1475         if ( $note ne $value ) {
1476             $note = $note . " " . $value;
1477         }
1478     }
1479
1480     if ( $note ) {
1481         $marcnote = { marcnote => $note };
1482         push @marcnotes, $marcnote;    #load last tag into array
1483     }
1484     return \@marcnotes;
1485 }    # end GetMarcNotes
1486
1487 =head2 GetMarcSubjects
1488
1489 =over 4
1490
1491 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1492 Get all subjects from the MARC record and returns them in an array.
1493 The subjects are stored in differents places depending on MARC flavour
1494
1495 =back
1496
1497 =cut
1498
1499 sub GetMarcSubjects {
1500     my ( $record, $marcflavour ) = @_;
1501     my ( $mintag, $maxtag );
1502     if ( $marcflavour eq "MARC21" ) {
1503         $mintag = "600";
1504         $maxtag = "699";
1505     }
1506     else {    # assume unimarc if not marc21
1507         $mintag = "600";
1508         $maxtag = "611";
1509     }
1510
1511     my @marcsubjcts;
1512
1513     foreach my $field ( $record->fields ) {
1514         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1515         my @subfields = $field->subfields();
1516         my $link;
1517         my $label = "su:";
1518         my $flag = 0;
1519         for my $subject_subfield ( @subfields ) {
1520             my $code = $subject_subfield->[0];
1521             $label .= $subject_subfield->[1] . " and su-to:" unless ( $code == 9 );
1522             if ( $code == 9 ) {
1523                 $link = "Koha-Auth-Number:".$subject_subfield->[1];
1524                 $flag = 1;
1525             }
1526             elsif ( ! $flag ) {
1527                 $link = $label;
1528                 $link =~ s/ and\ssu-to:$//;
1529             }
1530         }
1531         $label =~ s/su/ /g;
1532         $label =~ s/://g;
1533         $label =~ s/-to//g;
1534         $label =~ s/and//g;
1535         push @marcsubjcts,
1536           {
1537             label => $label,
1538             link  => $link
1539           }
1540     }
1541     return \@marcsubjcts;
1542 }    #end GetMarcSubjects
1543
1544 =head2 GetMarcAuthors
1545
1546 =over 4
1547
1548 authors = GetMarcAuthors($record,$marcflavour);
1549 Get all authors from the MARC record and returns them in an array.
1550 The authors are stored in differents places depending on MARC flavour
1551
1552 =back
1553
1554 =cut
1555
1556 sub GetMarcAuthors {
1557     my ( $record, $marcflavour ) = @_;
1558     my ( $mintag, $maxtag );
1559     if ( $marcflavour eq "MARC21" ) {
1560         $mintag = "100";
1561         $maxtag = "111";
1562     }
1563     else {    # assume unimarc if not marc21
1564         $mintag = "701";
1565         $maxtag = "712";
1566     }
1567
1568     my @marcauthors;
1569
1570     foreach my $field ( $record->fields ) {
1571         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1572         my %hash;
1573         my @subfields = $field->subfields();
1574         my $count_auth = 0;
1575         my $and ;
1576         for my $authors_subfield (@subfields) {
1577                 if ($count_auth ne '0'){
1578                 $and = " and au:";
1579                 }
1580             $count_auth++;
1581             my $subfieldcode     = $authors_subfield->[0];
1582             my $value            = $authors_subfield->[1];
1583             $hash{'tag'}         = $field->tag;
1584             $hash{value}        .= $value . " " if ($subfieldcode != 9) ;
1585             $hash{link}        .= $value if ($subfieldcode eq 9);
1586         }
1587         push @marcauthors, \%hash;
1588     }
1589     return \@marcauthors;
1590 }
1591
1592 =head2 GetMarcSeries
1593
1594 =over 4
1595
1596 $marcseriessarray = GetMarcSeries($record,$marcflavour);
1597 Get all series from the MARC record and returns them in an array.
1598 The series are stored in differents places depending on MARC flavour
1599
1600 =back
1601
1602 =cut
1603
1604 sub GetMarcSeries {
1605     my ($record, $marcflavour) = @_;
1606     my ($mintag, $maxtag);
1607     if ($marcflavour eq "MARC21") {
1608         $mintag = "440";
1609         $maxtag = "490";
1610     } else {           # assume unimarc if not marc21
1611         $mintag = "600";
1612         $maxtag = "619";
1613     }
1614
1615     my @marcseries;
1616     my $subjct = "";
1617     my $subfield = "";
1618     my $marcsubjct;
1619
1620     foreach my $field ($record->field('440'), $record->field('490')) {
1621         my @subfields_loop;
1622         #my $value = $field->subfield('a');
1623         #$marcsubjct = {MARCSUBJCT => $value,};
1624         my @subfields = $field->subfields();
1625         #warn "subfields:".join " ", @$subfields;
1626         my $counter = 0;
1627         my @link_loop;
1628         for my $series_subfield (@subfields) {
1629                         my $volume_number;
1630                         undef $volume_number;
1631                         # see if this is an instance of a volume
1632                         if ($series_subfield->[0] eq 'v') {
1633                                 $volume_number=1;
1634                         }
1635
1636             my $code = $series_subfield->[0];
1637             my $value = $series_subfield->[1];
1638             my $linkvalue = $value;
1639             $linkvalue =~ s/(\(|\))//g;
1640             my $operator = " and " unless $counter==0;
1641             push @link_loop, {link => $linkvalue, operator => $operator };
1642             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1643                         if ($volume_number) {
1644                         push @subfields_loop, {volumenum => $value};
1645                         }
1646                         else {
1647             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1648                         }
1649             $counter++;
1650         }
1651         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1652         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1653         #push @marcsubjcts, $marcsubjct;
1654         #$subjct = $value;
1655
1656     }
1657     my $marcseriessarray=\@marcseries;
1658     return $marcseriessarray;
1659 }  #end getMARCseriess
1660
1661 =head2 GetFrameworkCode
1662
1663 =over 4
1664
1665 $frameworkcode = GetFrameworkCode( $biblionumber )
1666
1667 =back
1668
1669 =cut
1670
1671 sub GetFrameworkCode {
1672     my ( $biblionumber ) = @_;
1673     my $dbh = C4::Context->dbh;
1674     my $sth =
1675       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
1676     $sth->execute($biblionumber);
1677     my ($frameworkcode) = $sth->fetchrow;
1678     return $frameworkcode;
1679 }
1680
1681 =head2 TransformKohaToMarc
1682
1683 =over 4
1684
1685 $record = TransformKohaToMarc( $hash )
1686 This function builds partial MARC::Record from a hash
1687 Hash entries can be from biblio or biblioitems.
1688 This function is called in acquisition module, to create a basic catalogue entry from user entry
1689
1690 =back
1691
1692 =cut
1693
1694 sub TransformKohaToMarc {
1695
1696     my ( $hash ) = @_;
1697     my $dbh = C4::Context->dbh;
1698     my $sth =
1699     $dbh->prepare(
1700         "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1701     );
1702     my $record = MARC::Record->new();
1703     foreach (keys %{$hash}) {
1704         &TransformKohaToMarcOneField( $sth, $record, $_,
1705             $hash->{$_}, '' );
1706         }
1707     return $record;
1708 }
1709
1710 =head2 TransformKohaToMarcOneField
1711
1712 =over 4
1713
1714 $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1715
1716 =back
1717
1718 =cut
1719
1720 sub TransformKohaToMarcOneField {
1721     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1722     $frameworkcode='' unless $frameworkcode;
1723     my $tagfield;
1724     my $tagsubfield;
1725
1726     if ( !defined $sth ) {
1727         my $dbh = C4::Context->dbh;
1728         $sth =
1729           $dbh->prepare(
1730 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1731           );
1732     }
1733     $sth->execute( $frameworkcode, $kohafieldname );
1734     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1735         my $tag = $record->field($tagfield);
1736         if ($tag) {
1737             $tag->update( $tagsubfield => $value );
1738             $record->delete_field($tag);
1739             $record->insert_fields_ordered($tag);
1740         }
1741         else {
1742             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1743         }
1744     }
1745     return $record;
1746 }
1747
1748 =head2 TransformHtmlToXml
1749
1750 =over 4
1751
1752 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag )
1753
1754 =back
1755
1756 =cut
1757
1758 sub TransformHtmlToXml {
1759     my ( $tags, $subfields, $values, $indicator, $ind_tag ) = @_;
1760     my $xml = MARC::File::XML::header('UTF-8');
1761     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1762         MARC::File::XML->default_record_format('UNIMARC');
1763         use POSIX qw(strftime);
1764         my $string = strftime( "%Y%m%d", localtime(time) );
1765         $string = sprintf( "%-*s", 35, $string );
1766         substr( $string, 22, 6, "frey50" );
1767         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1768         $xml .= "<subfield code=\"a\">$string</subfield>\n";
1769         $xml .= "</datafield>\n";
1770     }
1771     my $prevvalue;
1772     my $prevtag = -1;
1773     my $first   = 1;
1774     my $j       = -1;
1775     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
1776         @$values[$i] =~ s/&/&amp;/g;
1777         @$values[$i] =~ s/</&lt;/g;
1778         @$values[$i] =~ s/>/&gt;/g;
1779         @$values[$i] =~ s/"/&quot;/g;
1780         @$values[$i] =~ s/'/&apos;/g;
1781         if ( !utf8::is_utf8( @$values[$i] ) ) {
1782             utf8::decode( @$values[$i] );
1783         }
1784         if ( ( @$tags[$i] ne $prevtag ) ) {
1785             $j++ unless ( @$tags[$i] eq "" );
1786             if ( !$first ) {
1787                 $xml .= "</datafield>\n";
1788                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
1789                     && ( @$values[$i] ne "" ) )
1790                 {
1791                     my $ind1 = substr( @$indicator[$j], 0, 1 );
1792                     my $ind2;
1793                     if ( @$indicator[$j] ) {
1794                         $ind2 = substr( @$indicator[$j], 1, 1 );
1795                     }
1796                     else {
1797                         warn "Indicator in @$tags[$i] is empty";
1798                         $ind2 = " ";
1799                     }
1800                     $xml .=
1801 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1802                     $xml .=
1803 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1804                     $first = 0;
1805                 }
1806                 else {
1807                     $first = 1;
1808                 }
1809             }
1810             else {
1811                 if ( @$values[$i] ne "" ) {
1812
1813                     # leader
1814                     if ( @$tags[$i] eq "000" ) {
1815                         $xml .= "<leader>@$values[$i]</leader>\n";
1816                         $first = 1;
1817
1818                         # rest of the fixed fields
1819                     }
1820                     elsif ( @$tags[$i] < 10 ) {
1821                         $xml .=
1822 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
1823                         $first = 1;
1824                     }
1825                     else {
1826                         my $ind1 = substr( @$indicator[$j], 0, 1 );
1827                         my $ind2 = substr( @$indicator[$j], 1, 1 );
1828                         $xml .=
1829 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1830                         $xml .=
1831 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1832                         $first = 0;
1833                     }
1834                 }
1835             }
1836         }
1837         else {    # @$tags[$i] eq $prevtag
1838             if ( @$values[$i] eq "" ) {
1839             }
1840             else {
1841                 if ($first) {
1842                     my $ind1 = substr( @$indicator[$j], 0, 1 );
1843                     my $ind2 = substr( @$indicator[$j], 1, 1 );
1844                     $xml .=
1845 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1846                     $first = 0;
1847                 }
1848                 $xml .=
1849 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1850             }
1851         }
1852         $prevtag = @$tags[$i];
1853     }
1854     $xml .= MARC::File::XML::footer();
1855
1856     return $xml;
1857 }
1858
1859 =head2 TransformHtmlToMarc
1860
1861 =over 4
1862
1863 $record = TransformHtmlToMarc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
1864
1865 =back
1866
1867 =cut
1868
1869 sub TransformHtmlToMarc {
1870     my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
1871     my $prevtag = -1;
1872     my $record  = MARC::Record->new();
1873
1874     #     my %subfieldlist=();
1875     my $prevvalue;    # if tag <10
1876     my $field;        # if tag >=10
1877     for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
1878         next unless @$rvalues[$i];
1879
1880  # rebuild MARC::Record
1881  #             warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
1882         if ( @$rtags[$i] ne $prevtag ) {
1883             if ( $prevtag < 10 ) {
1884                 if ($prevvalue) {
1885
1886                     if ( $prevtag ne '000' ) {
1887                         $record->insert_fields_ordered(
1888                             ( sprintf "%03s", $prevtag ), $prevvalue );
1889                     }
1890                     else {
1891
1892                         $record->leader($prevvalue);
1893
1894                     }
1895                 }
1896             }
1897             else {
1898                 if ($field) {
1899                     $record->insert_fields_ordered($field);
1900                 }
1901             }
1902             $indicators{ @$rtags[$i] } .= '  ';
1903             if ( @$rtags[$i] < 10 ) {
1904                 $prevvalue = @$rvalues[$i];
1905                 undef $field;
1906             }
1907             else {
1908                 undef $prevvalue;
1909                 $field = MARC::Field->new(
1910                     ( sprintf "%03s", @$rtags[$i] ),
1911                     substr( $indicators{ @$rtags[$i] }, 0, 1 ),
1912                     substr( $indicators{ @$rtags[$i] }, 1, 1 ),
1913                     @$rsubfields[$i] => @$rvalues[$i]
1914                 );
1915             }
1916             $prevtag = @$rtags[$i];
1917         }
1918         else {
1919             if ( @$rtags[$i] < 10 ) {
1920                 $prevvalue = @$rvalues[$i];
1921             }
1922             else {
1923                 if ( length( @$rvalues[$i] ) > 0 ) {
1924                     $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
1925                 }
1926             }
1927             $prevtag = @$rtags[$i];
1928         }
1929     }
1930
1931     # the last has not been included inside the loop... do it now !
1932     $record->insert_fields_ordered($field) if $field;
1933
1934     #     warn "HTML2MARC=".$record->as_formatted;
1935     $record->encoding('UTF-8');
1936
1937     #    $record->MARC::File::USMARC::update_leader();
1938     return $record;
1939 }
1940
1941 =head2 TransformMarcToKoha
1942
1943 =over 4
1944
1945 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
1946
1947 =back
1948
1949 =cut
1950
1951 sub TransformMarcToKoha {
1952     my ( $dbh, $record, $frameworkcode ) = @_;
1953     my $sth =
1954       $dbh->prepare(
1955 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1956       );
1957     my $result;
1958     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
1959     $sth2->execute;
1960     my $field;
1961     while ( ($field) = $sth2->fetchrow ) {
1962         $result =
1963           &TransformMarcToKohaOneField( "biblio", $field, $record, $result,
1964             $frameworkcode );
1965     }
1966     $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
1967     $sth2->execute;
1968     while ( ($field) = $sth2->fetchrow ) {
1969         if ( $field eq 'notes' ) { $field = 'bnotes'; }
1970         $result =
1971           &TransformMarcToKohaOneField( "biblioitems", $field, $record, $result,
1972             $frameworkcode );
1973     }
1974     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
1975     $sth2->execute;
1976     while ( ($field) = $sth2->fetchrow ) {
1977         $result =
1978           &TransformMarcToKohaOneField( "items", $field, $record, $result,
1979             $frameworkcode );
1980     }
1981
1982     #
1983     # modify copyrightdate to keep only the 1st year found
1984     my $temp = $result->{'copyrightdate'};
1985     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
1986     if ( $1 > 0 ) {
1987         $result->{'copyrightdate'} = $1;
1988     }
1989     else {                      # if no cYYYY, get the 1st date.
1990         $temp =~ m/(\d\d\d\d)/;
1991         $result->{'copyrightdate'} = $1;
1992     }
1993
1994     # modify publicationyear to keep only the 1st year found
1995     $temp = $result->{'publicationyear'};
1996     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
1997     if ( $1 > 0 ) {
1998         $result->{'publicationyear'} = $1;
1999     }
2000     else {                      # if no cYYYY, get the 1st date.
2001         $temp =~ m/(\d\d\d\d)/;
2002         $result->{'publicationyear'} = $1;
2003     }
2004     return $result;
2005 }
2006
2007 =head2 TransformMarcToKohaOneField
2008
2009 =over 4
2010
2011 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2012
2013 =back
2014
2015 =cut
2016
2017 sub TransformMarcToKohaOneField {
2018
2019 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
2020     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2021
2022     my $res = "";
2023     my ( $tagfield, $subfield ) =
2024       GetMarcFromKohaField( "", $kohatable . "." . $kohafield,
2025         $frameworkcode );
2026     foreach my $field ( $record->field($tagfield) ) {
2027         if ( $field->tag() < 10 ) {
2028             if ( $result->{$kohafield} ) {
2029                 $result->{$kohafield} .= " | " . $field->data();
2030             }
2031             else {
2032                 $result->{$kohafield} = $field->data();
2033             }
2034         }
2035         else {
2036             if ( $field->subfields ) {
2037                 my @subfields = $field->subfields();
2038                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2039                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2040                         if ( $result->{$kohafield} ) {
2041                             $result->{$kohafield} .=
2042                               " | " . $subfields[$subfieldcount][1];
2043                         }
2044                         else {
2045                             $result->{$kohafield} =
2046                               $subfields[$subfieldcount][1];
2047                         }
2048                     }
2049                 }
2050             }
2051         }
2052     }
2053     return $result;
2054 }
2055 =head1  OTHER FUNCTIONS
2056
2057 =head2 char_decode
2058
2059 =over 4
2060
2061 my $string = char_decode( $string, $encoding );
2062
2063 converts ISO 5426 coded string to UTF-8
2064 sloppy code : should be improved in next issue
2065
2066 =back
2067
2068 =cut
2069
2070 sub char_decode {
2071     my ( $string, $encoding ) = @_;
2072     $_ = $string;
2073
2074     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2075     if ( $encoding eq "UNIMARC" ) {
2076
2077         #         s/\xe1/Æ/gm;
2078         s/\xe2/Ğ/gm;
2079         s/\xe9/Ø/gm;
2080         s/\xec/ş/gm;
2081         s/\xf1/æ/gm;
2082         s/\xf3/ğ/gm;
2083         s/\xf9/ø/gm;
2084         s/\xfb/ß/gm;
2085         s/\xc1\x61/à/gm;
2086         s/\xc1\x65/è/gm;
2087         s/\xc1\x69/ì/gm;
2088         s/\xc1\x6f/ò/gm;
2089         s/\xc1\x75/ù/gm;
2090         s/\xc1\x41/À/gm;
2091         s/\xc1\x45/È/gm;
2092         s/\xc1\x49/Ì/gm;
2093         s/\xc1\x4f/Ò/gm;
2094         s/\xc1\x55/Ù/gm;
2095         s/\xc2\x41/Á/gm;
2096         s/\xc2\x45/É/gm;
2097         s/\xc2\x49/Í/gm;
2098         s/\xc2\x4f/Ó/gm;
2099         s/\xc2\x55/Ú/gm;
2100         s/\xc2\x59/İ/gm;
2101         s/\xc2\x61/á/gm;
2102         s/\xc2\x65/é/gm;
2103         s/\xc2\x69/í/gm;
2104         s/\xc2\x6f/ó/gm;
2105         s/\xc2\x75/ú/gm;
2106         s/\xc2\x79/ı/gm;
2107         s/\xc3\x41/Â/gm;
2108         s/\xc3\x45/Ê/gm;
2109         s/\xc3\x49/Î/gm;
2110         s/\xc3\x4f/Ô/gm;
2111         s/\xc3\x55/Û/gm;
2112         s/\xc3\x61/â/gm;
2113         s/\xc3\x65/ê/gm;
2114         s/\xc3\x69/î/gm;
2115         s/\xc3\x6f/ô/gm;
2116         s/\xc3\x75/û/gm;
2117         s/\xc4\x41/Ã/gm;
2118         s/\xc4\x4e/Ñ/gm;
2119         s/\xc4\x4f/Õ/gm;
2120         s/\xc4\x61/ã/gm;
2121         s/\xc4\x6e/ñ/gm;
2122         s/\xc4\x6f/õ/gm;
2123         s/\xc8\x41/Ä/gm;
2124         s/\xc8\x45/Ë/gm;
2125         s/\xc8\x49/Ï/gm;
2126         s/\xc8\x61/ä/gm;
2127         s/\xc8\x65/ë/gm;
2128         s/\xc8\x69/ï/gm;
2129         s/\xc8\x6F/ö/gm;
2130         s/\xc8\x75/ü/gm;
2131         s/\xc8\x76/ÿ/gm;
2132         s/\xc9\x41/Ä/gm;
2133         s/\xc9\x45/Ë/gm;
2134         s/\xc9\x49/Ï/gm;
2135         s/\xc9\x4f/Ö/gm;
2136         s/\xc9\x55/Ü/gm;
2137         s/\xc9\x61/ä/gm;
2138         s/\xc9\x6f/ö/gm;
2139         s/\xc9\x75/ü/gm;
2140         s/\xca\x41/Å/gm;
2141         s/\xca\x61/å/gm;
2142         s/\xd0\x43/Ç/gm;
2143         s/\xd0\x63/ç/gm;
2144
2145         # this handles non-sorting blocks (if implementation requires this)
2146         $string = nsb_clean($_);
2147     }
2148     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2149         ##MARC-8 to UTF-8
2150
2151         s/\xe1\x61/à/gm;
2152         s/\xe1\x65/è/gm;
2153         s/\xe1\x69/ì/gm;
2154         s/\xe1\x6f/ò/gm;
2155         s/\xe1\x75/ù/gm;
2156         s/\xe1\x41/À/gm;
2157         s/\xe1\x45/È/gm;
2158         s/\xe1\x49/Ì/gm;
2159         s/\xe1\x4f/Ò/gm;
2160         s/\xe1\x55/Ù/gm;
2161         s/\xe2\x41/Á/gm;
2162         s/\xe2\x45/É/gm;
2163         s/\xe2\x49/Í/gm;
2164         s/\xe2\x4f/Ó/gm;
2165         s/\xe2\x55/Ú/gm;
2166         s/\xe2\x59/İ/gm;
2167         s/\xe2\x61/á/gm;
2168         s/\xe2\x65/é/gm;
2169         s/\xe2\x69/í/gm;
2170         s/\xe2\x6f/ó/gm;
2171         s/\xe2\x75/ú/gm;
2172         s/\xe2\x79/ı/gm;
2173         s/\xe3\x41/Â/gm;
2174         s/\xe3\x45/Ê/gm;
2175         s/\xe3\x49/Î/gm;
2176         s/\xe3\x4f/Ô/gm;
2177         s/\xe3\x55/Û/gm;
2178         s/\xe3\x61/â/gm;
2179         s/\xe3\x65/ê/gm;
2180         s/\xe3\x69/î/gm;
2181         s/\xe3\x6f/ô/gm;
2182         s/\xe3\x75/û/gm;
2183         s/\xe4\x41/Ã/gm;
2184         s/\xe4\x4e/Ñ/gm;
2185         s/\xe4\x4f/Õ/gm;
2186         s/\xe4\x61/ã/gm;
2187         s/\xe4\x6e/ñ/gm;
2188         s/\xe4\x6f/õ/gm;
2189         s/\xe6\x41/Ă/gm;
2190         s/\xe6\x45/Ĕ/gm;
2191         s/\xe6\x65/ĕ/gm;
2192         s/\xe6\x61/ă/gm;
2193         s/\xe8\x45/Ë/gm;
2194         s/\xe8\x49/Ï/gm;
2195         s/\xe8\x65/ë/gm;
2196         s/\xe8\x69/ï/gm;
2197         s/\xe8\x76/ÿ/gm;
2198         s/\xe9\x41/A/gm;
2199         s/\xe9\x4f/O/gm;
2200         s/\xe9\x55/U/gm;
2201         s/\xe9\x61/a/gm;
2202         s/\xe9\x6f/o/gm;
2203         s/\xe9\x75/u/gm;
2204         s/\xea\x41/A/gm;
2205         s/\xea\x61/a/gm;
2206
2207         #Additional Turkish characters
2208         s/\x1b//gm;
2209         s/\x1e//gm;
2210         s/(\xf0)s/\xc5\x9f/gm;
2211         s/(\xf0)S/\xc5\x9e/gm;
2212         s/(\xf0)c/ç/gm;
2213         s/(\xf0)C/Ç/gm;
2214         s/\xe7\x49/\\xc4\xb0/gm;
2215         s/(\xe6)G/\xc4\x9e/gm;
2216         s/(\xe6)g/ğ\xc4\x9f/gm;
2217         s/\xB8/ı/gm;
2218         s/\xB9/£/gm;
2219         s/(\xe8|\xc8)o/ö/gm;
2220         s/(\xe8|\xc8)O/Ö/gm;
2221         s/(\xe8|\xc8)u/ü/gm;
2222         s/(\xe8|\xc8)U/Ü/gm;
2223         s/\xc2\xb8/\xc4\xb1/gm;
2224         s/¸/\xc4\xb1/gm;
2225
2226         # this handles non-sorting blocks (if implementation requires this)
2227         $string = nsb_clean($_);
2228     }
2229     return ($string);
2230 }
2231
2232 =head2 nsb_clean
2233
2234 =over 4
2235
2236 my $string = nsb_clean( $string, $encoding );
2237
2238 =back
2239
2240 =cut
2241
2242 sub nsb_clean {
2243     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2244     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2245                               # handles non sorting blocks
2246     my ($string) = @_;
2247     $_ = $string;
2248     s/$NSB/(/gm;
2249     s/[ ]{0,1}$NSE/) /gm;
2250     $string = $_;
2251     return ($string);
2252 }
2253
2254 =head2 PrepareItemrecordDisplay
2255
2256 =over 4
2257
2258 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2259
2260 Returns a hash with all the fields for Display a given item data in a template
2261
2262 =back
2263
2264 =cut
2265
2266 sub PrepareItemrecordDisplay {
2267
2268     my ( $bibnum, $itemnum ) = @_;
2269
2270     my $dbh = C4::Context->dbh;
2271     my $frameworkcode = &GetFrameworkCode( $bibnum );
2272     my ( $itemtagfield, $itemtagsubfield ) =
2273       &GetMarcFromKohaField( $dbh, "items.itemnumber", $frameworkcode );
2274     my $tagslib = &GetMarcStructure( $dbh, 1, $frameworkcode );
2275     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2276     my @loop_data;
2277     my $authorised_values_sth =
2278       $dbh->prepare(
2279 "select authorised_value,lib from authorised_values where category=? order by lib"
2280       );
2281     foreach my $tag ( sort keys %{$tagslib} ) {
2282         my $previous_tag = '';
2283         if ( $tag ne '' ) {
2284             # loop through each subfield
2285             my $cntsubf;
2286             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2287                 next if ( subfield_is_koha_internal_p($subfield) );
2288                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2289                 my %subfield_data;
2290                 $subfield_data{tag}           = $tag;
2291                 $subfield_data{subfield}      = $subfield;
2292                 $subfield_data{countsubfield} = $cntsubf++;
2293                 $subfield_data{kohafield}     =
2294                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2295
2296          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2297                 $subfield_data{marc_lib} =
2298                     "<span id=\"error\" title=\""
2299                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2300                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2301                   . "</span>";
2302                 $subfield_data{mandatory} =
2303                   $tagslib->{$tag}->{$subfield}->{mandatory};
2304                 $subfield_data{repeatable} =
2305                   $tagslib->{$tag}->{$subfield}->{repeatable};
2306                 $subfield_data{hidden} = "display:none"
2307                   if $tagslib->{$tag}->{$subfield}->{hidden};
2308                 my ( $x, $value );
2309                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2310                   if ($itemrecord);
2311                 $value =~ s/"/&quot;/g;
2312
2313                 # search for itemcallnumber if applicable
2314                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2315                     'items.itemcallnumber'
2316                     && C4::Context->preference('itemcallnumber') )
2317                 {
2318                     my $CNtag =
2319                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2320                     my $CNsubfield =
2321                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2322                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2323                     if ($temp) {
2324                         $value = $temp->subfield($CNsubfield);
2325                     }
2326                 }
2327                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2328                     my @authorised_values;
2329                     my %authorised_lib;
2330
2331                     # builds list, depending on authorised value...
2332                     #---- branch
2333                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2334                         "branches" )
2335                     {
2336                         if ( ( C4::Context->preference("IndependantBranches") )
2337                             && ( C4::Context->userenv->{flags} != 1 ) )
2338                         {
2339                             my $sth =
2340                               $dbh->prepare(
2341 "select branchcode,branchname from branches where branchcode = ? order by branchname"
2342                               );
2343                             $sth->execute( C4::Context->userenv->{branch} );
2344                             push @authorised_values, ""
2345                               unless (
2346                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2347                             while ( my ( $branchcode, $branchname ) =
2348                                 $sth->fetchrow_array )
2349                             {
2350                                 push @authorised_values, $branchcode;
2351                                 $authorised_lib{$branchcode} = $branchname;
2352                             }
2353                         }
2354                         else {
2355                             my $sth =
2356                               $dbh->prepare(
2357 "select branchcode,branchname from branches order by branchname"
2358                               );
2359                             $sth->execute;
2360                             push @authorised_values, ""
2361                               unless (
2362                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2363                             while ( my ( $branchcode, $branchname ) =
2364                                 $sth->fetchrow_array )
2365                             {
2366                                 push @authorised_values, $branchcode;
2367                                 $authorised_lib{$branchcode} = $branchname;
2368                             }
2369                         }
2370
2371                         #----- itemtypes
2372                     }
2373                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2374                         "itemtypes" )
2375                     {
2376                         my $sth =
2377                           $dbh->prepare(
2378 "select itemtype,description from itemtypes order by description"
2379                           );
2380                         $sth->execute;
2381                         push @authorised_values, ""
2382                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2383                         while ( my ( $itemtype, $description ) =
2384                             $sth->fetchrow_array )
2385                         {
2386                             push @authorised_values, $itemtype;
2387                             $authorised_lib{$itemtype} = $description;
2388                         }
2389
2390                         #---- "true" authorised value
2391                     }
2392                     else {
2393                         $authorised_values_sth->execute(
2394                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2395                         push @authorised_values, ""
2396                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2397                         while ( my ( $value, $lib ) =
2398                             $authorised_values_sth->fetchrow_array )
2399                         {
2400                             push @authorised_values, $value;
2401                             $authorised_lib{$value} = $lib;
2402                         }
2403                     }
2404                     $subfield_data{marc_value} = CGI::scrolling_list(
2405                         -name     => 'field_value',
2406                         -values   => \@authorised_values,
2407                         -default  => "$value",
2408                         -labels   => \%authorised_lib,
2409                         -size     => 1,
2410                         -tabindex => '',
2411                         -multiple => 0,
2412                     );
2413                 }
2414                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2415                     $subfield_data{marc_value} =
2416 "<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>";
2417
2418 #"
2419 # COMMENTED OUT because No $i is provided with this API.
2420 # And thus, no value_builder can be activated.
2421 # BUT could be thought over.
2422 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2423 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2424 #             require $plugin;
2425 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2426 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2427 #             $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";
2428                 }
2429                 else {
2430                     $subfield_data{marc_value} =
2431 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2432                 }
2433                 push( @loop_data, \%subfield_data );
2434             }
2435         }
2436     }
2437     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2438       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2439     return {
2440         'itemtagfield'    => $itemtagfield,
2441         'itemtagsubfield' => $itemtagsubfield,
2442         'itemnumber'      => $itemnumber,
2443         'iteminformation' => \@loop_data
2444     };
2445 }
2446 #"
2447
2448 #
2449 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2450 # at the same time
2451 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2452 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2453 # =head2 ModZebrafiles
2454 #
2455 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2456 #
2457 # =cut
2458 #
2459 # sub ModZebrafiles {
2460 #
2461 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2462 #
2463 #     my $op;
2464 #     my $zebradir =
2465 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2466 #     unless ( opendir( DIR, "$zebradir" ) ) {
2467 #         warn "$zebradir not found";
2468 #         return;
2469 #     }
2470 #     closedir DIR;
2471 #     my $filename = $zebradir . $biblionumber;
2472 #
2473 #     if ($record) {
2474 #         open( OUTPUT, ">", $filename . ".xml" );
2475 #         print OUTPUT $record;
2476 #         close OUTPUT;
2477 #     }
2478 # }
2479
2480 =head2 ModZebra
2481
2482 =over 4
2483
2484 ModZebra( $dbh, $biblionumber, $op, $server );
2485
2486 =back
2487
2488 =cut
2489
2490 sub ModZebra {
2491 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2492     my ( $biblionumber, $op, $server ) = @_;
2493     my $dbh=C4::Context->dbh;
2494     #warn "SERVER:".$server;
2495 #
2496 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2497 # at the same time
2498 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2499 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2500
2501 my $sth=$dbh->prepare("insert into zebraqueue  (biblio_auth_number ,server,operation) values(?,?,?)");
2502 $sth->execute($biblionumber,$server,$op);
2503 $sth->finish;
2504
2505 #
2506 #     my @Zconnbiblio;
2507 #     my $tried     = 0;
2508 #     my $recon     = 0;
2509 #     my $reconnect = 0;
2510 #     my $record;
2511 #     my $shadow;
2512 #
2513 #   reconnect:
2514 #     $Zconnbiblio[0] = C4::Context->Zconn( $server, 0, 1 );
2515 #
2516 #     if ( $server eq "biblioserver" ) {
2517 #
2518 #         # it's unclear to me whether this should be in xml or MARC format
2519 #         # but it is clear it should be nabbed from zebra rather than from
2520 #         # the koha tables
2521 #         $record = GetMarcBiblio($biblionumber);
2522 #         $record = $record->as_xml_record() if $record;
2523 # #            warn "RECORD $biblionumber => ".$record;
2524 #         $shadow="biblioservershadow";
2525 #
2526 #         #           warn "RECORD $biblionumber => ".$record;
2527 #         $shadow = "biblioservershadow";
2528 #
2529 #     }
2530 #     elsif ( $server eq "authorityserver" ) {
2531 #         $record = C4::AuthoritiesMarc::XMLgetauthority( $dbh, $biblionumber );
2532 #         $shadow = "authorityservershadow";
2533 #     }    ## Add other servers as necessary
2534 #
2535 #     my $Zpackage = $Zconnbiblio[0]->package();
2536 #     $Zpackage->option( action => $op );
2537 #     $Zpackage->option( record => $record );
2538 #
2539 #   retry:
2540 #     $Zpackage->send("update");
2541 #     my $i;
2542 #     my $event;
2543 #
2544 #     while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
2545 #         $event = $Zconnbiblio[0]->last_event();
2546 #         last if $event == ZOOM::Event::ZEND;
2547 #     }
2548 #
2549 #     my ( $error, $errmsg, $addinfo, $diagset ) = $Zconnbiblio[0]->error_x();
2550 #     if ( $error == 10000 && $reconnect == 0 )
2551 #     {    ## This is serious ZEBRA server is not available -reconnect
2552 #         warn "problem with zebra server connection";
2553 #         $reconnect = 1;
2554 #         my $res = system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
2555 #
2556 #         #warn "Trying to restart ZEBRA Server";
2557 #         #goto "reconnect";
2558 #     }
2559 #     elsif ( $error == 10007 && $tried < 2 )
2560 #     {    ## timeout --another 30 looonng seconds for this update
2561 #         $tried = $tried + 1;
2562 #         warn "warn: timeout, trying again";
2563 #         goto "retry";
2564 #     }
2565 #     elsif ( $error == 10004 && $recon == 0 ) {    ##Lost connection -reconnect
2566 #         $recon = 1;
2567 #         warn "error: reconnecting to zebra";
2568 #         goto "reconnect";
2569 #
2570 #    # as a last resort, we save the data to the filesystem to be indexed in batch
2571 #     }
2572 #     elsif ($error) {
2573 #         warn
2574 # "Error-$server   $op $biblionumber /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
2575 #         $Zpackage->destroy();
2576 #         $Zconnbiblio[0]->destroy();
2577 #         ModZebrafiles( $dbh, $biblionumber, $record, $op, $server );
2578 #         return;
2579 #     }
2580 #     if ( C4::Context->$shadow ) {
2581 #         $Zpackage->send('commit');
2582 #         while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
2583 #
2584 #             #waiting zebra to finish;
2585 #          }
2586 #     }
2587 #     $Zpackage->destroy();
2588 }
2589
2590 =head1 INTERNAL FUNCTIONS
2591
2592 =head2 MARCitemchange
2593
2594 =over 4
2595
2596 &MARCitemchange( $record, $itemfield, $newvalue )
2597
2598 Function to update a single value in an item field.
2599 Used twice, could probably be replaced by something else, but works well...
2600
2601 =back
2602
2603 =back
2604
2605 =cut
2606
2607 sub MARCitemchange {
2608     my ( $record, $itemfield, $newvalue ) = @_;
2609     my $dbh = C4::Context->dbh;
2610
2611     my ( $tagfield, $tagsubfield ) =
2612       GetMarcFromKohaField( $dbh, $itemfield, "" );
2613     if ( ($tagfield) && ($tagsubfield) ) {
2614         my $tag = $record->field($tagfield);
2615         if ($tag) {
2616             $tag->update( $tagsubfield => $newvalue );
2617             $record->delete_field($tag);
2618             $record->insert_fields_ordered($tag);
2619         }
2620     }
2621 }
2622
2623 =head2 _koha_add_biblio
2624
2625 =over 4
2626
2627 _koha_add_biblio($dbh,$biblioitem);
2628
2629 Internal function to add a biblio ($biblio is a hash with the values)
2630
2631 =back
2632
2633 =cut
2634
2635 sub _koha_add_biblio {
2636     my ( $dbh, $biblio, $frameworkcode ) = @_;
2637     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
2638     $sth->execute;
2639     my $data         = $sth->fetchrow_arrayref;
2640     my $biblionumber = $$data[0] + 1;
2641     my $series       = 0;
2642
2643     if ( $biblio->{'seriestitle'} ) { $series = 1 }
2644     $sth->finish;
2645     $sth = $dbh->prepare(
2646         "INSERT INTO biblio
2647     SET biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?, frameworkcode = ? "
2648     );
2649     $sth->execute(
2650         $biblionumber,         $biblio->{'title'},
2651         $biblio->{'author'},   $biblio->{'copyrightdate'},
2652         $biblio->{'serial'},   $biblio->{'seriestitle'},
2653         $biblio->{'notes'},    $biblio->{'abstract'},
2654         $biblio->{'unititle'}, $frameworkcode
2655     );
2656
2657     $sth->finish;
2658     return ($biblionumber);
2659 }
2660
2661 =head2 _find_value
2662
2663 =over 4
2664
2665 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2666
2667 Find the given $subfield in the given $tag in the given
2668 MARC::Record $record.  If the subfield is found, returns
2669 the (indicators, value) pair; otherwise, (undef, undef) is
2670 returned.
2671
2672 PROPOSITION :
2673 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2674 I suggest we export it from this module.
2675
2676 =back
2677
2678 =cut
2679
2680 sub _find_value {
2681     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2682     my @result;
2683     my $indicator;
2684     if ( $tagfield < 10 ) {
2685         if ( $record->field($tagfield) ) {
2686             push @result, $record->field($tagfield)->data();
2687         }
2688         else {
2689             push @result, "";
2690         }
2691     }
2692     else {
2693         foreach my $field ( $record->field($tagfield) ) {
2694             my @subfields = $field->subfields();
2695             foreach my $subfield (@subfields) {
2696                 if ( @$subfield[0] eq $insubfield ) {
2697                     push @result, @$subfield[1];
2698                     $indicator = $field->indicator(1) . $field->indicator(2);
2699                 }
2700             }
2701         }
2702     }
2703     return ( $indicator, @result );
2704 }
2705
2706 =head2 _koha_modify_biblio
2707
2708 =over 4
2709
2710 Internal function for updating the biblio table
2711
2712 =back
2713
2714 =cut
2715
2716 sub _koha_modify_biblio {
2717     my ( $dbh, $biblio ) = @_;
2718
2719 # FIXME: this code could be made more portable by not hard-coding the values that are supposed to be in biblio table
2720     my $sth =
2721       $dbh->prepare(
2722 "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
2723       );
2724     $sth->execute(
2725         $biblio->{'title'},       $biblio->{'author'},
2726         $biblio->{'abstract'},    $biblio->{'copyrightdate'},
2727         $biblio->{'seriestitle'}, $biblio->{'serial'},
2728         $biblio->{'unititle'},    $biblio->{'notes'},
2729         $biblio->{'biblionumber'}
2730     );
2731     $sth->finish;
2732     return ( $biblio->{'biblionumber'} );
2733 }
2734
2735 =head2 _koha_modify_biblioitem
2736
2737 =over 4
2738
2739 _koha_modify_biblioitem( $dbh, $biblioitem );
2740
2741 =back
2742
2743 =cut
2744
2745 sub _koha_modify_biblioitem {
2746     my ( $dbh, $biblioitem ) = @_;
2747     my $query;
2748 ##Recalculate LC in case it changed --TG
2749
2750     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
2751     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
2752     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
2753     $biblioitem->{'issn'}          = $dbh->quote( $biblioitem->{'issn'} );
2754     $biblioitem->{'publishercode'} =
2755       $dbh->quote( $biblioitem->{'publishercode'} );
2756     $biblioitem->{'publicationyear'} =
2757       $dbh->quote( $biblioitem->{'publicationyear'} );
2758     $biblioitem->{'classification'} =
2759       $dbh->quote( $biblioitem->{'classification'} );
2760     $biblioitem->{'dewey'}        = $dbh->quote( $biblioitem->{'dewey'} );
2761     $biblioitem->{'subclass'}     = $dbh->quote( $biblioitem->{'subclass'} );
2762     $biblioitem->{'illus'}        = $dbh->quote( $biblioitem->{'illus'} );
2763     $biblioitem->{'pages'}        = $dbh->quote( $biblioitem->{'pages'} );
2764     $biblioitem->{'volumeddesc'}  = $dbh->quote( $biblioitem->{'volumeddesc'} );
2765     $biblioitem->{'bnotes'}       = $dbh->quote( $biblioitem->{'bnotes'} );
2766     $biblioitem->{'size'}         = $dbh->quote( $biblioitem->{'size'} );
2767     $biblioitem->{'place'}        = $dbh->quote( $biblioitem->{'place'} );
2768     $biblioitem->{'ccode'}        = $dbh->quote( $biblioitem->{'ccode'} );
2769     $biblioitem->{'biblionumber'} =
2770       $dbh->quote( $biblioitem->{'biblionumber'} );
2771
2772     $query = "Update biblioitems set
2773         itemtype        = $biblioitem->{'itemtype'},
2774         url             = $biblioitem->{'url'},
2775         isbn            = $biblioitem->{'isbn'},
2776         issn            = $biblioitem->{'issn'},
2777         publishercode   = $biblioitem->{'publishercode'},
2778         publicationyear = $biblioitem->{'publicationyear'},
2779         classification  = $biblioitem->{'classification'},
2780         dewey           = $biblioitem->{'dewey'},
2781         subclass        = $biblioitem->{'subclass'},
2782         illus           = $biblioitem->{'illus'},
2783         pages           = $biblioitem->{'pages'},
2784         volumeddesc     = $biblioitem->{'volumeddesc'},
2785         notes           = $biblioitem->{'bnotes'},
2786         size            = $biblioitem->{'size'},
2787         place           = $biblioitem->{'place'},
2788         ccode           = $biblioitem->{'ccode'}
2789         where biblionumber = $biblioitem->{'biblionumber'}";
2790
2791     $dbh->do($query);
2792     if ( $dbh->errstr ) {
2793         warn "$query";
2794     }
2795 }
2796
2797 =head2 _koha_add_biblioitem
2798
2799 =over 4
2800
2801 _koha_add_biblioitem( $dbh, $biblioitem );
2802
2803 Internal function to add a biblioitem
2804
2805 =back
2806
2807 =cut
2808
2809 sub _koha_add_biblioitem {
2810     my ( $dbh, $biblioitem ) = @_;
2811
2812     #  my $dbh   = C4Connect;
2813     my $sth = $dbh->prepare("SELECT max(biblioitemnumber) FROM biblioitems");
2814     my $data;
2815     my $bibitemnum;
2816
2817     $sth->execute;
2818     $data       = $sth->fetchrow_arrayref;
2819     $bibitemnum = $$data[0] + 1;
2820
2821     $sth->finish;
2822
2823     $sth = $dbh->prepare(
2824         "INSERT INTO biblioitems SET
2825             biblioitemnumber = ?, biblionumber    = ?,
2826             volume           = ?, number          = ?,
2827             classification   = ?, itemtype        = ?,
2828             url              = ?, isbn            = ?,
2829             issn             = ?, dewey           = ?,
2830             subclass         = ?, publicationyear = ?,
2831             publishercode    = ?, volumedate      = ?,
2832             volumeddesc      = ?, illus           = ?,
2833             pages            = ?, notes           = ?,
2834             size             = ?, lccn            = ?,
2835             marc             = ?, lcsort          =?,
2836             place            = ?, ccode           = ?
2837           "
2838     );
2839     my ($lcsort) =
2840       calculatelc( $biblioitem->{'classification'} )
2841       . $biblioitem->{'subclass'};
2842     $sth->execute(
2843         $bibitemnum,                     $biblioitem->{'biblionumber'},
2844         $biblioitem->{'volume'},         $biblioitem->{'number'},
2845         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
2846         $biblioitem->{'url'},            $biblioitem->{'isbn'},
2847         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
2848         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
2849         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
2850         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
2851         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
2852         $biblioitem->{'size'},           $biblioitem->{'lccn'},
2853         $biblioitem->{'marc'},           $biblioitem->{'place'},
2854         $lcsort,                         $biblioitem->{'ccode'}
2855     );
2856     $sth->finish;
2857     return ($bibitemnum);
2858 }
2859
2860 =head2 _koha_new_items
2861
2862 =over 4
2863
2864 _koha_new_items( $dbh, $item, $barcode );
2865
2866 =back
2867
2868 =cut
2869
2870 sub _koha_new_items {
2871     my ( $dbh, $item, $barcode ) = @_;
2872
2873     #  my $dbh   = C4Connect;
2874     my $sth = $dbh->prepare("Select max(itemnumber) from items");
2875     my $data;
2876     my $itemnumber;
2877     my $error = "";
2878
2879     $sth->execute;
2880     $data       = $sth->fetchrow_hashref;
2881     $itemnumber = $data->{'max(itemnumber)'} + 1;
2882     $sth->finish;
2883 ## Now calculate lccalnumber
2884     my ($cutterextra) = itemcalculator(
2885         $dbh,
2886         $item->{'biblioitemnumber'},
2887         $item->{'itemcallnumber'}
2888     );
2889
2890 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
2891     if ( $item->{'loan'} ) {
2892         $item->{'notforloan'} = $item->{'loan'};
2893     }
2894
2895     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
2896     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
2897
2898         $sth = $dbh->prepare(
2899             "Insert into items set
2900             itemnumber           = ?,     biblionumber     = ?,
2901             multivolumepart      = ?,
2902             biblioitemnumber     = ?,     barcode          = ?,
2903             booksellerid         = ?,     dateaccessioned  = NOW(),
2904             homebranch           = ?,     holdingbranch    = ?,
2905             price                = ?,     replacementprice = ?,
2906             replacementpricedate = NOW(), datelastseen     = NOW(),
2907             multivolume          = ?,     stack            = ?,
2908             itemlost             = ?,     wthdrawn         = ?,
2909             paidfor              = ?,     itemnotes        = ?,
2910             itemcallnumber       =?,      notforloan       = ?,
2911             location             = ?,     Cutterextra      = ?
2912           "
2913         );
2914         $sth->execute(
2915             $itemnumber,                $item->{'biblionumber'},
2916             $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
2917             $barcode,                   $item->{'booksellerid'},
2918             $item->{'homebranch'},      $item->{'holdingbranch'},
2919             $item->{'price'},           $item->{'replacementprice'},
2920             $item->{multivolume},       $item->{stack},
2921             $item->{itemlost},          $item->{wthdrawn},
2922             $item->{paidfor},           $item->{'itemnotes'},
2923             $item->{'itemcallnumber'},  $item->{'notforloan'},
2924             $item->{'location'},        $cutterextra
2925         );
2926     }
2927     else {
2928         $sth = $dbh->prepare(
2929             "INSERT INTO items SET
2930             itemnumber           = ?,     biblionumber     = ?,
2931             multivolumepart      = ?,
2932             biblioitemnumber     = ?,     barcode          = ?,
2933             booksellerid         = ?,     dateaccessioned  = ?,
2934             homebranch           = ?,     holdingbranch    = ?,
2935             price                = ?,     replacementprice = ?,
2936             replacementpricedate = NOW(), datelastseen     = NOW(),
2937             multivolume          = ?,     stack            = ?,
2938             itemlost             = ?,     wthdrawn         = ?,
2939             paidfor              = ?,     itemnotes        = ?,
2940             itemcallnumber       = ?,     notforloan       = ?,
2941             location             = ?,
2942             Cutterextra          = ?
2943                             "
2944         );
2945         $sth->execute(
2946             $itemnumber,                 $item->{'biblionumber'},
2947             $item->{'multivolumepart'},  $item->{'biblioitemnumber'},
2948             $barcode,                    $item->{'booksellerid'},
2949             $item->{'dateaccessioned'},  $item->{'homebranch'},
2950             $item->{'holdingbranch'},    $item->{'price'},
2951             $item->{'replacementprice'}, $item->{multivolume},
2952             $item->{stack},              $item->{itemlost},
2953             $item->{wthdrawn},           $item->{paidfor},
2954             $item->{'itemnotes'},        $item->{'itemcallnumber'},
2955             $item->{'notforloan'},       $item->{'location'},
2956             $cutterextra
2957         );
2958     }
2959     if ( defined $sth->errstr ) {
2960         $error .= $sth->errstr;
2961     }
2962     return ( $itemnumber, $error );
2963 }
2964
2965 =head2 _koha_modify_item
2966
2967 =over 4
2968
2969 _koha_modify_item( $dbh, $item, $op );
2970
2971 =back
2972
2973 =cut
2974
2975 sub _koha_modify_item {
2976     my ( $dbh, $item, $op ) = @_;
2977     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
2978
2979     # if all we're doing is setting statuses, just update those and get out
2980     if ( $op eq "setstatus" ) {
2981         my $query =
2982           "UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
2983         my @bind = (
2984             $item->{'itemlost'}, $item->{'wthdrawn'},
2985             $item->{'binding'},  $item->{'itemnumber'}
2986         );
2987         my $sth = $dbh->prepare($query);
2988         $sth->execute(@bind);
2989         $sth->finish;
2990         return undef;
2991     }
2992 ## Now calculate lccalnumber
2993     my ($cutterextra) =
2994       itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
2995
2996     my $query = "UPDATE items SET
2997 barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
2998
2999     my @bind = (
3000         $item->{'barcode'},        $item->{'notes'},
3001         $item->{'itemcallnumber'}, $item->{'notforloan'},
3002         $item->{'location'},       $item->{multivolumepart},
3003         $item->{multivolume},      $item->{stack},
3004         $item->{wthdrawn},         $item->{holdingbranch},
3005         $item->{homebranch},       $cutterextra,
3006         $item->{onloan},           $item->{binding}
3007     );
3008     if ( $item->{'lost'} ne '' ) {
3009         $query =
3010 "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
3011                             itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
3012                              location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
3013         @bind = (
3014             $item->{'bibitemnum'},     $item->{'barcode'},
3015             $item->{'notes'},          $item->{'homebranch'},
3016             $item->{'lost'},           $item->{'wthdrawn'},
3017             $item->{'itemcallnumber'}, $item->{'notforloan'},
3018             $item->{'location'},       $item->{multivolumepart},
3019             $item->{multivolume},      $item->{stack},
3020             $item->{wthdrawn},         $item->{holdingbranch},
3021             $cutterextra,              $item->{onloan},
3022             $item->{binding}
3023         );
3024         if ( $item->{homebranch} ) {
3025             $query .= ",homebranch=?";
3026             push @bind, $item->{homebranch};
3027         }
3028         if ( $item->{holdingbranch} ) {
3029             $query .= ",holdingbranch=?";
3030             push @bind, $item->{holdingbranch};
3031         }
3032     }
3033     $query .= " where itemnumber=?";
3034     push @bind, $item->{'itemnum'};
3035     if ( $item->{'replacement'} ne '' ) {
3036         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
3037     }
3038     my $sth = $dbh->prepare($query);
3039     $sth->execute(@bind);
3040     $sth->finish;
3041 }
3042
3043 =head2 _koha_delete_biblio
3044
3045 =over 4
3046
3047 $error = _koha_delete_biblio($dbh,$biblionumber);
3048
3049 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3050
3051 C<$dbh> - the database handle
3052 C<$biblionumber> - the biblionumber of the biblio to be deleted
3053
3054 =back
3055
3056 =cut
3057
3058 # FIXME: add error handling
3059
3060 sub _koha_delete_biblio {
3061     my ( $dbh, $biblionumber ) = @_;
3062
3063     # get all the data for this biblio
3064     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3065     $sth->execute($biblionumber);
3066
3067     if ( my $data = $sth->fetchrow_hashref ) {
3068
3069         # save the record in deletedbiblio
3070         # find the fields to save
3071         my $query = "INSERT INTO deletedbiblio SET ";
3072         my @bind  = ();
3073         foreach my $temp ( keys %$data ) {
3074             $query .= "$temp = ?,";
3075             push( @bind, $data->{$temp} );
3076         }
3077
3078         # replace the last , by ",?)"
3079         $query =~ s/\,$//;
3080         my $bkup_sth = $dbh->prepare($query);
3081         $bkup_sth->execute(@bind);
3082         $bkup_sth->finish;
3083
3084         # delete the biblio
3085         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3086         $del_sth->execute($biblionumber);
3087         $del_sth->finish;
3088     }
3089     $sth->finish;
3090     return undef;
3091 }
3092
3093 =head2 _koha_delete_biblioitems
3094
3095 =over 4
3096
3097 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3098
3099 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3100
3101 C<$dbh> - the database handle
3102 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3103
3104 =back
3105
3106 =cut
3107
3108 # FIXME: add error handling
3109
3110 sub _koha_delete_biblioitems {
3111     my ( $dbh, $biblioitemnumber ) = @_;
3112
3113     # get all the data for this biblioitem
3114     my $sth =
3115       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3116     $sth->execute($biblioitemnumber);
3117
3118     if ( my $data = $sth->fetchrow_hashref ) {
3119
3120         # save the record in deletedbiblioitems
3121         # find the fields to save
3122         my $query = "INSERT INTO deletedbiblioitems SET ";
3123         my @bind  = ();
3124         foreach my $temp ( keys %$data ) {
3125             $query .= "$temp = ?,";
3126             push( @bind, $data->{$temp} );
3127         }
3128
3129         # replace the last , by ",?)"
3130         $query =~ s/\,$//;
3131         my $bkup_sth = $dbh->prepare($query);
3132         $bkup_sth->execute(@bind);
3133         $bkup_sth->finish;
3134
3135         # delete the biblioitem
3136         my $del_sth =
3137           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3138         $del_sth->execute($biblioitemnumber);
3139         $del_sth->finish;
3140     }
3141     $sth->finish;
3142     return undef;
3143 }
3144
3145 =head2 _koha_delete_item
3146
3147 =over 4
3148
3149 _koha_delete_item( $dbh, $itemnum );
3150
3151 Internal function to delete an item record from the koha tables
3152
3153 =back
3154
3155 =cut
3156
3157 sub _koha_delete_item {
3158     my ( $dbh, $itemnum ) = @_;
3159
3160     my $sth = $dbh->prepare("select * from items where itemnumber=?");
3161     $sth->execute($itemnum);
3162     my $data = $sth->fetchrow_hashref;
3163     $sth->finish;
3164     my $query = "Insert into deleteditems set ";
3165     my @bind  = ();
3166     foreach my $temp ( keys %$data ) {
3167         $query .= "$temp = ?,";
3168         push( @bind, $data->{$temp} );
3169     }
3170     $query =~ s/\,$//;
3171
3172     #  print $query;
3173     $sth = $dbh->prepare($query);
3174     $sth->execute(@bind);
3175     $sth->finish;
3176     $sth = $dbh->prepare("Delete from items where itemnumber=?");
3177     $sth->execute($itemnum);
3178     $sth->finish;
3179 }
3180
3181 =head1 UNEXPORTED FUNCTIONS
3182
3183 =over 4
3184
3185 =head2 calculatelc
3186
3187 $lc = calculatelc($classification);
3188
3189 =back
3190
3191 =cut
3192
3193 sub calculatelc {
3194     my ($classification) = @_;
3195     $classification =~ s/^\s+|\s+$//g;
3196     my $i = 0;
3197     my $lc2;
3198     my $lc1;
3199
3200     for ( $i = 0 ; $i < length($classification) ; $i++ ) {
3201         my $c = ( substr( $classification, $i, 1 ) );
3202         if ( $c ge '0' && $c le '9' ) {
3203
3204             $lc2 = substr( $classification, $i );
3205             last;
3206         }
3207         else {
3208             $lc1 .= substr( $classification, $i, 1 );
3209
3210         }
3211     }    #while
3212
3213     my $other = length($lc1);
3214     if ( !$lc1 ) {
3215         $other = 0;
3216     }
3217
3218     my $extras;
3219     if ( $other < 4 ) {
3220         for ( 1 .. ( 4 - $other ) ) {
3221             $extras .= "0";
3222         }
3223     }
3224     $lc1 .= $extras;
3225     $lc2 =~ s/^ //g;
3226
3227     $lc2 =~ s/ //g;
3228     $extras = "";
3229     ##Find the decimal part of $lc2
3230     my $pos = index( $lc2, "." );
3231     if ( $pos < 0 ) { $pos = length($lc2); }
3232     if ( $pos >= 0 && $pos < 5 ) {
3233         ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
3234
3235         for ( 1 .. ( 5 - $pos ) ) {
3236             $extras .= "0";
3237         }
3238     }
3239     $lc2 = $extras . $lc2;
3240     return ( $lc1 . $lc2 );
3241 }
3242
3243 =head2 itemcalculator
3244
3245 =over 4
3246
3247 $cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
3248
3249 =back
3250
3251 =cut
3252
3253 sub itemcalculator {
3254     my ( $dbh, $biblioitem, $callnumber ) = @_;
3255     my $sth =
3256       $dbh->prepare(
3257 "select classification, subclass from biblioitems where biblioitemnumber=?"
3258       );
3259
3260     $sth->execute($biblioitem);
3261     my ( $classification, $subclass ) = $sth->fetchrow;
3262     my $all         = $classification . " " . $subclass;
3263     my $total       = length($all);
3264     my $cutterextra = substr( $callnumber, $total - 1 );
3265
3266     return $cutterextra;
3267 }
3268
3269 =head2 ModBiblioMarc
3270
3271 =over 4
3272
3273 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3274
3275 Add MARC data for a biblio to koha
3276
3277 Function exported, but should NOT be used, unless you really know what you're doing
3278
3279 =back
3280
3281 =cut
3282
3283 sub ModBiblioMarc {
3284
3285 # pass the MARC::Record to this function, and it will create the records in the marc tables
3286     my ( $record, $biblionumber, $frameworkcode ) = @_;
3287     my $dbh = C4::Context->dbh;
3288     my @fields = $record->fields();
3289     if ( !$frameworkcode ) {
3290         $frameworkcode = "";
3291     }
3292     my $sth =
3293       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3294     $sth->execute( $frameworkcode, $biblionumber );
3295     $sth->finish;
3296     my $encoding = C4::Context->preference("marcflavour");
3297
3298 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3299     if ( $encoding eq "UNIMARC" ) {
3300         my $string;
3301         if ( $record->subfield( 100, "a" ) ) {
3302             $string = $record->subfield( 100, "a" );
3303             my $f100 = $record->field(100);
3304             $record->delete_field($f100);
3305         }
3306         else {
3307             $string = POSIX::strftime( "%Y%m%d", localtime );
3308             $string =~ s/\-//g;
3309             $string = sprintf( "%-*s", 35, $string );
3310         }
3311         substr( $string, 22, 6, "frey50" );
3312         unless ( $record->subfield( 100, "a" ) ) {
3313             $record->insert_grouped_field(
3314                 MARC::Field->new( 100, "", "", "a" => $string ) );
3315         }
3316     }
3317 #     warn "biblionumber : ".$biblionumber;
3318     $sth =
3319       $dbh->prepare(
3320         "update biblioitems set marc=?,marcxml=?  where biblionumber=?");
3321     $sth->execute( $record->as_usmarc(), $record->as_xml_record(),
3322         $biblionumber );
3323 #     warn $record->as_xml_record();
3324     $sth->finish;
3325     ModZebra($biblionumber,"specialUpdate","biblioserver");
3326     return $biblionumber;
3327 }
3328
3329 =head2 AddItemInMarc
3330
3331 =over 4
3332
3333 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
3334
3335 Add an item in a MARC record and save the MARC record
3336
3337 Function exported, but should NOT be used, unless you really know what you're doing
3338
3339 =back
3340
3341 =cut
3342
3343 sub AddItemInMarc {
3344
3345 # pass the MARC::Record to this function, and it will create the records in the marc tables
3346     my ( $record, $biblionumber, $frameworkcode ) = @_;
3347     my $newrec = &GetMarcBiblio($biblionumber);
3348
3349     # create it
3350     my @fields = $record->fields();
3351     foreach my $field (@fields) {
3352         $newrec->append_fields($field);
3353     }
3354
3355     # FIXME: should we be making sure the biblionumbers are the same?
3356     my $newbiblionumber =
3357       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
3358     return $newbiblionumber;
3359 }
3360
3361 =head2 z3950_extended_services
3362
3363 z3950_extended_services($serviceType,$serviceOptions,$record);
3364
3365     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.
3366
3367 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3368
3369 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3370
3371     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3372
3373 and maybe
3374
3375     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3376     syntax => the record syntax (transfer syntax)
3377     databaseName = Database from connection object
3378
3379     To set serviceOptions, call set_service_options($serviceType)
3380
3381 C<$record> the record, if one is needed for the service type
3382
3383     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3384
3385 =cut
3386
3387 sub z3950_extended_services {
3388     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3389
3390     # get our connection object
3391     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3392
3393     # create a new package object
3394     my $Zpackage = $Zconn->package();
3395
3396     # set our options
3397     $Zpackage->option( action => $action );
3398
3399     if ( $serviceOptions->{'databaseName'} ) {
3400         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3401     }
3402     if ( $serviceOptions->{'recordIdNumber'} ) {
3403         $Zpackage->option(
3404             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3405     }
3406     if ( $serviceOptions->{'recordIdOpaque'} ) {
3407         $Zpackage->option(
3408             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3409     }
3410
3411  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3412  #if ($serviceType eq 'itemorder') {
3413  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3414  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3415  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3416  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3417  #}
3418
3419     if ( $serviceOptions->{record} ) {
3420         $Zpackage->option( record => $serviceOptions->{record} );
3421
3422         # can be xml or marc
3423         if ( $serviceOptions->{'syntax'} ) {
3424             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3425         }
3426     }
3427
3428     # send the request, handle any exception encountered
3429     eval { $Zpackage->send($serviceType) };
3430     if ( $@ && $@->isa("ZOOM::Exception") ) {
3431         return "error:  " . $@->code() . " " . $@->message() . "\n";
3432     }
3433
3434     # free up package resources
3435     $Zpackage->destroy();
3436 }
3437
3438 =head2 set_service_options
3439
3440 my $serviceOptions = set_service_options($serviceType);
3441
3442 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3443
3444 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3445
3446 =cut
3447
3448 sub set_service_options {
3449     my ($serviceType) = @_;
3450     my $serviceOptions;
3451
3452 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3453 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3454
3455     if ( $serviceType eq 'commit' ) {
3456
3457         # nothing to do
3458     }
3459     if ( $serviceType eq 'create' ) {
3460
3461         # nothing to do
3462     }
3463     if ( $serviceType eq 'drop' ) {
3464         die "ERROR: 'drop' not currently supported (by Zebra)";
3465     }
3466     return $serviceOptions;
3467 }
3468
3469 END { }    # module clean-up code here (global destructor)
3470
3471 1;
3472
3473 __END__
3474
3475 =head1 AUTHOR
3476
3477 Koha Developement team <info@koha.org>
3478
3479 Paul POULAIN paul.poulain@free.fr
3480
3481 Joshua Ferraro jmf@liblime.com
3482
3483 =cut
3484
3485 # $Id$
3486 # $Log$
3487 # Revision 1.193  2007/03/29 16:45:53  tipaul
3488 # Code cleaning of Biblio.pm (continued)
3489 #
3490 # All subs have be cleaned :
3491 # - removed useless
3492 # - merged some
3493 # - reordering Biblio.pm completly
3494 # - using only naming conventions
3495 #
3496 # Seems to have broken nothing, but it still has to be heavily tested.
3497 # Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
3498 #
3499 # Revision 1.192  2007/03/29 13:30:31  tipaul
3500 # Code cleaning :
3501 # == Biblio.pm cleaning (useless) ==
3502 # * some sub declaration dropped
3503 # * removed modbiblio sub
3504 # * removed moditem sub
3505 # * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
3506 # * removed MARCkoha2marcItem
3507 # * removed MARCdelsubfield declaration
3508 # * removed MARCkoha2marcBiblio
3509 #
3510 # == Biblio.pm cleaning (naming conventions) ==
3511 # * MARCgettagslib renamed to GetMarcStructure
3512 # * MARCgetitems renamed to GetMarcItem
3513 # * MARCfind_frameworkcode renamed to GetFrameworkCode
3514 # * MARCmarc2koha renamed to TransformMarcToKoha
3515 # * MARChtml2marc renamed to TransformHtmlToMarc
3516 # * MARChtml2xml renamed to TranformeHtmlToXml
3517 # * zebraop renamed to ModZebra
3518 #
3519 # == MARC=OFF ==
3520 # * removing MARC=OFF related scripts (in cataloguing directory)
3521 # * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
3522 # * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
3523 #
3524 # Revision 1.191  2007/03/29 09:42:13  tipaul
3525 # adding default value new feature into cataloguing. The system (definition) part has already been added by toins
3526 #
3527 # Revision 1.190  2007/03/29 08:45:19  hdl
3528 # Deleting ignore_errors(1) pour MARC::Charset
3529 #
3530 # Revision 1.189  2007/03/28 10:39:16  hdl
3531 # removing $dbh as a parameter in AuthoritiesMarc functions
3532 # And reporting all differences into the scripts taht relies on those functions.