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