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