C4/Items.pm

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