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