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