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