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