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