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 $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 $count_reserves;
1302         my $datedue = '';
1303         $isth->execute( $data->{'itemnumber'} );
1304         if ( my $idata = $isth->fetchrow_hashref ) {
1305             $data->{borrowernumber} = $idata->{borrowernumber};
1306             $data->{cardnumber}     = $idata->{cardnumber};
1307             $data->{surname}     = $idata->{surname};
1308             $data->{firstname}     = $idata->{firstname};
1309             $datedue                = $idata->{'date_due'};
1310         if (C4::Context->preference("IndependantBranches")){
1311         my $userenv = C4::Context->userenv;
1312         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1313             $data->{'NOTSAMEBRANCH'} = 1 if ($idata->{'bcode'} ne $userenv->{branch});
1314         }
1315         }
1316         }
1317                 if ( $data->{'serial'}) {
1318                         $ssth->execute($data->{'itemnumber'}) ;
1319                         ($data->{'serialseq'} , $data->{'publisheddate'}) = $ssth->fetchrow_array();
1320                         $serial = 1;
1321         }
1322                 if ( $datedue eq '' ) {
1323             my ( $restype, $reserves ) =
1324               C4::Reserves::CheckReserves( $data->{'itemnumber'} );
1325             if ($restype) {
1326                 $count_reserves = $restype;
1327             }
1328         }
1329         $isth->finish;
1330         $ssth->finish;
1331         #get branch information.....
1332         my $bsth = $dbh->prepare(
1333             "SELECT * FROM branches WHERE branchcode = ?
1334         "
1335         );
1336         $bsth->execute( $data->{'holdingbranch'} );
1337         if ( my $bdata = $bsth->fetchrow_hashref ) {
1338             $data->{'branchname'} = $bdata->{'branchname'};
1339         }
1340         $data->{'datedue'}        = $datedue;
1341         $data->{'count_reserves'} = $count_reserves;
1342
1343         # get notforloan complete status if applicable
1344         my $sthnflstatus = $dbh->prepare(
1345             'SELECT authorised_value
1346             FROM   marc_subfield_structure
1347             WHERE  kohafield="items.notforloan"
1348         '
1349         );
1350
1351         $sthnflstatus->execute;
1352         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
1353         if ($authorised_valuecode) {
1354             $sthnflstatus = $dbh->prepare(
1355                 "SELECT lib FROM authorised_values
1356                  WHERE  category=?
1357                  AND authorised_value=?"
1358             );
1359             $sthnflstatus->execute( $authorised_valuecode,
1360                 $data->{itemnotforloan} );
1361             my ($lib) = $sthnflstatus->fetchrow;
1362             $data->{notforloanvalue} = $lib;
1363         }
1364                 $data->{itypenotforloan} = $data->{notforloan} if (C4::Context->preference('item-level_itypes'));
1365
1366         # my stack procedures
1367         my $stackstatus = $dbh->prepare(
1368             'SELECT authorised_value
1369              FROM   marc_subfield_structure
1370              WHERE  kohafield="items.stack"
1371         '
1372         );
1373         $stackstatus->execute;
1374
1375         ($authorised_valuecode) = $stackstatus->fetchrow;
1376         if ($authorised_valuecode) {
1377             $stackstatus = $dbh->prepare(
1378                 "SELECT lib
1379                  FROM   authorised_values
1380                  WHERE  category=?
1381                  AND    authorised_value=?
1382             "
1383             );
1384             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
1385             my ($lib) = $stackstatus->fetchrow;
1386             $data->{stack} = $lib;
1387         }
1388         # Find the last 3 people who borrowed this item.
1389         my $sth2 = $dbh->prepare("SELECT * FROM old_issues,borrowers
1390                                     WHERE itemnumber = ?
1391                                     AND old_issues.borrowernumber = borrowers.borrowernumber
1392                                     ORDER BY returndate DESC
1393                                     LIMIT 3");
1394         $sth2->execute($data->{'itemnumber'});
1395         my $ii = 0;
1396         while (my $data2 = $sth2->fetchrow_hashref()) {
1397             $data->{"timestamp$ii"} = $data2->{'timestamp'} if $data2->{'timestamp'};
1398             $data->{"card$ii"}      = $data2->{'cardnumber'} if $data2->{'cardnumber'};
1399             $data->{"borrower$ii"}  = $data2->{'borrowernumber'} if $data2->{'borrowernumber'};
1400             $ii++;
1401         }
1402
1403         $results[$i] = $data;
1404         $i++;
1405     }
1406         if($serial) {
1407                 return( sort { ($b->{'publisheddate'} || $b->{'enumchron'}) cmp ($a->{'publisheddate'} || $a->{'enumchron'}) } @results );
1408         } else {
1409         return (@results);
1410         }
1411 }
1412
1413 =head2 get_itemnumbers_of
1414
1415 =over 4
1416
1417 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1418
1419 =back
1420
1421 Given a list of biblionumbers, return the list of corresponding itemnumbers
1422 for each biblionumber.
1423
1424 Return a reference on a hash where keys are biblionumbers and values are
1425 references on array of itemnumbers.
1426
1427 =cut
1428
1429 sub get_itemnumbers_of {
1430     my @biblionumbers = @_;
1431
1432     my $dbh = C4::Context->dbh;
1433
1434     my $query = '
1435         SELECT itemnumber,
1436             biblionumber
1437         FROM items
1438         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1439     ';
1440     my $sth = $dbh->prepare($query);
1441     $sth->execute(@biblionumbers);
1442
1443     my %itemnumbers_of;
1444
1445     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1446         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1447     }
1448
1449     return \%itemnumbers_of;
1450 }
1451
1452 =head2 GetItemnumberFromBarcode
1453
1454 =over 4
1455
1456 $result = GetItemnumberFromBarcode($barcode);
1457
1458 =back
1459
1460 =cut
1461
1462 sub GetItemnumberFromBarcode {
1463     my ($barcode) = @_;
1464     my $dbh = C4::Context->dbh;
1465
1466     my $rq =
1467       $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?");
1468     $rq->execute($barcode);
1469     my ($result) = $rq->fetchrow;
1470     return ($result);
1471 }
1472
1473 =head3 get_item_authorised_values
1474
1475   find the types and values for all authorised values assigned to this item.
1476
1477   parameters:
1478     itemnumber
1479
1480   returns: a hashref malling the authorised value to the value set for this itemnumber
1481
1482     $authorised_values = {
1483              'CCODE'      => undef,
1484              'DAMAGED'    => '0',
1485              'LOC'        => '3',
1486              'LOST'       => '0'
1487              'NOT_LOAN'   => '0',
1488              'RESTRICTED' => undef,
1489              'STACK'      => undef,
1490              'WITHDRAWN'  => '0',
1491              'branches'   => 'CPL',
1492              'cn_source'  => undef,
1493              'itemtypes'  => 'SER',
1494            };
1495
1496    Notes: see C4::Biblio::get_biblio_authorised_values for a similar method at the biblio level.
1497
1498 =cut
1499
1500 sub get_item_authorised_values {
1501     my $itemnumber = shift;
1502
1503     # assume that these entries in the authorised_value table are item level.
1504     my $query = q(SELECT distinct authorised_value, kohafield
1505                     FROM marc_subfield_structure
1506                     WHERE kohafield like 'item%'
1507                       AND authorised_value != '' );
1508
1509     my $itemlevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
1510     my $iteminfo = GetItem( $itemnumber );
1511     # warn( Data::Dumper->Dump( [ $itemlevel_authorised_values ], [ 'itemlevel_authorised_values' ] ) );
1512     my $return;
1513     foreach my $this_authorised_value ( keys %$itemlevel_authorised_values ) {
1514         my $field = $itemlevel_authorised_values->{ $this_authorised_value }->{'kohafield'};
1515         $field =~ s/^items\.//;
1516         if ( exists $iteminfo->{ $field } ) {
1517             $return->{ $this_authorised_value } = $iteminfo->{ $field };
1518         }
1519     }
1520     # warn( Data::Dumper->Dump( [ $return ], [ 'return' ] ) );
1521     return $return;
1522 }
1523
1524 =head3 get_authorised_value_images
1525
1526   find a list of icons that are appropriate for display based on the
1527   authorised values for a biblio.
1528
1529   parameters: listref of authorised values, such as comes from
1530     get_item_authorised_values or
1531     from C4::Biblio::get_biblio_authorised_values
1532
1533   returns: listref of hashrefs for each image. Each hashref looks like
1534     this:
1535
1536       { imageurl => '/intranet-tmpl/prog/img/itemtypeimg/npl/WEB.gif',
1537         label    => '',
1538         category => '',
1539         value    => '', }
1540
1541   Notes: Currently, I put on the full path to the images on the staff
1542   side. This should either be configurable or not done at all. Since I
1543   have to deal with 'intranet' or 'opac' in
1544   get_biblio_authorised_values, perhaps I should be passing it in.
1545
1546 =cut
1547
1548 sub get_authorised_value_images {
1549     my $authorised_values = shift;
1550
1551     my @imagelist;
1552
1553     my $authorised_value_list = GetAuthorisedValues();
1554     # warn ( Data::Dumper->Dump( [ $authorised_value_list ], [ 'authorised_value_list' ] ) );
1555     foreach my $this_authorised_value ( @$authorised_value_list ) {
1556         if ( exists $authorised_values->{ $this_authorised_value->{'category'} }
1557              && $authorised_values->{ $this_authorised_value->{'category'} } eq $this_authorised_value->{'authorised_value'} ) {
1558             # warn ( Data::Dumper->Dump( [ $this_authorised_value ], [ 'this_authorised_value' ] ) );
1559             if ( defined $this_authorised_value->{'imageurl'} ) {
1560                 push @imagelist, { imageurl => C4::Koha::getitemtypeimagelocation( 'intranet', $this_authorised_value->{'imageurl'} ),
1561                                    label    => $this_authorised_value->{'lib'},
1562                                    category => $this_authorised_value->{'category'},
1563                                    value    => $this_authorised_value->{'authorised_value'}, };
1564             }
1565         }
1566     }
1567
1568     # warn ( Data::Dumper->Dump( [ \@imagelist ], [ 'imagelist' ] ) );
1569     return \@imagelist;
1570
1571 }
1572
1573 =head1 LIMITED USE FUNCTIONS
1574
1575 The following functions, while part of the public API,
1576 are not exported.  This is generally because they are
1577 meant to be used by only one script for a specific
1578 purpose, and should not be used in any other context
1579 without careful thought.
1580
1581 =cut
1582
1583 =head2 GetMarcItem
1584
1585 =over 4
1586
1587 my $item_marc = GetMarcItem($biblionumber, $itemnumber);
1588
1589 =back
1590
1591 Returns MARC::Record of the item passed in parameter.
1592 This function is meant for use only in C<cataloguing/additem.pl>,
1593 where it is needed to support that script's MARC-like
1594 editor.
1595
1596 =cut
1597
1598 sub GetMarcItem {
1599     my ( $biblionumber, $itemnumber ) = @_;
1600
1601     # GetMarcItem has been revised so that it does the following:
1602     #  1. Gets the item information from the items table.
1603     #  2. Converts it to a MARC field for storage in the bib record.
1604     #
1605     # The previous behavior was:
1606     #  1. Get the bib record.
1607     #  2. Return the MARC tag corresponding to the item record.
1608     #
1609     # The difference is that one treats the items row as authoritative,
1610     # while the other treats the MARC representation as authoritative
1611     # under certain circumstances.
1612
1613     my $itemrecord = GetItem($itemnumber);
1614
1615     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
1616     # Also, don't emit a subfield if the underlying field is blank.
1617     my $mungeditem = {
1618         map {
1619             defined($itemrecord->{$_}) && $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()
1620         } keys %{ $itemrecord }
1621     };
1622     my $itemmarc = TransformKohaToMarc($mungeditem);
1623
1624     my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($mungeditem->{'items.more_subfields_xml'});
1625     if (defined $unlinked_item_subfields and $#$unlinked_item_subfields > -1) {
1626         my @fields = $itemmarc->fields();
1627         if ($#fields > -1) {
1628             $fields[0]->add_subfields(@$unlinked_item_subfields);
1629         }
1630     }
1631
1632     return $itemmarc;
1633
1634 }
1635
1636 =head1 PRIVATE FUNCTIONS AND VARIABLES
1637
1638 The following functions are not meant to be called
1639 directly, but are documented in order to explain
1640 the inner workings of C<C4::Items>.
1641
1642 =cut
1643
1644 =head2 %derived_columns
1645
1646 This hash keeps track of item columns that
1647 are strictly derived from other columns in
1648 the item record and are not meant to be set
1649 independently.
1650
1651 Each key in the hash should be the name of a
1652 column (as named by TransformMarcToKoha).  Each
1653 value should be hashref whose keys are the
1654 columns on which the derived column depends.  The
1655 hashref should also contain a 'BUILDER' key
1656 that is a reference to a sub that calculates
1657 the derived value.
1658
1659 =cut
1660
1661 my %derived_columns = (
1662     'items.cn_sort' => {
1663         'itemcallnumber' => 1,
1664         'items.cn_source' => 1,
1665         'BUILDER' => \&_calc_items_cn_sort,
1666     }
1667 );
1668
1669 =head2 _set_derived_columns_for_add
1670
1671 =over 4
1672
1673 _set_derived_column_for_add($item);
1674
1675 =back
1676
1677 Given an item hash representing a new item to be added,
1678 calculate any derived columns.  Currently the only
1679 such column is C<items.cn_sort>.
1680
1681 =cut
1682
1683 sub _set_derived_columns_for_add {
1684     my $item = shift;
1685
1686     foreach my $column (keys %derived_columns) {
1687         my $builder = $derived_columns{$column}->{'BUILDER'};
1688         my $source_values = {};
1689         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1690             next if $source_column eq 'BUILDER';
1691             $source_values->{$source_column} = $item->{$source_column};
1692         }
1693         $builder->($item, $source_values);
1694     }
1695 }
1696
1697 =head2 _set_derived_columns_for_mod
1698
1699 =over 4
1700
1701 _set_derived_column_for_mod($item);
1702
1703 =back
1704
1705 Given an item hash representing a new item to be modified.
1706 calculate any derived columns.  Currently the only
1707 such column is C<items.cn_sort>.
1708
1709 This routine differs from C<_set_derived_columns_for_add>
1710 in that it needs to handle partial item records.  In other
1711 words, the caller of C<ModItem> may have supplied only one
1712 or two columns to be changed, so this function needs to
1713 determine whether any of the columns to be changed affect
1714 any of the derived columns.  Also, if a derived column
1715 depends on more than one column, but the caller is not
1716 changing all of then, this routine retrieves the unchanged
1717 values from the database in order to ensure a correct
1718 calculation.
1719
1720 =cut
1721
1722 sub _set_derived_columns_for_mod {
1723     my $item = shift;
1724
1725     foreach my $column (keys %derived_columns) {
1726         my $builder = $derived_columns{$column}->{'BUILDER'};
1727         my $source_values = {};
1728         my %missing_sources = ();
1729         my $must_recalc = 0;
1730         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1731             next if $source_column eq 'BUILDER';
1732             if (exists $item->{$source_column}) {
1733                 $must_recalc = 1;
1734                 $source_values->{$source_column} = $item->{$source_column};
1735             } else {
1736                 $missing_sources{$source_column} = 1;
1737             }
1738         }
1739         if ($must_recalc) {
1740             foreach my $source_column (keys %missing_sources) {
1741                 $source_values->{$source_column} = _get_single_item_column($source_column, $item->{'itemnumber'});
1742             }
1743             $builder->($item, $source_values);
1744         }
1745     }
1746 }
1747
1748 =head2 _do_column_fixes_for_mod
1749
1750 =over 4
1751
1752 _do_column_fixes_for_mod($item);
1753
1754 =back
1755
1756 Given an item hashref containing one or more
1757 columns to modify, fix up certain values.
1758 Specifically, set to 0 any passed value
1759 of C<notforloan>, C<damaged>, C<itemlost>, or
1760 C<wthdrawn> that is either undefined or
1761 contains the empty string.
1762
1763 =cut
1764
1765 sub _do_column_fixes_for_mod {
1766     my $item = shift;
1767
1768     if (exists $item->{'notforloan'} and
1769         (not defined $item->{'notforloan'} or $item->{'notforloan'} eq '')) {
1770         $item->{'notforloan'} = 0;
1771     }
1772     if (exists $item->{'damaged'} and
1773         (not defined $item->{'damaged'} or $item->{'damaged'} eq '')) {
1774         $item->{'damaged'} = 0;
1775     }
1776     if (exists $item->{'itemlost'} and
1777         (not defined $item->{'itemlost'} or $item->{'itemlost'} eq '')) {
1778         $item->{'itemlost'} = 0;
1779     }
1780     if (exists $item->{'wthdrawn'} and
1781         (not defined $item->{'wthdrawn'} or $item->{'wthdrawn'} eq '')) {
1782         $item->{'wthdrawn'} = 0;
1783     }
1784 }
1785
1786 =head2 _get_single_item_column
1787
1788 =over 4
1789
1790 _get_single_item_column($column, $itemnumber);
1791
1792 =back
1793
1794 Retrieves the value of a single column from an C<items>
1795 row specified by C<$itemnumber>.
1796
1797 =cut
1798
1799 sub _get_single_item_column {
1800     my $column = shift;
1801     my $itemnumber = shift;
1802
1803     my $dbh = C4::Context->dbh;
1804     my $sth = $dbh->prepare("SELECT $column FROM items WHERE itemnumber = ?");
1805     $sth->execute($itemnumber);
1806     my ($value) = $sth->fetchrow();
1807     return $value;
1808 }
1809
1810 =head2 _calc_items_cn_sort
1811
1812 =over 4
1813
1814 _calc_items_cn_sort($item, $source_values);
1815
1816 =back
1817
1818 Helper routine to calculate C<items.cn_sort>.
1819
1820 =cut
1821
1822 sub _calc_items_cn_sort {
1823     my $item = shift;
1824     my $source_values = shift;
1825
1826     $item->{'items.cn_sort'} = GetClassSort($source_values->{'items.cn_source'}, $source_values->{'itemcallnumber'}, "");
1827 }
1828
1829 =head2 _set_defaults_for_add
1830
1831 =over 4
1832
1833 _set_defaults_for_add($item_hash);
1834
1835 =back
1836
1837 Given an item hash representing an item to be added, set
1838 correct default values for columns whose default value
1839 is not handled by the DBMS.  This includes the following
1840 columns:
1841
1842 =over 2
1843
1844 =item *
1845
1846 C<items.dateaccessioned>
1847
1848 =item *
1849
1850 C<items.notforloan>
1851
1852 =item *
1853
1854 C<items.damaged>
1855
1856 =item *
1857
1858 C<items.itemlost>
1859
1860 =item *
1861
1862 C<items.wthdrawn>
1863
1864 =back
1865
1866 =cut
1867
1868 sub _set_defaults_for_add {
1869     my $item = shift;
1870     $item->{dateaccessioned} ||= C4::Dates->new->output('iso');
1871     $item->{$_} ||= 0 for (qw( notforloan damaged itemlost wthdrawn));
1872 }
1873
1874 =head2 _koha_new_item
1875
1876 =over 4
1877
1878 my ($itemnumber,$error) = _koha_new_item( $item, $barcode );
1879
1880 =back
1881
1882 Perform the actual insert into the C<items> table.
1883
1884 =cut
1885
1886 sub _koha_new_item {
1887     my ( $item, $barcode ) = @_;
1888     my $dbh=C4::Context->dbh;
1889     my $error;
1890     my $query =
1891            "INSERT INTO items SET
1892             biblionumber        = ?,
1893             biblioitemnumber    = ?,
1894             barcode             = ?,
1895             dateaccessioned     = ?,
1896             booksellerid        = ?,
1897             homebranch          = ?,
1898             price               = ?,
1899             replacementprice    = ?,
1900             replacementpricedate = NOW(),
1901             datelastborrowed    = ?,
1902             datelastseen        = NOW(),
1903             stack               = ?,
1904             notforloan          = ?,
1905             damaged             = ?,
1906             itemlost            = ?,
1907             wthdrawn            = ?,
1908             itemcallnumber      = ?,
1909             restricted          = ?,
1910             itemnotes           = ?,
1911             holdingbranch       = ?,
1912             paidfor             = ?,
1913             location            = ?,
1914             onloan              = ?,
1915             issues              = ?,
1916             renewals            = ?,
1917             reserves            = ?,
1918             cn_source           = ?,
1919             cn_sort             = ?,
1920             ccode               = ?,
1921             itype               = ?,
1922             materials           = ?,
1923             uri = ?,
1924             enumchron           = ?,
1925             more_subfields_xml  = ?,
1926             copynumber          = ?
1927           ";
1928     my $sth = $dbh->prepare($query);
1929    $sth->execute(
1930             $item->{'biblionumber'},
1931             $item->{'biblioitemnumber'},
1932             $barcode,
1933             $item->{'dateaccessioned'},
1934             $item->{'booksellerid'},
1935             $item->{'homebranch'},
1936             $item->{'price'},
1937             $item->{'replacementprice'},
1938             $item->{datelastborrowed},
1939             $item->{stack},
1940             $item->{'notforloan'},
1941             $item->{'damaged'},
1942             $item->{'itemlost'},
1943             $item->{'wthdrawn'},
1944             $item->{'itemcallnumber'},
1945             $item->{'restricted'},
1946             $item->{'itemnotes'},
1947             $item->{'holdingbranch'},
1948             $item->{'paidfor'},
1949             $item->{'location'},
1950             $item->{'onloan'},
1951             $item->{'issues'},
1952             $item->{'renewals'},
1953             $item->{'reserves'},
1954             $item->{'items.cn_source'},
1955             $item->{'items.cn_sort'},
1956             $item->{'ccode'},
1957             $item->{'itype'},
1958             $item->{'materials'},
1959             $item->{'uri'},
1960             $item->{'enumchron'},
1961             $item->{'more_subfields_xml'},
1962             $item->{'copynumber'},
1963     );
1964     my $itemnumber = $dbh->{'mysql_insertid'};
1965     if ( defined $sth->errstr ) {
1966         $error.="ERROR in _koha_new_item $query".$sth->errstr;
1967     }
1968     $sth->finish();
1969     return ( $itemnumber, $error );
1970 }
1971
1972 =head2 _koha_modify_item
1973
1974 =over 4
1975
1976 my ($itemnumber,$error) =_koha_modify_item( $item );
1977
1978 =back
1979
1980 Perform the actual update of the C<items> row.  Note that this
1981 routine accepts a hashref specifying the columns to update.
1982
1983 =cut
1984
1985 sub _koha_modify_item {
1986     my ( $item ) = @_;
1987     my $dbh=C4::Context->dbh;
1988     my $error;
1989
1990     my $query = "UPDATE items SET ";
1991     my @bind;
1992     for my $key ( keys %$item ) {
1993         $query.="$key=?,";
1994         push @bind, $item->{$key};
1995     }
1996     $query =~ s/,$//;
1997     $query .= " WHERE itemnumber=?";
1998     push @bind, $item->{'itemnumber'};
1999     my $sth = C4::Context->dbh->prepare($query);
2000     $sth->execute(@bind);
2001     if ( C4::Context->dbh->errstr ) {
2002         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
2003         warn $error;
2004     }
2005     $sth->finish();
2006     return ($item->{'itemnumber'},$error);
2007 }
2008
2009 =head2 _koha_delete_item
2010
2011 =over 4
2012
2013 _koha_delete_item( $dbh, $itemnum );
2014
2015 =back
2016
2017 Internal function to delete an item record from the koha tables
2018
2019 =cut
2020
2021 sub _koha_delete_item {
2022     my ( $dbh, $itemnum ) = @_;
2023
2024     # save the deleted item to deleteditems table
2025     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
2026     $sth->execute($itemnum);
2027     my $data = $sth->fetchrow_hashref();
2028     $sth->finish();
2029     my $query = "INSERT INTO deleteditems SET ";
2030     my @bind  = ();
2031     foreach my $key ( keys %$data ) {
2032         $query .= "$key = ?,";
2033         push( @bind, $data->{$key} );
2034     }
2035     $query =~ s/\,$//;
2036     $sth = $dbh->prepare($query);
2037     $sth->execute(@bind);
2038     $sth->finish();
2039
2040     # delete from items table
2041     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
2042     $sth->execute($itemnum);
2043     $sth->finish();
2044     return undef;
2045 }
2046
2047 =head2 _marc_from_item_hash
2048
2049 =over 4
2050
2051 my $item_marc = _marc_from_item_hash($item, $frameworkcode[, $unlinked_item_subfields]);
2052
2053 =back
2054
2055 Given an item hash representing a complete item record,
2056 create a C<MARC::Record> object containing an embedded
2057 tag representing that item.
2058
2059 The third, optional parameter C<$unlinked_item_subfields> is
2060 an arrayref of subfields (not mapped to C<items> fields per the
2061 framework) to be added to the MARC representation
2062 of the item.
2063
2064 =cut
2065
2066 sub _marc_from_item_hash {
2067     my $item = shift;
2068     my $frameworkcode = shift;
2069     my $unlinked_item_subfields;
2070     if (@_) {
2071         $unlinked_item_subfields = shift;
2072     }
2073
2074     # Tack on 'items.' prefix to column names so lookup from MARC frameworks will work
2075     # Also, don't emit a subfield if the underlying field is blank.
2076     my $mungeditem = { map {  (defined($item->{$_}) and $item->{$_} ne '') ?
2077                                 (/^items\./ ? ($_ => $item->{$_}) : ("items.$_" => $item->{$_}))
2078                                 : ()  } keys %{ $item } };
2079
2080     my $item_marc = MARC::Record->new();
2081     foreach my $item_field (keys %{ $mungeditem }) {
2082         my ($tag, $subfield) = GetMarcFromKohaField($item_field, $frameworkcode);
2083         next unless defined $tag and defined $subfield; # skip if not mapped to MARC field
2084         if (my $field = $item_marc->field($tag)) {
2085             $field->add_subfields($subfield => $mungeditem->{$item_field});
2086         } else {
2087             my $add_subfields = [];
2088             if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
2089                 $add_subfields = $unlinked_item_subfields;
2090             }
2091             $item_marc->add_fields( $tag, " ", " ", $subfield =>  $mungeditem->{$item_field}, @$add_subfields);
2092         }
2093     }
2094
2095     return $item_marc;
2096 }
2097
2098 =head2 _add_item_field_to_biblio
2099
2100 =over 4
2101
2102 _add_item_field_to_biblio($item_marc, $biblionumber, $frameworkcode);
2103
2104 =back
2105
2106 Adds the fields from a MARC record containing the
2107 representation of a Koha item record to the MARC
2108 biblio record.  The input C<$item_marc> record
2109 is expect to contain just one field, the embedded
2110 item information field.
2111
2112 =cut
2113
2114 sub _add_item_field_to_biblio {
2115     my ($item_marc, $biblionumber, $frameworkcode) = @_;
2116
2117     my $biblio_marc = GetMarcBiblio($biblionumber);
2118     foreach my $field ($item_marc->fields()) {
2119         $biblio_marc->append_fields($field);
2120     }
2121
2122     ModBiblioMarc($biblio_marc, $biblionumber, $frameworkcode);
2123 }
2124
2125 =head2 _replace_item_field_in_biblio
2126
2127 =over
2128
2129 &_replace_item_field_in_biblio($item_marc, $biblionumber, $itemnumber, $frameworkcode)
2130
2131 =back
2132
2133 Given a MARC::Record C<$item_marc> containing one tag with the MARC
2134 representation of the item, examine the biblio MARC
2135 for the corresponding tag for that item and
2136 replace it with the tag from C<$item_marc>.
2137
2138 =cut
2139
2140 sub _replace_item_field_in_biblio {
2141     my ($ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
2142     my $dbh = C4::Context->dbh;
2143
2144     # get complete MARC record & replace the item field by the new one
2145     my $completeRecord = GetMarcBiblio($biblionumber);
2146     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
2147     my $itemField = $ItemRecord->field($itemtag);
2148     my @items = $completeRecord->field($itemtag);
2149     my $found = 0;
2150     foreach (@items) {
2151         if ($_->subfield($itemsubfield) eq $itemnumber) {
2152             $_->replace_with($itemField);
2153             $found = 1;
2154         }
2155     }
2156
2157     unless ($found) {
2158         # If we haven't found the matching field,
2159         # just add it.  However, this means that
2160         # there is likely a bug.
2161         $completeRecord->append_fields($itemField);
2162     }
2163
2164     # save the record
2165     ModBiblioMarc($completeRecord, $biblionumber, $frameworkcode);
2166 }
2167
2168 =head2 _repack_item_errors
2169
2170 Add an error message hash generated by C<CheckItemPreSave>
2171 to a list of errors.
2172
2173 =cut
2174
2175 sub _repack_item_errors {
2176     my $item_sequence_num = shift;
2177     my $item_ref = shift;
2178     my $error_ref = shift;
2179
2180     my @repacked_errors = ();
2181
2182     foreach my $error_code (sort keys %{ $error_ref }) {
2183         my $repacked_error = {};
2184         $repacked_error->{'item_sequence'} = $item_sequence_num;
2185         $repacked_error->{'item_barcode'} = exists($item_ref->{'barcode'}) ? $item_ref->{'barcode'} : '';
2186         $repacked_error->{'error_code'} = $error_code;
2187         $repacked_error->{'error_information'} = $error_ref->{$error_code};
2188         push @repacked_errors, $repacked_error;
2189     }
2190
2191     return @repacked_errors;
2192 }
2193
2194 =head2 _get_unlinked_item_subfields
2195
2196 =over 4
2197
2198 my $unlinked_item_subfields = _get_unlinked_item_subfields($original_item_marc, $frameworkcode);
2199
2200 =back
2201
2202 =cut
2203
2204 sub _get_unlinked_item_subfields {
2205     my $original_item_marc = shift;
2206     my $frameworkcode = shift;
2207
2208     my $marcstructure = GetMarcStructure(1, $frameworkcode);
2209
2210     # assume that this record has only one field, and that that
2211     # field contains only the item information
2212     my $subfields = [];
2213     my @fields = $original_item_marc->fields();
2214     if ($#fields > -1) {
2215         my $field = $fields[0];
2216             my $tag = $field->tag();
2217         foreach my $subfield ($field->subfields()) {
2218             if (defined $subfield->[1] and
2219                 $subfield->[1] ne '' and
2220                 !$marcstructure->{$tag}->{$subfield->[0]}->{'kohafield'}) {
2221                 push @$subfields, $subfield->[0] => $subfield->[1];
2222             }
2223         }
2224     }
2225     return $subfields;
2226 }
2227
2228 =head2 _get_unlinked_subfields_xml
2229
2230 =over 4
2231
2232 my $unlinked_subfields_xml = _get_unlinked_subfields_xml($unlinked_item_subfields);
2233
2234 =back
2235
2236 =cut
2237
2238 sub _get_unlinked_subfields_xml {
2239     my $unlinked_item_subfields = shift;
2240
2241     my $xml;
2242     if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
2243         my $marc = MARC::Record->new();
2244         # use of tag 999 is arbitrary, and doesn't need to match the item tag
2245         # used in the framework
2246         $marc->append_fields(MARC::Field->new('999', ' ', ' ', @$unlinked_item_subfields));
2247         $marc->encoding("UTF-8");
2248         $xml = $marc->as_xml("USMARC");
2249     }
2250
2251     return $xml;
2252 }
2253
2254 =head2 _parse_unlinked_item_subfields_from_xml
2255
2256 =over 4
2257
2258 my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($whole_item->{'more_subfields_xml'}):
2259
2260 =back
2261
2262 =cut
2263
2264 sub  _parse_unlinked_item_subfields_from_xml {
2265     my $xml = shift;
2266
2267     return unless defined $xml and $xml ne "";
2268     my $marc = MARC::Record->new_from_xml(StripNonXmlChars($xml),'UTF-8');
2269     my $unlinked_subfields = [];
2270     my @fields = $marc->fields();
2271     if ($#fields > -1) {
2272         foreach my $subfield ($fields[0]->subfields()) {
2273             push @$unlinked_subfields, $subfield->[0] => $subfield->[1];
2274         }
2275     }
2276     return $unlinked_subfields;
2277 }
2278
2279 1;