C4/Items.pm

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