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