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           # why the hell do we need to explicitly decode utf8 ?
1241           # that's a good question, but we must do it...
1242           use utf8;
1243           utf8::decode($res->{$tag}->{lib});
1244 #           warn "$liblibrarian";
1245         $res->{$tab}->{tab}        = "";            # XXX
1246         $res->{$tag}->{mandatory}  = $mandatory;
1247         $res->{$tag}->{repeatable} = $repeatable;
1248     }
1249
1250     $sth =
1251       $dbh->prepare(
1252 "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"
1253       );
1254     $sth->execute($frameworkcode);
1255
1256     my $subfield;
1257     my $authorised_value;
1258     my $authtypecode;
1259     my $value_builder;
1260     my $kohafield;
1261     my $seealso;
1262     my $hidden;
1263     my $isurl;
1264     my $link;
1265     my $defaultvalue;
1266
1267     while (
1268         (
1269             $tag,          $subfield,      $liblibrarian,
1270             ,              $libopac,       $tab,
1271             $mandatory,    $repeatable,    $authorised_value,
1272             $authtypecode, $value_builder, $kohafield,
1273             $seealso,      $hidden,        $isurl,
1274             $link,$defaultvalue
1275         )
1276         = $sth->fetchrow
1277       )
1278     {
1279         $res->{$tag}->{$subfield}->{lib} =
1280           ( $forlibrarian or !$libopac ) ? $liblibrarian : $libopac;
1281         $res->{$tag}->{$subfield}->{tab}              = $tab;
1282         $res->{$tag}->{$subfield}->{mandatory}        = $mandatory;
1283         $res->{$tag}->{$subfield}->{repeatable}       = $repeatable;
1284         $res->{$tag}->{$subfield}->{authorised_value} = $authorised_value;
1285         $res->{$tag}->{$subfield}->{authtypecode}     = $authtypecode;
1286         $res->{$tag}->{$subfield}->{value_builder}    = $value_builder;
1287         $res->{$tag}->{$subfield}->{kohafield}        = $kohafield;
1288         $res->{$tag}->{$subfield}->{seealso}          = $seealso;
1289         $res->{$tag}->{$subfield}->{hidden}           = $hidden;
1290         $res->{$tag}->{$subfield}->{isurl}            = $isurl;
1291         $res->{$tag}->{$subfield}->{link}             = $link;
1292         $res->{$tag}->{$subfield}->{defaultvalue}     = $defaultvalue;
1293     }
1294     return $res;
1295 }
1296
1297 =head2 GetMarcFromKohaField
1298
1299 =over 4
1300
1301 ($MARCfield,$MARCsubfield)=GetMarcFromKohaField($dbh,$kohafield,$frameworkcode);
1302 Returns the MARC fields & subfields mapped to the koha field
1303 for the given frameworkcode
1304
1305 =back
1306
1307 =cut
1308
1309 sub GetMarcFromKohaField {
1310     my ( $dbh, $kohafield, $frameworkcode ) = @_;
1311     return 0, 0 unless $kohafield;
1312     my $relations = C4::Context->marcfromkohafield;
1313     return (
1314         $relations->{$frameworkcode}->{$kohafield}->[0],
1315         $relations->{$frameworkcode}->{$kohafield}->[1]
1316     );
1317 }
1318
1319 =head2 GetMarcBiblio
1320
1321 =over 4
1322
1323 Returns MARC::Record of the biblionumber passed in parameter.
1324 the marc record contains both biblio & item datas
1325
1326 =back
1327
1328 =cut
1329
1330 sub GetMarcBiblio {
1331     my $biblionumber = shift;
1332     my $dbh          = C4::Context->dbh;
1333     my $sth          =
1334       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1335     $sth->execute($biblionumber);
1336     my ($marcxml) = $sth->fetchrow;
1337 #     warn "marcxml : $marcxml";
1338     MARC::File::XML->default_record_format(C4::Context->preference('marcflavour'));
1339     $marcxml =~ s/\x1e//g;
1340     $marcxml =~ s/\x1f//g;
1341     $marcxml =~ s/\x1d//g;
1342     $marcxml =~ s/\x0f//g;
1343     $marcxml =~ s/\x0c//g;
1344     my $record = MARC::Record->new();
1345     $record = MARC::Record::new_from_xml( $marcxml, "utf8",C4::Context->preference('marcflavour')) if $marcxml;
1346     return $record;
1347 }
1348
1349 =head2 GetXmlBiblio
1350
1351 =over 4
1352
1353 my $marcxml = GetXmlBiblio($biblionumber);
1354
1355 Returns biblioitems.marcxml of the biblionumber passed in parameter.
1356 The XML contains both biblio & item datas
1357
1358 =back
1359
1360 =cut
1361
1362 sub GetXmlBiblio {
1363     my ( $biblionumber ) = @_;
1364     my $dbh = C4::Context->dbh;
1365     my $sth =
1366       $dbh->prepare("select marcxml from biblioitems where biblionumber=? ");
1367     $sth->execute($biblionumber);
1368     my ($marcxml) = $sth->fetchrow;
1369     return $marcxml;
1370 }
1371
1372 =head2 GetAuthorisedValueDesc
1373
1374 =over 4
1375
1376 my $subfieldvalue =get_authorised_value_desc(
1377     $tag, $subf[$i][0],$subf[$i][1], '', $taglib);
1378 Retrieve the complete description for a given authorised value.
1379
1380 =back
1381
1382 =cut
1383
1384 sub GetAuthorisedValueDesc {
1385     my ( $tag, $subfield, $value, $framework, $tagslib ) = @_;
1386     my $dbh = C4::Context->dbh;
1387
1388     #---- branch
1389     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
1390         return C4::Branch::GetBranchName($value);
1391     }
1392
1393     #---- itemtypes
1394     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "itemtypes" ) {
1395         return getitemtypeinfo($value);
1396     }
1397
1398     #---- "true" authorized value
1399     my $category = $tagslib->{$tag}->{$subfield}->{'authorised_value'};
1400
1401     if ( $category ne "" ) {
1402         my $sth =
1403           $dbh->prepare(
1404             "select lib from authorised_values where category = ? and authorised_value = ?"
1405           );
1406         $sth->execute( $category, $value );
1407         my $data = $sth->fetchrow_hashref;
1408         return $data->{'lib'};
1409     }
1410     else {
1411         return $value;    # if nothing is found return the original value
1412     }
1413 }
1414
1415 =head2 GetMarcItem
1416
1417 =over 4
1418
1419 Returns MARC::Record of the item passed in parameter.
1420
1421 =back
1422
1423 =cut
1424
1425 sub GetMarcItem {
1426     my ( $biblionumber, $itemnumber ) = @_;
1427     my $dbh = C4::Context->dbh;
1428     my $newrecord = MARC::Record->new();
1429     my $marcflavour = C4::Context->preference('marcflavour');
1430
1431     my $marcxml = GetXmlBiblio($biblionumber);
1432     my $record = MARC::Record->new();
1433 #     warn "marcxml :$marcxml";
1434     $record = MARC::Record::new_from_xml( $marcxml, "utf8", $marcflavour );
1435 #     warn "record :".$record->as_formatted;
1436     # now, find where the itemnumber is stored & extract only the item
1437     my ( $itemnumberfield, $itemnumbersubfield ) =
1438       GetMarcFromKohaField( $dbh, 'items.itemnumber', '' );
1439     my @fields = $record->field($itemnumberfield);
1440     foreach my $field (@fields) {
1441         if ( $field->subfield($itemnumbersubfield) eq $itemnumber ) {
1442             $newrecord->insert_fields_ordered($field);
1443         }
1444     }
1445     return $newrecord;
1446 }
1447
1448 =head2 GetMarcNotes
1449
1450 =over 4
1451
1452 $marcnotesarray = GetMarcNotes( $record, $marcflavour );
1453 Get all notes from the MARC record and returns them in an array.
1454 The note are stored in differents places depending on MARC flavour
1455
1456 =back
1457
1458 =cut
1459
1460 sub GetMarcNotes {
1461     my ( $record, $marcflavour ) = @_;
1462     my $scope;
1463     if ( $marcflavour eq "MARC21" ) {
1464         $scope = '5..';
1465     }
1466     else {    # assume unimarc if not marc21
1467         $scope = '3..';
1468     }
1469     my @marcnotes;
1470     my $note = "";
1471     my $tag  = "";
1472     my $marcnote;
1473     foreach my $field ( $record->field($scope) ) {
1474         my $value = $field->as_string();
1475         if ( $note ne "" ) {
1476             $marcnote = { marcnote => $note, };
1477             push @marcnotes, $marcnote;
1478             $note = $value;
1479         }
1480         if ( $note ne $value ) {
1481             $note = $note . " " . $value;
1482         }
1483     }
1484
1485     if ( $note ) {
1486         $marcnote = { marcnote => $note };
1487         push @marcnotes, $marcnote;    #load last tag into array
1488     }
1489     return \@marcnotes;
1490 }    # end GetMarcNotes
1491
1492 =head2 GetMarcSubjects
1493
1494 =over 4
1495
1496 $marcsubjcts = GetMarcSubjects($record,$marcflavour);
1497 Get all subjects from the MARC record and returns them in an array.
1498 The subjects are stored in differents places depending on MARC flavour
1499
1500 =back
1501
1502 =cut
1503
1504 sub GetMarcSubjects {
1505     my ( $record, $marcflavour ) = @_;
1506     my ( $mintag, $maxtag );
1507     if ( $marcflavour eq "MARC21" ) {
1508         $mintag = "600";
1509         $maxtag = "699";
1510     }
1511     else {    # assume unimarc if not marc21
1512         $mintag = "600";
1513         $maxtag = "611";
1514     }
1515
1516     my @marcsubjcts;
1517
1518     foreach my $field ( $record->fields ) {
1519         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1520         my @subfields = $field->subfields();
1521         my $link;
1522         my $label = "su:";
1523         my $flag = 0;
1524         for my $subject_subfield ( @subfields ) {
1525             my $code = $subject_subfield->[0];
1526             $label .= $subject_subfield->[1] . " and su-to:" unless ( $code == 9 );
1527             if ( $code == 9 ) {
1528                 $link = "Koha-Auth-Number:".$subject_subfield->[1];
1529                 $flag = 1;
1530             }
1531             elsif ( ! $flag ) {
1532                 $link = $label;
1533                 $link =~ s/ and\ssu-to:$//;
1534             }
1535         }
1536         $label =~ s/su/ /g;
1537         $label =~ s/://g;
1538         $label =~ s/-to//g;
1539         $label =~ s/and//g;
1540         push @marcsubjcts,
1541           {
1542             label => $label,
1543             link  => $link
1544           }
1545     }
1546     return \@marcsubjcts;
1547 }    #end GetMarcSubjects
1548
1549 =head2 GetMarcAuthors
1550
1551 =over 4
1552
1553 authors = GetMarcAuthors($record,$marcflavour);
1554 Get all authors from the MARC record and returns them in an array.
1555 The authors are stored in differents places depending on MARC flavour
1556
1557 =back
1558
1559 =cut
1560
1561 sub GetMarcAuthors {
1562     my ( $record, $marcflavour ) = @_;
1563     my ( $mintag, $maxtag );
1564     if ( $marcflavour eq "MARC21" ) {
1565         $mintag = "100";
1566         $maxtag = "111";
1567     }
1568     else {    # assume unimarc if not marc21
1569         $mintag = "701";
1570         $maxtag = "712";
1571     }
1572
1573     my @marcauthors;
1574
1575     foreach my $field ( $record->fields ) {
1576         next unless $field->tag() >= $mintag && $field->tag() <= $maxtag;
1577         my %hash;
1578         my @subfields = $field->subfields();
1579         my $count_auth = 0;
1580         my $and ;
1581         for my $authors_subfield (@subfields) {
1582                 if ($count_auth ne '0'){
1583                 $and = " and au:";
1584                 }
1585             $count_auth++;
1586             my $subfieldcode     = $authors_subfield->[0];
1587             my $value            = $authors_subfield->[1];
1588             $hash{'tag'}         = $field->tag;
1589             $hash{value}        .= $value . " " if ($subfieldcode != 9) ;
1590             $hash{link}        .= $value if ($subfieldcode eq 9);
1591         }
1592         push @marcauthors, \%hash;
1593     }
1594     return \@marcauthors;
1595 }
1596
1597 =head2 GetMarcSeries
1598
1599 =over 4
1600
1601 $marcseriessarray = GetMarcSeries($record,$marcflavour);
1602 Get all series from the MARC record and returns them in an array.
1603 The series are stored in differents places depending on MARC flavour
1604
1605 =back
1606
1607 =cut
1608
1609 sub GetMarcSeries {
1610     my ($record, $marcflavour) = @_;
1611     my ($mintag, $maxtag);
1612     if ($marcflavour eq "MARC21") {
1613         $mintag = "440";
1614         $maxtag = "490";
1615     } else {           # assume unimarc if not marc21
1616         $mintag = "600";
1617         $maxtag = "619";
1618     }
1619
1620     my @marcseries;
1621     my $subjct = "";
1622     my $subfield = "";
1623     my $marcsubjct;
1624
1625     foreach my $field ($record->field('440'), $record->field('490')) {
1626         my @subfields_loop;
1627         #my $value = $field->subfield('a');
1628         #$marcsubjct = {MARCSUBJCT => $value,};
1629         my @subfields = $field->subfields();
1630         #warn "subfields:".join " ", @$subfields;
1631         my $counter = 0;
1632         my @link_loop;
1633         for my $series_subfield (@subfields) {
1634                         my $volume_number;
1635                         undef $volume_number;
1636                         # see if this is an instance of a volume
1637                         if ($series_subfield->[0] eq 'v') {
1638                                 $volume_number=1;
1639                         }
1640
1641             my $code = $series_subfield->[0];
1642             my $value = $series_subfield->[1];
1643             my $linkvalue = $value;
1644             $linkvalue =~ s/(\(|\))//g;
1645             my $operator = " and " unless $counter==0;
1646             push @link_loop, {link => $linkvalue, operator => $operator };
1647             my $separator = C4::Context->preference("authoritysep") unless $counter==0;
1648                         if ($volume_number) {
1649                         push @subfields_loop, {volumenum => $value};
1650                         }
1651                         else {
1652             push @subfields_loop, {code => $code, value => $value, link_loop => \@link_loop, separator => $separator, volumenum => $volume_number};
1653                         }
1654             $counter++;
1655         }
1656         push @marcseries, { MARCSERIES_SUBFIELDS_LOOP => \@subfields_loop };
1657         #$marcsubjct = {MARCSUBJCT => $field->as_string(),};
1658         #push @marcsubjcts, $marcsubjct;
1659         #$subjct = $value;
1660
1661     }
1662     my $marcseriessarray=\@marcseries;
1663     return $marcseriessarray;
1664 }  #end getMARCseriess
1665
1666 =head2 GetFrameworkCode
1667
1668 =over 4
1669
1670 $frameworkcode = GetFrameworkCode( $biblionumber )
1671
1672 =back
1673
1674 =cut
1675
1676 sub GetFrameworkCode {
1677     my ( $biblionumber ) = @_;
1678     my $dbh = C4::Context->dbh;
1679     my $sth =
1680       $dbh->prepare("select frameworkcode from biblio where biblionumber=?");
1681     $sth->execute($biblionumber);
1682     my ($frameworkcode) = $sth->fetchrow;
1683     return $frameworkcode;
1684 }
1685
1686 =head2 TransformKohaToMarc
1687
1688 =over 4
1689
1690 $record = TransformKohaToMarc( $hash )
1691 This function builds partial MARC::Record from a hash
1692 Hash entries can be from biblio or biblioitems.
1693 This function is called in acquisition module, to create a basic catalogue entry from user entry
1694
1695 =back
1696
1697 =cut
1698
1699 sub TransformKohaToMarc {
1700
1701     my ( $hash ) = @_;
1702     my $dbh = C4::Context->dbh;
1703     my $sth =
1704     $dbh->prepare(
1705         "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1706     );
1707     my $record = MARC::Record->new();
1708     foreach (keys %{$hash}) {
1709         &TransformKohaToMarcOneField( $sth, $record, $_,
1710             $hash->{$_}, '' );
1711         }
1712     return $record;
1713 }
1714
1715 =head2 TransformKohaToMarcOneField
1716
1717 =over 4
1718
1719 $record = TransformKohaToMarcOneField( $sth, $record, $kohafieldname, $value, $frameworkcode );
1720
1721 =back
1722
1723 =cut
1724
1725 sub TransformKohaToMarcOneField {
1726     my ( $sth, $record, $kohafieldname, $value, $frameworkcode ) = @_;
1727     $frameworkcode='' unless $frameworkcode;
1728     my $tagfield;
1729     my $tagsubfield;
1730
1731     if ( !defined $sth ) {
1732         my $dbh = C4::Context->dbh;
1733         $sth =
1734           $dbh->prepare(
1735 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1736           );
1737     }
1738     $sth->execute( $frameworkcode, $kohafieldname );
1739     if ( ( $tagfield, $tagsubfield ) = $sth->fetchrow ) {
1740         my $tag = $record->field($tagfield);
1741         if ($tag) {
1742             $tag->update( $tagsubfield => $value );
1743             $record->delete_field($tag);
1744             $record->insert_fields_ordered($tag);
1745         }
1746         else {
1747             $record->add_fields( $tagfield, " ", " ", $tagsubfield => $value );
1748         }
1749     }
1750     return $record;
1751 }
1752
1753 =head2 TransformHtmlToXml
1754
1755 =over 4
1756
1757 $xml = TransformHtmlToXml( $tags, $subfields, $values, $indicator, $ind_tag )
1758
1759 =back
1760
1761 =cut
1762
1763 sub TransformHtmlToXml {
1764     my ( $tags, $subfields, $values, $indicator, $ind_tag ) = @_;
1765     my $xml = MARC::File::XML::header('UTF-8');
1766     if ( C4::Context->preference('marcflavour') eq 'UNIMARC' ) {
1767         MARC::File::XML->default_record_format('UNIMARC');
1768         use POSIX qw(strftime);
1769         my $string = strftime( "%Y%m%d", localtime(time) );
1770         $string = sprintf( "%-*s", 35, $string );
1771         substr( $string, 22, 6, "frey50" );
1772         $xml .= "<datafield tag=\"100\" ind1=\"\" ind2=\"\">\n";
1773         $xml .= "<subfield code=\"a\">$string</subfield>\n";
1774         $xml .= "</datafield>\n";
1775     }
1776     my $prevvalue;
1777     my $prevtag = -1;
1778     my $first   = 1;
1779     my $j       = -1;
1780     for ( my $i = 0 ; $i <= @$tags ; $i++ ) {
1781         @$values[$i] =~ s/&/&amp;/g;
1782         @$values[$i] =~ s/</&lt;/g;
1783         @$values[$i] =~ s/>/&gt;/g;
1784         @$values[$i] =~ s/"/&quot;/g;
1785         @$values[$i] =~ s/'/&apos;/g;
1786         if ( !utf8::is_utf8( @$values[$i] ) ) {
1787             utf8::decode( @$values[$i] );
1788         }
1789         if ( ( @$tags[$i] ne $prevtag ) ) {
1790             $j++ unless ( @$tags[$i] eq "" );
1791             if ( !$first ) {
1792                 $xml .= "</datafield>\n";
1793                 if (   ( @$tags[$i] && @$tags[$i] > 10 )
1794                     && ( @$values[$i] ne "" ) )
1795                 {
1796                     my $ind1 = substr( @$indicator[$j], 0, 1 );
1797                     my $ind2;
1798                     if ( @$indicator[$j] ) {
1799                         $ind2 = substr( @$indicator[$j], 1, 1 );
1800                     }
1801                     else {
1802                         warn "Indicator in @$tags[$i] is empty";
1803                         $ind2 = " ";
1804                     }
1805                     $xml .=
1806 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1807                     $xml .=
1808 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1809                     $first = 0;
1810                 }
1811                 else {
1812                     $first = 1;
1813                 }
1814             }
1815             else {
1816                 if ( @$values[$i] ne "" ) {
1817
1818                     # leader
1819                     if ( @$tags[$i] eq "000" ) {
1820                         $xml .= "<leader>@$values[$i]</leader>\n";
1821                         $first = 1;
1822
1823                         # rest of the fixed fields
1824                     }
1825                     elsif ( @$tags[$i] < 10 ) {
1826                         $xml .=
1827 "<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
1828                         $first = 1;
1829                     }
1830                     else {
1831                         my $ind1 = substr( @$indicator[$j], 0, 1 );
1832                         my $ind2 = substr( @$indicator[$j], 1, 1 );
1833                         $xml .=
1834 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1835                         $xml .=
1836 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1837                         $first = 0;
1838                     }
1839                 }
1840             }
1841         }
1842         else {    # @$tags[$i] eq $prevtag
1843             if ( @$values[$i] eq "" ) {
1844             }
1845             else {
1846                 if ($first) {
1847                     my $ind1 = substr( @$indicator[$j], 0, 1 );
1848                     my $ind2 = substr( @$indicator[$j], 1, 1 );
1849                     $xml .=
1850 "<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
1851                     $first = 0;
1852                 }
1853                 $xml .=
1854 "<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
1855             }
1856         }
1857         $prevtag = @$tags[$i];
1858     }
1859     $xml .= MARC::File::XML::footer();
1860
1861     return $xml;
1862 }
1863
1864 =head2 TransformHtmlToMarc
1865
1866 =over 4
1867
1868 $record = TransformHtmlToMarc( $dbh, $rtags, $rsubfields, $rvalues, %indicators )
1869
1870 =back
1871
1872 =cut
1873
1874 sub TransformHtmlToMarc {
1875     my ( $dbh, $rtags, $rsubfields, $rvalues, %indicators ) = @_;
1876     my $prevtag = -1;
1877     my $record  = MARC::Record->new();
1878
1879     #     my %subfieldlist=();
1880     my $prevvalue;    # if tag <10
1881     my $field;        # if tag >=10
1882     for ( my $i = 0 ; $i < @$rtags ; $i++ ) {
1883         next unless @$rvalues[$i];
1884
1885  # rebuild MARC::Record
1886  #             warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
1887         if ( @$rtags[$i] ne $prevtag ) {
1888             if ( $prevtag < 10 ) {
1889                 if ($prevvalue) {
1890
1891                     if ( $prevtag ne '000' ) {
1892                         $record->insert_fields_ordered(
1893                             ( sprintf "%03s", $prevtag ), $prevvalue );
1894                     }
1895                     else {
1896
1897                         $record->leader($prevvalue);
1898
1899                     }
1900                 }
1901             }
1902             else {
1903                 if ($field) {
1904                     $record->insert_fields_ordered($field);
1905                 }
1906             }
1907             $indicators{ @$rtags[$i] } .= '  ';
1908             if ( @$rtags[$i] < 10 ) {
1909                 $prevvalue = @$rvalues[$i];
1910                 undef $field;
1911             }
1912             else {
1913                 undef $prevvalue;
1914                 $field = MARC::Field->new(
1915                     ( sprintf "%03s", @$rtags[$i] ),
1916                     substr( $indicators{ @$rtags[$i] }, 0, 1 ),
1917                     substr( $indicators{ @$rtags[$i] }, 1, 1 ),
1918                     @$rsubfields[$i] => @$rvalues[$i]
1919                 );
1920             }
1921             $prevtag = @$rtags[$i];
1922         }
1923         else {
1924             if ( @$rtags[$i] < 10 ) {
1925                 $prevvalue = @$rvalues[$i];
1926             }
1927             else {
1928                 if ( length( @$rvalues[$i] ) > 0 ) {
1929                     $field->add_subfields( @$rsubfields[$i] => @$rvalues[$i] );
1930                 }
1931             }
1932             $prevtag = @$rtags[$i];
1933         }
1934     }
1935
1936     # the last has not been included inside the loop... do it now !
1937     $record->insert_fields_ordered($field) if $field;
1938
1939     #     warn "HTML2MARC=".$record->as_formatted;
1940     $record->encoding('UTF-8');
1941
1942     #    $record->MARC::File::USMARC::update_leader();
1943     return $record;
1944 }
1945
1946 =head2 TransformMarcToKoha
1947
1948 =over 4
1949
1950 $result = TransformMarcToKoha( $dbh, $record, $frameworkcode )
1951
1952 =back
1953
1954 =cut
1955
1956 sub TransformMarcToKoha {
1957     my ( $dbh, $record, $frameworkcode ) = @_;
1958     my $sth =
1959       $dbh->prepare(
1960 "select tagfield,tagsubfield from marc_subfield_structure where frameworkcode=? and kohafield=?"
1961       );
1962     my $result;
1963     my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
1964     $sth2->execute;
1965     my $field;
1966     while ( ($field) = $sth2->fetchrow ) {
1967         $result =
1968           &TransformMarcToKohaOneField( "biblio", $field, $record, $result,
1969             $frameworkcode );
1970     }
1971     $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
1972     $sth2->execute;
1973     while ( ($field) = $sth2->fetchrow ) {
1974         if ( $field eq 'notes' ) { $field = 'bnotes'; }
1975         $result =
1976           &TransformMarcToKohaOneField( "biblioitems", $field, $record, $result,
1977             $frameworkcode );
1978     }
1979     $sth2 = $dbh->prepare("SHOW COLUMNS from items");
1980     $sth2->execute;
1981     while ( ($field) = $sth2->fetchrow ) {
1982         $result =
1983           &TransformMarcToKohaOneField( "items", $field, $record, $result,
1984             $frameworkcode );
1985     }
1986
1987     #
1988     # modify copyrightdate to keep only the 1st year found
1989     my $temp = $result->{'copyrightdate'};
1990     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
1991     if ( $1 > 0 ) {
1992         $result->{'copyrightdate'} = $1;
1993     }
1994     else {                      # if no cYYYY, get the 1st date.
1995         $temp =~ m/(\d\d\d\d)/;
1996         $result->{'copyrightdate'} = $1;
1997     }
1998
1999     # modify publicationyear to keep only the 1st year found
2000     $temp = $result->{'publicationyear'};
2001     $temp =~ m/c(\d\d\d\d)/;    # search cYYYY first
2002     if ( $1 > 0 ) {
2003         $result->{'publicationyear'} = $1;
2004     }
2005     else {                      # if no cYYYY, get the 1st date.
2006         $temp =~ m/(\d\d\d\d)/;
2007         $result->{'publicationyear'} = $1;
2008     }
2009     return $result;
2010 }
2011
2012 =head2 TransformMarcToKohaOneField
2013
2014 =over 4
2015
2016 $result = TransformMarcToKohaOneField( $kohatable, $kohafield, $record, $result, $frameworkcode )
2017
2018 =back
2019
2020 =cut
2021
2022 sub TransformMarcToKohaOneField {
2023
2024 # FIXME ? if a field has a repeatable subfield that is used in old-db, only the 1st will be retrieved...
2025     my ( $kohatable, $kohafield, $record, $result, $frameworkcode ) = @_;
2026
2027     my $res = "";
2028     my ( $tagfield, $subfield ) =
2029       GetMarcFromKohaField( "", $kohatable . "." . $kohafield,
2030         $frameworkcode );
2031     foreach my $field ( $record->field($tagfield) ) {
2032         if ( $field->tag() < 10 ) {
2033             if ( $result->{$kohafield} ) {
2034                 $result->{$kohafield} .= " | " . $field->data();
2035             }
2036             else {
2037                 $result->{$kohafield} = $field->data();
2038             }
2039         }
2040         else {
2041             if ( $field->subfields ) {
2042                 my @subfields = $field->subfields();
2043                 foreach my $subfieldcount ( 0 .. $#subfields ) {
2044                     if ( $subfields[$subfieldcount][0] eq $subfield ) {
2045                         if ( $result->{$kohafield} ) {
2046                             $result->{$kohafield} .=
2047                               " | " . $subfields[$subfieldcount][1];
2048                         }
2049                         else {
2050                             $result->{$kohafield} =
2051                               $subfields[$subfieldcount][1];
2052                         }
2053                     }
2054                 }
2055             }
2056         }
2057     }
2058     return $result;
2059 }
2060 =head1  OTHER FUNCTIONS
2061
2062 =head2 char_decode
2063
2064 =over 4
2065
2066 my $string = char_decode( $string, $encoding );
2067
2068 converts ISO 5426 coded string to UTF-8
2069 sloppy code : should be improved in next issue
2070
2071 =back
2072
2073 =cut
2074
2075 sub char_decode {
2076     my ( $string, $encoding ) = @_;
2077     $_ = $string;
2078
2079     $encoding = C4::Context->preference("marcflavour") unless $encoding;
2080     if ( $encoding eq "UNIMARC" ) {
2081
2082         #         s/\xe1/Æ/gm;
2083         s/\xe2/Ğ/gm;
2084         s/\xe9/Ø/gm;
2085         s/\xec/ş/gm;
2086         s/\xf1/æ/gm;
2087         s/\xf3/ğ/gm;
2088         s/\xf9/ø/gm;
2089         s/\xfb/ß/gm;
2090         s/\xc1\x61/à/gm;
2091         s/\xc1\x65/è/gm;
2092         s/\xc1\x69/ì/gm;
2093         s/\xc1\x6f/ò/gm;
2094         s/\xc1\x75/ù/gm;
2095         s/\xc1\x41/À/gm;
2096         s/\xc1\x45/È/gm;
2097         s/\xc1\x49/Ì/gm;
2098         s/\xc1\x4f/Ò/gm;
2099         s/\xc1\x55/Ù/gm;
2100         s/\xc2\x41/Á/gm;
2101         s/\xc2\x45/É/gm;
2102         s/\xc2\x49/Í/gm;
2103         s/\xc2\x4f/Ó/gm;
2104         s/\xc2\x55/Ú/gm;
2105         s/\xc2\x59/İ/gm;
2106         s/\xc2\x61/á/gm;
2107         s/\xc2\x65/é/gm;
2108         s/\xc2\x69/í/gm;
2109         s/\xc2\x6f/ó/gm;
2110         s/\xc2\x75/ú/gm;
2111         s/\xc2\x79/ı/gm;
2112         s/\xc3\x41/Â/gm;
2113         s/\xc3\x45/Ê/gm;
2114         s/\xc3\x49/Î/gm;
2115         s/\xc3\x4f/Ô/gm;
2116         s/\xc3\x55/Û/gm;
2117         s/\xc3\x61/â/gm;
2118         s/\xc3\x65/ê/gm;
2119         s/\xc3\x69/î/gm;
2120         s/\xc3\x6f/ô/gm;
2121         s/\xc3\x75/û/gm;
2122         s/\xc4\x41/Ã/gm;
2123         s/\xc4\x4e/Ñ/gm;
2124         s/\xc4\x4f/Õ/gm;
2125         s/\xc4\x61/ã/gm;
2126         s/\xc4\x6e/ñ/gm;
2127         s/\xc4\x6f/õ/gm;
2128         s/\xc8\x41/Ä/gm;
2129         s/\xc8\x45/Ë/gm;
2130         s/\xc8\x49/Ï/gm;
2131         s/\xc8\x61/ä/gm;
2132         s/\xc8\x65/ë/gm;
2133         s/\xc8\x69/ï/gm;
2134         s/\xc8\x6F/ö/gm;
2135         s/\xc8\x75/ü/gm;
2136         s/\xc8\x76/ÿ/gm;
2137         s/\xc9\x41/Ä/gm;
2138         s/\xc9\x45/Ë/gm;
2139         s/\xc9\x49/Ï/gm;
2140         s/\xc9\x4f/Ö/gm;
2141         s/\xc9\x55/Ü/gm;
2142         s/\xc9\x61/ä/gm;
2143         s/\xc9\x6f/ö/gm;
2144         s/\xc9\x75/ü/gm;
2145         s/\xca\x41/Å/gm;
2146         s/\xca\x61/å/gm;
2147         s/\xd0\x43/Ç/gm;
2148         s/\xd0\x63/ç/gm;
2149
2150         # this handles non-sorting blocks (if implementation requires this)
2151         $string = nsb_clean($_);
2152     }
2153     elsif ( $encoding eq "USMARC" || $encoding eq "MARC21" ) {
2154         ##MARC-8 to UTF-8
2155
2156         s/\xe1\x61/à/gm;
2157         s/\xe1\x65/è/gm;
2158         s/\xe1\x69/ì/gm;
2159         s/\xe1\x6f/ò/gm;
2160         s/\xe1\x75/ù/gm;
2161         s/\xe1\x41/À/gm;
2162         s/\xe1\x45/È/gm;
2163         s/\xe1\x49/Ì/gm;
2164         s/\xe1\x4f/Ò/gm;
2165         s/\xe1\x55/Ù/gm;
2166         s/\xe2\x41/Á/gm;
2167         s/\xe2\x45/É/gm;
2168         s/\xe2\x49/Í/gm;
2169         s/\xe2\x4f/Ó/gm;
2170         s/\xe2\x55/Ú/gm;
2171         s/\xe2\x59/İ/gm;
2172         s/\xe2\x61/á/gm;
2173         s/\xe2\x65/é/gm;
2174         s/\xe2\x69/í/gm;
2175         s/\xe2\x6f/ó/gm;
2176         s/\xe2\x75/ú/gm;
2177         s/\xe2\x79/ı/gm;
2178         s/\xe3\x41/Â/gm;
2179         s/\xe3\x45/Ê/gm;
2180         s/\xe3\x49/Î/gm;
2181         s/\xe3\x4f/Ô/gm;
2182         s/\xe3\x55/Û/gm;
2183         s/\xe3\x61/â/gm;
2184         s/\xe3\x65/ê/gm;
2185         s/\xe3\x69/î/gm;
2186         s/\xe3\x6f/ô/gm;
2187         s/\xe3\x75/û/gm;
2188         s/\xe4\x41/Ã/gm;
2189         s/\xe4\x4e/Ñ/gm;
2190         s/\xe4\x4f/Õ/gm;
2191         s/\xe4\x61/ã/gm;
2192         s/\xe4\x6e/ñ/gm;
2193         s/\xe4\x6f/õ/gm;
2194         s/\xe6\x41/Ă/gm;
2195         s/\xe6\x45/Ĕ/gm;
2196         s/\xe6\x65/ĕ/gm;
2197         s/\xe6\x61/ă/gm;
2198         s/\xe8\x45/Ë/gm;
2199         s/\xe8\x49/Ï/gm;
2200         s/\xe8\x65/ë/gm;
2201         s/\xe8\x69/ï/gm;
2202         s/\xe8\x76/ÿ/gm;
2203         s/\xe9\x41/A/gm;
2204         s/\xe9\x4f/O/gm;
2205         s/\xe9\x55/U/gm;
2206         s/\xe9\x61/a/gm;
2207         s/\xe9\x6f/o/gm;
2208         s/\xe9\x75/u/gm;
2209         s/\xea\x41/A/gm;
2210         s/\xea\x61/a/gm;
2211
2212         #Additional Turkish characters
2213         s/\x1b//gm;
2214         s/\x1e//gm;
2215         s/(\xf0)s/\xc5\x9f/gm;
2216         s/(\xf0)S/\xc5\x9e/gm;
2217         s/(\xf0)c/ç/gm;
2218         s/(\xf0)C/Ç/gm;
2219         s/\xe7\x49/\\xc4\xb0/gm;
2220         s/(\xe6)G/\xc4\x9e/gm;
2221         s/(\xe6)g/ğ\xc4\x9f/gm;
2222         s/\xB8/ı/gm;
2223         s/\xB9/£/gm;
2224         s/(\xe8|\xc8)o/ö/gm;
2225         s/(\xe8|\xc8)O/Ö/gm;
2226         s/(\xe8|\xc8)u/ü/gm;
2227         s/(\xe8|\xc8)U/Ü/gm;
2228         s/\xc2\xb8/\xc4\xb1/gm;
2229         s/¸/\xc4\xb1/gm;
2230
2231         # this handles non-sorting blocks (if implementation requires this)
2232         $string = nsb_clean($_);
2233     }
2234     return ($string);
2235 }
2236
2237 =head2 nsb_clean
2238
2239 =over 4
2240
2241 my $string = nsb_clean( $string, $encoding );
2242
2243 =back
2244
2245 =cut
2246
2247 sub nsb_clean {
2248     my $NSB      = '\x88';    # NSB : begin Non Sorting Block
2249     my $NSE      = '\x89';    # NSE : Non Sorting Block end
2250                               # handles non sorting blocks
2251     my ($string) = @_;
2252     $_ = $string;
2253     s/$NSB/(/gm;
2254     s/[ ]{0,1}$NSE/) /gm;
2255     $string = $_;
2256     return ($string);
2257 }
2258
2259 =head2 PrepareItemrecordDisplay
2260
2261 =over 4
2262
2263 PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber);
2264
2265 Returns a hash with all the fields for Display a given item data in a template
2266
2267 =back
2268
2269 =cut
2270
2271 sub PrepareItemrecordDisplay {
2272
2273     my ( $bibnum, $itemnum ) = @_;
2274
2275     my $dbh = C4::Context->dbh;
2276     my $frameworkcode = &GetFrameworkCode( $bibnum );
2277     my ( $itemtagfield, $itemtagsubfield ) =
2278       &GetMarcFromKohaField( $dbh, "items.itemnumber", $frameworkcode );
2279     my $tagslib = &GetMarcStructure( $dbh, 1, $frameworkcode );
2280     my $itemrecord = GetMarcItem( $bibnum, $itemnum) if ($itemnum);
2281     my @loop_data;
2282     my $authorised_values_sth =
2283       $dbh->prepare(
2284 "select authorised_value,lib from authorised_values where category=? order by lib"
2285       );
2286     foreach my $tag ( sort keys %{$tagslib} ) {
2287         my $previous_tag = '';
2288         if ( $tag ne '' ) {
2289             # loop through each subfield
2290             my $cntsubf;
2291             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2292                 next if ( subfield_is_koha_internal_p($subfield) );
2293                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2294                 my %subfield_data;
2295                 $subfield_data{tag}           = $tag;
2296                 $subfield_data{subfield}      = $subfield;
2297                 $subfield_data{countsubfield} = $cntsubf++;
2298                 $subfield_data{kohafield}     =
2299                   $tagslib->{$tag}->{$subfield}->{'kohafield'};
2300
2301          #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2302                 $subfield_data{marc_lib} =
2303                     "<span id=\"error\" title=\""
2304                   . $tagslib->{$tag}->{$subfield}->{lib} . "\">"
2305                   . substr( $tagslib->{$tag}->{$subfield}->{lib}, 0, 12 )
2306                   . "</span>";
2307                 $subfield_data{mandatory} =
2308                   $tagslib->{$tag}->{$subfield}->{mandatory};
2309                 $subfield_data{repeatable} =
2310                   $tagslib->{$tag}->{$subfield}->{repeatable};
2311                 $subfield_data{hidden} = "display:none"
2312                   if $tagslib->{$tag}->{$subfield}->{hidden};
2313                 my ( $x, $value );
2314                 ( $x, $value ) = _find_value( $tag, $subfield, $itemrecord )
2315                   if ($itemrecord);
2316                 $value =~ s/"/&quot;/g;
2317
2318                 # search for itemcallnumber if applicable
2319                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq
2320                     'items.itemcallnumber'
2321                     && C4::Context->preference('itemcallnumber') )
2322                 {
2323                     my $CNtag =
2324                       substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2325                     my $CNsubfield =
2326                       substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2327                     my $temp = $itemrecord->field($CNtag) if ($itemrecord);
2328                     if ($temp) {
2329                         $value = $temp->subfield($CNsubfield);
2330                     }
2331                 }
2332                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2333                     my @authorised_values;
2334                     my %authorised_lib;
2335
2336                     # builds list, depending on authorised value...
2337                     #---- branch
2338                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq
2339                         "branches" )
2340                     {
2341                         if ( ( C4::Context->preference("IndependantBranches") )
2342                             && ( C4::Context->userenv->{flags} != 1 ) )
2343                         {
2344                             my $sth =
2345                               $dbh->prepare(
2346 "select branchcode,branchname from branches where branchcode = ? order by branchname"
2347                               );
2348                             $sth->execute( C4::Context->userenv->{branch} );
2349                             push @authorised_values, ""
2350                               unless (
2351                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2352                             while ( my ( $branchcode, $branchname ) =
2353                                 $sth->fetchrow_array )
2354                             {
2355                                 push @authorised_values, $branchcode;
2356                                 $authorised_lib{$branchcode} = $branchname;
2357                             }
2358                         }
2359                         else {
2360                             my $sth =
2361                               $dbh->prepare(
2362 "select branchcode,branchname from branches order by branchname"
2363                               );
2364                             $sth->execute;
2365                             push @authorised_values, ""
2366                               unless (
2367                                 $tagslib->{$tag}->{$subfield}->{mandatory} );
2368                             while ( my ( $branchcode, $branchname ) =
2369                                 $sth->fetchrow_array )
2370                             {
2371                                 push @authorised_values, $branchcode;
2372                                 $authorised_lib{$branchcode} = $branchname;
2373                             }
2374                         }
2375
2376                         #----- itemtypes
2377                     }
2378                     elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq
2379                         "itemtypes" )
2380                     {
2381                         my $sth =
2382                           $dbh->prepare(
2383 "select itemtype,description from itemtypes order by description"
2384                           );
2385                         $sth->execute;
2386                         push @authorised_values, ""
2387                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2388                         while ( my ( $itemtype, $description ) =
2389                             $sth->fetchrow_array )
2390                         {
2391                             push @authorised_values, $itemtype;
2392                             $authorised_lib{$itemtype} = $description;
2393                         }
2394
2395                         #---- "true" authorised value
2396                     }
2397                     else {
2398                         $authorised_values_sth->execute(
2399                             $tagslib->{$tag}->{$subfield}->{authorised_value} );
2400                         push @authorised_values, ""
2401                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2402                         while ( my ( $value, $lib ) =
2403                             $authorised_values_sth->fetchrow_array )
2404                         {
2405                             push @authorised_values, $value;
2406                             $authorised_lib{$value} = $lib;
2407                         }
2408                     }
2409                     $subfield_data{marc_value} = CGI::scrolling_list(
2410                         -name     => 'field_value',
2411                         -values   => \@authorised_values,
2412                         -default  => "$value",
2413                         -labels   => \%authorised_lib,
2414                         -size     => 1,
2415                         -tabindex => '',
2416                         -multiple => 0,
2417                     );
2418                 }
2419                 elsif ( $tagslib->{$tag}->{$subfield}->{thesaurus_category} ) {
2420                     $subfield_data{marc_value} =
2421 "<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>";
2422
2423 #"
2424 # COMMENTED OUT because No $i is provided with this API.
2425 # And thus, no value_builder can be activated.
2426 # BUT could be thought over.
2427 #         } elsif ($tagslib->{$tag}->{$subfield}->{'value_builder'}) {
2428 #             my $plugin="value_builder/".$tagslib->{$tag}->{$subfield}->{'value_builder'};
2429 #             require $plugin;
2430 #             my $extended_param = plugin_parameters($dbh,$itemrecord,$tagslib,$i,0);
2431 #             my ($function_name,$javascript) = plugin_javascript($dbh,$record,$tagslib,$i,0);
2432 #             $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";
2433                 }
2434                 else {
2435                     $subfield_data{marc_value} =
2436 "<input type=\"text\" name=\"field_value\" value=\"$value\" size=50 maxlength=255>";
2437                 }
2438                 push( @loop_data, \%subfield_data );
2439             }
2440         }
2441     }
2442     my $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield )
2443       if ( $itemrecord && $itemrecord->field($itemtagfield) );
2444     return {
2445         'itemtagfield'    => $itemtagfield,
2446         'itemtagsubfield' => $itemtagsubfield,
2447         'itemnumber'      => $itemnumber,
2448         'iteminformation' => \@loop_data
2449     };
2450 }
2451 #"
2452
2453 #
2454 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2455 # at the same time
2456 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2457 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2458 # =head2 ModZebrafiles
2459 #
2460 # &ModZebrafiles( $dbh, $biblionumber, $record, $folder, $server );
2461 #
2462 # =cut
2463 #
2464 # sub ModZebrafiles {
2465 #
2466 #     my ( $dbh, $biblionumber, $record, $folder, $server ) = @_;
2467 #
2468 #     my $op;
2469 #     my $zebradir =
2470 #       C4::Context->zebraconfig($server)->{directory} . "/" . $folder . "/";
2471 #     unless ( opendir( DIR, "$zebradir" ) ) {
2472 #         warn "$zebradir not found";
2473 #         return;
2474 #     }
2475 #     closedir DIR;
2476 #     my $filename = $zebradir . $biblionumber;
2477 #
2478 #     if ($record) {
2479 #         open( OUTPUT, ">", $filename . ".xml" );
2480 #         print OUTPUT $record;
2481 #         close OUTPUT;
2482 #     }
2483 # }
2484
2485 =head2 ModZebra
2486
2487 =over 4
2488
2489 ModZebra( $dbh, $biblionumber, $op, $server );
2490
2491 =back
2492
2493 =cut
2494
2495 sub ModZebra {
2496 ###Accepts a $server variable thus we can use it for biblios authorities or other zebra dbs
2497     my ( $biblionumber, $op, $server ) = @_;
2498     my $dbh=C4::Context->dbh;
2499     #warn "SERVER:".$server;
2500 #
2501 # true ModZebra commented until indexdata fixes zebraDB crashes (it seems they occur on multiple updates
2502 # at the same time
2503 # replaced by a zebraqueue table, that is filled with ModZebra to run.
2504 # the table is emptied by misc/cronjobs/zebraqueue_start.pl script
2505
2506 my $sth=$dbh->prepare("insert into zebraqueue  (biblio_auth_number ,server,operation) values(?,?,?)");
2507 $sth->execute($biblionumber,$server,$op);
2508 $sth->finish;
2509
2510 #
2511 #     my @Zconnbiblio;
2512 #     my $tried     = 0;
2513 #     my $recon     = 0;
2514 #     my $reconnect = 0;
2515 #     my $record;
2516 #     my $shadow;
2517 #
2518 #   reconnect:
2519 #     $Zconnbiblio[0] = C4::Context->Zconn( $server, 0, 1 );
2520 #
2521 #     if ( $server eq "biblioserver" ) {
2522 #
2523 #         # it's unclear to me whether this should be in xml or MARC format
2524 #         # but it is clear it should be nabbed from zebra rather than from
2525 #         # the koha tables
2526 #         $record = GetMarcBiblio($biblionumber);
2527 #         $record = $record->as_xml_record() if $record;
2528 # #            warn "RECORD $biblionumber => ".$record;
2529 #         $shadow="biblioservershadow";
2530 #
2531 #         #           warn "RECORD $biblionumber => ".$record;
2532 #         $shadow = "biblioservershadow";
2533 #
2534 #     }
2535 #     elsif ( $server eq "authorityserver" ) {
2536 #         $record = C4::AuthoritiesMarc::XMLgetauthority( $dbh, $biblionumber );
2537 #         $shadow = "authorityservershadow";
2538 #     }    ## Add other servers as necessary
2539 #
2540 #     my $Zpackage = $Zconnbiblio[0]->package();
2541 #     $Zpackage->option( action => $op );
2542 #     $Zpackage->option( record => $record );
2543 #
2544 #   retry:
2545 #     $Zpackage->send("update");
2546 #     my $i;
2547 #     my $event;
2548 #
2549 #     while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
2550 #         $event = $Zconnbiblio[0]->last_event();
2551 #         last if $event == ZOOM::Event::ZEND;
2552 #     }
2553 #
2554 #     my ( $error, $errmsg, $addinfo, $diagset ) = $Zconnbiblio[0]->error_x();
2555 #     if ( $error == 10000 && $reconnect == 0 )
2556 #     {    ## This is serious ZEBRA server is not available -reconnect
2557 #         warn "problem with zebra server connection";
2558 #         $reconnect = 1;
2559 #         my $res = system('sc start "Z39.50 Server" >c:/zebraserver/error.log');
2560 #
2561 #         #warn "Trying to restart ZEBRA Server";
2562 #         #goto "reconnect";
2563 #     }
2564 #     elsif ( $error == 10007 && $tried < 2 )
2565 #     {    ## timeout --another 30 looonng seconds for this update
2566 #         $tried = $tried + 1;
2567 #         warn "warn: timeout, trying again";
2568 #         goto "retry";
2569 #     }
2570 #     elsif ( $error == 10004 && $recon == 0 ) {    ##Lost connection -reconnect
2571 #         $recon = 1;
2572 #         warn "error: reconnecting to zebra";
2573 #         goto "reconnect";
2574 #
2575 #    # as a last resort, we save the data to the filesystem to be indexed in batch
2576 #     }
2577 #     elsif ($error) {
2578 #         warn
2579 # "Error-$server   $op $biblionumber /errcode:, $error, /MSG:,$errmsg,$addinfo \n";
2580 #         $Zpackage->destroy();
2581 #         $Zconnbiblio[0]->destroy();
2582 #         ModZebrafiles( $dbh, $biblionumber, $record, $op, $server );
2583 #         return;
2584 #     }
2585 #     if ( C4::Context->$shadow ) {
2586 #         $Zpackage->send('commit');
2587 #         while ( ( $i = ZOOM::event( \@Zconnbiblio ) ) != 0 ) {
2588 #
2589 #             #waiting zebra to finish;
2590 #          }
2591 #     }
2592 #     $Zpackage->destroy();
2593 }
2594
2595 =head1 INTERNAL FUNCTIONS
2596
2597 =head2 MARCitemchange
2598
2599 =over 4
2600
2601 &MARCitemchange( $record, $itemfield, $newvalue )
2602
2603 Function to update a single value in an item field.
2604 Used twice, could probably be replaced by something else, but works well...
2605
2606 =back
2607
2608 =back
2609
2610 =cut
2611
2612 sub MARCitemchange {
2613     my ( $record, $itemfield, $newvalue ) = @_;
2614     my $dbh = C4::Context->dbh;
2615
2616     my ( $tagfield, $tagsubfield ) =
2617       GetMarcFromKohaField( $dbh, $itemfield, "" );
2618     if ( ($tagfield) && ($tagsubfield) ) {
2619         my $tag = $record->field($tagfield);
2620         if ($tag) {
2621             $tag->update( $tagsubfield => $newvalue );
2622             $record->delete_field($tag);
2623             $record->insert_fields_ordered($tag);
2624         }
2625     }
2626 }
2627
2628 =head2 _koha_add_biblio
2629
2630 =over 4
2631
2632 _koha_add_biblio($dbh,$biblioitem);
2633
2634 Internal function to add a biblio ($biblio is a hash with the values)
2635
2636 =back
2637
2638 =cut
2639
2640 sub _koha_add_biblio {
2641     my ( $dbh, $biblio, $frameworkcode ) = @_;
2642     my $sth = $dbh->prepare("Select max(biblionumber) from biblio");
2643     $sth->execute;
2644     my $data         = $sth->fetchrow_arrayref;
2645     my $biblionumber = $$data[0] + 1;
2646     my $series       = 0;
2647
2648     if ( $biblio->{'seriestitle'} ) { $series = 1 }
2649     $sth->finish;
2650     $sth = $dbh->prepare(
2651         "INSERT INTO biblio
2652     SET biblionumber  = ?, title = ?, author = ?, copyrightdate = ?, serial = ?, seriestitle = ?, notes = ?, abstract = ?, unititle = ?, frameworkcode = ? "
2653     );
2654     $sth->execute(
2655         $biblionumber,         $biblio->{'title'},
2656         $biblio->{'author'},   $biblio->{'copyrightdate'},
2657         $biblio->{'serial'},   $biblio->{'seriestitle'},
2658         $biblio->{'notes'},    $biblio->{'abstract'},
2659         $biblio->{'unititle'}, $frameworkcode
2660     );
2661
2662     $sth->finish;
2663     return ($biblionumber);
2664 }
2665
2666 =head2 _find_value
2667
2668 =over 4
2669
2670 ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2671
2672 Find the given $subfield in the given $tag in the given
2673 MARC::Record $record.  If the subfield is found, returns
2674 the (indicators, value) pair; otherwise, (undef, undef) is
2675 returned.
2676
2677 PROPOSITION :
2678 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2679 I suggest we export it from this module.
2680
2681 =back
2682
2683 =cut
2684
2685 sub _find_value {
2686     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2687     my @result;
2688     my $indicator;
2689     if ( $tagfield < 10 ) {
2690         if ( $record->field($tagfield) ) {
2691             push @result, $record->field($tagfield)->data();
2692         }
2693         else {
2694             push @result, "";
2695         }
2696     }
2697     else {
2698         foreach my $field ( $record->field($tagfield) ) {
2699             my @subfields = $field->subfields();
2700             foreach my $subfield (@subfields) {
2701                 if ( @$subfield[0] eq $insubfield ) {
2702                     push @result, @$subfield[1];
2703                     $indicator = $field->indicator(1) . $field->indicator(2);
2704                 }
2705             }
2706         }
2707     }
2708     return ( $indicator, @result );
2709 }
2710
2711 =head2 _koha_modify_biblio
2712
2713 =over 4
2714
2715 Internal function for updating the biblio table
2716
2717 =back
2718
2719 =cut
2720
2721 sub _koha_modify_biblio {
2722     my ( $dbh, $biblio ) = @_;
2723
2724 # FIXME: this code could be made more portable by not hard-coding the values that are supposed to be in biblio table
2725     my $sth =
2726       $dbh->prepare(
2727 "Update biblio set title = ?, author = ?, abstract = ?, copyrightdate = ?, seriestitle = ?, serial = ?, unititle = ?, notes = ? where biblionumber = ?"
2728       );
2729     $sth->execute(
2730         $biblio->{'title'},       $biblio->{'author'},
2731         $biblio->{'abstract'},    $biblio->{'copyrightdate'},
2732         $biblio->{'seriestitle'}, $biblio->{'serial'},
2733         $biblio->{'unititle'},    $biblio->{'notes'},
2734         $biblio->{'biblionumber'}
2735     );
2736     $sth->finish;
2737     return ( $biblio->{'biblionumber'} );
2738 }
2739
2740 =head2 _koha_modify_biblioitem
2741
2742 =over 4
2743
2744 _koha_modify_biblioitem( $dbh, $biblioitem );
2745
2746 =back
2747
2748 =cut
2749
2750 sub _koha_modify_biblioitem {
2751     my ( $dbh, $biblioitem ) = @_;
2752     my $query;
2753 ##Recalculate LC in case it changed --TG
2754
2755     $biblioitem->{'itemtype'}      = $dbh->quote( $biblioitem->{'itemtype'} );
2756     $biblioitem->{'url'}           = $dbh->quote( $biblioitem->{'url'} );
2757     $biblioitem->{'isbn'}          = $dbh->quote( $biblioitem->{'isbn'} );
2758     $biblioitem->{'issn'}          = $dbh->quote( $biblioitem->{'issn'} );
2759     $biblioitem->{'publishercode'} =
2760       $dbh->quote( $biblioitem->{'publishercode'} );
2761     $biblioitem->{'publicationyear'} =
2762       $dbh->quote( $biblioitem->{'publicationyear'} );
2763     $biblioitem->{'classification'} =
2764       $dbh->quote( $biblioitem->{'classification'} );
2765     $biblioitem->{'dewey'}        = $dbh->quote( $biblioitem->{'dewey'} );
2766     $biblioitem->{'subclass'}     = $dbh->quote( $biblioitem->{'subclass'} );
2767     $biblioitem->{'illus'}        = $dbh->quote( $biblioitem->{'illus'} );
2768     $biblioitem->{'pages'}        = $dbh->quote( $biblioitem->{'pages'} );
2769     $biblioitem->{'volumeddesc'}  = $dbh->quote( $biblioitem->{'volumeddesc'} );
2770     $biblioitem->{'bnotes'}       = $dbh->quote( $biblioitem->{'bnotes'} );
2771     $biblioitem->{'size'}         = $dbh->quote( $biblioitem->{'size'} );
2772     $biblioitem->{'place'}        = $dbh->quote( $biblioitem->{'place'} );
2773     $biblioitem->{'ccode'}        = $dbh->quote( $biblioitem->{'ccode'} );
2774     $biblioitem->{'biblionumber'} =
2775       $dbh->quote( $biblioitem->{'biblionumber'} );
2776
2777     $query = "Update biblioitems set
2778         itemtype        = $biblioitem->{'itemtype'},
2779         url             = $biblioitem->{'url'},
2780         isbn            = $biblioitem->{'isbn'},
2781         issn            = $biblioitem->{'issn'},
2782         publishercode   = $biblioitem->{'publishercode'},
2783         publicationyear = $biblioitem->{'publicationyear'},
2784         classification  = $biblioitem->{'classification'},
2785         dewey           = $biblioitem->{'dewey'},
2786         subclass        = $biblioitem->{'subclass'},
2787         illus           = $biblioitem->{'illus'},
2788         pages           = $biblioitem->{'pages'},
2789         volumeddesc     = $biblioitem->{'volumeddesc'},
2790         notes           = $biblioitem->{'bnotes'},
2791         size            = $biblioitem->{'size'},
2792         place           = $biblioitem->{'place'},
2793         ccode           = $biblioitem->{'ccode'}
2794         where biblionumber = $biblioitem->{'biblionumber'}";
2795
2796     $dbh->do($query);
2797     if ( $dbh->errstr ) {
2798         warn "$query";
2799     }
2800 }
2801
2802 =head2 _koha_add_biblioitem
2803
2804 =over 4
2805
2806 _koha_add_biblioitem( $dbh, $biblioitem );
2807
2808 Internal function to add a biblioitem
2809
2810 =back
2811
2812 =cut
2813
2814 sub _koha_add_biblioitem {
2815     my ( $dbh, $biblioitem ) = @_;
2816
2817     #  my $dbh   = C4Connect;
2818     my $sth = $dbh->prepare("SELECT max(biblioitemnumber) FROM biblioitems");
2819     my $data;
2820     my $bibitemnum;
2821
2822     $sth->execute;
2823     $data       = $sth->fetchrow_arrayref;
2824     $bibitemnum = $$data[0] + 1;
2825
2826     $sth->finish;
2827
2828     $sth = $dbh->prepare(
2829         "INSERT INTO biblioitems SET
2830             biblioitemnumber = ?, biblionumber    = ?,
2831             volume           = ?, number          = ?,
2832             classification   = ?, itemtype        = ?,
2833             url              = ?, isbn            = ?,
2834             issn             = ?, dewey           = ?,
2835             subclass         = ?, publicationyear = ?,
2836             publishercode    = ?, volumedate      = ?,
2837             volumeddesc      = ?, illus           = ?,
2838             pages            = ?, notes           = ?,
2839             size             = ?, lccn            = ?,
2840             marc             = ?, lcsort          =?,
2841             place            = ?, ccode           = ?
2842           "
2843     );
2844     my ($lcsort) =
2845       calculatelc( $biblioitem->{'classification'} )
2846       . $biblioitem->{'subclass'};
2847     $sth->execute(
2848         $bibitemnum,                     $biblioitem->{'biblionumber'},
2849         $biblioitem->{'volume'},         $biblioitem->{'number'},
2850         $biblioitem->{'classification'}, $biblioitem->{'itemtype'},
2851         $biblioitem->{'url'},            $biblioitem->{'isbn'},
2852         $biblioitem->{'issn'},           $biblioitem->{'dewey'},
2853         $biblioitem->{'subclass'},       $biblioitem->{'publicationyear'},
2854         $biblioitem->{'publishercode'},  $biblioitem->{'volumedate'},
2855         $biblioitem->{'volumeddesc'},    $biblioitem->{'illus'},
2856         $biblioitem->{'pages'},          $biblioitem->{'bnotes'},
2857         $biblioitem->{'size'},           $biblioitem->{'lccn'},
2858         $biblioitem->{'marc'},           $biblioitem->{'place'},
2859         $lcsort,                         $biblioitem->{'ccode'}
2860     );
2861     $sth->finish;
2862     return ($bibitemnum);
2863 }
2864
2865 =head2 _koha_new_items
2866
2867 =over 4
2868
2869 _koha_new_items( $dbh, $item, $barcode );
2870
2871 =back
2872
2873 =cut
2874
2875 sub _koha_new_items {
2876     my ( $dbh, $item, $barcode ) = @_;
2877
2878     #  my $dbh   = C4Connect;
2879     my $sth = $dbh->prepare("Select max(itemnumber) from items");
2880     my $data;
2881     my $itemnumber;
2882     my $error = "";
2883
2884     $sth->execute;
2885     $data       = $sth->fetchrow_hashref;
2886     $itemnumber = $data->{'max(itemnumber)'} + 1;
2887     $sth->finish;
2888 ## Now calculate lccalnumber
2889     my ($cutterextra) = itemcalculator(
2890         $dbh,
2891         $item->{'biblioitemnumber'},
2892         $item->{'itemcallnumber'}
2893     );
2894
2895 # FIXME the "notforloan" field seems to be named "loan" in some places. workaround bugfix.
2896     if ( $item->{'loan'} ) {
2897         $item->{'notforloan'} = $item->{'loan'};
2898     }
2899
2900     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
2901     if ( $item->{'dateaccessioned'} eq '' || !$item->{'dateaccessioned'} ) {
2902
2903         $sth = $dbh->prepare(
2904             "Insert into items set
2905             itemnumber           = ?,     biblionumber     = ?,
2906             multivolumepart      = ?,
2907             biblioitemnumber     = ?,     barcode          = ?,
2908             booksellerid         = ?,     dateaccessioned  = NOW(),
2909             homebranch           = ?,     holdingbranch    = ?,
2910             price                = ?,     replacementprice = ?,
2911             replacementpricedate = NOW(), datelastseen     = NOW(),
2912             multivolume          = ?,     stack            = ?,
2913             itemlost             = ?,     wthdrawn         = ?,
2914             paidfor              = ?,     itemnotes        = ?,
2915             itemcallnumber       =?,      notforloan       = ?,
2916             location             = ?,     Cutterextra      = ?
2917           "
2918         );
2919         $sth->execute(
2920             $itemnumber,                $item->{'biblionumber'},
2921             $item->{'multivolumepart'}, $item->{'biblioitemnumber'},
2922             $barcode,                   $item->{'booksellerid'},
2923             $item->{'homebranch'},      $item->{'holdingbranch'},
2924             $item->{'price'},           $item->{'replacementprice'},
2925             $item->{multivolume},       $item->{stack},
2926             $item->{itemlost},          $item->{wthdrawn},
2927             $item->{paidfor},           $item->{'itemnotes'},
2928             $item->{'itemcallnumber'},  $item->{'notforloan'},
2929             $item->{'location'},        $cutterextra
2930         );
2931     }
2932     else {
2933         $sth = $dbh->prepare(
2934             "INSERT INTO items SET
2935             itemnumber           = ?,     biblionumber     = ?,
2936             multivolumepart      = ?,
2937             biblioitemnumber     = ?,     barcode          = ?,
2938             booksellerid         = ?,     dateaccessioned  = ?,
2939             homebranch           = ?,     holdingbranch    = ?,
2940             price                = ?,     replacementprice = ?,
2941             replacementpricedate = NOW(), datelastseen     = NOW(),
2942             multivolume          = ?,     stack            = ?,
2943             itemlost             = ?,     wthdrawn         = ?,
2944             paidfor              = ?,     itemnotes        = ?,
2945             itemcallnumber       = ?,     notforloan       = ?,
2946             location             = ?,
2947             Cutterextra          = ?
2948                             "
2949         );
2950         $sth->execute(
2951             $itemnumber,                 $item->{'biblionumber'},
2952             $item->{'multivolumepart'},  $item->{'biblioitemnumber'},
2953             $barcode,                    $item->{'booksellerid'},
2954             $item->{'dateaccessioned'},  $item->{'homebranch'},
2955             $item->{'holdingbranch'},    $item->{'price'},
2956             $item->{'replacementprice'}, $item->{multivolume},
2957             $item->{stack},              $item->{itemlost},
2958             $item->{wthdrawn},           $item->{paidfor},
2959             $item->{'itemnotes'},        $item->{'itemcallnumber'},
2960             $item->{'notforloan'},       $item->{'location'},
2961             $cutterextra
2962         );
2963     }
2964     if ( defined $sth->errstr ) {
2965         $error .= $sth->errstr;
2966     }
2967     return ( $itemnumber, $error );
2968 }
2969
2970 =head2 _koha_modify_item
2971
2972 =over 4
2973
2974 _koha_modify_item( $dbh, $item, $op );
2975
2976 =back
2977
2978 =cut
2979
2980 sub _koha_modify_item {
2981     my ( $dbh, $item, $op ) = @_;
2982     $item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
2983
2984     # if all we're doing is setting statuses, just update those and get out
2985     if ( $op eq "setstatus" ) {
2986         my $query =
2987           "UPDATE items SET itemlost=?,wthdrawn=?,binding=? WHERE itemnumber=?";
2988         my @bind = (
2989             $item->{'itemlost'}, $item->{'wthdrawn'},
2990             $item->{'binding'},  $item->{'itemnumber'}
2991         );
2992         my $sth = $dbh->prepare($query);
2993         $sth->execute(@bind);
2994         $sth->finish;
2995         return undef;
2996     }
2997 ## Now calculate lccalnumber
2998     my ($cutterextra) =
2999       itemcalculator( $dbh, $item->{'bibitemnum'}, $item->{'itemcallnumber'} );
3000
3001     my $query = "UPDATE items SET
3002 barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,homebranch=?,cutterextra=?, onloan=?, binding=?";
3003
3004     my @bind = (
3005         $item->{'barcode'},        $item->{'notes'},
3006         $item->{'itemcallnumber'}, $item->{'notforloan'},
3007         $item->{'location'},       $item->{multivolumepart},
3008         $item->{multivolume},      $item->{stack},
3009         $item->{wthdrawn},         $item->{holdingbranch},
3010         $item->{homebranch},       $cutterextra,
3011         $item->{onloan},           $item->{binding}
3012     );
3013     if ( $item->{'lost'} ne '' ) {
3014         $query =
3015 "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
3016                             itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
3017                              location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?,holdingbranch=?,cutterextra=?,onloan=?, binding=?";
3018         @bind = (
3019             $item->{'bibitemnum'},     $item->{'barcode'},
3020             $item->{'notes'},          $item->{'homebranch'},
3021             $item->{'lost'},           $item->{'wthdrawn'},
3022             $item->{'itemcallnumber'}, $item->{'notforloan'},
3023             $item->{'location'},       $item->{multivolumepart},
3024             $item->{multivolume},      $item->{stack},
3025             $item->{wthdrawn},         $item->{holdingbranch},
3026             $cutterextra,              $item->{onloan},
3027             $item->{binding}
3028         );
3029         if ( $item->{homebranch} ) {
3030             $query .= ",homebranch=?";
3031             push @bind, $item->{homebranch};
3032         }
3033         if ( $item->{holdingbranch} ) {
3034             $query .= ",holdingbranch=?";
3035             push @bind, $item->{holdingbranch};
3036         }
3037     }
3038     $query .= " where itemnumber=?";
3039     push @bind, $item->{'itemnum'};
3040     if ( $item->{'replacement'} ne '' ) {
3041         $query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
3042     }
3043     my $sth = $dbh->prepare($query);
3044     $sth->execute(@bind);
3045     $sth->finish;
3046 }
3047
3048 =head2 _koha_delete_biblio
3049
3050 =over 4
3051
3052 $error = _koha_delete_biblio($dbh,$biblionumber);
3053
3054 Internal sub for deleting from biblio table -- also saves to deletedbiblio
3055
3056 C<$dbh> - the database handle
3057 C<$biblionumber> - the biblionumber of the biblio to be deleted
3058
3059 =back
3060
3061 =cut
3062
3063 # FIXME: add error handling
3064
3065 sub _koha_delete_biblio {
3066     my ( $dbh, $biblionumber ) = @_;
3067
3068     # get all the data for this biblio
3069     my $sth = $dbh->prepare("SELECT * FROM biblio WHERE biblionumber=?");
3070     $sth->execute($biblionumber);
3071
3072     if ( my $data = $sth->fetchrow_hashref ) {
3073
3074         # save the record in deletedbiblio
3075         # find the fields to save
3076         my $query = "INSERT INTO deletedbiblio SET ";
3077         my @bind  = ();
3078         foreach my $temp ( keys %$data ) {
3079             $query .= "$temp = ?,";
3080             push( @bind, $data->{$temp} );
3081         }
3082
3083         # replace the last , by ",?)"
3084         $query =~ s/\,$//;
3085         my $bkup_sth = $dbh->prepare($query);
3086         $bkup_sth->execute(@bind);
3087         $bkup_sth->finish;
3088
3089         # delete the biblio
3090         my $del_sth = $dbh->prepare("DELETE FROM biblio WHERE biblionumber=?");
3091         $del_sth->execute($biblionumber);
3092         $del_sth->finish;
3093     }
3094     $sth->finish;
3095     return undef;
3096 }
3097
3098 =head2 _koha_delete_biblioitems
3099
3100 =over 4
3101
3102 $error = _koha_delete_biblioitems($dbh,$biblioitemnumber);
3103
3104 Internal sub for deleting from biblioitems table -- also saves to deletedbiblioitems
3105
3106 C<$dbh> - the database handle
3107 C<$biblionumber> - the biblioitemnumber of the biblioitem to be deleted
3108
3109 =back
3110
3111 =cut
3112
3113 # FIXME: add error handling
3114
3115 sub _koha_delete_biblioitems {
3116     my ( $dbh, $biblioitemnumber ) = @_;
3117
3118     # get all the data for this biblioitem
3119     my $sth =
3120       $dbh->prepare("SELECT * FROM biblioitems WHERE biblioitemnumber=?");
3121     $sth->execute($biblioitemnumber);
3122
3123     if ( my $data = $sth->fetchrow_hashref ) {
3124
3125         # save the record in deletedbiblioitems
3126         # find the fields to save
3127         my $query = "INSERT INTO deletedbiblioitems SET ";
3128         my @bind  = ();
3129         foreach my $temp ( keys %$data ) {
3130             $query .= "$temp = ?,";
3131             push( @bind, $data->{$temp} );
3132         }
3133
3134         # replace the last , by ",?)"
3135         $query =~ s/\,$//;
3136         my $bkup_sth = $dbh->prepare($query);
3137         $bkup_sth->execute(@bind);
3138         $bkup_sth->finish;
3139
3140         # delete the biblioitem
3141         my $del_sth =
3142           $dbh->prepare("DELETE FROM biblioitems WHERE biblioitemnumber=?");
3143         $del_sth->execute($biblioitemnumber);
3144         $del_sth->finish;
3145     }
3146     $sth->finish;
3147     return undef;
3148 }
3149
3150 =head2 _koha_delete_item
3151
3152 =over 4
3153
3154 _koha_delete_item( $dbh, $itemnum );
3155
3156 Internal function to delete an item record from the koha tables
3157
3158 =back
3159
3160 =cut
3161
3162 sub _koha_delete_item {
3163     my ( $dbh, $itemnum ) = @_;
3164
3165     my $sth = $dbh->prepare("select * from items where itemnumber=?");
3166     $sth->execute($itemnum);
3167     my $data = $sth->fetchrow_hashref;
3168     $sth->finish;
3169     my $query = "Insert into deleteditems set ";
3170     my @bind  = ();
3171     foreach my $temp ( keys %$data ) {
3172         $query .= "$temp = ?,";
3173         push( @bind, $data->{$temp} );
3174     }
3175     $query =~ s/\,$//;
3176
3177     #  print $query;
3178     $sth = $dbh->prepare($query);
3179     $sth->execute(@bind);
3180     $sth->finish;
3181     $sth = $dbh->prepare("Delete from items where itemnumber=?");
3182     $sth->execute($itemnum);
3183     $sth->finish;
3184 }
3185
3186 =head1 UNEXPORTED FUNCTIONS
3187
3188 =over 4
3189
3190 =head2 calculatelc
3191
3192 $lc = calculatelc($classification);
3193
3194 =back
3195
3196 =cut
3197
3198 sub calculatelc {
3199     my ($classification) = @_;
3200     $classification =~ s/^\s+|\s+$//g;
3201     my $i = 0;
3202     my $lc2;
3203     my $lc1;
3204
3205     for ( $i = 0 ; $i < length($classification) ; $i++ ) {
3206         my $c = ( substr( $classification, $i, 1 ) );
3207         if ( $c ge '0' && $c le '9' ) {
3208
3209             $lc2 = substr( $classification, $i );
3210             last;
3211         }
3212         else {
3213             $lc1 .= substr( $classification, $i, 1 );
3214
3215         }
3216     }    #while
3217
3218     my $other = length($lc1);
3219     if ( !$lc1 ) {
3220         $other = 0;
3221     }
3222
3223     my $extras;
3224     if ( $other < 4 ) {
3225         for ( 1 .. ( 4 - $other ) ) {
3226             $extras .= "0";
3227         }
3228     }
3229     $lc1 .= $extras;
3230     $lc2 =~ s/^ //g;
3231
3232     $lc2 =~ s/ //g;
3233     $extras = "";
3234     ##Find the decimal part of $lc2
3235     my $pos = index( $lc2, "." );
3236     if ( $pos < 0 ) { $pos = length($lc2); }
3237     if ( $pos >= 0 && $pos < 5 ) {
3238         ##Pad lc2 with zeros to create a 5digit decimal needed in marc record to sort as numeric
3239
3240         for ( 1 .. ( 5 - $pos ) ) {
3241             $extras .= "0";
3242         }
3243     }
3244     $lc2 = $extras . $lc2;
3245     return ( $lc1 . $lc2 );
3246 }
3247
3248 =head2 itemcalculator
3249
3250 =over 4
3251
3252 $cutterextra = itemcalculator( $dbh, $biblioitem, $callnumber );
3253
3254 =back
3255
3256 =cut
3257
3258 sub itemcalculator {
3259     my ( $dbh, $biblioitem, $callnumber ) = @_;
3260     my $sth =
3261       $dbh->prepare(
3262 "select classification, subclass from biblioitems where biblioitemnumber=?"
3263       );
3264
3265     $sth->execute($biblioitem);
3266     my ( $classification, $subclass ) = $sth->fetchrow;
3267     my $all         = $classification . " " . $subclass;
3268     my $total       = length($all);
3269     my $cutterextra = substr( $callnumber, $total - 1 );
3270
3271     return $cutterextra;
3272 }
3273
3274 =head2 ModBiblioMarc
3275
3276 =over 4
3277
3278 &ModBiblioMarc($newrec,$biblionumber,$frameworkcode);
3279
3280 Add MARC data for a biblio to koha
3281
3282 Function exported, but should NOT be used, unless you really know what you're doing
3283
3284 =back
3285
3286 =cut
3287
3288 sub ModBiblioMarc {
3289
3290 # pass the MARC::Record to this function, and it will create the records in the marc tables
3291     my ( $record, $biblionumber, $frameworkcode ) = @_;
3292     my $dbh = C4::Context->dbh;
3293     my @fields = $record->fields();
3294     if ( !$frameworkcode ) {
3295         $frameworkcode = "";
3296     }
3297     my $sth =
3298       $dbh->prepare("UPDATE biblio SET frameworkcode=? WHERE biblionumber=?");
3299     $sth->execute( $frameworkcode, $biblionumber );
3300     $sth->finish;
3301     my $encoding = C4::Context->preference("marcflavour");
3302
3303 # deal with UNIMARC field 100 (encoding) : create it if needed & set encoding to unicode
3304     if ( $encoding eq "UNIMARC" ) {
3305         my $string;
3306         if ( $record->subfield( 100, "a" ) ) {
3307             $string = $record->subfield( 100, "a" );
3308             my $f100 = $record->field(100);
3309             $record->delete_field($f100);
3310         }
3311         else {
3312             $string = POSIX::strftime( "%Y%m%d", localtime );
3313             $string =~ s/\-//g;
3314             $string = sprintf( "%-*s", 35, $string );
3315         }
3316         substr( $string, 22, 6, "frey50" );
3317         unless ( $record->subfield( 100, "a" ) ) {
3318             $record->insert_grouped_field(
3319                 MARC::Field->new( 100, "", "", "a" => $string ) );
3320         }
3321     }
3322 #     warn "biblionumber : ".$biblionumber;
3323     $sth =
3324       $dbh->prepare(
3325         "update biblioitems set marc=?,marcxml=?  where biblionumber=?");
3326     $sth->execute( $record->as_usmarc(), $record->as_xml_record(),
3327         $biblionumber );
3328 #     warn $record->as_xml_record();
3329     $sth->finish;
3330     ModZebra($biblionumber,"specialUpdate","biblioserver");
3331     return $biblionumber;
3332 }
3333
3334 =head2 AddItemInMarc
3335
3336 =over 4
3337
3338 $newbiblionumber = AddItemInMarc( $record, $biblionumber, $frameworkcode );
3339
3340 Add an item in a MARC record and save the MARC record
3341
3342 Function exported, but should NOT be used, unless you really know what you're doing
3343
3344 =back
3345
3346 =cut
3347
3348 sub AddItemInMarc {
3349
3350 # pass the MARC::Record to this function, and it will create the records in the marc tables
3351     my ( $record, $biblionumber, $frameworkcode ) = @_;
3352     my $newrec = &GetMarcBiblio($biblionumber);
3353
3354     # create it
3355     my @fields = $record->fields();
3356     foreach my $field (@fields) {
3357         $newrec->append_fields($field);
3358     }
3359
3360     # FIXME: should we be making sure the biblionumbers are the same?
3361     my $newbiblionumber =
3362       &ModBiblioMarc( $newrec, $biblionumber, $frameworkcode );
3363     return $newbiblionumber;
3364 }
3365
3366 =head2 z3950_extended_services
3367
3368 z3950_extended_services($serviceType,$serviceOptions,$record);
3369
3370     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.
3371
3372 C<$serviceType> one of: itemorder,create,drop,commit,update,xmlupdate
3373
3374 C<$serviceOptions> a has of key/value pairs. For instance, if service_type is 'update', $service_options should contain:
3375
3376     action => update action, one of specialUpdate, recordInsert, recordReplace, recordDelete, elementUpdate.
3377
3378 and maybe
3379
3380     recordidOpaque => Opaque Record ID (user supplied) or recordidNumber => Record ID number (system number).
3381     syntax => the record syntax (transfer syntax)
3382     databaseName = Database from connection object
3383
3384     To set serviceOptions, call set_service_options($serviceType)
3385
3386 C<$record> the record, if one is needed for the service type
3387
3388     A record should be in XML. You can convert it to XML from MARC by running it through marc2xml().
3389
3390 =cut
3391
3392 sub z3950_extended_services {
3393     my ( $server, $serviceType, $action, $serviceOptions ) = @_;
3394
3395     # get our connection object
3396     my $Zconn = C4::Context->Zconn( $server, 0, 1 );
3397
3398     # create a new package object
3399     my $Zpackage = $Zconn->package();
3400
3401     # set our options
3402     $Zpackage->option( action => $action );
3403
3404     if ( $serviceOptions->{'databaseName'} ) {
3405         $Zpackage->option( databaseName => $serviceOptions->{'databaseName'} );
3406     }
3407     if ( $serviceOptions->{'recordIdNumber'} ) {
3408         $Zpackage->option(
3409             recordIdNumber => $serviceOptions->{'recordIdNumber'} );
3410     }
3411     if ( $serviceOptions->{'recordIdOpaque'} ) {
3412         $Zpackage->option(
3413             recordIdOpaque => $serviceOptions->{'recordIdOpaque'} );
3414     }
3415
3416  # this is an ILL request (Zebra doesn't support it, but Koha could eventually)
3417  #if ($serviceType eq 'itemorder') {
3418  #   $Zpackage->option('contact-name' => $serviceOptions->{'contact-name'});
3419  #   $Zpackage->option('contact-phone' => $serviceOptions->{'contact-phone'});
3420  #   $Zpackage->option('contact-email' => $serviceOptions->{'contact-email'});
3421  #   $Zpackage->option('itemorder-item' => $serviceOptions->{'itemorder-item'});
3422  #}
3423
3424     if ( $serviceOptions->{record} ) {
3425         $Zpackage->option( record => $serviceOptions->{record} );
3426
3427         # can be xml or marc
3428         if ( $serviceOptions->{'syntax'} ) {
3429             $Zpackage->option( syntax => $serviceOptions->{'syntax'} );
3430         }
3431     }
3432
3433     # send the request, handle any exception encountered
3434     eval { $Zpackage->send($serviceType) };
3435     if ( $@ && $@->isa("ZOOM::Exception") ) {
3436         return "error:  " . $@->code() . " " . $@->message() . "\n";
3437     }
3438
3439     # free up package resources
3440     $Zpackage->destroy();
3441 }
3442
3443 =head2 set_service_options
3444
3445 my $serviceOptions = set_service_options($serviceType);
3446
3447 C<$serviceType> itemorder,create,drop,commit,update,xmlupdate
3448
3449 Currently, we only support 'create', 'commit', and 'update'. 'drop' support will be added as soon as Zebra supports it.
3450
3451 =cut
3452
3453 sub set_service_options {
3454     my ($serviceType) = @_;
3455     my $serviceOptions;
3456
3457 # FIXME: This needs to be an OID ... if we ever need 'syntax' this sub will need to change
3458 #   $serviceOptions->{ 'syntax' } = ''; #zebra doesn't support syntaxes other than xml
3459
3460     if ( $serviceType eq 'commit' ) {
3461
3462         # nothing to do
3463     }
3464     if ( $serviceType eq 'create' ) {
3465
3466         # nothing to do
3467     }
3468     if ( $serviceType eq 'drop' ) {
3469         die "ERROR: 'drop' not currently supported (by Zebra)";
3470     }
3471     return $serviceOptions;
3472 }
3473
3474 END { }    # module clean-up code here (global destructor)
3475
3476 1;
3477
3478 __END__
3479
3480 =head1 AUTHOR
3481
3482 Koha Developement team <info@koha.org>
3483
3484 Paul POULAIN paul.poulain@free.fr
3485
3486 Joshua Ferraro jmf@liblime.com
3487
3488 =cut
3489
3490 # $Id$
3491 # $Log$
3492 # Revision 1.194  2007/03/30 12:00:42  tipaul
3493 # why the hell do we need to explicitly utf8 decode this string ? I really don't know, but it seems it's mandatory, otherwise, tag descriptions are not properly encoded...
3494 #
3495 # Revision 1.193  2007/03/29 16:45:53  tipaul
3496 # Code cleaning of Biblio.pm (continued)
3497 #
3498 # All subs have be cleaned :
3499 # - removed useless
3500 # - merged some
3501 # - reordering Biblio.pm completly
3502 # - using only naming conventions
3503 #
3504 # Seems to have broken nothing, but it still has to be heavily tested.
3505 # Note that Biblio.pm is now much more efficient than previously & probably more reliable as well.
3506 #
3507 # Revision 1.192  2007/03/29 13:30:31  tipaul
3508 # Code cleaning :
3509 # == Biblio.pm cleaning (useless) ==
3510 # * some sub declaration dropped
3511 # * removed modbiblio sub
3512 # * removed moditem sub
3513 # * removed newitems. It was used only in finishrecieve. Replaced by a TransformKohaToMarc+AddItem, that is better.
3514 # * removed MARCkoha2marcItem
3515 # * removed MARCdelsubfield declaration
3516 # * removed MARCkoha2marcBiblio
3517 #
3518 # == Biblio.pm cleaning (naming conventions) ==
3519 # * MARCgettagslib renamed to GetMarcStructure
3520 # * MARCgetitems renamed to GetMarcItem
3521 # * MARCfind_frameworkcode renamed to GetFrameworkCode
3522 # * MARCmarc2koha renamed to TransformMarcToKoha
3523 # * MARChtml2marc renamed to TransformHtmlToMarc
3524 # * MARChtml2xml renamed to TranformeHtmlToXml
3525 # * zebraop renamed to ModZebra
3526 #
3527 # == MARC=OFF ==
3528 # * removing MARC=OFF related scripts (in cataloguing directory)
3529 # * removed checkitems (function related to MARC=off feature, that is completly broken in head. If someone want to reintroduce it, hard work coming...)
3530 # * removed getitemsbybiblioitem (used only by MARC=OFF scripts, that is removed as well)
3531 #
3532 # Revision 1.191  2007/03/29 09:42:13  tipaul
3533 # adding default value new feature into cataloguing. The system (definition) part has already been added by toins
3534 #
3535 # Revision 1.190  2007/03/29 08:45:19  hdl
3536 # Deleting ignore_errors(1) pour MARC::Charset
3537 #
3538 # Revision 1.189  2007/03/28 10:39:16  hdl
3539 # removing $dbh as a parameter in AuthoritiesMarc functions
3540 # And reporting all differences into the scripts taht relies on those functions.