C4/Items.pm

   1 package C4::Items;
   2
   3 # Copyright 2007 LibLime, Inc.
   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 use C4::Context;
  23 use C4::Koha;
  24 use C4::Biblio;
  25 use C4::Dates qw/format_date format_date_in_iso/;
  26 use MARC::Record;
  27 use C4::ClassSource;
  28 use C4::Log;
  29 use C4::Branch;
  30 require C4::Reserves;
  31 use C4::Charset;
  32
  33 use vars qw($VERSION @ISA @EXPORT);
  34
  35 BEGIN {
  36     $VERSION = 3.01;
  37
  38         require Exporter;
  39     @ISA = qw( Exporter );
  40
  41     # function exports
  42     @EXPORT = qw(
  43         GetItem
  44         AddItemFromMarc
  45         AddItem
  46         AddItemBatchFromMarc
  47         ModItemFromMarc
  48         ModItem
  49         ModDateLastSeen
  50         ModItemTransfer
  51         DelItem
  52         DelItemCheck
  53
  54         CheckItemPreSave
  55
  56         GetItemStatus
  57         GetItemLocation
  58         GetLostItems
  59         GetItemsForInventory
  60         GetItemsCount
  61         GetItemInfosOf
  62         GetItemsByBiblioitemnumber
  63         GetItemsInfo
  64         get_itemnumbers_of
  65         GetItemnumberFromBarcode
  66     );
  67 }
  68
  69 =head1 NAME
  70
  71 C4::Items - item management functions
  72
  73 =head1 DESCRIPTION
  74
  75 This module contains an API for manipulating item
  76 records in Koha, and is used by cataloguing, circulation,
  77 acquisitions, and serials management.
  78
  79 A Koha item record is stored in two places: the
  80 items table and embedded in a MARC tag in the XML
  81 version of the associated bib record in C<biblioitems.marcxml>.
  82 This is done to allow the item information to be readily
  83 indexed (e.g., by Zebra), but means that each item
  84 modification transaction must keep the items table
  85 and the MARC XML in sync at all times.
  86
  87 Consequently, all code that creates, modifies, or deletes
  88 item records B<must> use an appropriate function from
  89 C<C4::Items>.  If no existing function is suitable, it is
  90 better to add one to C<C4::Items> than to use add
  91 one-off SQL statements to add or modify items.
  92
  93 The items table will be considered authoritative.  In other
  94 words, if there is ever a discrepancy between the items
  95 table and the MARC XML, the items table should be considered
  96 accurate.
  97
  98 =head1 HISTORICAL NOTE
  99
 100 Most of the functions in C<C4::Items> were originally in
 101 the C<C4::Biblio> module.
 102
 103 =head1 CORE EXPORTED FUNCTIONS
 104
 105 The following functions are meant for use by users
 106 of C<C4::Items>
 107
 108 =cut
 109
 110 =head2 GetItem
 111
 112 =over 4
 113
 114 $item = GetItem($itemnumber,$barcode,$serial);
 115
 116 =back
 117
 118 Return item information, for a given itemnumber or barcode.
 119 The return value is a hashref mapping item column
 120 names to values.  If C<$serial> is true, include serial publication data.
 121
 122 =cut
 123
 124 sub GetItem {
 125     my ($itemnumber,$barcode, $serial) = @_;
 126     my $dbh = C4::Context->dbh;
 127         my $data;
 128     if ($itemnumber) {
 129         my $sth = $dbh->prepare("
 130             SELECT * FROM items
 131             WHERE itemnumber = ?");
 132         $sth->execute($itemnumber);
 133         $data = $sth->fetchrow_hashref;
 134     } else {
 135         my $sth = $dbh->prepare("
 136             SELECT * FROM items
 137             WHERE barcode = ?"
 138             );
 139         $sth->execute($barcode);
 140         $data = $sth->fetchrow_hashref;
 141     }
 142     if ( $serial) {
 143     my $ssth = $dbh->prepare("SELECT serialseq,publisheddate from serialitems left join serial on serialitems.serialid=serial.serialid where serialitems.itemnumber=?");
 144         $ssth->execute($data->{'itemnumber'}) ;
 145         ($data->{'serialseq'} , $data->{'publisheddate'}) = $ssth->fetchrow_array();
 146                 warn $data->{'serialseq'} , $data->{'publisheddate'};
 147     }
 148         #if we don't have an items.itype, use biblioitems.itemtype.
 149         if( ! $data->{'itype'} ) {
 150                 my $sth = $dbh->prepare("SELECT itemtype FROM biblioitems  WHERE biblionumber = ?");
 151                 $sth->execute($data->{'biblionumber'});
 152                 ($data->{'itype'}) = $sth->fetchrow_array;
 153         }
 154     return $data;
 155 }    # sub GetItem
 156
 157 =head2 AddItemFromMarc
 158
 159 =over 4
 160
 161 my ($biblionumber, $biblioitemnumber, $itemnumber)
 162     = AddItemFromMarc($source_item_marc, $biblionumber);
 163
 164 =back
 165
 166 Given a MARC::Record object containing an embedded item
 167 record and a biblionumber, create a new item record.
 168
 169 =cut
 170
 171 sub AddItemFromMarc {
 172     my ( $source_item_marc, $biblionumber ) = @_;
 173     my $dbh = C4::Context->dbh;
 174
 175     # parse item hash from MARC
 176     my $frameworkcode = GetFrameworkCode( $biblionumber );
 177     my $item = &TransformMarcToKoha( $dbh, $source_item_marc, $frameworkcode );
 178     my $unlinked_item_subfields = _get_unlinked_item_subfields($source_item_marc, $frameworkcode);
 179     return AddItem($item, $biblionumber, $dbh, $frameworkcode, $unlinked_item_subfields);
 180 }
 181
 182 =head2 AddItem
 183
 184 =over 4
 185
 186 my ($biblionumber, $biblioitemnumber, $itemnumber)
 187     = AddItem($item, $biblionumber[, $dbh, $frameworkcode, $unlinked_item_subfields]);
 188
 189 =back
 190
 191 Given a hash containing item column names as keys,
 192 create a new Koha item record.
 193
 194 The first two optional parameters (C<$dbh> and C<$frameworkcode>)
 195 do not need to be supplied for general use; they exist
 196 simply to allow them to be picked up from AddItemFromMarc.
 197
 198 The final optional parameter, C<$unlinked_item_subfields>, contains
 199 an arrayref containing subfields present in the original MARC
 200 representation of the item (e.g., from the item editor) that are
 201 not mapped to C<items> columns directly but should instead
 202 be stored in C<items.more_subfields_xml> and included in
 203 the biblio items tag for display and indexing.
 204
 205 =cut
 206
 207 sub AddItem {
 208     my $item = shift;
 209     my $biblionumber = shift;
 210
 211     my $dbh           = @_ ? shift : C4::Context->dbh;
 212     my $frameworkcode = @_ ? shift : GetFrameworkCode( $biblionumber );
 213     my $unlinked_item_subfields;
 214     if (@_) {
 215         $unlinked_item_subfields = shift
 216     };
 217
 218     # needs old biblionumber and biblioitemnumber
 219     $item->{'biblionumber'} = $biblionumber;
 220     my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 221     $sth->execute( $item->{'biblionumber'} );
 222     ($item->{'biblioitemnumber'}) = $sth->fetchrow;
 223
 224     _set_defaults_for_add($item);
 225     _set_derived_columns_for_add($item);
 226     $item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);
 227     # FIXME - checks here
 228     unless ( $item->{itype} ) {  # default to biblioitem.itemtype if no itype
 229         my $itype_sth = $dbh->prepare("SELECT itemtype FROM biblioitems WHERE biblionumber = ?");
 230         $itype_sth->execute( $item->{'biblionumber'} );
 231         ( $item->{'itype'} ) = $itype_sth->fetchrow_array;
 232     }
 233
 234         my ( $itemnumber, $error ) = _koha_new_item( $item, $item->{barcode} );
 235     $item->{'itemnumber'} = $itemnumber;
 236
 237     # create MARC tag representing item and add to bib
 238     my $new_item_marc = _marc_from_item_hash($item, $frameworkcode, $unlinked_item_subfields);
 239     _add_item_field_to_biblio($new_item_marc, $item->{'biblionumber'}, $frameworkcode );
 240
 241     logaction("CATALOGUING", "ADD", $itemnumber, "item") if C4::Context->preference("CataloguingLog");
 242
 243     return ($item->{biblionumber}, $item->{biblioitemnumber}, $itemnumber);
 244 }
 245
 246 =head2 AddItemBatchFromMarc
 247
 248 =over 4
 249
 250 ($itemnumber_ref, $error_ref) = AddItemBatchFromMarc($record, $biblionumber, $biblioitemnumber, $frameworkcode);
 251
 252 =back
 253
 254 Efficiently create item records from a MARC biblio record with
 255 embedded item fields.  This routine is suitable for batch jobs.
 256
 257 This API assumes that the bib record has already been
 258 saved to the C<biblio> and C<biblioitems> tables.  It does
 259 not expect that C<biblioitems.marc> and C<biblioitems.marcxml>
 260 are populated, but it will do so via a call to ModBibiloMarc.
 261
 262 The goal of this API is to have a similar effect to using AddBiblio
 263 and AddItems in succession, but without inefficient repeated
 264 parsing of the MARC XML bib record.
 265
 266 This function returns an arrayref of new itemsnumbers and an arrayref of item
 267 errors encountered during the processing.  Each entry in the errors
 268 list is a hashref containing the following keys:
 269
 270 =over 2
 271
 272 =item item_sequence
 273
 274 Sequence number of original item tag in the MARC record.
 275
 276 =item item_barcode
 277
 278 Item barcode, provide to assist in the construction of
 279 useful error messages.
 280
 281 =item error_condition
 282
 283 Code representing the error condition.  Can be 'duplicate_barcode',
 284 'invalid_homebranch', or 'invalid_holdingbranch'.
 285
 286 =item error_information
 287
 288 Additional information appropriate to the error condition.
 289
 290 =back
 291
 292 =cut
 293
 294 sub AddItemBatchFromMarc {
 295     my ($record, $biblionumber, $biblioitemnumber, $frameworkcode) = @_;
 296     my $error;
 297     my @itemnumbers = ();
 298     my @errors = ();
 299     my $dbh = C4::Context->dbh;
 300
 301     # loop through the item tags and start creating items
 302     my @bad_item_fields = ();
 303     my ($itemtag, $itemsubfield) = &GetMarcFromKohaField("items.itemnumber",'');
 304     my $item_sequence_num = 0;
 305     ITEMFIELD: foreach my $item_field ($record->field($itemtag)) {
 306         $item_sequence_num++;
 307         # we take the item field and stick it into a new
 308         # MARC record -- this is required so far because (FIXME)
 309         # TransformMarcToKoha requires a MARC::Record, not a MARC::Field
 310         # and there is no TransformMarcFieldToKoha
 311         my $temp_item_marc = MARC::Record->new();
 312         $temp_item_marc->append_fields($item_field);
 313
 314         # add biblionumber and biblioitemnumber
 315         my $item = TransformMarcToKoha( $dbh, $temp_item_marc, $frameworkcode, 'items' );
 316         my $unlinked_item_subfields = _get_unlinked_item_subfields($temp_item_marc, $frameworkcode);
 317         $item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);
 318         $item->{'biblionumber'} = $biblionumber;
 319         $item->{'biblioitemnumber'} = $biblioitemnumber;
 320
 321         # check for duplicate barcode
 322         my %item_errors = CheckItemPreSave($item);
 323         if (%item_errors) {
 324             push @errors, _repack_item_errors($item_sequence_num, $item, \%item_errors);
 325             push @bad_item_fields, $item_field;
 326             next ITEMFIELD;
 327         }
 328
 329         _set_defaults_for_add($item);
 330         _set_derived_columns_for_add($item);
 331         my ( $itemnumber, $error ) = _koha_new_item( $item, $item->{barcode} );
 332         warn $error if $error;
 333         push @itemnumbers, $itemnumber; # FIXME not checking error
 334         $item->{'itemnumber'} = $itemnumber;
 335
 336         logaction("CATALOGUING", "ADD", $itemnumber, "item") if C4::Context->preference("CataloguingLog");
 337
 338         my $new_item_marc = _marc_from_item_hash($item, $frameworkcode, $unlinked_item_subfields);
 339         $item_field->replace_with($new_item_marc->field($itemtag));
 340     }
 341
 342     # remove any MARC item fields for rejected items
 343     foreach my $item_field (@bad_item_fields) {
 344         $record->delete_field($item_field);
 345     }
 346
 347     # update the MARC biblio
 348     $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 349
 350     return (\@itemnumbers, \@errors);
 351 }
 352
 353 =head2 ModItemFromMarc
 354
 355 =over 4
 356
 357 ModItemFromMarc($item_marc, $biblionumber, $itemnumber);
 358
 359 =back
 360
 361 This function updates an item record based on a supplied
 362 C<MARC::Record> object containing an embedded item field.
 363 This API is meant for the use of C<additem.pl>; for
 364 other purposes, C<ModItem> should be used.
 365
 366 This function uses the hash %default_values_for_mod_from_marc,
 367 which contains default values for item fields to
 368 apply when modifying an item.  This is needed beccause
 369 if an item field's value is cleared, TransformMarcToKoha
 370 does not include the column in the
 371 hash that's passed to ModItem, which without
 372 use of this hash makes it impossible to clear
 373 an item field's value.  See bug 2466.
 374
 375 Note that only columns that can be directly
 376 changed from the cataloging and serials
 377 item editors are included in this hash.
 378
 379 =cut
 380
 381 my %default_values_for_mod_from_marc = (
 382     barcode              => undef,
 383     booksellerid         => undef,
 384     ccode                => undef,
 385     'items.cn_source'    => undef,
 386     copynumber           => undef,
 387     damaged              => 0,
 388     dateaccessioned      => undef,
 389     enumchron            => undef,
 390     holdingbranch        => undef,
 391     homebranch           => undef,
 392     itemcallnumber       => undef,
 393     itemlost             => 0,
 394     itemnotes            => undef,
 395     itype                => undef,
 396     location             => undef,
 397     materials            => undef,
 398     notforloan           => 0,
 399     paidfor              => undef,
 400     price                => undef,
 401     replacementprice     => undef,
 402     replacementpricedate => undef,
 403     restricted           => undef,
 404     stack                => undef,
 405     uri                  => undef,
 406     wthdrawn             => 0,
 407 );
 408
 409 sub ModItemFromMarc {
 410     my $item_marc = shift;
 411     my $biblionumber = shift;
 412     my $itemnumber = shift;
 413
 414     my $dbh = C4::Context->dbh;
 415     my $frameworkcode = GetFrameworkCode( $biblionumber );
 416     my $item = &TransformMarcToKoha( $dbh, $item_marc, $frameworkcode );
 417     foreach my $item_field (keys %default_values_for_mod_from_marc) {
 418         $item->{$item_field} = $default_values_for_mod_from_marc{$item_field} unless exists $item->{$item_field};
 419     }
 420     my $unlinked_item_subfields = _get_unlinked_item_subfields($item_marc, $frameworkcode);
 421
 422     return ModItem($item, $biblionumber, $itemnumber, $dbh, $frameworkcode, $unlinked_item_subfields);
 423 }
 424
 425 =head2 ModItem
 426
 427 =over 4
 428
 429 ModItem({ column => $newvalue }, $biblionumber, $itemnumber[, $original_item_marc]);
 430
 431 =back
 432
 433 Change one or more columns in an item record and update
 434 the MARC representation of the item.
 435
 436 The first argument is a hashref mapping from item column
 437 names to the new values.  The second and third arguments
 438 are the biblionumber and itemnumber, respectively.
 439
 440 The fourth, optional parameter, C<$unlinked_item_subfields>, contains
 441 an arrayref containing subfields present in the original MARC
 442 representation of the item (e.g., from the item editor) that are
 443 not mapped to C<items> columns directly but should instead
 444 be stored in C<items.more_subfields_xml> and included in
 445 the biblio items tag for display and indexing.
 446
 447 If one of the changed columns is used to calculate
 448 the derived value of a column such as C<items.cn_sort>,
 449 this routine will perform the necessary calculation
 450 and set the value.
 451
 452 =cut
 453
 454 sub ModItem {
 455     my $item = shift;
 456     my $biblionumber = shift;
 457     my $itemnumber = shift;
 458
 459     # if $biblionumber is undefined, get it from the current item
 460     unless (defined $biblionumber) {
 461         $biblionumber = _get_single_item_column('biblionumber', $itemnumber);
 462     }
 463
 464     my $dbh           = @_ ? shift : C4::Context->dbh;
 465     my $frameworkcode = @_ ? shift : GetFrameworkCode( $biblionumber );
 466
 467     my $unlinked_item_subfields;
 468     if (@_) {
 469         $unlinked_item_subfields = shift;
 470         $item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);
 471     };
 472
 473     $item->{'itemnumber'} = $itemnumber or return undef;
 474     _set_derived_columns_for_mod($item);
 475     _do_column_fixes_for_mod($item);
 476     # FIXME add checks
 477     # duplicate barcode
 478     # attempt to change itemnumber
 479     # attempt to change biblionumber (if we want
 480     # an API to relink an item to a different bib,
 481     # it should be a separate function)
 482
 483     # update items table
 484     _koha_modify_item($item);
 485
 486     # update biblio MARC XML
 487     my $whole_item = GetItem($itemnumber) or die "FAILED GetItem($itemnumber)";
 488
 489     unless (defined $unlinked_item_subfields) {
 490         $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($whole_item->{'more_subfields_xml'});
 491     }
 492     my $new_item_marc = _marc_from_item_hash($whole_item, $frameworkcode, $unlinked_item_subfields)
 493         or die "FAILED _marc_from_item_hash($whole_item, $frameworkcode)";
 494
 495     _replace_item_field_in_biblio($new_item_marc, $biblionumber, $itemnumber, $frameworkcode);
 496         ($new_item_marc       eq '0') and die "$new_item_marc is '0', not hashref";  # logaction line would crash anyway
 497     logaction("CATALOGUING", "MODIFY", $itemnumber, $new_item_marc->as_formatted) if C4::Context->preference("CataloguingLog");
 498 }
 499
 500 =head2 ModItemTransfer
 501
 502 =over 4
 503
 504 ModItemTransfer($itenumber, $frombranch, $tobranch);
 505
 506 =back
 507
 508 Marks an item as being transferred from one branch
 509 to another.
 510
 511 =cut
 512
 513 sub ModItemTransfer {
 514     my ( $itemnumber, $frombranch, $tobranch ) = @_;
 515
 516     my $dbh = C4::Context->dbh;
 517
 518     #new entry in branchtransfers....
 519     my $sth = $dbh->prepare(
 520         "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
 521         VALUES (?, ?, NOW(), ?)");
 522     $sth->execute($itemnumber, $frombranch, $tobranch);
 523
 524     ModItem({ holdingbranch => $tobranch }, undef, $itemnumber);
 525     ModDateLastSeen($itemnumber);
 526     return;
 527 }
 528
 529 =head2 ModDateLastSeen
 530
 531 =over 4
 532
 533 ModDateLastSeen($itemnum);
 534
 535 =back
 536
 537 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking.
 538 C<$itemnum> is the item number
 539
 540 =cut
 541
 542 sub ModDateLastSeen {
 543     my ($itemnumber) = @_;
 544
 545     my $today = C4::Dates->new();
 546     ModItem({ itemlost => 0, datelastseen => $today->output("iso") }, undef, $itemnumber);
 547 }
 548
 549 =head2 DelItem
 550
 551 =over 4
 552
 553 DelItem($biblionumber, $itemnumber);
 554
 555 =back
 556
 557 Exported function (core API) for deleting an item record in Koha.
 558
 559 =cut
 560
 561 sub DelItem {
 562     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 563
 564     # FIXME check the item has no current issues
 565
 566     _koha_delete_item( $dbh, $itemnumber );
 567
 568     # get the MARC record
 569     my $record = GetMarcBiblio($biblionumber);
 570     my $frameworkcode = GetFrameworkCode($biblionumber);
 571
 572     # backup the record
 573     my $copy2deleted = $dbh->prepare("UPDATE deleteditems SET marc=? WHERE itemnumber=?");
 574     $copy2deleted->execute( $record->as_usmarc(), $itemnumber );
 575
 576     #search item field code
 577     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 578     my @fields = $record->field($itemtag);
 579
 580     # delete the item specified
 581     foreach my $field (@fields) {
 582         if ( $field->subfield($itemsubfield) eq $itemnumber ) {
 583             $record->delete_field($field);
 584         }
 585     }
 586     &ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 587     logaction("CATALOGUING", "DELETE", $itemnumber, "item") if C4::Context->preference("CataloguingLog");
 588 }
 589
 590 =head2 DelItemCheck
 591
 592 =over 4
 593
 594 DelItemCheck($dbh, $biblionumber, $itemnumber);
 595
 596 =back
 597
 598 Exported function (core API) for deleting an item record in Koha if there no current issue.
 599
 600 =cut
 601
 602 sub DelItemCheck {
 603     my ( $dbh, $biblionumber, $itemnumber ) = @_;
 604     my $error;
 605
 606     # check that there is no issue on this item before deletion.
 607     my $sth=$dbh->prepare("select * from issues i where i.itemnumber=?");
 608     $sth->execute($itemnumber);
 609
 610     my $onloan=$sth->fetchrow;
 611
 612     $sth->finish();
 613     if ($onloan){
 614         $error = "book_on_loan"
 615     }else{
 616         # check it doesnt have a waiting reserve
 617         $sth=$dbh->prepare("SELECT * FROM reserves WHERE found = 'W' AND itemnumber = ?");
 618         $sth->execute($itemnumber);
 619         my $reserve=$sth->fetchrow;
 620         $sth->finish();
 621         if ($reserve){
 622             $error = "book_reserved";
 623         }else{
 624             DelItem($dbh, $biblionumber, $itemnumber);
 625             return 1;
 626         }
 627     }
 628     return $error;
 629 }
 630
 631 =head2 CheckItemPreSave
 632
 633 =over 4
 634
 635     my $item_ref = TransformMarcToKoha($marc, 'items');
 636     # do stuff
 637     my %errors = CheckItemPreSave($item_ref);
 638     if (exists $errors{'duplicate_barcode'}) {
 639         print "item has duplicate barcode: ", $errors{'duplicate_barcode'}, "\n";
 640     } elsif (exists $errors{'invalid_homebranch'}) {
 641         print "item has invalid home branch: ", $errors{'invalid_homebranch'}, "\n";
 642     } elsif (exists $errors{'invalid_holdingbranch'}) {
 643         print "item has invalid holding branch: ", $errors{'invalid_holdingbranch'}, "\n";
 644     } else {
 645         print "item is OK";
 646     }
 647
 648 =back
 649
 650 Given a hashref containing item fields, determine if it can be
 651 inserted or updated in the database.  Specifically, checks for
 652 database integrity issues, and returns a hash containing any
 653 of the following keys, if applicable.
 654
 655 =over 2
 656
 657 =item duplicate_barcode
 658
 659 Barcode, if it duplicates one already found in the database.
 660
 661 =item invalid_homebranch
 662
 663 Home branch, if not defined in branches table.
 664
 665 =item invalid_holdingbranch
 666
 667 Holding branch, if not defined in branches table.
 668
 669 =back
 670
 671 This function does NOT implement any policy-related checks,
 672 e.g., whether current operator is allowed to save an
 673 item that has a given branch code.
 674
 675 =cut
 676
 677 sub CheckItemPreSave {
 678     my $item_ref = shift;
 679
 680     my %errors = ();
 681
 682     # check for duplicate barcode
 683     if (exists $item_ref->{'barcode'} and defined $item_ref->{'barcode'}) {
 684         my $existing_itemnumber = GetItemnumberFromBarcode($item_ref->{'barcode'});
 685         if ($existing_itemnumber) {
 686             if (!exists $item_ref->{'itemnumber'}                       # new item
 687                 or $item_ref->{'itemnumber'} != $existing_itemnumber) { # existing item
 688                 $errors{'duplicate_barcode'} = $item_ref->{'barcode'};
 689             }
 690         }
 691     }
 692
 693     # check for valid home branch
 694     if (exists $item_ref->{'homebranch'} and defined $item_ref->{'homebranch'}) {
 695         my $branch_name = GetBranchName($item_ref->{'homebranch'});
 696         unless (defined $branch_name) {
 697             # relies on fact that branches.branchname is a non-NULL column,
 698             # so GetBranchName returns undef only if branch does not exist
 699             $errors{'invalid_homebranch'} = $item_ref->{'homebranch'};
 700         }
 701     }
 702
 703     # check for valid holding branch
 704     if (exists $item_ref->{'holdingbranch'} and defined $item_ref->{'holdingbranch'}) {
 705         my $branch_name = GetBranchName($item_ref->{'holdingbranch'});
 706         unless (defined $branch_name) {
 707             # relies on fact that branches.branchname is a non-NULL column,
 708             # so GetBranchName returns undef only if branch does not exist
 709             $errors{'invalid_holdingbranch'} = $item_ref->{'holdingbranch'};
 710         }
 711     }
 712
 713     return %errors;
 714
 715 }
 716
 717 =head1 EXPORTED SPECIAL ACCESSOR FUNCTIONS
 718
 719 The following functions provide various ways of
 720 getting an item record, a set of item records, or
 721 lists of authorized values for certain item fields.
 722
 723 Some of the functions in this group are candidates
 724 for refactoring -- for example, some of the code
 725 in C<GetItemsByBiblioitemnumber> and C<GetItemsInfo>
 726 has copy-and-paste work.
 727
 728 =cut
 729
 730 =head2 GetItemStatus
 731
 732 =over 4
 733
 734 $itemstatushash = GetItemStatus($fwkcode);
 735
 736 =back
 737
 738 Returns a list of valid values for the
 739 C<items.notforloan> field.
 740
 741 NOTE: does B<not> return an individual item's
 742 status.
 743
 744 Can be MARC dependant.
 745 fwkcode is optional.
 746 But basically could be can be loan or not
 747 Create a status selector with the following code
 748
 749 =head3 in PERL SCRIPT
 750
 751 =over 4
 752
 753 my $itemstatushash = getitemstatus;
 754 my @itemstatusloop;
 755 foreach my $thisstatus (keys %$itemstatushash) {
 756     my %row =(value => $thisstatus,
 757                 statusname => $itemstatushash->{$thisstatus}->{'statusname'},
 758             );
 759     push @itemstatusloop, \%row;
 760 }
 761 $template->param(statusloop=>\@itemstatusloop);
 762
 763 =back
 764
 765 =head3 in TEMPLATE
 766
 767 =over 4
 768
 769 <select name="statusloop">
 770     <option value="">Default</option>
 771 <!-- TMPL_LOOP name="statusloop" -->
 772     <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="statusname" --></option>
 773 <!-- /TMPL_LOOP -->
 774 </select>
 775
 776 =back
 777
 778 =cut
 779
 780 sub GetItemStatus {
 781
 782     # returns a reference to a hash of references to status...
 783     my ($fwk) = @_;
 784     my %itemstatus;
 785     my $dbh = C4::Context->dbh;
 786     my $sth;
 787     $fwk = '' unless ($fwk);
 788     my ( $tag, $subfield ) =
 789       GetMarcFromKohaField( "items.notforloan", $fwk );
 790     if ( $tag and $subfield ) {
 791         my $sth =
 792           $dbh->prepare(
 793             "SELECT authorised_value
 794             FROM marc_subfield_structure
 795             WHERE tagfield=?
 796                 AND tagsubfield=?
 797                 AND frameworkcode=?
 798             "
 799           );
 800         $sth->execute( $tag, $subfield, $fwk );
 801         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 802             my $authvalsth =
 803               $dbh->prepare(
 804                 "SELECT authorised_value,lib
 805                 FROM authorised_values
 806                 WHERE category=?
 807                 ORDER BY lib
 808                 "
 809               );
 810             $authvalsth->execute($authorisedvaluecat);
 811             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 812                 $itemstatus{$authorisedvalue} = $lib;
 813             }
 814             $authvalsth->finish;
 815             return \%itemstatus;
 816             exit 1;
 817         }
 818         else {
 819
 820             #No authvalue list
 821             # build default
 822         }
 823         $sth->finish;
 824     }
 825
 826     #No authvalue list
 827     #build default
 828     $itemstatus{"1"} = "Not For Loan";
 829     return \%itemstatus;
 830 }
 831
 832 =head2 GetItemLocation
 833
 834 =over 4
 835
 836 $itemlochash = GetItemLocation($fwk);
 837
 838 =back
 839
 840 Returns a list of valid values for the
 841 C<items.location> field.
 842
 843 NOTE: does B<not> return an individual item's
 844 location.
 845
 846 where fwk stands for an optional framework code.
 847 Create a location selector with the following code
 848
 849 =head3 in PERL SCRIPT
 850
 851 =over 4
 852
 853 my $itemlochash = getitemlocation;
 854 my @itemlocloop;
 855 foreach my $thisloc (keys %$itemlochash) {
 856     my $selected = 1 if $thisbranch eq $branch;
 857     my %row =(locval => $thisloc,
 858                 selected => $selected,
 859                 locname => $itemlochash->{$thisloc},
 860             );
 861     push @itemlocloop, \%row;
 862 }
 863 $template->param(itemlocationloop => \@itemlocloop);
 864
 865 =back
 866
 867 =head3 in TEMPLATE
 868
 869 =over 4
 870
 871 <select name="location">
 872     <option value="">Default</option>
 873 <!-- TMPL_LOOP name="itemlocationloop" -->
 874     <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
 875 <!-- /TMPL_LOOP -->
 876 </select>
 877
 878 =back
 879
 880 =cut
 881
 882 sub GetItemLocation {
 883
 884     # returns a reference to a hash of references to location...
 885     my ($fwk) = @_;
 886     my %itemlocation;
 887     my $dbh = C4::Context->dbh;
 888     my $sth;
 889     $fwk = '' unless ($fwk);
 890     my ( $tag, $subfield ) =
 891       GetMarcFromKohaField( "items.location", $fwk );
 892     if ( $tag and $subfield ) {
 893         my $sth =
 894           $dbh->prepare(
 895             "SELECT authorised_value
 896             FROM marc_subfield_structure
 897             WHERE tagfield=?
 898                 AND tagsubfield=?
 899                 AND frameworkcode=?"
 900           );
 901         $sth->execute( $tag, $subfield, $fwk );
 902         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 903             my $authvalsth =
 904               $dbh->prepare(
 905                 "SELECT authorised_value,lib
 906                 FROM authorised_values
 907                 WHERE category=?
 908                 ORDER BY lib"
 909               );
 910             $authvalsth->execute($authorisedvaluecat);
 911             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 912                 $itemlocation{$authorisedvalue} = $lib;
 913             }
 914             $authvalsth->finish;
 915             return \%itemlocation;
 916             exit 1;
 917         }
 918         else {
 919
 920             #No authvalue list
 921             # build default
 922         }
 923         $sth->finish;
 924     }
 925
 926     #No authvalue list
 927     #build default
 928     $itemlocation{"1"} = "Not For Loan";
 929     return \%itemlocation;
 930 }
 931
 932 =head2 GetLostItems
 933
 934 =over 4
 935
 936 $items = GetLostItems( $where, $orderby );
 937
 938 =back
 939
 940 This function gets a list of lost items.
 941
 942 =over 2
 943
 944 =item input:
 945
 946 C<$where> is a hashref. it containts a field of the items table as key
 947 and the value to match as value. For example:
 948
 949 { barcode    => 'abc123',
 950   homebranch => 'CPL',    }
 951
 952 C<$orderby> is a field of the items table by which the resultset
 953 should be orderd.
 954
 955 =item return:
 956
 957 C<$items> is a reference to an array full of hashrefs with columns
 958 from the "items" table as keys.
 959
 960 =item usage in the perl script:
 961
 962 my $where = { barcode => '0001548' };
 963 my $items = GetLostItems( $where, "homebranch" );
 964 $template->param( itemsloop => $items );
 965
 966 =back
 967
 968 =cut
 969
 970 sub GetLostItems {
 971     # Getting input args.
 972     my $where   = shift;
 973     my $orderby = shift;
 974     my $dbh     = C4::Context->dbh;
 975
 976     my $query   = "
 977         SELECT *
 978         FROM   items
 979             LEFT JOIN biblio ON (items.biblionumber = biblio.biblionumber)
 980             LEFT JOIN biblioitems ON (items.biblionumber = biblioitems.biblionumber)
 981             LEFT JOIN authorised_values ON (items.itemlost = authorised_values.authorised_value)
 982         WHERE
 983                 authorised_values.category = 'LOST'
 984                 AND itemlost IS NOT NULL
 985                 AND itemlost <> 0
 986     ";
 987     my @query_parameters;
 988     foreach my $key (keys %$where) {
 989         $query .= " AND $key LIKE ?";
 990         push @query_parameters, "%$where->{$key}%";
 991     }
 992     my @ordervalues = qw/title author homebranch itype barcode price replacementprice lib datelastseen location/;
 993
 994     if ( defined $orderby && grep($orderby, @ordervalues)) {
 995         $query .= ' ORDER BY '.$orderby;
 996     }
 997
 998     my $sth = $dbh->prepare($query);
 999     $sth->execute( @query_parameters );
1000     my $items = [];
1001     while ( my $row = $sth->fetchrow_hashref ){
1002         push @$items, $row;
1003     }
1004     return $items;
1005 }
1006
1007 =head2 GetItemsForInventory
1008
1009 =over 4
1010
1011 $itemlist = GetItemsForInventory($minlocation, $maxlocation, $location, $itemtype $datelastseen, $branch, $offset, $size);
1012
1013 =back
1014
1015 Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
1016
1017 The sub returns a reference to a list of hashes, each containing
1018 itemnumber, author, title, barcode, item callnumber, and date last
1019 seen. It is ordered by callnumber then title.
1020
1021 The required minlocation & maxlocation parameters are used to specify a range of item callnumbers
1022 the datelastseen can be used to specify that you want to see items not seen since a past date only.
1023 offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
1024
1025 =cut
1026
1027 sub GetItemsForInventory {
1028     my ( $minlocation, $maxlocation,$location, $itemtype, $ignoreissued, $datelastseen, $branch, $offset, $size ) = @_;
1029     my $dbh = C4::Context->dbh;
1030     my ( @bind_params, @where_strings );
1031
1032     my $query = <<'END_SQL';
1033 SELECT items.itemnumber, barcode, itemcallnumber, title, author, biblio.biblionumber, datelastseen
1034 FROM items
1035   LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1036   LEFT JOIN biblioitems on items.biblionumber = biblioitems.biblionumber
1037 END_SQL
1038
1039     if ($minlocation) {
1040         push @where_strings, 'itemcallnumber >= ?';
1041         push @bind_params, $minlocation;
1042     }
1043
1044     if ($maxlocation) {
1045         push @where_strings, 'itemcallnumber <= ?';
1046         push @bind_params, $maxlocation;
1047     }
1048
1049     if ($datelastseen) {
1050         $datelastseen = format_date_in_iso($datelastseen);
1051         push @where_strings, '(datelastseen < ? OR datelastseen IS NULL)';
1052         push @bind_params, $datelastseen;
1053     }
1054
1055     if ( $location ) {
1056         push @where_strings, 'items.location = ?';
1057         push @bind_params, $location;
1058     }
1059
1060     if ( $branch ) {
1061         push @where_strings, 'items.homebranch = ?';
1062         push @bind_params, $branch;
1063     }
1064
1065     if ( $itemtype ) {
1066         push @where_strings, 'biblioitems.itemtype = ?';
1067         push @bind_params, $itemtype;
1068     }
1069     if ( $ignoreissued) {
1070         $query .= "LEFT JOIN issues ON items.itemnumber = issues.itemnumber ";
1071         push @where_strings, 'issues.date_due IS NULL';
1072     }
1073
1074     if ( $ignoreissued) {
1075         $query .= "LEFT JOIN issues ON items.itemnumber = issues.itemnumber ";
1076         push @where_strings, 'issues.date_due IS NULL';
1077     }
1078
1079     if ( @where_strings ) {
1080         $query .= 'WHERE ';
1081         $query .= join ' AND ', @where_strings;
1082     }
1083     $query .= ' ORDER BY itemcallnumber, title';
1084     my $sth = $dbh->prepare($query);
1085     $sth->execute( @bind_params );
1086
1087     my @results;
1088     $size--;
1089     while ( my $row = $sth->fetchrow_hashref ) {
1090         $offset-- if ($offset);
1091         $row->{datelastseen}=format_date($row->{datelastseen});
1092         if ( ( !$offset ) && $size ) {
1093             push @results, $row;
1094             $size--;
1095         }
1096     }
1097     return \@results;
1098 }
1099
1100 =head2 GetItemsCount
1101
1102 =over 4
1103 $count = &GetItemsCount( $biblionumber);
1104
1105 =back
1106
1107 This function return count of item with $biblionumber
1108
1109 =cut
1110
1111 sub GetItemsCount {
1112     my ( $biblionumber ) = @_;
1113     my $dbh = C4::Context->dbh;
1114     my $query = "SELECT count(*)
1115           FROM  items
1116           WHERE biblionumber=?";
1117     my $sth = $dbh->prepare($query);
1118     $sth->execute($biblionumber);
1119     my $count = $sth->fetchrow;
1120     $sth->finish;
1121     return ($count);
1122 }
1123
1124 =head2 GetItemInfosOf
1125
1126 =over 4
1127
1128 GetItemInfosOf(@itemnumbers);
1129
1130 =back
1131
1132 =cut
1133
1134 sub GetItemInfosOf {
1135     my @itemnumbers = @_;
1136
1137     my $query = '
1138         SELECT *
1139         FROM items
1140         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
1141     ';
1142     return get_infos_of( $query, 'itemnumber' );
1143 }
1144
1145 =head2 GetItemsByBiblioitemnumber
1146
1147 =over 4
1148
1149 GetItemsByBiblioitemnumber($biblioitemnumber);
1150
1151 =back
1152
1153 Returns an arrayref of hashrefs suitable for use in a TMPL_LOOP
1154 Called by C<C4::XISBN>
1155
1156 =cut
1157
1158 sub GetItemsByBiblioitemnumber {
1159     my ( $bibitem ) = @_;
1160     my $dbh = C4::Context->dbh;
1161     my $sth = $dbh->prepare("SELECT * FROM items WHERE items.biblioitemnumber = ?") || die $dbh->errstr;
1162     # Get all items attached to a biblioitem
1163     my $i = 0;
1164     my @results;
1165     $sth->execute($bibitem) || die $sth->errstr;
1166     while ( my $data = $sth->fetchrow_hashref ) {
1167         # Foreach item, get circulation information
1168         my $sth2 = $dbh->prepare( "SELECT * FROM issues,borrowers
1169                                    WHERE itemnumber = ?
1170                                    AND issues.borrowernumber = borrowers.borrowernumber"
1171         );
1172         $sth2->execute( $data->{'itemnumber'} );
1173         if ( my $data2 = $sth2->fetchrow_hashref ) {
1174             # if item is out, set the due date and who it is out too
1175             $data->{'date_due'}   = $data2->{'date_due'};
1176             $data->{'cardnumber'} = $data2->{'cardnumber'};
1177             $data->{'borrowernumber'}   = $data2->{'borrowernumber'};
1178         }
1179         else {
1180             # set date_due to blank, so in the template we check itemlost, and wthdrawn
1181             $data->{'date_due'} = '';
1182         }    # else
1183         $sth2->finish;
1184         # Find the last 3 people who borrowed this item.
1185         my $query2 = "SELECT * FROM old_issues, borrowers WHERE itemnumber = ?
1186                       AND old_issues.borrowernumber = borrowers.borrowernumber
1187                       ORDER BY returndate desc,timestamp desc LIMIT 3";
1188         $sth2 = $dbh->prepare($query2) || die $dbh->errstr;
1189         $sth2->execute( $data->{'itemnumber'} ) || die $sth2->errstr;
1190         my $i2 = 0;
1191         while ( my $data2 = $sth2->fetchrow_hashref ) {
1192             $data->{"timestamp$i2"} = $data2->{'timestamp'};
1193             $data->{"card$i2"}      = $data2->{'cardnumber'};
1194             $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
1195             $i2++;
1196         }
1197         $sth2->finish;
1198         push(@results,$data);
1199     }
1200     $sth->finish;
1201     return (\@results);
1202 }
1203
1204 =head2 GetItemsInfo
1205
1206 =over 4
1207
1208 @results = GetItemsInfo($biblionumber, $type);
1209
1210 =back
1211
1212 Returns information about books with the given biblionumber.
1213
1214 C<$type> may be either C<intra> or anything else. If it is not set to
1215 C<intra>, then the search will exclude lost, very overdue, and
1216 withdrawn items.
1217
1218 C<GetItemsInfo> returns a list of references-to-hash. Each element
1219 contains a number of keys. Most of them are table items from the
1220 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
1221 Koha database. Other keys include:
1222
1223 =over 2
1224
1225 =item C<$data-E<gt>{branchname}>
1226
1227 The name (not the code) of the branch to which the book belongs.
1228
1229 =item C<$data-E<gt>{datelastseen}>
1230
1231 This is simply C<items.datelastseen>, except that while the date is
1232 stored in YYYY-MM-DD format in the database, here it is converted to
1233 DD/MM/YYYY format. A NULL date is returned as C<//>.
1234
1235 =item C<$data-E<gt>{datedue}>
1236
1237 =item C<$data-E<gt>{class}>
1238
1239 This is the concatenation of C<biblioitems.classification>, the book's
1240 Dewey code, and C<biblioitems.subclass>.
1241
1242 =item C<$data-E<gt>{ocount}>
1243
1244 I think this is the number of copies of the book available.
1245
1246 =item C<$data-E<gt>{order}>
1247
1248 If this is set, it is set to C<One Order>.
1249
1250 =back
1251
1252 =cut
1253
1254 sub GetItemsInfo {
1255     my ( $biblionumber, $type ) = @_;
1256     my $dbh   = C4::Context->dbh;
1257     # note biblioitems.* must be avoided to prevent large marc and marcxml fields from killing performance.
1258     my $query = "
1259     SELECT items.*,
1260            biblio.*,
1261            biblioitems.volume,
1262            biblioitems.number,
1263            biblioitems.itemtype,
1264            biblioitems.isbn,
1265            biblioitems.issn,
1266            biblioitems.publicationyear,
1267            biblioitems.publishercode,
1268            biblioitems.volumedate,
1269            biblioitems.volumedesc,
1270            biblioitems.lccn,
1271            biblioitems.url,
1272            items.notforloan as itemnotforloan,
1273            itemtypes.description
1274      FROM items
1275      LEFT JOIN biblio      ON      biblio.biblionumber     = items.biblionumber
1276      LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1277      LEFT JOIN itemtypes   ON   itemtypes.itemtype         = "
1278      . (C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype');
1279     $query .= " WHERE items.biblionumber = ? ORDER BY items.dateaccessioned desc" ;
1280     my $sth = $dbh->prepare($query);
1281     $sth->execute($biblionumber);
1282     my $i = 0;
1283     my @results;
1284     my ( $date_due, $count_reserves, $serial );
1285
1286     my $isth    = $dbh->prepare(
1287         "SELECT issues.*,borrowers.cardnumber,borrowers.surname,borrowers.firstname,borrowers.branchcode as bcode
1288         FROM   issues LEFT JOIN borrowers ON issues.borrowernumber=borrowers.borrowernumber
1289         WHERE  itemnumber = ?"
1290        );
1291         my $ssth = $dbh->prepare("SELECT serialseq,publisheddate from serialitems left join serial on serialitems.serialid=serial.serialid where serialitems.itemnumber=? ");
1292         while ( my $data = $sth->fetchrow_hashref ) {
1293         my $datedue = '';
1294         $isth->execute( $data->{'itemnumber'} );
1295         if ( my $idata = $isth->fetchrow_hashref ) {
1296             $data->{borrowernumber} = $idata->{borrowernumber};
1297             $data->{cardnumber}     = $idata->{cardnumber};
1298             $data->{surname}     = $idata->{surname};
1299             $data->{firstname}     = $idata->{firstname};
1300             $datedue                = $idata->{'date_due'};
1301         if (C4::Context->preference("IndependantBranches")){
1302         my $userenv = C4::Context->userenv;
1303         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1304             $data->{'NOTSAMEBRANCH'} = 1 if ($idata->{'bcode'} ne $userenv->{branch});
1305         }
1306         }
1307         }
1308                 if ( $data->{'serial'}) {
1309                         $ssth->execute($data->{'itemnumber'}) ;
1310                         ($data->{'serialseq'} , $data->{'publisheddate'}) = $ssth->fetchrow_array();
1311                         $serial = 1;
1312         }
1313                 if ( $datedue eq '' ) {
1314             my ( $restype, $reserves ) =
1315               C4::Reserves::CheckReserves( $data->{'itemnumber'} );
1316             if ($restype) {
1317                 $count_reserves = $restype;
1318             }
1319         }
1320         $isth->finish;
1321         $ssth->finish;
1322         #get branch information.....
1323         my $bsth = $dbh->prepare(
1324             "SELECT * FROM branches WHERE branchcode = ?
1325         "
1326         );
1327         $bsth->execute( $data->{'holdingbranch'} );
1328         if ( my $bdata = $bsth->fetchrow_hashref ) {
1329             $data->{'branchname'} = $bdata->{'branchname'};
1330         }
1331         $data->{'datedue'}        = $datedue;
1332         $data->{'count_reserves'} = $count_reserves;
1333
1334         # get notforloan complete status if applicable
1335         my $sthnflstatus = $dbh->prepare(
1336             'SELECT authorised_value
1337             FROM   marc_subfield_structure
1338             WHERE  kohafield="items.notforloan"
1339         '
1340         );
1341
1342         $sthnflstatus->execute;
1343         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
1344         if ($authorised_valuecode) {
1345             $sthnflstatus = $dbh->prepare(
1346                 "SELECT lib FROM authorised_values
1347                  WHERE  category=?
1348                  AND authorised_value=?"
1349             );
1350             $sthnflstatus->execute( $authorised_valuecode,
1351                 $data->{itemnotforloan} );
1352             my ($lib) = $sthnflstatus->fetchrow;
1353             $data->{notforloanvalue} = $lib;
1354         }
1355                 $data->{itypenotforloan} = $data->{notforloan} if (C4::Context->preference('item-level_itypes'));
1356
1357         # my stack procedures
1358         my $stackstatus = $dbh->prepare(
1359             'SELECT authorised_value
1360              FROM   marc_subfield_structure
1361              WHERE  kohafield="items.stack"
1362         '
1363         );
1364         $stackstatus->execute;
1365
1366         ($authorised_valuecode) = $stackstatus->fetchrow;
1367         if ($authorised_valuecode) {
1368             $stackstatus = $dbh->prepare(
1369                 "SELECT lib
1370                  FROM   authorised_values
1371                  WHERE  category=?
1372                  AND    authorised_value=?
1373             "
1374             );
1375             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
1376             my ($lib) = $stackstatus->fetchrow;
1377             $data->{stack} = $lib;
1378         }
1379         # Find the last 3 people who borrowed this item.
1380         my $sth2 = $dbh->prepare("SELECT * FROM old_issues,borrowers
1381                                     WHERE itemnumber = ?
1382                                     AND old_issues.borrowernumber = borrowers.borrowernumber
1383                                     ORDER BY returndate DESC
1384                                     LIMIT 3");
1385         $sth2->execute($data->{'itemnumber'});
1386         my $ii = 0;
1387         while (my $data2 = $sth2->fetchrow_hashref()) {
1388             $data->{"timestamp$ii"} = $data2->{'timestamp'} if $data2->{'timestamp'};
1389             $data->{"card$ii"}      = $data2->{'cardnumber'} if $data2->{'cardnumber'};
1390             $data->{"borrower$ii"}  = $data2->{'borrowernumber'} if $data2->{'borrowernumber'};
1391             $ii++;
1392         }
1393
1394         $results[$i] = $data;
1395         $i++;
1396     }
1397         if($serial) {
1398                 return( sort { ($b->{'publisheddate'} || $b->{'enumchron'}) cmp ($a->{'publisheddate'} || $a->{'enumchron'}) } @results );
1399         } else {
1400         return (@results);
1401         }
1402 }
1403
1404 =head2 get_itemnumbers_of
1405
1406 =over 4
1407
1408 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1409
1410 =back
1411
1412 Given a list of biblionumbers, return the list of corresponding itemnumbers
1413 for each biblionumber.
1414
1415 Return a reference on a hash where keys are biblionumbers and values are
1416 references on array of itemnumbers.
1417
1418 =cut
1419
1420 sub get_itemnumbers_of {
1421     my @biblionumbers = @_;
1422
1423     my $dbh = C4::Context->dbh;
1424
1425     my $query = '
1426         SELECT itemnumber,
1427             biblionumber
1428         FROM items
1429         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1430     ';
1431     my $sth = $dbh->prepare($query);
1432     $sth->execute(@biblionumbers);
1433
1434     my %itemnumbers_of;
1435
1436     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1437         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1438     }
1439
1440     return \%itemnumbers_of;
1441 }
1442
1443 =head2 GetItemnumberFromBarcode
1444
1445 =over 4
1446
1447 $result = GetItemnumberFromBarcode($barcode);
1448
1449 =back
1450
1451 =cut
1452
1453 sub GetItemnumberFromBarcode {
1454     my ($barcode) = @_;
1455     my $dbh = C4::Context->dbh;
1456
1457     my $rq =
1458       $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?");
1459     $rq->execute($barcode);
1460     my ($result) = $rq->fetchrow;
1461     return ($result);
1462 }
1463
1464 =head3 get_item_authorised_values
1465
1466   find the types and values for all authorised values assigned to this item.
1467
1468   parameters:
1469     itemnumber
1470
1471   returns: a hashref malling the authorised value to the value set for this itemnumber
1472
1473     $authorised_values = {
1474              'CCODE'      => undef,
1475              'DAMAGED'    => '0',
1476              'LOC'        => '3',
1477              'LOST'       => '0'
1478              'NOT_LOAN'   => '0',
1479              'RESTRICTED' => undef,
1480              'STACK'      => undef,
1481              'WITHDRAWN'  => '0',
1482              'branches'   => 'CPL',
1483              'cn_source'  => undef,
1484              'itemtypes'  => 'SER',
1485            };
1486
1487    Notes: see C4::Biblio::get_biblio_authorised_values for a similar method at the biblio level.
1488
1489 =cut
1490
1491 sub get_item_authorised_values {
1492     my $itemnumber = shift;
1493
1494     # assume that these entries in the authorised_value table are item level.
1495     my $query = q(SELECT distinct authorised_value, kohafield
1496                     FROM marc_subfield_structure
1497                     WHERE kohafield like 'item%'
1498                       AND authorised_value != '' );
1499
1500     my $itemlevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
1501     my $iteminfo = GetItem( $itemnumber );
1502     # warn( Data::Dumper->Dump( [ $itemlevel_authorised_values ], [ 'itemlevel_authorised_values' ] ) );
1503     my $return;
1504     foreach my $this_authorised_value ( keys %$itemlevel_authorised_values ) {
1505         my $field = $itemlevel_authorised_values->{ $this_authorised_value }->{'kohafield'};
1506         $field =~ s/^items\.//;
1507         if ( exists $iteminfo->{ $field } ) {
1508             $return->{ $this_authorised_value } = $iteminfo->{ $field };
1509         }
1510     }
1511     # warn( Data::Dumper->Dump( [ $return ], [ 'return' ] ) );
1512     return $return;
1513 }
1514
1515 =head3 get_authorised_value_images
1516
1517   find a list of icons that are appropriate for display based on the
1518   authorised values for a biblio.
1519
1520   parameters: listref of authorised values, such as comes from
1521     get_item_authorised_values or
1522     from C4::Biblio::get_biblio_authorised_values
1523
1524   returns: listref of hashrefs for each image. Each hashref looks like
1525     this:
1526
1527       { imageurl => '/intranet-tmpl/prog/img/itemtypeimg/npl/WEB.gif',
1528         label    => '',
1529         category => '',
1530         value    => '', }
1531
1532   Notes: Currently, I put on the full path to the images on the staff
1533   side. This should either be configurable or not done at all. Since I
1534   have to deal with 'intranet' or 'opac' in
1535   get_biblio_authorised_values, perhaps I should be passing it in.
1536
1537 =cut
1538
1539 sub get_authorised_value_images {
1540     my $authorised_values = shift;
1541
1542     my @imagelist;
1543
1544     my $authorised_value_list = GetAuthorisedValues();
1545     # warn ( Data::Dumper->Dump( [ $authorised_value_list ], [ 'authorised_value_list' ] ) );
1546     foreach my $this_authorised_value ( @$authorised_value_list ) {
1547         if ( exists $authorised_values->{ $this_authorised_value->{'category'} }
1548              && $authorised_values->{ $this_authorised_value->{'category'} } eq $this_authorised_value->{'authorised_value'} ) {
1549             # warn ( Data::Dumper->Dump( [ $this_authorised_value ], [ 'this_authorised_value' ] ) );
1550             if ( defined $this_authorised_value->{'imageurl'} ) {
1551                 push @imagelist, { imageurl => C4::Koha::getitemtypeimagelocation( 'intranet', $this_authorised_value->{'imageurl'} ),
1552                                    label    => $this_authorised_value->{'lib'},
1553                                    category => $this_authorised_value->{'category'},
1554                                    value    => $this_authorised_value->{'authorised_value'}, };
1555             }
1556         }
1557     }
1558
1559     # warn ( Data::Dumper->Dump( [ \@imagelist ], [ 'imagelist' ] ) );
1560     return \@imagelist;
1561
1562 }
1563
1564 =head1 LIMITED USE FUNCTIONS
1565
1566 The following functions, while part of the public API,
1567 are not exported.  This is generally because they are
1568 meant to be used by only one script for a specific
1569 purpose, and should not be used in any other context
1570 without careful thought.
1571
1572 =cut
1573
1574 =head2 GetMarcItem
1575
1576 =over 4
1577
1578 my $item_marc = GetMarcItem($biblionumber, $itemnumber);
1579
1580 =back
1581
1582 Returns MARC::Record of the item passed in parameter.
1583 This function is meant for use only in C<cataloguing/additem.pl>,
1584 where it is needed to support that script's MARC-like
1585 editor.
1586
1587 =cut
1588
1589 sub GetMarcItem {
1590     my ( $biblionumber, $itemnumber ) = @_;
1591
1592     # GetMarcItem has been revised so that it does the following:
1593     #  1. Gets the item information from the items table.
1594     #  2. Converts it to a MARC field for storage in the bib record.
1595     #
1596     # The previous behavior was:
1597     #  1. Get the bib record.
1598     #  2. Return the MARC tag corresponding to the item record.
1599     #
1600     # The difference is that one treats the items row as authoritative,
1601     # while the other treats the MARC representation as authoritative
1602     # under certain circumstances.
1603
1604     my $itemrecord = GetItem($itemnumber);
1605
1606     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
1607     # Also, don't emit a subfield if the underlying field is blank.
1608     my $mungeditem = {
1609         map {
1610             defined($itemrecord->{$_}) && $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()
1611         } keys %{ $itemrecord }
1612     };
1613     my $itemmarc = TransformKohaToMarc($mungeditem);
1614
1615     my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($mungeditem->{'items.more_subfields_xml'});
1616     if (defined $unlinked_item_subfields and $#$unlinked_item_subfields > -1) {
1617         my @fields = $itemmarc->fields();
1618         if ($#fields > -1) {
1619             $fields[0]->add_subfields(@$unlinked_item_subfields);
1620         }
1621     }
1622
1623     return $itemmarc;
1624
1625 }
1626
1627 =head1 PRIVATE FUNCTIONS AND VARIABLES
1628
1629 The following functions are not meant to be called
1630 directly, but are documented in order to explain
1631 the inner workings of C<C4::Items>.
1632
1633 =cut
1634
1635 =head2 %derived_columns
1636
1637 This hash keeps track of item columns that
1638 are strictly derived from other columns in
1639 the item record and are not meant to be set
1640 independently.
1641
1642 Each key in the hash should be the name of a
1643 column (as named by TransformMarcToKoha).  Each
1644 value should be hashref whose keys are the
1645 columns on which the derived column depends.  The
1646 hashref should also contain a 'BUILDER' key
1647 that is a reference to a sub that calculates
1648 the derived value.
1649
1650 =cut
1651
1652 my %derived_columns = (
1653     'items.cn_sort' => {
1654         'itemcallnumber' => 1,
1655         'items.cn_source' => 1,
1656         'BUILDER' => \&_calc_items_cn_sort,
1657     }
1658 );
1659
1660 =head2 _set_derived_columns_for_add
1661
1662 =over 4
1663
1664 _set_derived_column_for_add($item);
1665
1666 =back
1667
1668 Given an item hash representing a new item to be added,
1669 calculate any derived columns.  Currently the only
1670 such column is C<items.cn_sort>.
1671
1672 =cut
1673
1674 sub _set_derived_columns_for_add {
1675     my $item = shift;
1676
1677     foreach my $column (keys %derived_columns) {
1678         my $builder = $derived_columns{$column}->{'BUILDER'};
1679         my $source_values = {};
1680         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1681             next if $source_column eq 'BUILDER';
1682             $source_values->{$source_column} = $item->{$source_column};
1683         }
1684         $builder->($item, $source_values);
1685     }
1686 }
1687
1688 =head2 _set_derived_columns_for_mod
1689
1690 =over 4
1691
1692 _set_derived_column_for_mod($item);
1693
1694 =back
1695
1696 Given an item hash representing a new item to be modified.
1697 calculate any derived columns.  Currently the only
1698 such column is C<items.cn_sort>.
1699
1700 This routine differs from C<_set_derived_columns_for_add>
1701 in that it needs to handle partial item records.  In other
1702 words, the caller of C<ModItem> may have supplied only one
1703 or two columns to be changed, so this function needs to
1704 determine whether any of the columns to be changed affect
1705 any of the derived columns.  Also, if a derived column
1706 depends on more than one column, but the caller is not
1707 changing all of then, this routine retrieves the unchanged
1708 values from the database in order to ensure a correct
1709 calculation.
1710
1711 =cut
1712
1713 sub _set_derived_columns_for_mod {
1714     my $item = shift;
1715
1716     foreach my $column (keys %derived_columns) {
1717         my $builder = $derived_columns{$column}->{'BUILDER'};
1718         my $source_values = {};
1719         my %missing_sources = ();
1720         my $must_recalc = 0;
1721         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1722             next if $source_column eq 'BUILDER';
1723             if (exists $item->{$source_column}) {
1724                 $must_recalc = 1;
1725                 $source_values->{$source_column} = $item->{$source_column};
1726             } else {
1727                 $missing_sources{$source_column} = 1;
1728             }
1729         }
1730         if ($must_recalc) {
1731             foreach my $source_column (keys %missing_sources) {
1732                 $source_values->{$source_column} = _get_single_item_column($source_column, $item->{'itemnumber'});
1733             }
1734             $builder->($item, $source_values);
1735         }
1736     }
1737 }
1738
1739 =head2 _do_column_fixes_for_mod
1740
1741 =over 4
1742
1743 _do_column_fixes_for_mod($item);
1744
1745 =back
1746
1747 Given an item hashref containing one or more
1748 columns to modify, fix up certain values.
1749 Specifically, set to 0 any passed value
1750 of C<notforloan>, C<damaged>, C<itemlost>, or
1751 C<wthdrawn> that is either undefined or
1752 contains the empty string.
1753
1754 =cut
1755
1756 sub _do_column_fixes_for_mod {
1757     my $item = shift;
1758
1759     if (exists $item->{'notforloan'} and
1760         (not defined $item->{'notforloan'} or $item->{'notforloan'} eq '')) {
1761         $item->{'notforloan'} = 0;
1762     }
1763     if (exists $item->{'damaged'} and
1764         (not defined $item->{'damaged'} or $item->{'damaged'} eq '')) {
1765         $item->{'damaged'} = 0;
1766     }
1767     if (exists $item->{'itemlost'} and
1768         (not defined $item->{'itemlost'} or $item->{'itemlost'} eq '')) {
1769         $item->{'itemlost'} = 0;
1770     }
1771     if (exists $item->{'wthdrawn'} and
1772         (not defined $item->{'wthdrawn'} or $item->{'wthdrawn'} eq '')) {
1773         $item->{'wthdrawn'} = 0;
1774     }
1775 }
1776
1777 =head2 _get_single_item_column
1778
1779 =over 4
1780
1781 _get_single_item_column($column, $itemnumber);
1782
1783 =back
1784
1785 Retrieves the value of a single column from an C<items>
1786 row specified by C<$itemnumber>.
1787
1788 =cut
1789
1790 sub _get_single_item_column {
1791     my $column = shift;
1792     my $itemnumber = shift;
1793
1794     my $dbh = C4::Context->dbh;
1795     my $sth = $dbh->prepare("SELECT $column FROM items WHERE itemnumber = ?");
1796     $sth->execute($itemnumber);
1797     my ($value) = $sth->fetchrow();
1798     return $value;
1799 }
1800
1801 =head2 _calc_items_cn_sort
1802
1803 =over 4
1804
1805 _calc_items_cn_sort($item, $source_values);
1806
1807 =back
1808
1809 Helper routine to calculate C<items.cn_sort>.
1810
1811 =cut
1812
1813 sub _calc_items_cn_sort {
1814     my $item = shift;
1815     my $source_values = shift;
1816
1817     $item->{'items.cn_sort'} = GetClassSort($source_values->{'items.cn_source'}, $source_values->{'itemcallnumber'}, "");
1818 }
1819
1820 =head2 _set_defaults_for_add
1821
1822 =over 4
1823
1824 _set_defaults_for_add($item_hash);
1825
1826 =back
1827
1828 Given an item hash representing an item to be added, set
1829 correct default values for columns whose default value
1830 is not handled by the DBMS.  This includes the following
1831 columns:
1832
1833 =over 2
1834
1835 =item *
1836
1837 C<items.dateaccessioned>
1838
1839 =item *
1840
1841 C<items.notforloan>
1842
1843 =item *
1844
1845 C<items.damaged>
1846
1847 =item *
1848
1849 C<items.itemlost>
1850
1851 =item *
1852
1853 C<items.wthdrawn>
1854
1855 =back
1856
1857 =cut
1858
1859 sub _set_defaults_for_add {
1860     my $item = shift;
1861     $item->{dateaccessioned} ||= C4::Dates->new->output('iso');
1862     $item->{$_} ||= 0 for (qw( notforloan damaged itemlost wthdrawn));
1863 }
1864
1865 =head2 _koha_new_item
1866
1867 =over 4
1868
1869 my ($itemnumber,$error) = _koha_new_item( $item, $barcode );
1870
1871 =back
1872
1873 Perform the actual insert into the C<items> table.
1874
1875 =cut
1876
1877 sub _koha_new_item {
1878     my ( $item, $barcode ) = @_;
1879     my $dbh=C4::Context->dbh;
1880     my $error;
1881     my $query =
1882            "INSERT INTO items SET
1883             biblionumber        = ?,
1884             biblioitemnumber    = ?,
1885             barcode             = ?,
1886             dateaccessioned     = ?,
1887             booksellerid        = ?,
1888             homebranch          = ?,
1889             price               = ?,
1890             replacementprice    = ?,
1891             replacementpricedate = NOW(),
1892             datelastborrowed    = ?,
1893             datelastseen        = NOW(),
1894             stack               = ?,
1895             notforloan          = ?,
1896             damaged             = ?,
1897             itemlost            = ?,
1898             wthdrawn            = ?,
1899             itemcallnumber      = ?,
1900             restricted          = ?,
1901             itemnotes           = ?,
1902             holdingbranch       = ?,
1903             paidfor             = ?,
1904             location            = ?,
1905             onloan              = ?,
1906             issues              = ?,
1907             renewals            = ?,
1908             reserves            = ?,
1909             cn_source           = ?,
1910             cn_sort             = ?,
1911             ccode               = ?,
1912             itype               = ?,
1913             materials           = ?,
1914             uri = ?,
1915             enumchron           = ?,
1916             more_subfields_xml  = ?,
1917             copynumber          = ?
1918           ";
1919     my $sth = $dbh->prepare($query);
1920    $sth->execute(
1921             $item->{'biblionumber'},
1922             $item->{'biblioitemnumber'},
1923             $barcode,
1924             $item->{'dateaccessioned'},
1925             $item->{'booksellerid'},
1926             $item->{'homebranch'},
1927             $item->{'price'},
1928             $item->{'replacementprice'},
1929             $item->{datelastborrowed},
1930             $item->{stack},
1931             $item->{'notforloan'},
1932             $item->{'damaged'},
1933             $item->{'itemlost'},
1934             $item->{'wthdrawn'},
1935             $item->{'itemcallnumber'},
1936             $item->{'restricted'},
1937             $item->{'itemnotes'},
1938             $item->{'holdingbranch'},
1939             $item->{'paidfor'},
1940             $item->{'location'},
1941             $item->{'onloan'},
1942             $item->{'issues'},
1943             $item->{'renewals'},
1944             $item->{'reserves'},
1945             $item->{'items.cn_source'},
1946             $item->{'items.cn_sort'},
1947             $item->{'ccode'},
1948             $item->{'itype'},
1949             $item->{'materials'},
1950             $item->{'uri'},
1951             $item->{'enumchron'},
1952             $item->{'more_subfields_xml'},
1953             $item->{'copynumber'},
1954     );
1955     my $itemnumber = $dbh->{'mysql_insertid'};
1956     if ( defined $sth->errstr ) {
1957         $error.="ERROR in _koha_new_item $query".$sth->errstr;
1958     }
1959     $sth->finish();
1960     return ( $itemnumber, $error );
1961 }
1962
1963 =head2 _koha_modify_item
1964
1965 =over 4
1966
1967 my ($itemnumber,$error) =_koha_modify_item( $item );
1968
1969 =back
1970
1971 Perform the actual update of the C<items> row.  Note that this
1972 routine accepts a hashref specifying the columns to update.
1973
1974 =cut
1975
1976 sub _koha_modify_item {
1977     my ( $item ) = @_;
1978     my $dbh=C4::Context->dbh;
1979     my $error;
1980
1981     my $query = "UPDATE items SET ";
1982     my @bind;
1983     for my $key ( keys %$item ) {
1984         $query.="$key=?,";
1985         push @bind, $item->{$key};
1986     }
1987     $query =~ s/,$//;
1988     $query .= " WHERE itemnumber=?";
1989     push @bind, $item->{'itemnumber'};
1990     my $sth = C4::Context->dbh->prepare($query);
1991     $sth->execute(@bind);
1992     if ( C4::Context->dbh->errstr ) {
1993         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
1994         warn $error;
1995     }
1996     $sth->finish();
1997     return ($item->{'itemnumber'},$error);
1998 }
1999
2000 =head2 _koha_delete_item
2001
2002 =over 4
2003
2004 _koha_delete_item( $dbh, $itemnum );
2005
2006 =back
2007
2008 Internal function to delete an item record from the koha tables
2009
2010 =cut
2011
2012 sub _koha_delete_item {
2013     my ( $dbh, $itemnum ) = @_;
2014
2015     # save the deleted item to deleteditems table
2016     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
2017     $sth->execute($itemnum);
2018     my $data = $sth->fetchrow_hashref();
2019     $sth->finish();
2020     my $query = "INSERT INTO deleteditems SET ";
2021     my @bind  = ();
2022     foreach my $key ( keys %$data ) {
2023         $query .= "$key = ?,";
2024         push( @bind, $data->{$key} );
2025     }
2026     $query =~ s/\,$//;
2027     $sth = $dbh->prepare($query);
2028     $sth->execute(@bind);
2029     $sth->finish();
2030
2031     # delete from items table
2032     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
2033     $sth->execute($itemnum);
2034     $sth->finish();
2035     return undef;
2036 }
2037
2038 =head2 _marc_from_item_hash
2039
2040 =over 4
2041
2042 my $item_marc = _marc_from_item_hash($item, $frameworkcode[, $unlinked_item_subfields]);
2043
2044 =back
2045
2046 Given an item hash representing a complete item record,
2047 create a C<MARC::Record> object containing an embedded
2048 tag representing that item.
2049
2050 The third, optional parameter C<$unlinked_item_subfields> is
2051 an arrayref of subfields (not mapped to C<items> fields per the
2052 framework) to be added to the MARC representation
2053 of the item.
2054
2055 =cut
2056
2057 sub _marc_from_item_hash {
2058     my $item = shift;
2059     my $frameworkcode = shift;
2060     my $unlinked_item_subfields;
2061     if (@_) {
2062         $unlinked_item_subfields = shift;
2063     }
2064
2065     # Tack on 'items.' prefix to column names so lookup from MARC frameworks will work
2066     # Also, don't emit a subfield if the underlying field is blank.
2067     my $mungeditem = { map {  (defined($item->{$_}) and $item->{$_} ne '') ?
2068                                 (/^items\./ ? ($_ => $item->{$_}) : ("items.$_" => $item->{$_}))
2069                                 : ()  } keys %{ $item } };
2070
2071     my $item_marc = MARC::Record->new();
2072     foreach my $item_field (keys %{ $mungeditem }) {
2073         my ($tag, $subfield) = GetMarcFromKohaField($item_field, $frameworkcode);
2074         next unless defined $tag and defined $subfield; # skip if not mapped to MARC field
2075         if (my $field = $item_marc->field($tag)) {
2076             $field->add_subfields($subfield => $mungeditem->{$item_field});
2077         } else {
2078             my $add_subfields = [];
2079             if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
2080                 $add_subfields = $unlinked_item_subfields;
2081             }
2082             $item_marc->add_fields( $tag, " ", " ", $subfield =>  $mungeditem->{$item_field}, @$add_subfields);
2083         }
2084     }
2085
2086     return $item_marc;
2087 }
2088
2089 =head2 _add_item_field_to_biblio
2090
2091 =over 4
2092
2093 _add_item_field_to_biblio($item_marc, $biblionumber, $frameworkcode);
2094
2095 =back
2096
2097 Adds the fields from a MARC record containing the
2098 representation of a Koha item record to the MARC
2099 biblio record.  The input C<$item_marc> record
2100 is expect to contain just one field, the embedded
2101 item information field.
2102
2103 =cut
2104
2105 sub _add_item_field_to_biblio {
2106     my ($item_marc, $biblionumber, $frameworkcode) = @_;
2107
2108     my $biblio_marc = GetMarcBiblio($biblionumber);
2109     foreach my $field ($item_marc->fields()) {
2110         $biblio_marc->append_fields($field);
2111     }
2112
2113     ModBiblioMarc($biblio_marc, $biblionumber, $frameworkcode);
2114 }
2115
2116 =head2 _replace_item_field_in_biblio
2117
2118 =over
2119
2120 &_replace_item_field_in_biblio($item_marc, $biblionumber, $itemnumber, $frameworkcode)
2121
2122 =back
2123
2124 Given a MARC::Record C<$item_marc> containing one tag with the MARC
2125 representation of the item, examine the biblio MARC
2126 for the corresponding tag for that item and
2127 replace it with the tag from C<$item_marc>.
2128
2129 =cut
2130
2131 sub _replace_item_field_in_biblio {
2132     my ($ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
2133     my $dbh = C4::Context->dbh;
2134
2135     # get complete MARC record & replace the item field by the new one
2136     my $completeRecord = GetMarcBiblio($biblionumber);
2137     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
2138     my $itemField = $ItemRecord->field($itemtag);
2139     my @items = $completeRecord->field($itemtag);
2140     my $found = 0;
2141     foreach (@items) {
2142         if ($_->subfield($itemsubfield) eq $itemnumber) {
2143             $_->replace_with($itemField);
2144             $found = 1;
2145         }
2146     }
2147
2148     unless ($found) {
2149         # If we haven't found the matching field,
2150         # just add it.  However, this means that
2151         # there is likely a bug.
2152         $completeRecord->append_fields($itemField);
2153     }
2154
2155     # save the record
2156     ModBiblioMarc($completeRecord, $biblionumber, $frameworkcode);
2157 }
2158
2159 =head2 _repack_item_errors
2160
2161 Add an error message hash generated by C<CheckItemPreSave>
2162 to a list of errors.
2163
2164 =cut
2165
2166 sub _repack_item_errors {
2167     my $item_sequence_num = shift;
2168     my $item_ref = shift;
2169     my $error_ref = shift;
2170
2171     my @repacked_errors = ();
2172
2173     foreach my $error_code (sort keys %{ $error_ref }) {
2174         my $repacked_error = {};
2175         $repacked_error->{'item_sequence'} = $item_sequence_num;
2176         $repacked_error->{'item_barcode'} = exists($item_ref->{'barcode'}) ? $item_ref->{'barcode'} : '';
2177         $repacked_error->{'error_code'} = $error_code;
2178         $repacked_error->{'error_information'} = $error_ref->{$error_code};
2179         push @repacked_errors, $repacked_error;
2180     }
2181
2182     return @repacked_errors;
2183 }
2184
2185 =head2 _get_unlinked_item_subfields
2186
2187 =over 4
2188
2189 my $unlinked_item_subfields = _get_unlinked_item_subfields($original_item_marc, $frameworkcode);
2190
2191 =back
2192
2193 =cut
2194
2195 sub _get_unlinked_item_subfields {
2196     my $original_item_marc = shift;
2197     my $frameworkcode = shift;
2198
2199     my $marcstructure = GetMarcStructure(1, $frameworkcode);
2200
2201     # assume that this record has only one field, and that that
2202     # field contains only the item information
2203     my $subfields = [];
2204     my @fields = $original_item_marc->fields();
2205     if ($#fields > -1) {
2206         my $field = $fields[0];
2207             my $tag = $field->tag();
2208         foreach my $subfield ($field->subfields()) {
2209             if (defined $subfield->[1] and
2210                 $subfield->[1] ne '' and
2211                 !$marcstructure->{$tag}->{$subfield->[0]}->{'kohafield'}) {
2212                 push @$subfields, $subfield->[0] => $subfield->[1];
2213             }
2214         }
2215     }
2216     return $subfields;
2217 }
2218
2219 =head2 _get_unlinked_subfields_xml
2220
2221 =over 4
2222
2223 my $unlinked_subfields_xml = _get_unlinked_subfields_xml($unlinked_item_subfields);
2224
2225 =back
2226
2227 =cut
2228
2229 sub _get_unlinked_subfields_xml {
2230     my $unlinked_item_subfields = shift;
2231
2232     my $xml;
2233     if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
2234         my $marc = MARC::Record->new();
2235         # use of tag 999 is arbitrary, and doesn't need to match the item tag
2236         # used in the framework
2237         $marc->append_fields(MARC::Field->new('999', ' ', ' ', @$unlinked_item_subfields));
2238         $marc->encoding("UTF-8");
2239         $xml = $marc->as_xml("USMARC");
2240     }
2241
2242     return $xml;
2243 }
2244
2245 =head2 _parse_unlinked_item_subfields_from_xml
2246
2247 =over 4
2248
2249 my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($whole_item->{'more_subfields_xml'}):
2250
2251 =back
2252
2253 =cut
2254
2255 sub  _parse_unlinked_item_subfields_from_xml {
2256     my $xml = shift;
2257
2258     return unless defined $xml and $xml ne "";
2259     my $marc = MARC::Record->new_from_xml(StripNonXmlChars($xml),'UTF-8');
2260     my $unlinked_subfields = [];
2261     my @fields = $marc->fields();
2262     if ($#fields > -1) {
2263         foreach my $subfield ($fields[0]->subfields()) {
2264             push @$unlinked_subfields, $subfield->[0] => $subfield->[1];
2265         }
2266     }
2267     return $unlinked_subfields;
2268 }
2269
2270 1;