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