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