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