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, $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                  WHERE itemcallnumber>= ?
 926                    AND itemcallnumber <=?
 927                    AND (datelastseen< ? OR datelastseen IS NULL)";
 928         $query.= " AND items.location=".$dbh->quote($location) if $location;
 929         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
 930         $query .= " ORDER BY itemcallnumber,title";
 931         $sth = $dbh->prepare($query);
 932         $sth->execute( $minlocation, $maxlocation, $datelastseen );
 933     }
 934     else {
 935         my $query ="
 936                 SELECT itemnumber,barcode,itemcallnumber,biblio.biblionumber,title,author,datelastseen
 937                 FROM items
 938                   LEFT JOIN biblio ON items.biblionumber=biblio.biblionumber
 939                 WHERE itemcallnumber>= ?
 940                   AND itemcallnumber <=?";
 941         $query.= " AND items.location=".$dbh->quote($location) if $location;
 942         $query.= " AND items.homebranch=".$dbh->quote($branch) if $branch;
 943         $query .= " ORDER BY itemcallnumber,title";
 944         $sth = $dbh->prepare($query);
 945         $sth->execute( $minlocation, $maxlocation );
 946     }
 947     my @results;
 948     while ( my $row = $sth->fetchrow_hashref ) {
 949         $offset-- if ($offset);
 950         $row->{datelastseen}=format_date($row->{datelastseen});
 951         if ( ( !$offset ) && $size ) {
 952             push @results, $row;
 953             $size--;
 954         }
 955     }
 956     return \@results;
 957 }
 958
 959 =head2 GetItemsCount
 960
 961 =over 4
 962 $count = &GetItemsCount( $biblionumber);
 963
 964 =back
 965
 966 This function return count of item with $biblionumber
 967
 968 =cut
 969
 970 sub GetItemsCount {
 971     my ( $biblionumber ) = @_;
 972     my $dbh = C4::Context->dbh;
 973     my $query = "SELECT count(*)
 974           FROM  items
 975           WHERE biblionumber=?";
 976     my $sth = $dbh->prepare($query);
 977     $sth->execute($biblionumber);
 978     my $count = $sth->fetchrow;
 979     $sth->finish;
 980     return ($count);
 981 }
 982
 983 =head2 GetItemInfosOf
 984
 985 =over 4
 986
 987 GetItemInfosOf(@itemnumbers);
 988
 989 =back
 990
 991 =cut
 992
 993 sub GetItemInfosOf {
 994     my @itemnumbers = @_;
 995
 996     my $query = '
 997         SELECT *
 998         FROM items
 999         WHERE itemnumber IN (' . join( ',', @itemnumbers ) . ')
1000     ';
1001     return get_infos_of( $query, 'itemnumber' );
1002 }
1003
1004 =head2 GetItemsByBiblioitemnumber
1005
1006 =over 4
1007
1008 GetItemsByBiblioitemnumber($biblioitemnumber);
1009
1010 =back
1011
1012 Returns an arrayref of hashrefs suitable for use in a TMPL_LOOP
1013 Called by C<C4::XISBN>
1014
1015 =cut
1016
1017 sub GetItemsByBiblioitemnumber {
1018     my ( $bibitem ) = @_;
1019     my $dbh = C4::Context->dbh;
1020     my $sth = $dbh->prepare("SELECT * FROM items WHERE items.biblioitemnumber = ?") || die $dbh->errstr;
1021     # Get all items attached to a biblioitem
1022     my $i = 0;
1023     my @results;
1024     $sth->execute($bibitem) || die $sth->errstr;
1025     while ( my $data = $sth->fetchrow_hashref ) {
1026         # Foreach item, get circulation information
1027         my $sth2 = $dbh->prepare( "SELECT * FROM issues,borrowers
1028                                    WHERE itemnumber = ?
1029                                    AND returndate is NULL
1030                                    AND issues.borrowernumber = borrowers.borrowernumber"
1031         );
1032         $sth2->execute( $data->{'itemnumber'} );
1033         if ( my $data2 = $sth2->fetchrow_hashref ) {
1034             # if item is out, set the due date and who it is out too
1035             $data->{'date_due'}   = $data2->{'date_due'};
1036             $data->{'cardnumber'} = $data2->{'cardnumber'};
1037             $data->{'borrowernumber'}   = $data2->{'borrowernumber'};
1038         }
1039         else {
1040             # set date_due to blank, so in the template we check itemlost, and wthdrawn
1041             $data->{'date_due'} = '';
1042         }    # else
1043         $sth2->finish;
1044         # Find the last 3 people who borrowed this item.
1045         my $query2 = "SELECT * FROM issues, borrowers WHERE itemnumber = ?
1046                       AND issues.borrowernumber = borrowers.borrowernumber
1047                       AND returndate is not NULL
1048                       ORDER BY returndate desc,timestamp desc LIMIT 3";
1049         $sth2 = $dbh->prepare($query2) || die $dbh->errstr;
1050         $sth2->execute( $data->{'itemnumber'} ) || die $sth2->errstr;
1051         my $i2 = 0;
1052         while ( my $data2 = $sth2->fetchrow_hashref ) {
1053             $data->{"timestamp$i2"} = $data2->{'timestamp'};
1054             $data->{"card$i2"}      = $data2->{'cardnumber'};
1055             $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
1056             $i2++;
1057         }
1058         $sth2->finish;
1059         push(@results,$data);
1060     }
1061     $sth->finish;
1062     return (\@results);
1063 }
1064
1065 =head2 GetItemsInfo
1066
1067 =over 4
1068
1069 @results = GetItemsInfo($biblionumber, $type);
1070
1071 =back
1072
1073 Returns information about books with the given biblionumber.
1074
1075 C<$type> may be either C<intra> or anything else. If it is not set to
1076 C<intra>, then the search will exclude lost, very overdue, and
1077 withdrawn items.
1078
1079 C<GetItemsInfo> returns a list of references-to-hash. Each element
1080 contains a number of keys. Most of them are table items from the
1081 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
1082 Koha database. Other keys include:
1083
1084 =over 2
1085
1086 =item C<$data-E<gt>{branchname}>
1087
1088 The name (not the code) of the branch to which the book belongs.
1089
1090 =item C<$data-E<gt>{datelastseen}>
1091
1092 This is simply C<items.datelastseen>, except that while the date is
1093 stored in YYYY-MM-DD format in the database, here it is converted to
1094 DD/MM/YYYY format. A NULL date is returned as C<//>.
1095
1096 =item C<$data-E<gt>{datedue}>
1097
1098 =item C<$data-E<gt>{class}>
1099
1100 This is the concatenation of C<biblioitems.classification>, the book's
1101 Dewey code, and C<biblioitems.subclass>.
1102
1103 =item C<$data-E<gt>{ocount}>
1104
1105 I think this is the number of copies of the book available.
1106
1107 =item C<$data-E<gt>{order}>
1108
1109 If this is set, it is set to C<One Order>.
1110
1111 =back
1112
1113 =cut
1114
1115 sub GetItemsInfo {
1116     my ( $biblionumber, $type ) = @_;
1117     my $dbh   = C4::Context->dbh;
1118     my $query = "SELECT *,items.notforloan as itemnotforloan
1119                  FROM items
1120                  LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
1121                  LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber";
1122     $query .=  (C4::Context->preference('item-level_itypes')) ?
1123                      " LEFT JOIN itemtypes on items.itype = itemtypes.itemtype "
1124                     : " LEFT JOIN itemtypes on biblioitems.itemtype = itemtypes.itemtype ";
1125     $query .= "WHERE items.biblionumber = ? ORDER BY items.dateaccessioned desc" ;
1126     my $sth = $dbh->prepare($query);
1127     $sth->execute($biblionumber);
1128     my $i = 0;
1129     my @results;
1130     my ( $date_due, $count_reserves, $serial );
1131
1132     my $isth    = $dbh->prepare(
1133         "SELECT issues.*,borrowers.cardnumber,borrowers.surname,borrowers.firstname,borrowers.branchcode as bcode
1134         FROM   issues LEFT JOIN borrowers ON issues.borrowernumber=borrowers.borrowernumber
1135         WHERE  itemnumber = ?
1136             AND returndate IS NULL"
1137        );
1138         my $ssth = $dbh->prepare("SELECT serialseq,publisheddate from serialitems left join serial on serialitems.serialid=serial.serialid where serialitems.itemnumber=? ");
1139         while ( my $data = $sth->fetchrow_hashref ) {
1140         my $datedue = '';
1141         $isth->execute( $data->{'itemnumber'} );
1142         if ( my $idata = $isth->fetchrow_hashref ) {
1143             $data->{borrowernumber} = $idata->{borrowernumber};
1144             $data->{cardnumber}     = $idata->{cardnumber};
1145             $data->{surname}     = $idata->{surname};
1146             $data->{firstname}     = $idata->{firstname};
1147             $datedue                = $idata->{'date_due'};
1148         if (C4::Context->preference("IndependantBranches")){
1149         my $userenv = C4::Context->userenv;
1150         if ( ($userenv) && ( $userenv->{flags} != 1 ) ) {
1151             $data->{'NOTSAMEBRANCH'} = 1 if ($idata->{'bcode'} ne $userenv->{branch});
1152         }
1153         }
1154         }
1155                 if ( $data->{'serial'}) {
1156                         $ssth->execute($data->{'itemnumber'}) ;
1157                         ($data->{'serialseq'} , $data->{'publisheddate'}) = $ssth->fetchrow_array();
1158                         $serial = 1;
1159         }
1160                 if ( $datedue eq '' ) {
1161             my ( $restype, $reserves ) =
1162               C4::Reserves::CheckReserves( $data->{'itemnumber'} );
1163             if ($restype) {
1164                 $count_reserves = $restype;
1165             }
1166         }
1167         $isth->finish;
1168         $ssth->finish;
1169         #get branch information.....
1170         my $bsth = $dbh->prepare(
1171             "SELECT * FROM branches WHERE branchcode = ?
1172         "
1173         );
1174         $bsth->execute( $data->{'holdingbranch'} );
1175         if ( my $bdata = $bsth->fetchrow_hashref ) {
1176             $data->{'branchname'} = $bdata->{'branchname'};
1177         }
1178         $data->{'datedue'}        = $datedue;
1179         $data->{'count_reserves'} = $count_reserves;
1180
1181         # get notforloan complete status if applicable
1182         my $sthnflstatus = $dbh->prepare(
1183             'SELECT authorised_value
1184             FROM   marc_subfield_structure
1185             WHERE  kohafield="items.notforloan"
1186         '
1187         );
1188
1189         $sthnflstatus->execute;
1190         my ($authorised_valuecode) = $sthnflstatus->fetchrow;
1191         if ($authorised_valuecode) {
1192             $sthnflstatus = $dbh->prepare(
1193                 "SELECT lib FROM authorised_values
1194                  WHERE  category=?
1195                  AND authorised_value=?"
1196             );
1197             $sthnflstatus->execute( $authorised_valuecode,
1198                 $data->{itemnotforloan} );
1199             my ($lib) = $sthnflstatus->fetchrow;
1200             $data->{notforloanvalue} = $lib;
1201         }
1202
1203         # my stack procedures
1204         my $stackstatus = $dbh->prepare(
1205             'SELECT authorised_value
1206              FROM   marc_subfield_structure
1207              WHERE  kohafield="items.stack"
1208         '
1209         );
1210         $stackstatus->execute;
1211
1212         ($authorised_valuecode) = $stackstatus->fetchrow;
1213         if ($authorised_valuecode) {
1214             $stackstatus = $dbh->prepare(
1215                 "SELECT lib
1216                  FROM   authorised_values
1217                  WHERE  category=?
1218                  AND    authorised_value=?
1219             "
1220             );
1221             $stackstatus->execute( $authorised_valuecode, $data->{stack} );
1222             my ($lib) = $stackstatus->fetchrow;
1223             $data->{stack} = $lib;
1224         }
1225         # Find the last 3 people who borrowed this item.
1226         my $sth2 = $dbh->prepare("SELECT * FROM issues,borrowers
1227                                     WHERE itemnumber = ?
1228                                     AND issues.borrowernumber = borrowers.borrowernumber
1229                                     AND returndate IS NOT NULL LIMIT 3");
1230         $sth2->execute($data->{'itemnumber'});
1231         my $ii = 0;
1232         while (my $data2 = $sth2->fetchrow_hashref()) {
1233             $data->{"timestamp$ii"} = $data2->{'timestamp'} if $data2->{'timestamp'};
1234             $data->{"card$ii"}      = $data2->{'cardnumber'} if $data2->{'cardnumber'};
1235             $data->{"borrower$ii"}  = $data2->{'borrowernumber'} if $data2->{'borrowernumber'};
1236             $ii++;
1237         }
1238
1239         $results[$i] = $data;
1240         $i++;
1241     }
1242     $sth->finish;
1243         if($serial) {
1244                 return( sort { $b->{'publisheddate'} cmp $a->{'publisheddate'} } @results );
1245         } else {
1246         return (@results);
1247         }
1248 }
1249
1250 =head2 get_itemnumbers_of
1251
1252 =over 4
1253
1254 my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1255
1256 =back
1257
1258 Given a list of biblionumbers, return the list of corresponding itemnumbers
1259 for each biblionumber.
1260
1261 Return a reference on a hash where keys are biblionumbers and values are
1262 references on array of itemnumbers.
1263
1264 =cut
1265
1266 sub get_itemnumbers_of {
1267     my @biblionumbers = @_;
1268
1269     my $dbh = C4::Context->dbh;
1270
1271     my $query = '
1272         SELECT itemnumber,
1273             biblionumber
1274         FROM items
1275         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1276     ';
1277     my $sth = $dbh->prepare($query);
1278     $sth->execute(@biblionumbers);
1279
1280     my %itemnumbers_of;
1281
1282     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1283         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1284     }
1285
1286     return \%itemnumbers_of;
1287 }
1288
1289 =head2 GetItemnumberFromBarcode
1290
1291 =over 4
1292
1293 $result = GetItemnumberFromBarcode($barcode);
1294
1295 =back
1296
1297 =cut
1298
1299 sub GetItemnumberFromBarcode {
1300     my ($barcode) = @_;
1301     my $dbh = C4::Context->dbh;
1302
1303     my $rq =
1304       $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?");
1305     $rq->execute($barcode);
1306     my ($result) = $rq->fetchrow;
1307     return ($result);
1308 }
1309
1310 =head1 LIMITED USE FUNCTIONS
1311
1312 The following functions, while part of the public API,
1313 are not exported.  This is generally because they are
1314 meant to be used by only one script for a specific
1315 purpose, and should not be used in any other context
1316 without careful thought.
1317
1318 =cut
1319
1320 =head2 GetMarcItem
1321
1322 =over 4
1323
1324 my $item_marc = GetMarcItem($biblionumber, $itemnumber);
1325
1326 =back
1327
1328 Returns MARC::Record of the item passed in parameter.
1329 This function is meant for use only in C<cataloguing/additem.pl>,
1330 where it is needed to support that script's MARC-like
1331 editor.
1332
1333 =cut
1334
1335 sub GetMarcItem {
1336     my ( $biblionumber, $itemnumber ) = @_;
1337
1338     # GetMarcItem has been revised so that it does the following:
1339     #  1. Gets the item information from the items table.
1340     #  2. Converts it to a MARC field for storage in the bib record.
1341     #
1342     # The previous behavior was:
1343     #  1. Get the bib record.
1344     #  2. Return the MARC tag corresponding to the item record.
1345     #
1346     # The difference is that one treats the items row as authoritative,
1347     # while the other treats the MARC representation as authoritative
1348     # under certain circumstances.
1349
1350     my $itemrecord = GetItem($itemnumber);
1351
1352     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
1353     # Also, don't emit a subfield if the underlying field is blank.
1354     my $mungeditem = { map {  $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()  } keys %{ $itemrecord } };
1355     my $itemmarc = TransformKohaToMarc($mungeditem);
1356
1357     my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($mungeditem->{'items.more_subfields_xml'});
1358     if (defined $unlinked_item_subfields and $#$unlinked_item_subfields > -1) {
1359         my @fields = $itemmarc->fields();
1360         if ($#fields > -1) {
1361             $fields[0]->add_subfields(@$unlinked_item_subfields);
1362         }
1363     }
1364
1365     return $itemmarc;
1366
1367 }
1368
1369 =head1 PRIVATE FUNCTIONS AND VARIABLES
1370
1371 The following functions are not meant to be called
1372 directly, but are documented in order to explain
1373 the inner workings of C<C4::Items>.
1374
1375 =cut
1376
1377 =head2 %derived_columns
1378
1379 This hash keeps track of item columns that
1380 are strictly derived from other columns in
1381 the item record and are not meant to be set
1382 independently.
1383
1384 Each key in the hash should be the name of a
1385 column (as named by TransformMarcToKoha).  Each
1386 value should be hashref whose keys are the
1387 columns on which the derived column depends.  The
1388 hashref should also contain a 'BUILDER' key
1389 that is a reference to a sub that calculates
1390 the derived value.
1391
1392 =cut
1393
1394 my %derived_columns = (
1395     'items.cn_sort' => {
1396         'itemcallnumber' => 1,
1397         'items.cn_source' => 1,
1398         'BUILDER' => \&_calc_items_cn_sort,
1399     }
1400 );
1401
1402 =head2 _set_derived_columns_for_add
1403
1404 =over 4
1405
1406 _set_derived_column_for_add($item);
1407
1408 =back
1409
1410 Given an item hash representing a new item to be added,
1411 calculate any derived columns.  Currently the only
1412 such column is C<items.cn_sort>.
1413
1414 =cut
1415
1416 sub _set_derived_columns_for_add {
1417     my $item = shift;
1418
1419     foreach my $column (keys %derived_columns) {
1420         my $builder = $derived_columns{$column}->{'BUILDER'};
1421         my $source_values = {};
1422         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1423             next if $source_column eq 'BUILDER';
1424             $source_values->{$source_column} = $item->{$source_column};
1425         }
1426         $builder->($item, $source_values);
1427     }
1428 }
1429
1430 =head2 _set_derived_columns_for_mod
1431
1432 =over 4
1433
1434 _set_derived_column_for_mod($item);
1435
1436 =back
1437
1438 Given an item hash representing a new item to be modified.
1439 calculate any derived columns.  Currently the only
1440 such column is C<items.cn_sort>.
1441
1442 This routine differs from C<_set_derived_columns_for_add>
1443 in that it needs to handle partial item records.  In other
1444 words, the caller of C<ModItem> may have supplied only one
1445 or two columns to be changed, so this function needs to
1446 determine whether any of the columns to be changed affect
1447 any of the derived columns.  Also, if a derived column
1448 depends on more than one column, but the caller is not
1449 changing all of then, this routine retrieves the unchanged
1450 values from the database in order to ensure a correct
1451 calculation.
1452
1453 =cut
1454
1455 sub _set_derived_columns_for_mod {
1456     my $item = shift;
1457
1458     foreach my $column (keys %derived_columns) {
1459         my $builder = $derived_columns{$column}->{'BUILDER'};
1460         my $source_values = {};
1461         my %missing_sources = ();
1462         my $must_recalc = 0;
1463         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1464             next if $source_column eq 'BUILDER';
1465             if (exists $item->{$source_column}) {
1466                 $must_recalc = 1;
1467                 $source_values->{$source_column} = $item->{$source_column};
1468             } else {
1469                 $missing_sources{$source_column} = 1;
1470             }
1471         }
1472         if ($must_recalc) {
1473             foreach my $source_column (keys %missing_sources) {
1474                 $source_values->{$source_column} = _get_single_item_column($source_column, $item->{'itemnumber'});
1475             }
1476             $builder->($item, $source_values);
1477         }
1478     }
1479 }
1480
1481 =head2 _do_column_fixes_for_mod
1482
1483 =over 4
1484
1485 _do_column_fixes_for_mod($item);
1486
1487 =back
1488
1489 Given an item hashref containing one or more
1490 columns to modify, fix up certain values.
1491 Specifically, set to 0 any passed value
1492 of C<notforloan>, C<damaged>, C<itemlost>, or
1493 C<wthdrawn> that is either undefined or
1494 contains the empty string.
1495
1496 =cut
1497
1498 sub _do_column_fixes_for_mod {
1499     my $item = shift;
1500
1501     if (exists $item->{'notforloan'} and
1502         (not defined $item->{'notforloan'} or $item->{'notforloan'} eq '')) {
1503         $item->{'notforloan'} = 0;
1504     }
1505     if (exists $item->{'damaged'} and
1506         (not defined $item->{'damaged'} or $item->{'damaged'} eq '')) {
1507         $item->{'damaged'} = 0;
1508     }
1509     if (exists $item->{'itemlost'} and
1510         (not defined $item->{'itemlost'} or $item->{'itemlost'} eq '')) {
1511         $item->{'itemlost'} = 0;
1512     }
1513     if (exists $item->{'wthdrawn'} and
1514         (not defined $item->{'wthdrawn'} or $item->{'wthdrawn'} eq '')) {
1515         $item->{'wthdrawn'} = 0;
1516     }
1517 }
1518
1519 =head2 _get_single_item_column
1520
1521 =over 4
1522
1523 _get_single_item_column($column, $itemnumber);
1524
1525 =back
1526
1527 Retrieves the value of a single column from an C<items>
1528 row specified by C<$itemnumber>.
1529
1530 =cut
1531
1532 sub _get_single_item_column {
1533     my $column = shift;
1534     my $itemnumber = shift;
1535
1536     my $dbh = C4::Context->dbh;
1537     my $sth = $dbh->prepare("SELECT $column FROM items WHERE itemnumber = ?");
1538     $sth->execute($itemnumber);
1539     my ($value) = $sth->fetchrow();
1540     return $value;
1541 }
1542
1543 =head2 _calc_items_cn_sort
1544
1545 =over 4
1546
1547 _calc_items_cn_sort($item, $source_values);
1548
1549 =back
1550
1551 Helper routine to calculate C<items.cn_sort>.
1552
1553 =cut
1554
1555 sub _calc_items_cn_sort {
1556     my $item = shift;
1557     my $source_values = shift;
1558
1559     $item->{'items.cn_sort'} = GetClassSort($source_values->{'items.cn_source'}, $source_values->{'itemcallnumber'}, "");
1560 }
1561
1562 =head2 _set_defaults_for_add
1563
1564 =over 4
1565
1566 _set_defaults_for_add($item_hash);
1567
1568 =back
1569
1570 Given an item hash representing an item to be added, set
1571 correct default values for columns whose default value
1572 is not handled by the DBMS.  This includes the following
1573 columns:
1574
1575 =over 2
1576
1577 =item *
1578
1579 C<items.dateaccessioned>
1580
1581 =item *
1582
1583 C<items.notforloan>
1584
1585 =item *
1586
1587 C<items.damaged>
1588
1589 =item *
1590
1591 C<items.itemlost>
1592
1593 =item *
1594
1595 C<items.wthdrawn>
1596
1597 =back
1598
1599 =cut
1600
1601 sub _set_defaults_for_add {
1602     my $item = shift;
1603
1604     # if dateaccessioned is provided, use it. Otherwise, set to NOW()
1605     if (!(exists $item->{'dateaccessioned'}) ||
1606          ($item->{'dateaccessioned'} eq '')) {
1607         # FIXME add check for invalid date
1608         my $today = C4::Dates->new();
1609         $item->{'dateaccessioned'} =  $today->output("iso"); #TODO: check time issues
1610     }
1611
1612     # various item status fields cannot be null
1613     $item->{'notforloan'} = 0 unless exists $item->{'notforloan'} and defined $item->{'notforloan'} and $item->{'notforloan'} ne '';
1614     $item->{'damaged'}    = 0 unless exists $item->{'damaged'}    and defined $item->{'damaged'}    and $item->{'damaged'} ne '';
1615     $item->{'itemlost'}   = 0 unless exists $item->{'itemlost'}   and defined $item->{'itemlost'}   and $item->{'itemlost'} ne '';
1616     $item->{'wthdrawn'}   = 0 unless exists $item->{'wthdrawn'}   and defined $item->{'wthdrawn'}   and $item->{'wthdrawn'} ne '';
1617 }
1618
1619 =head2 _koha_new_item
1620
1621 =over 4
1622
1623 my ($itemnumber,$error) = _koha_new_item( $item, $barcode );
1624
1625 =back
1626
1627 Perform the actual insert into the C<items> table.
1628
1629 =cut
1630
1631 sub _koha_new_item {
1632     my ( $item, $barcode ) = @_;
1633     my $dbh=C4::Context->dbh;
1634     my $error;
1635     my $query =
1636            "INSERT INTO items SET
1637             biblionumber        = ?,
1638             biblioitemnumber    = ?,
1639             barcode             = ?,
1640             dateaccessioned     = ?,
1641             booksellerid        = ?,
1642             homebranch          = ?,
1643             price               = ?,
1644             replacementprice    = ?,
1645             replacementpricedate = NOW(),
1646             datelastborrowed    = ?,
1647             datelastseen        = NOW(),
1648             stack               = ?,
1649             notforloan          = ?,
1650             damaged             = ?,
1651             itemlost            = ?,
1652             wthdrawn            = ?,
1653             itemcallnumber      = ?,
1654             restricted          = ?,
1655             itemnotes           = ?,
1656             holdingbranch       = ?,
1657             paidfor             = ?,
1658             location            = ?,
1659             onloan              = ?,
1660             issues              = ?,
1661             renewals            = ?,
1662             reserves            = ?,
1663             cn_source           = ?,
1664             cn_sort             = ?,
1665             ccode               = ?,
1666             itype               = ?,
1667             materials           = ?,
1668                         uri                 = ?,
1669             more_subfields_xml  = ?
1670           ";
1671     my $sth = $dbh->prepare($query);
1672    $sth->execute(
1673             $item->{'biblionumber'},
1674             $item->{'biblioitemnumber'},
1675             $barcode,
1676             $item->{'dateaccessioned'},
1677             $item->{'booksellerid'},
1678             $item->{'homebranch'},
1679             $item->{'price'},
1680             $item->{'replacementprice'},
1681             $item->{datelastborrowed},
1682             $item->{stack},
1683             $item->{'notforloan'},
1684             $item->{'damaged'},
1685             $item->{'itemlost'},
1686             $item->{'wthdrawn'},
1687             $item->{'itemcallnumber'},
1688             $item->{'restricted'},
1689             $item->{'itemnotes'},
1690             $item->{'holdingbranch'},
1691             $item->{'paidfor'},
1692             $item->{'location'},
1693             $item->{'onloan'},
1694             $item->{'issues'},
1695             $item->{'renewals'},
1696             $item->{'reserves'},
1697             $item->{'items.cn_source'},
1698             $item->{'items.cn_sort'},
1699             $item->{'ccode'},
1700             $item->{'itype'},
1701             $item->{'materials'},
1702             $item->{'uri'},
1703             $item->{'more_subfields_xml'},
1704     );
1705     my $itemnumber = $dbh->{'mysql_insertid'};
1706     if ( defined $sth->errstr ) {
1707         $error.="ERROR in _koha_new_item $query".$sth->errstr;
1708     }
1709     $sth->finish();
1710     return ( $itemnumber, $error );
1711 }
1712
1713 =head2 _koha_modify_item
1714
1715 =over 4
1716
1717 my ($itemnumber,$error) =_koha_modify_item( $item );
1718
1719 =back
1720
1721 Perform the actual update of the C<items> row.  Note that this
1722 routine accepts a hashref specifying the columns to update.
1723
1724 =cut
1725
1726 sub _koha_modify_item {
1727     my ( $item ) = @_;
1728     my $dbh=C4::Context->dbh;
1729     my $error;
1730
1731     my $query = "UPDATE items SET ";
1732     my @bind;
1733     for my $key ( keys %$item ) {
1734         $query.="$key=?,";
1735         push @bind, $item->{$key};
1736     }
1737     $query =~ s/,$//;
1738     $query .= " WHERE itemnumber=?";
1739     push @bind, $item->{'itemnumber'};
1740     my $sth = C4::Context->dbh->prepare($query);
1741     $sth->execute(@bind);
1742     if ( C4::Context->dbh->errstr ) {
1743         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
1744         warn $error;
1745     }
1746     $sth->finish();
1747     return ($item->{'itemnumber'},$error);
1748 }
1749
1750 =head2 _koha_delete_item
1751
1752 =over 4
1753
1754 _koha_delete_item( $dbh, $itemnum );
1755
1756 =back
1757
1758 Internal function to delete an item record from the koha tables
1759
1760 =cut
1761
1762 sub _koha_delete_item {
1763     my ( $dbh, $itemnum ) = @_;
1764
1765     # save the deleted item to deleteditems table
1766     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
1767     $sth->execute($itemnum);
1768     my $data = $sth->fetchrow_hashref();
1769     $sth->finish();
1770     my $query = "INSERT INTO deleteditems SET ";
1771     my @bind  = ();
1772     foreach my $key ( keys %$data ) {
1773         $query .= "$key = ?,";
1774         push( @bind, $data->{$key} );
1775     }
1776     $query =~ s/\,$//;
1777     $sth = $dbh->prepare($query);
1778     $sth->execute(@bind);
1779     $sth->finish();
1780
1781     # delete from items table
1782     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
1783     $sth->execute($itemnum);
1784     $sth->finish();
1785     return undef;
1786 }
1787
1788 =head2 _marc_from_item_hash
1789
1790 =over 4
1791
1792 my $item_marc = _marc_from_item_hash($item, $frameworkcode[, $unlinked_item_subfields]);
1793
1794 =back
1795
1796 Given an item hash representing a complete item record,
1797 create a C<MARC::Record> object containing an embedded
1798 tag representing that item.
1799
1800 The third, optional parameter C<$unlinked_item_subfields> is
1801 an arrayref of subfields (not mapped to C<items> fields per the
1802 framework) to be added to the MARC representation
1803 of the item.
1804
1805 =cut
1806
1807 sub _marc_from_item_hash {
1808     my $item = shift;
1809     my $frameworkcode = shift;
1810     my $unlinked_item_subfields;
1811     if (@_) {
1812         $unlinked_item_subfields = shift;
1813     }
1814
1815     # Tack on 'items.' prefix to column names so lookup from MARC frameworks will work
1816     # Also, don't emit a subfield if the underlying field is blank.
1817     my $mungeditem = { map {  (defined($item->{$_}) and $item->{$_} ne '') ?
1818                                 (/^items\./ ? ($_ => $item->{$_}) : ("items.$_" => $item->{$_}))
1819                                 : ()  } keys %{ $item } };
1820
1821     my $item_marc = MARC::Record->new();
1822     foreach my $item_field (keys %{ $mungeditem }) {
1823         my ($tag, $subfield) = GetMarcFromKohaField($item_field, $frameworkcode);
1824         next unless defined $tag and defined $subfield; # skip if not mapped to MARC field
1825         if (my $field = $item_marc->field($tag)) {
1826             $field->add_subfields($subfield => $mungeditem->{$item_field});
1827         } else {
1828             my $add_subfields = [];
1829             if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
1830                 $add_subfields = $unlinked_item_subfields;
1831             }
1832             $item_marc->add_fields( $tag, " ", " ", $subfield =>  $mungeditem->{$item_field}, @$add_subfields);
1833         }
1834     }
1835
1836     return $item_marc;
1837 }
1838
1839 =head2 _add_item_field_to_biblio
1840
1841 =over 4
1842
1843 _add_item_field_to_biblio($item_marc, $biblionumber, $frameworkcode);
1844
1845 =back
1846
1847 Adds the fields from a MARC record containing the
1848 representation of a Koha item record to the MARC
1849 biblio record.  The input C<$item_marc> record
1850 is expect to contain just one field, the embedded
1851 item information field.
1852
1853 =cut
1854
1855 sub _add_item_field_to_biblio {
1856     my ($item_marc, $biblionumber, $frameworkcode) = @_;
1857
1858     my $biblio_marc = GetMarcBiblio($biblionumber);
1859
1860     foreach my $field ($item_marc->fields()) {
1861         $biblio_marc->append_fields($field);
1862     }
1863
1864     ModBiblioMarc($biblio_marc, $biblionumber, $frameworkcode);
1865 }
1866
1867 =head2 _replace_item_field_in_biblio
1868
1869 =over
1870
1871 &_replace_item_field_in_biblio($item_marc, $biblionumber, $itemnumber, $frameworkcode)
1872
1873 =back
1874
1875 Given a MARC::Record C<$item_marc> containing one tag with the MARC
1876 representation of the item, examine the biblio MARC
1877 for the corresponding tag for that item and
1878 replace it with the tag from C<$item_marc>.
1879
1880 =cut
1881
1882 sub _replace_item_field_in_biblio {
1883     my ($ItemRecord, $biblionumber, $itemnumber, $frameworkcode) = @_;
1884     my $dbh = C4::Context->dbh;
1885
1886     # get complete MARC record & replace the item field by the new one
1887     my $completeRecord = GetMarcBiblio($biblionumber);
1888     my ($itemtag,$itemsubfield) = GetMarcFromKohaField("items.itemnumber",$frameworkcode);
1889     my $itemField = $ItemRecord->field($itemtag);
1890     my @items = $completeRecord->field($itemtag);
1891     my $found = 0;
1892     foreach (@items) {
1893         if ($_->subfield($itemsubfield) eq $itemnumber) {
1894             $_->replace_with($itemField);
1895             $found = 1;
1896         }
1897     }
1898
1899     unless ($found) {
1900         # If we haven't found the matching field,
1901         # just add it.  However, this means that
1902         # there is likely a bug.
1903         $completeRecord->append_fields($itemField);
1904     }
1905
1906     # save the record
1907     ModBiblioMarc($completeRecord, $biblionumber, $frameworkcode);
1908 }
1909
1910 =head2 _repack_item_errors
1911
1912 Add an error message hash generated by C<CheckItemPreSave>
1913 to a list of errors.
1914
1915 =cut
1916
1917 sub _repack_item_errors {
1918     my $item_sequence_num = shift;
1919     my $item_ref = shift;
1920     my $error_ref = shift;
1921
1922     my @repacked_errors = ();
1923
1924     foreach my $error_code (sort keys %{ $error_ref }) {
1925         my $repacked_error = {};
1926         $repacked_error->{'item_sequence'} = $item_sequence_num;
1927         $repacked_error->{'item_barcode'} = exists($item_ref->{'barcode'}) ? $item_ref->{'barcode'} : '';
1928         $repacked_error->{'error_code'} = $error_code;
1929         $repacked_error->{'error_information'} = $error_ref->{$error_code};
1930         push @repacked_errors, $repacked_error;
1931     }
1932
1933     return @repacked_errors;
1934 }
1935
1936 =head2 _get_unlinked_item_subfields
1937
1938 =over 4
1939
1940 my $unlinked_item_subfields = _get_unlinked_item_subfields($original_item_marc, $frameworkcode);
1941
1942 =back
1943
1944 =cut
1945
1946 sub _get_unlinked_item_subfields {
1947     my $original_item_marc = shift;
1948     my $frameworkcode = shift;
1949
1950     my $marcstructure = GetMarcStructure(1, $frameworkcode);
1951
1952     # assume that this record has only one field, and that that
1953     # field contains only the item information
1954     my $subfields = [];
1955     my @fields = $original_item_marc->fields();
1956     if ($#fields > -1) {
1957         my $field = $fields[0];
1958             my $tag = $field->tag();
1959         foreach my $subfield ($field->subfields()) {
1960             if (defined $subfield->[1] and
1961                 $subfield->[1] ne '' and
1962                 !$marcstructure->{$tag}->{$subfield->[0]}->{'kohafield'}) {
1963                 push @$subfields, $subfield->[0] => $subfield->[1];
1964             }
1965         }
1966     }
1967     return $subfields;
1968 }
1969
1970 =head2 _get_unlinked_subfields_xml
1971
1972 =over 4
1973
1974 my $unlinked_subfields_xml = _get_unlinked_subfields_xml($unlinked_item_subfields);
1975
1976 =back
1977
1978 =cut
1979
1980 sub _get_unlinked_subfields_xml {
1981     my $unlinked_item_subfields = shift;
1982
1983     my $xml;
1984     if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
1985         my $marc = MARC::Record->new();
1986         # use of tag 999 is arbitrary, and doesn't need to match the item tag
1987         # used in the framework
1988         $marc->append_fields(MARC::Field->new('999', ' ', ' ', @$unlinked_item_subfields));
1989         $xml = $marc->as_xml();
1990     }
1991
1992     return $xml;
1993 }
1994
1995 =head2 _parse_unlinked_item_subfields_from_xml
1996
1997 =over 4
1998
1999 my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($whole_item->{'more_subfields_xml'}):
2000
2001 =back
2002
2003 =cut
2004
2005 sub  _parse_unlinked_item_subfields_from_xml {
2006     my $xml = shift;
2007
2008     return unless defined $xml and $xml ne "";
2009     my $marc = MARC::Record->new_from_xml(StripNonXmlChars($xml), 'UTF-8', C4::Context->preference("marcflavour"));
2010     my $unlinked_subfields = [];
2011     my @fields = $marc->fields();
2012     if ($#fields > -1) {
2013         foreach my $subfield ($fields[0]->subfields()) {
2014             push @$unlinked_subfields, $subfield->[0] => $subfield->[1];
2015         }
2016     }
2017     return $unlinked_subfields;
2018 }
2019
2020 1;