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