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