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