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