C4/Items.pm

   1 package C4::Items;
   2
   3 # Copyright 2007 LibLime, Inc.
   4 # Parts Copyright Biblibre 2010
   5 #
   6 # This file is part of Koha.
   7 #
   8 # Koha is free software; you can redistribute it and/or modify it
   9 # under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 3 of the License, or
  11 # (at your option) any later version.
  12 #
  13 # Koha is distributed in the hope that it will be useful, but
  14 # WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  20
  21 use strict;
  22 #use warnings; FIXME - Bug 2505
  23
  24 use Carp;
  25 use C4::Context;
  26 use C4::Koha;
  27 use C4::Biblio;
  28 use Koha::DateUtils;
  29 use MARC::Record;
  30 use C4::ClassSource;
  31 use C4::Log;
  32 use List::MoreUtils qw/any/;
  33 use YAML qw/Load/;
  34 use DateTime::Format::MySQL;
  35 use Data::Dumper; # used as part of logging item record changes, not just for
  36                   # debugging; so please don't remove this
  37 use Koha::DateUtils qw/dt_from_string/;
  38 use Koha::Database;
  39
  40 use Koha::Database;
  41
  42 use vars qw($VERSION @ISA @EXPORT);
  43
  44 BEGIN {
  45     $VERSION = 3.07.00.049;
  46
  47         require Exporter;
  48     @ISA = qw( Exporter );
  49
  50     # function exports
  51     @EXPORT = qw(
  52         GetItem
  53         AddItemFromMarc
  54         AddItem
  55         AddItemBatchFromMarc
  56         ModItemFromMarc
  57     Item2Marc
  58         ModItem
  59         ModDateLastSeen
  60         ModItemTransfer
  61         DelItem
  62
  63         CheckItemPreSave
  64
  65         GetItemStatus
  66         GetItemLocation
  67         GetLostItems
  68         GetItemsForInventory
  69         GetItemsCount
  70         GetItemInfosOf
  71         GetItemsByBiblioitemnumber
  72         GetItemsInfo
  73         GetItemsLocationInfo
  74         GetHostItemsInfo
  75         GetItemnumbersForBiblio
  76         get_itemnumbers_of
  77         get_hostitemnumbers_of
  78         GetItemnumberFromBarcode
  79         GetBarcodeFromItemnumber
  80         GetHiddenItemnumbers
  81         DelItemCheck
  82     MoveItemFromBiblio
  83     GetLatestAcquisitions
  84
  85         CartToShelf
  86         ShelfToCart
  87
  88         GetAnalyticsCount
  89         GetItemHolds
  90
  91         SearchItemsByField
  92         SearchItems
  93
  94         PrepareItemrecordDisplay
  95
  96     );
  97 }
  98
  99 =head1 NAME
 100
 101 C4::Items - item management functions
 102
 103 =head1 DESCRIPTION
 104
 105 This module contains an API for manipulating item
 106 records in Koha, and is used by cataloguing, circulation,
 107 acquisitions, and serials management.
 108
 109 A Koha item record is stored in two places: the
 110 items table and embedded in a MARC tag in the XML
 111 version of the associated bib record in C<biblioitems.marcxml>.
 112 This is done to allow the item information to be readily
 113 indexed (e.g., by Zebra), but means that each item
 114 modification transaction must keep the items table
 115 and the MARC XML in sync at all times.
 116
 117 Consequently, all code that creates, modifies, or deletes
 118 item records B<must> use an appropriate function from
 119 C<C4::Items>.  If no existing function is suitable, it is
 120 better to add one to C<C4::Items> than to use add
 121 one-off SQL statements to add or modify items.
 122
 123 The items table will be considered authoritative.  In other
 124 words, if there is ever a discrepancy between the items
 125 table and the MARC XML, the items table should be considered
 126 accurate.
 127
 128 =head1 HISTORICAL NOTE
 129
 130 Most of the functions in C<C4::Items> were originally in
 131 the C<C4::Biblio> module.
 132
 133 =head1 CORE EXPORTED FUNCTIONS
 134
 135 The following functions are meant for use by users
 136 of C<C4::Items>
 137
 138 =cut
 139
 140 =head2 GetItem
 141
 142   $item = GetItem($itemnumber,$barcode,$serial);
 143
 144 Return item information, for a given itemnumber or barcode.
 145 The return value is a hashref mapping item column
 146 names to values.  If C<$serial> is true, include serial publication data.
 147
 148 =cut
 149
 150 sub GetItem {
 151     my ($itemnumber,$barcode, $serial) = @_;
 152     my $dbh = C4::Context->dbh;
 153         my $data;
 154
 155     if ($itemnumber) {
 156         my $sth = $dbh->prepare("
 157             SELECT * FROM items
 158             WHERE itemnumber = ?");
 159         $sth->execute($itemnumber);
 160         $data = $sth->fetchrow_hashref;
 161     } else {
 162         my $sth = $dbh->prepare("
 163             SELECT * FROM items
 164             WHERE barcode = ?"
 165             );
 166         $sth->execute($barcode);
 167         $data = $sth->fetchrow_hashref;
 168     }
 169
 170     return unless ( $data );
 171
 172     if ( $serial) {
 173     my $ssth = $dbh->prepare("SELECT serialseq,publisheddate from serialitems left join serial on serialitems.serialid=serial.serialid where serialitems.itemnumber=?");
 174         $ssth->execute($data->{'itemnumber'}) ;
 175         ($data->{'serialseq'} , $data->{'publisheddate'}) = $ssth->fetchrow_array();
 176     }
 177         #if we don't have an items.itype, use biblioitems.itemtype.
 178     # FIXME this should respect the itypes systempreference
 179     # if (C4::Context->preference('item-level_itypes')) {
 180         if( ! $data->{'itype'} ) {
 181                 my $sth = $dbh->prepare("SELECT itemtype FROM biblioitems  WHERE biblionumber = ?");
 182                 $sth->execute($data->{'biblionumber'});
 183                 ($data->{'itype'}) = $sth->fetchrow_array;
 184         }
 185     return $data;
 186 }    # sub GetItem
 187
 188 =head2 CartToShelf
 189
 190   CartToShelf($itemnumber);
 191
 192 Set the current shelving location of the item record
 193 to its stored permanent shelving location.  This is
 194 primarily used to indicate when an item whose current
 195 location is a special processing ('PROC') or shelving cart
 196 ('CART') location is back in the stacks.
 197
 198 =cut
 199
 200 sub CartToShelf {
 201     my ( $itemnumber ) = @_;
 202
 203     unless ( $itemnumber ) {
 204         croak "FAILED CartToShelf() - no itemnumber supplied";
 205     }
 206
 207     my $item = GetItem($itemnumber);
 208     if ( $item->{location} eq 'CART' ) {
 209         $item->{location} = $item->{permanent_location};
 210         ModItem($item, undef, $itemnumber);
 211     }
 212 }
 213
 214 =head2 ShelfToCart
 215
 216   ShelfToCart($itemnumber);
 217
 218 Set the current shelving location of the item
 219 to shelving cart ('CART').
 220
 221 =cut
 222
 223 sub ShelfToCart {
 224     my ( $itemnumber ) = @_;
 225
 226     unless ( $itemnumber ) {
 227         croak "FAILED ShelfToCart() - no itemnumber supplied";
 228     }
 229
 230     my $item = GetItem($itemnumber);
 231     $item->{'location'} = 'CART';
 232     ModItem($item, undef, $itemnumber);
 233 }
 234
 235 =head2 AddItemFromMarc
 236
 237   my ($biblionumber, $biblioitemnumber, $itemnumber)
 238       = AddItemFromMarc($source_item_marc, $biblionumber);
 239
 240 Given a MARC::Record object containing an embedded item
 241 record and a biblionumber, create a new item record.
 242
 243 =cut
 244
 245 sub AddItemFromMarc {
 246     my ( $source_item_marc, $biblionumber ) = @_;
 247     my $dbh = C4::Context->dbh;
 248
 249     # parse item hash from MARC
 250     my $frameworkcode = GetFrameworkCode( $biblionumber );
 251         my ($itemtag,$itemsubfield)=GetMarcFromKohaField("items.itemnumber",$frameworkcode);
 252
 253         my $localitemmarc=MARC::Record->new;
 254         $localitemmarc->append_fields($source_item_marc->field($itemtag));
 255     my $item = &TransformMarcToKoha( $dbh, $localitemmarc, $frameworkcode ,'items');
 256     my $unlinked_item_subfields = _get_unlinked_item_subfields($localitemmarc, $frameworkcode);
 257     return AddItem($item, $biblionumber, $dbh, $frameworkcode, $unlinked_item_subfields);
 258 }
 259
 260 =head2 AddItem
 261
 262   my ($biblionumber, $biblioitemnumber, $itemnumber)
 263       = AddItem($item, $biblionumber[, $dbh, $frameworkcode, $unlinked_item_subfields]);
 264
 265 Given a hash containing item column names as keys,
 266 create a new Koha item record.
 267
 268 The first two optional parameters (C<$dbh> and C<$frameworkcode>)
 269 do not need to be supplied for general use; they exist
 270 simply to allow them to be picked up from AddItemFromMarc.
 271
 272 The final optional parameter, C<$unlinked_item_subfields>, contains
 273 an arrayref containing subfields present in the original MARC
 274 representation of the item (e.g., from the item editor) that are
 275 not mapped to C<items> columns directly but should instead
 276 be stored in C<items.more_subfields_xml> and included in
 277 the biblio items tag for display and indexing.
 278
 279 =cut
 280
 281 sub AddItem {
 282     my $item = shift;
 283     my $biblionumber = shift;
 284
 285     my $dbh           = @_ ? shift : C4::Context->dbh;
 286     my $frameworkcode = @_ ? shift : GetFrameworkCode( $biblionumber );
 287     my $unlinked_item_subfields;
 288     if (@_) {
 289         $unlinked_item_subfields = shift
 290     };
 291
 292     # needs old biblionumber and biblioitemnumber
 293     $item->{'biblionumber'} = $biblionumber;
 294     my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber=?");
 295     $sth->execute( $item->{'biblionumber'} );
 296     ($item->{'biblioitemnumber'}) = $sth->fetchrow;
 297
 298     _set_defaults_for_add($item);
 299     _set_derived_columns_for_add($item);
 300     $item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);
 301     # FIXME - checks here
 302     unless ( $item->{itype} ) {  # default to biblioitem.itemtype if no itype
 303         my $itype_sth = $dbh->prepare("SELECT itemtype FROM biblioitems WHERE biblionumber = ?");
 304         $itype_sth->execute( $item->{'biblionumber'} );
 305         ( $item->{'itype'} ) = $itype_sth->fetchrow_array;
 306     }
 307
 308         my ( $itemnumber, $error ) = _koha_new_item( $item, $item->{barcode} );
 309     $item->{'itemnumber'} = $itemnumber;
 310
 311     ModZebra( $item->{biblionumber}, "specialUpdate", "biblioserver" );
 312
 313     logaction("CATALOGUING", "ADD", $itemnumber, "item") if C4::Context->preference("CataloguingLog");
 314
 315     return ($item->{biblionumber}, $item->{biblioitemnumber}, $itemnumber);
 316 }
 317
 318 =head2 AddItemBatchFromMarc
 319
 320   ($itemnumber_ref, $error_ref) = AddItemBatchFromMarc($record,
 321              $biblionumber, $biblioitemnumber, $frameworkcode);
 322
 323 Efficiently create item records from a MARC biblio record with
 324 embedded item fields.  This routine is suitable for batch jobs.
 325
 326 This API assumes that the bib record has already been
 327 saved to the C<biblio> and C<biblioitems> tables.  It does
 328 not expect that C<biblioitems.marc> and C<biblioitems.marcxml>
 329 are populated, but it will do so via a call to ModBibiloMarc.
 330
 331 The goal of this API is to have a similar effect to using AddBiblio
 332 and AddItems in succession, but without inefficient repeated
 333 parsing of the MARC XML bib record.
 334
 335 This function returns an arrayref of new itemsnumbers and an arrayref of item
 336 errors encountered during the processing.  Each entry in the errors
 337 list is a hashref containing the following keys:
 338
 339 =over
 340
 341 =item item_sequence
 342
 343 Sequence number of original item tag in the MARC record.
 344
 345 =item item_barcode
 346
 347 Item barcode, provide to assist in the construction of
 348 useful error messages.
 349
 350 =item error_code
 351
 352 Code representing the error condition.  Can be 'duplicate_barcode',
 353 'invalid_homebranch', or 'invalid_holdingbranch'.
 354
 355 =item error_information
 356
 357 Additional information appropriate to the error condition.
 358
 359 =back
 360
 361 =cut
 362
 363 sub AddItemBatchFromMarc {
 364     my ($record, $biblionumber, $biblioitemnumber, $frameworkcode) = @_;
 365     my $error;
 366     my @itemnumbers = ();
 367     my @errors = ();
 368     my $dbh = C4::Context->dbh;
 369
 370     # We modify the record, so lets work on a clone so we don't change the
 371     # original.
 372     $record = $record->clone();
 373     # loop through the item tags and start creating items
 374     my @bad_item_fields = ();
 375     my ($itemtag, $itemsubfield) = &GetMarcFromKohaField("items.itemnumber",'');
 376     my $item_sequence_num = 0;
 377     ITEMFIELD: foreach my $item_field ($record->field($itemtag)) {
 378         $item_sequence_num++;
 379         # we take the item field and stick it into a new
 380         # MARC record -- this is required so far because (FIXME)
 381         # TransformMarcToKoha requires a MARC::Record, not a MARC::Field
 382         # and there is no TransformMarcFieldToKoha
 383         my $temp_item_marc = MARC::Record->new();
 384         $temp_item_marc->append_fields($item_field);
 385
 386         # add biblionumber and biblioitemnumber
 387         my $item = TransformMarcToKoha( $dbh, $temp_item_marc, $frameworkcode, 'items' );
 388         my $unlinked_item_subfields = _get_unlinked_item_subfields($temp_item_marc, $frameworkcode);
 389         $item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);
 390         $item->{'biblionumber'} = $biblionumber;
 391         $item->{'biblioitemnumber'} = $biblioitemnumber;
 392
 393         # check for duplicate barcode
 394         my %item_errors = CheckItemPreSave($item);
 395         if (%item_errors) {
 396             push @errors, _repack_item_errors($item_sequence_num, $item, \%item_errors);
 397             push @bad_item_fields, $item_field;
 398             next ITEMFIELD;
 399         }
 400
 401         _set_defaults_for_add($item);
 402         _set_derived_columns_for_add($item);
 403         my ( $itemnumber, $error ) = _koha_new_item( $item, $item->{barcode} );
 404         warn $error if $error;
 405         push @itemnumbers, $itemnumber; # FIXME not checking error
 406         $item->{'itemnumber'} = $itemnumber;
 407
 408         logaction("CATALOGUING", "ADD", $itemnumber, "item") if C4::Context->preference("CataloguingLog");
 409
 410         my $new_item_marc = _marc_from_item_hash($item, $frameworkcode, $unlinked_item_subfields);
 411         $item_field->replace_with($new_item_marc->field($itemtag));
 412     }
 413
 414     # remove any MARC item fields for rejected items
 415     foreach my $item_field (@bad_item_fields) {
 416         $record->delete_field($item_field);
 417     }
 418
 419     # update the MARC biblio
 420  #   $biblionumber = ModBiblioMarc( $record, $biblionumber, $frameworkcode );
 421
 422     return (\@itemnumbers, \@errors);
 423 }
 424
 425 =head2 ModItemFromMarc
 426
 427   ModItemFromMarc($item_marc, $biblionumber, $itemnumber);
 428
 429 This function updates an item record based on a supplied
 430 C<MARC::Record> object containing an embedded item field.
 431 This API is meant for the use of C<additem.pl>; for
 432 other purposes, C<ModItem> should be used.
 433
 434 This function uses the hash %default_values_for_mod_from_marc,
 435 which contains default values for item fields to
 436 apply when modifying an item.  This is needed because
 437 if an item field's value is cleared, TransformMarcToKoha
 438 does not include the column in the
 439 hash that's passed to ModItem, which without
 440 use of this hash makes it impossible to clear
 441 an item field's value.  See bug 2466.
 442
 443 Note that only columns that can be directly
 444 changed from the cataloging and serials
 445 item editors are included in this hash.
 446
 447 Returns item record
 448
 449 =cut
 450
 451 our %default_values_for_mod_from_marc;
 452
 453 sub _build_default_values_for_mod_marc {
 454     my ($frameworkcode) = @_;
 455     return $default_values_for_mod_from_marc{$frameworkcode}
 456       if exists $default_values_for_mod_from_marc{$frameworkcode};
 457     my $marc_structure = C4::Biblio::GetMarcStructure( 1, $frameworkcode );
 458     my $default_values = {
 459         barcode                  => undef,
 460         booksellerid             => undef,
 461         ccode                    => undef,
 462         'items.cn_source'        => undef,
 463         coded_location_qualifier => undef,
 464         copynumber               => undef,
 465         damaged                  => 0,
 466         enumchron                => undef,
 467         holdingbranch            => undef,
 468         homebranch               => undef,
 469         itemcallnumber           => undef,
 470         itemlost                 => 0,
 471         itemnotes                => undef,
 472         itemnotes_nonpublic      => undef,
 473         itype                    => undef,
 474         location                 => undef,
 475         permanent_location       => undef,
 476         materials                => undef,
 477         new                      => undef,
 478         notforloan               => 0,
 479         # paidfor => undef, # commented, see bug 12817
 480         price                    => undef,
 481         replacementprice         => undef,
 482         replacementpricedate     => undef,
 483         restricted               => undef,
 484         stack                    => undef,
 485         stocknumber              => undef,
 486         uri                      => undef,
 487         withdrawn                => 0,
 488     };
 489     while ( my ( $field, $default_value ) = each %$default_values ) {
 490         my $kohafield = $field;
 491         $kohafield =~ s|^([^\.]+)$|items.$1|;
 492         $default_values_for_mod_from_marc{$frameworkcode}{$field} =
 493           $default_value
 494           if C4::Koha::IsKohaFieldLinked(
 495             { kohafield => $kohafield, frameworkcode => $frameworkcode } );
 496     }
 497     return $default_values_for_mod_from_marc{$frameworkcode};
 498 }
 499
 500 sub ModItemFromMarc {
 501     my $item_marc = shift;
 502     my $biblionumber = shift;
 503     my $itemnumber = shift;
 504
 505     my $dbh           = C4::Context->dbh;
 506     my $frameworkcode = GetFrameworkCode($biblionumber);
 507     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
 508
 509     my $localitemmarc = MARC::Record->new;
 510     $localitemmarc->append_fields( $item_marc->field($itemtag) );
 511     my $item = &TransformMarcToKoha( $dbh, $localitemmarc, $frameworkcode, 'items' );
 512     my $default_values = _build_default_values_for_mod_marc();
 513     foreach my $item_field ( keys %$default_values ) {
 514         $item->{$item_field} = $default_values->{$item_field}
 515           unless exists $item->{$item_field};
 516     }
 517     my $unlinked_item_subfields = _get_unlinked_item_subfields( $localitemmarc, $frameworkcode );
 518
 519     ModItem($item, $biblionumber, $itemnumber, $dbh, $frameworkcode, $unlinked_item_subfields);
 520     return $item;
 521 }
 522
 523 =head2 ModItem
 524
 525   ModItem({ column => $newvalue }, $biblionumber, $itemnumber);
 526
 527 Change one or more columns in an item record and update
 528 the MARC representation of the item.
 529
 530 The first argument is a hashref mapping from item column
 531 names to the new values.  The second and third arguments
 532 are the biblionumber and itemnumber, respectively.
 533
 534 The fourth, optional parameter, C<$unlinked_item_subfields>, contains
 535 an arrayref containing subfields present in the original MARC
 536 representation of the item (e.g., from the item editor) that are
 537 not mapped to C<items> columns directly but should instead
 538 be stored in C<items.more_subfields_xml> and included in
 539 the biblio items tag for display and indexing.
 540
 541 If one of the changed columns is used to calculate
 542 the derived value of a column such as C<items.cn_sort>,
 543 this routine will perform the necessary calculation
 544 and set the value.
 545
 546 =cut
 547
 548 sub ModItem {
 549     my $item = shift;
 550     my $biblionumber = shift;
 551     my $itemnumber = shift;
 552
 553     # if $biblionumber is undefined, get it from the current item
 554     unless (defined $biblionumber) {
 555         $biblionumber = _get_single_item_column('biblionumber', $itemnumber);
 556     }
 557
 558     my $dbh           = @_ ? shift : C4::Context->dbh;
 559     my $frameworkcode = @_ ? shift : GetFrameworkCode( $biblionumber );
 560
 561     my $unlinked_item_subfields;
 562     if (@_) {
 563         $unlinked_item_subfields = shift;
 564         $item->{'more_subfields_xml'} = _get_unlinked_subfields_xml($unlinked_item_subfields);
 565     };
 566
 567     $item->{'itemnumber'} = $itemnumber or return;
 568
 569     my @fields = qw( itemlost withdrawn );
 570
 571     # Only call GetItem if we need to set an "on" date field
 572     if ( $item->{itemlost} || $item->{withdrawn} ) {
 573         my $pre_mod_item = GetItem( $item->{'itemnumber'} );
 574         for my $field (@fields) {
 575             if (    defined( $item->{$field} )
 576                 and not $pre_mod_item->{$field}
 577                 and $item->{$field} )
 578             {
 579                 $item->{ $field . '_on' } =
 580                   DateTime::Format::MySQL->format_datetime( dt_from_string() );
 581             }
 582         }
 583     }
 584
 585     # If the field is defined but empty, we are removing and,
 586     # and thus need to clear out the 'on' field as well
 587     for my $field (@fields) {
 588         if ( defined( $item->{$field} ) && !$item->{$field} ) {
 589             $item->{ $field . '_on' } = undef;
 590         }
 591     }
 592
 593
 594     _set_derived_columns_for_mod($item);
 595     _do_column_fixes_for_mod($item);
 596     # FIXME add checks
 597     # duplicate barcode
 598     # attempt to change itemnumber
 599     # attempt to change biblionumber (if we want
 600     # an API to relink an item to a different bib,
 601     # it should be a separate function)
 602
 603     # update items table
 604     _koha_modify_item($item);
 605
 606     # request that bib be reindexed so that searching on current
 607     # item status is possible
 608     ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
 609
 610     logaction("CATALOGUING", "MODIFY", $itemnumber, "item ".Dumper($item)) if C4::Context->preference("CataloguingLog");
 611 }
 612
 613 =head2 ModItemTransfer
 614
 615   ModItemTransfer($itenumber, $frombranch, $tobranch);
 616
 617 Marks an item as being transferred from one branch
 618 to another.
 619
 620 =cut
 621
 622 sub ModItemTransfer {
 623     my ( $itemnumber, $frombranch, $tobranch ) = @_;
 624
 625     my $dbh = C4::Context->dbh;
 626
 627     # Remove the 'shelving cart' location status if it is being used.
 628     CartToShelf( $itemnumber ) if ( C4::Context->preference("ReturnToShelvingCart") );
 629
 630     #new entry in branchtransfers....
 631     my $sth = $dbh->prepare(
 632         "INSERT INTO branchtransfers (itemnumber, frombranch, datesent, tobranch)
 633         VALUES (?, ?, NOW(), ?)");
 634     $sth->execute($itemnumber, $frombranch, $tobranch);
 635
 636     ModItem({ holdingbranch => $tobranch }, undef, $itemnumber);
 637     ModDateLastSeen($itemnumber);
 638     return;
 639 }
 640
 641 =head2 ModDateLastSeen
 642
 643   ModDateLastSeen($itemnum);
 644
 645 Mark item as seen. Is called when an item is issued, returned or manually marked during inventory/stocktaking.
 646 C<$itemnum> is the item number
 647
 648 =cut
 649
 650 sub ModDateLastSeen {
 651     my ($itemnumber) = @_;
 652
 653     my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
 654     ModItem({ itemlost => 0, datelastseen => $today }, undef, $itemnumber);
 655 }
 656
 657 =head2 DelItem
 658
 659   DelItem({ itemnumber => $itemnumber, [ biblionumber => $biblionumber ] } );
 660
 661 Exported function (core API) for deleting an item record in Koha.
 662
 663 =cut
 664
 665 sub DelItem {
 666     my ( $params ) = @_;
 667
 668     my $itemnumber   = $params->{itemnumber};
 669     my $biblionumber = $params->{biblionumber};
 670
 671     unless ($biblionumber) {
 672         $biblionumber = C4::Biblio::GetBiblionumberFromItemnumber($itemnumber);
 673     }
 674
 675     # If there is no biblionumber for the given itemnumber, there is nothing to delete
 676     return 0 unless $biblionumber;
 677
 678     # FIXME check the item has no current issues
 679     my $deleted = _koha_delete_item( $itemnumber );
 680
 681     # get the MARC record
 682     my $record = GetMarcBiblio($biblionumber);
 683     ModZebra( $biblionumber, "specialUpdate", "biblioserver" );
 684
 685     #search item field code
 686     logaction("CATALOGUING", "DELETE", $itemnumber, "item") if C4::Context->preference("CataloguingLog");
 687     return $deleted;
 688 }
 689
 690 =head2 CheckItemPreSave
 691
 692     my $item_ref = TransformMarcToKoha($marc, 'items');
 693     # do stuff
 694     my %errors = CheckItemPreSave($item_ref);
 695     if (exists $errors{'duplicate_barcode'}) {
 696         print "item has duplicate barcode: ", $errors{'duplicate_barcode'}, "\n";
 697     } elsif (exists $errors{'invalid_homebranch'}) {
 698         print "item has invalid home branch: ", $errors{'invalid_homebranch'}, "\n";
 699     } elsif (exists $errors{'invalid_holdingbranch'}) {
 700         print "item has invalid holding branch: ", $errors{'invalid_holdingbranch'}, "\n";
 701     } else {
 702         print "item is OK";
 703     }
 704
 705 Given a hashref containing item fields, determine if it can be
 706 inserted or updated in the database.  Specifically, checks for
 707 database integrity issues, and returns a hash containing any
 708 of the following keys, if applicable.
 709
 710 =over 2
 711
 712 =item duplicate_barcode
 713
 714 Barcode, if it duplicates one already found in the database.
 715
 716 =item invalid_homebranch
 717
 718 Home branch, if not defined in branches table.
 719
 720 =item invalid_holdingbranch
 721
 722 Holding branch, if not defined in branches table.
 723
 724 =back
 725
 726 This function does NOT implement any policy-related checks,
 727 e.g., whether current operator is allowed to save an
 728 item that has a given branch code.
 729
 730 =cut
 731
 732 sub CheckItemPreSave {
 733     my $item_ref = shift;
 734     require C4::Branch;
 735
 736     my %errors = ();
 737
 738     # check for duplicate barcode
 739     if (exists $item_ref->{'barcode'} and defined $item_ref->{'barcode'}) {
 740         my $existing_itemnumber = GetItemnumberFromBarcode($item_ref->{'barcode'});
 741         if ($existing_itemnumber) {
 742             if (!exists $item_ref->{'itemnumber'}                       # new item
 743                 or $item_ref->{'itemnumber'} != $existing_itemnumber) { # existing item
 744                 $errors{'duplicate_barcode'} = $item_ref->{'barcode'};
 745             }
 746         }
 747     }
 748
 749     # check for valid home branch
 750     if (exists $item_ref->{'homebranch'} and defined $item_ref->{'homebranch'}) {
 751         my $branch_name = C4::Branch::GetBranchName($item_ref->{'homebranch'});
 752         unless (defined $branch_name) {
 753             # relies on fact that branches.branchname is a non-NULL column,
 754             # so GetBranchName returns undef only if branch does not exist
 755             $errors{'invalid_homebranch'} = $item_ref->{'homebranch'};
 756         }
 757     }
 758
 759     # check for valid holding branch
 760     if (exists $item_ref->{'holdingbranch'} and defined $item_ref->{'holdingbranch'}) {
 761         my $branch_name = C4::Branch::GetBranchName($item_ref->{'holdingbranch'});
 762         unless (defined $branch_name) {
 763             # relies on fact that branches.branchname is a non-NULL column,
 764             # so GetBranchName returns undef only if branch does not exist
 765             $errors{'invalid_holdingbranch'} = $item_ref->{'holdingbranch'};
 766         }
 767     }
 768
 769     return %errors;
 770
 771 }
 772
 773 =head1 EXPORTED SPECIAL ACCESSOR FUNCTIONS
 774
 775 The following functions provide various ways of
 776 getting an item record, a set of item records, or
 777 lists of authorized values for certain item fields.
 778
 779 Some of the functions in this group are candidates
 780 for refactoring -- for example, some of the code
 781 in C<GetItemsByBiblioitemnumber> and C<GetItemsInfo>
 782 has copy-and-paste work.
 783
 784 =cut
 785
 786 =head2 GetItemStatus
 787
 788   $itemstatushash = GetItemStatus($fwkcode);
 789
 790 Returns a list of valid values for the
 791 C<items.notforloan> field.
 792
 793 NOTE: does B<not> return an individual item's
 794 status.
 795
 796 Can be MARC dependent.
 797 fwkcode is optional.
 798 But basically could be can be loan or not
 799 Create a status selector with the following code
 800
 801 =head3 in PERL SCRIPT
 802
 803  my $itemstatushash = getitemstatus;
 804  my @itemstatusloop;
 805  foreach my $thisstatus (keys %$itemstatushash) {
 806      my %row =(value => $thisstatus,
 807                  statusname => $itemstatushash->{$thisstatus}->{'statusname'},
 808              );
 809      push @itemstatusloop, \%row;
 810  }
 811  $template->param(statusloop=>\@itemstatusloop);
 812
 813 =head3 in TEMPLATE
 814
 815 <select name="statusloop" id="statusloop">
 816     <option value="">Default</option>
 817     [% FOREACH statusloo IN statusloop %]
 818         [% IF ( statusloo.selected ) %]
 819             <option value="[% statusloo.value %]" selected="selected">[% statusloo.statusname %]</option>
 820         [% ELSE %]
 821             <option value="[% statusloo.value %]">[% statusloo.statusname %]</option>
 822         [% END %]
 823     [% END %]
 824 </select>
 825
 826 =cut
 827
 828 sub GetItemStatus {
 829
 830     # returns a reference to a hash of references to status...
 831     my ($fwk) = @_;
 832     my %itemstatus;
 833     my $dbh = C4::Context->dbh;
 834     my $sth;
 835     $fwk = '' unless ($fwk);
 836     my ( $tag, $subfield ) =
 837       GetMarcFromKohaField( "items.notforloan", $fwk );
 838     if ( $tag and $subfield ) {
 839         my $sth =
 840           $dbh->prepare(
 841             "SELECT authorised_value
 842             FROM marc_subfield_structure
 843             WHERE tagfield=?
 844                 AND tagsubfield=?
 845                 AND frameworkcode=?
 846             "
 847           );
 848         $sth->execute( $tag, $subfield, $fwk );
 849         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 850             my $authvalsth =
 851               $dbh->prepare(
 852                 "SELECT authorised_value,lib
 853                 FROM authorised_values
 854                 WHERE category=?
 855                 ORDER BY lib
 856                 "
 857               );
 858             $authvalsth->execute($authorisedvaluecat);
 859             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 860                 $itemstatus{$authorisedvalue} = $lib;
 861             }
 862             return \%itemstatus;
 863             exit 1;
 864         }
 865         else {
 866
 867             #No authvalue list
 868             # build default
 869         }
 870     }
 871
 872     #No authvalue list
 873     #build default
 874     $itemstatus{"1"} = "Not For Loan";
 875     return \%itemstatus;
 876 }
 877
 878 =head2 GetItemLocation
 879
 880   $itemlochash = GetItemLocation($fwk);
 881
 882 Returns a list of valid values for the
 883 C<items.location> field.
 884
 885 NOTE: does B<not> return an individual item's
 886 location.
 887
 888 where fwk stands for an optional framework code.
 889 Create a location selector with the following code
 890
 891 =head3 in PERL SCRIPT
 892
 893   my $itemlochash = getitemlocation;
 894   my @itemlocloop;
 895   foreach my $thisloc (keys %$itemlochash) {
 896       my $selected = 1 if $thisbranch eq $branch;
 897       my %row =(locval => $thisloc,
 898                   selected => $selected,
 899                   locname => $itemlochash->{$thisloc},
 900                );
 901       push @itemlocloop, \%row;
 902   }
 903   $template->param(itemlocationloop => \@itemlocloop);
 904
 905 =head3 in TEMPLATE
 906
 907   <select name="location">
 908       <option value="">Default</option>
 909   <!-- TMPL_LOOP name="itemlocationloop" -->
 910       <option value="<!-- TMPL_VAR name="locval" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="locname" --></option>
 911   <!-- /TMPL_LOOP -->
 912   </select>
 913
 914 =cut
 915
 916 sub GetItemLocation {
 917
 918     # returns a reference to a hash of references to location...
 919     my ($fwk) = @_;
 920     my %itemlocation;
 921     my $dbh = C4::Context->dbh;
 922     my $sth;
 923     $fwk = '' unless ($fwk);
 924     my ( $tag, $subfield ) =
 925       GetMarcFromKohaField( "items.location", $fwk );
 926     if ( $tag and $subfield ) {
 927         my $sth =
 928           $dbh->prepare(
 929             "SELECT authorised_value
 930             FROM marc_subfield_structure
 931             WHERE tagfield=?
 932                 AND tagsubfield=?
 933                 AND frameworkcode=?"
 934           );
 935         $sth->execute( $tag, $subfield, $fwk );
 936         if ( my ($authorisedvaluecat) = $sth->fetchrow ) {
 937             my $authvalsth =
 938               $dbh->prepare(
 939                 "SELECT authorised_value,lib
 940                 FROM authorised_values
 941                 WHERE category=?
 942                 ORDER BY lib"
 943               );
 944             $authvalsth->execute($authorisedvaluecat);
 945             while ( my ( $authorisedvalue, $lib ) = $authvalsth->fetchrow ) {
 946                 $itemlocation{$authorisedvalue} = $lib;
 947             }
 948             return \%itemlocation;
 949             exit 1;
 950         }
 951         else {
 952
 953             #No authvalue list
 954             # build default
 955         }
 956     }
 957
 958     #No authvalue list
 959     #build default
 960     $itemlocation{"1"} = "Not For Loan";
 961     return \%itemlocation;
 962 }
 963
 964 =head2 GetLostItems
 965
 966   $items = GetLostItems( $where );
 967
 968 This function gets a list of lost items.
 969
 970 =over 2
 971
 972 =item input:
 973
 974 C<$where> is a hashref. it containts a field of the items table as key
 975 and the value to match as value. For example:
 976
 977 { barcode    => 'abc123',
 978   homebranch => 'CPL',    }
 979
 980 =item return:
 981
 982 C<$items> is a reference to an array full of hashrefs with columns
 983 from the "items" table as keys.
 984
 985 =item usage in the perl script:
 986
 987   my $where = { barcode => '0001548' };
 988   my $items = GetLostItems( $where );
 989   $template->param( itemsloop => $items );
 990
 991 =back
 992
 993 =cut
 994
 995 sub GetLostItems {
 996     # Getting input args.
 997     my $where   = shift;
 998     my $dbh     = C4::Context->dbh;
 999
1000     my $query   = "
1001         SELECT title, author, lib, itemlost, authorised_value, barcode, datelastseen, price, replacementprice, homebranch,
1002                itype, itemtype, holdingbranch, location, itemnotes, items.biblionumber as biblionumber, itemcallnumber
1003         FROM   items
1004             LEFT JOIN biblio ON (items.biblionumber = biblio.biblionumber)
1005             LEFT JOIN biblioitems ON (items.biblionumber = biblioitems.biblionumber)
1006             LEFT JOIN authorised_values ON (items.itemlost = authorised_values.authorised_value)
1007         WHERE
1008                 authorised_values.category = 'LOST'
1009                 AND itemlost IS NOT NULL
1010                 AND itemlost <> 0
1011     ";
1012     my @query_parameters;
1013     foreach my $key (keys %$where) {
1014         $query .= " AND $key LIKE ?";
1015         push @query_parameters, "%$where->{$key}%";
1016     }
1017
1018     my $sth = $dbh->prepare($query);
1019     $sth->execute( @query_parameters );
1020     my $items = [];
1021     while ( my $row = $sth->fetchrow_hashref ){
1022         push @$items, $row;
1023     }
1024     return $items;
1025 }
1026
1027 =head2 GetItemsForInventory
1028
1029 ($itemlist, $iTotalRecords) = GetItemsForInventory( {
1030   minlocation  => $minlocation,
1031   maxlocation  => $maxlocation,
1032   location     => $location,
1033   itemtype     => $itemtype,
1034   ignoreissued => $ignoreissued,
1035   datelastseen => $datelastseen,
1036   branchcode   => $branchcode,
1037   branch       => $branch,
1038   offset       => $offset,
1039   size         => $size,
1040   statushash   => $statushash,
1041   interface    => $interface,
1042 } );
1043
1044 Retrieve a list of title/authors/barcode/callnumber, for biblio inventory.
1045
1046 The sub returns a reference to a list of hashes, each containing
1047 itemnumber, author, title, barcode, item callnumber, and date last
1048 seen. It is ordered by callnumber then title.
1049
1050 The required minlocation & maxlocation parameters are used to specify a range of item callnumbers
1051 the datelastseen can be used to specify that you want to see items not seen since a past date only.
1052 offset & size can be used to retrieve only a part of the whole listing (defaut behaviour)
1053 $statushash requires a hashref that has the authorized values fieldname (intems.notforloan, etc...) as keys, and an arrayref of statuscodes we are searching for as values.
1054
1055 $iTotalRecords is the number of rows that would have been returned without the $offset, $size limit clause
1056
1057 =cut
1058
1059 sub GetItemsForInventory {
1060     my ( $parameters ) = @_;
1061     my $minlocation  = $parameters->{'minlocation'}  // '';
1062     my $maxlocation  = $parameters->{'maxlocation'}  // '';
1063     my $location     = $parameters->{'location'}     // '';
1064     my $itemtype     = $parameters->{'itemtype'}     // '';
1065     my $ignoreissued = $parameters->{'ignoreissued'} // '';
1066     my $datelastseen = $parameters->{'datelastseen'} // '';
1067     my $branchcode   = $parameters->{'branchcode'}   // '';
1068     my $branch       = $parameters->{'branch'}       // '';
1069     my $offset       = $parameters->{'offset'}       // '';
1070     my $size         = $parameters->{'size'}         // '';
1071     my $statushash   = $parameters->{'statushash'}   // '';
1072     my $interface    = $parameters->{'interface'}    // '';
1073
1074     my $dbh = C4::Context->dbh;
1075     my ( @bind_params, @where_strings );
1076
1077     my $select_columns = q{
1078         SELECT items.itemnumber, barcode, itemcallnumber, title, author, biblio.biblionumber, biblio.frameworkcode, datelastseen, homebranch, location, notforloan, damaged, itemlost, withdrawn, stocknumber
1079     };
1080     my $select_count = q{SELECT COUNT(*)};
1081     my $query = q{
1082         FROM items
1083         LEFT JOIN biblio ON items.biblionumber = biblio.biblionumber
1084         LEFT JOIN biblioitems on items.biblionumber = biblioitems.biblionumber
1085     };
1086     if ($statushash){
1087         for my $authvfield (keys %$statushash){
1088             if ( scalar @{$statushash->{$authvfield}} > 0 ){
1089                 my $joinedvals = join ',', @{$statushash->{$authvfield}};
1090                 push @where_strings, "$authvfield in (" . $joinedvals . ")";
1091             }
1092         }
1093     }
1094
1095     if ($minlocation) {
1096         push @where_strings, 'itemcallnumber >= ?';
1097         push @bind_params, $minlocation;
1098     }
1099
1100     if ($maxlocation) {
1101         push @where_strings, 'itemcallnumber <= ?';
1102         push @bind_params, $maxlocation;
1103     }
1104
1105     if ($datelastseen) {
1106         $datelastseen = output_pref({ str => $datelastseen, dateformat => 'iso', dateonly => 1 });
1107         push @where_strings, '(datelastseen < ? OR datelastseen IS NULL)';
1108         push @bind_params, $datelastseen;
1109     }
1110
1111     if ( $location ) {
1112         push @where_strings, 'items.location = ?';
1113         push @bind_params, $location;
1114     }
1115
1116     if ( $branchcode ) {
1117         if($branch eq "homebranch"){
1118         push @where_strings, 'items.homebranch = ?';
1119         }else{
1120             push @where_strings, 'items.holdingbranch = ?';
1121         }
1122         push @bind_params, $branchcode;
1123     }
1124
1125     if ( $itemtype ) {
1126         push @where_strings, 'biblioitems.itemtype = ?';
1127         push @bind_params, $itemtype;
1128     }
1129
1130     if ( $ignoreissued) {
1131         $query .= "LEFT JOIN issues ON items.itemnumber = issues.itemnumber ";
1132         push @where_strings, 'issues.date_due IS NULL';
1133     }
1134
1135     if ( @where_strings ) {
1136         $query .= 'WHERE ';
1137         $query .= join ' AND ', @where_strings;
1138     }
1139     $query .= ' ORDER BY items.cn_sort, itemcallnumber, title';
1140     my $count_query = $select_count . $query;
1141     $query .= " LIMIT $offset, $size" if ($offset and $size);
1142     $query = $select_columns . $query;
1143     my $sth = $dbh->prepare($query);
1144     $sth->execute( @bind_params );
1145
1146     my @results = ();
1147     my $tmpresults = $sth->fetchall_arrayref({});
1148     $sth = $dbh->prepare( $count_query );
1149     $sth->execute( @bind_params );
1150     my ($iTotalRecords) = $sth->fetchrow_array();
1151
1152     my $avmapping = C4::Koha::GetKohaAuthorisedValuesMapping( {
1153                       interface => $interface
1154                     } );
1155     foreach my $row (@$tmpresults) {
1156
1157         # Auth values
1158         foreach (keys %$row) {
1159             if (defined($avmapping->{"items.$_,".$row->{'frameworkcode'}.",".$row->{$_}})) {
1160                 $row->{$_} = $avmapping->{"items.$_,".$row->{'frameworkcode'}.",".$row->{$_}};
1161             }
1162         }
1163         push @results, $row;
1164     }
1165
1166     return (\@results, $iTotalRecords);
1167 }
1168
1169 =head2 GetItemsCount
1170
1171   $count = &GetItemsCount( $biblionumber);
1172
1173 This function return count of item with $biblionumber
1174
1175 =cut
1176
1177 sub GetItemsCount {
1178     my ( $biblionumber ) = @_;
1179     my $dbh = C4::Context->dbh;
1180     my $query = "SELECT count(*)
1181           FROM  items
1182           WHERE biblionumber=?";
1183     my $sth = $dbh->prepare($query);
1184     $sth->execute($biblionumber);
1185     my $count = $sth->fetchrow;
1186     return ($count);
1187 }
1188
1189 =head2 GetItemInfosOf
1190
1191   GetItemInfosOf(@itemnumbers);
1192
1193 =cut
1194
1195 sub GetItemInfosOf {
1196     my @itemnumbers = @_;
1197
1198     my $itemnumber_values = @itemnumbers ? join( ',', @itemnumbers ) : "''";
1199
1200     my $query = "
1201         SELECT *
1202         FROM items
1203         WHERE itemnumber IN ($itemnumber_values)
1204     ";
1205     return get_infos_of( $query, 'itemnumber' );
1206 }
1207
1208 =head2 GetItemsByBiblioitemnumber
1209
1210   GetItemsByBiblioitemnumber($biblioitemnumber);
1211
1212 Returns an arrayref of hashrefs suitable for use in a TMPL_LOOP
1213 Called by C<C4::XISBN>
1214
1215 =cut
1216
1217 sub GetItemsByBiblioitemnumber {
1218     my ( $bibitem ) = @_;
1219     my $dbh = C4::Context->dbh;
1220     my $sth = $dbh->prepare("SELECT * FROM items WHERE items.biblioitemnumber = ?") || die $dbh->errstr;
1221     # Get all items attached to a biblioitem
1222     my $i = 0;
1223     my @results;
1224     $sth->execute($bibitem) || die $sth->errstr;
1225     while ( my $data = $sth->fetchrow_hashref ) {
1226         # Foreach item, get circulation information
1227         my $sth2 = $dbh->prepare( "SELECT * FROM issues,borrowers
1228                                    WHERE itemnumber = ?
1229                                    AND issues.borrowernumber = borrowers.borrowernumber"
1230         );
1231         $sth2->execute( $data->{'itemnumber'} );
1232         if ( my $data2 = $sth2->fetchrow_hashref ) {
1233             # if item is out, set the due date and who it is out too
1234             $data->{'date_due'}   = $data2->{'date_due'};
1235             $data->{'cardnumber'} = $data2->{'cardnumber'};
1236             $data->{'borrowernumber'}   = $data2->{'borrowernumber'};
1237         }
1238         else {
1239             # set date_due to blank, so in the template we check itemlost, and withdrawn
1240             $data->{'date_due'} = '';
1241         }    # else
1242         # Find the last 3 people who borrowed this item.
1243         my $query2 = "SELECT * FROM old_issues, borrowers WHERE itemnumber = ?
1244                       AND old_issues.borrowernumber = borrowers.borrowernumber
1245                       ORDER BY returndate desc,timestamp desc LIMIT 3";
1246         $sth2 = $dbh->prepare($query2) || die $dbh->errstr;
1247         $sth2->execute( $data->{'itemnumber'} ) || die $sth2->errstr;
1248         my $i2 = 0;
1249         while ( my $data2 = $sth2->fetchrow_hashref ) {
1250             $data->{"timestamp$i2"} = $data2->{'timestamp'};
1251             $data->{"card$i2"}      = $data2->{'cardnumber'};
1252             $data->{"borrower$i2"}  = $data2->{'borrowernumber'};
1253             $i2++;
1254         }
1255         push(@results,$data);
1256     }
1257     return (\@results);
1258 }
1259
1260 =head2 GetItemsInfo
1261
1262   @results = GetItemsInfo($biblionumber);
1263
1264 Returns information about items with the given biblionumber.
1265
1266 C<GetItemsInfo> returns a list of references-to-hash. Each element
1267 contains a number of keys. Most of them are attributes from the
1268 C<biblio>, C<biblioitems>, C<items>, and C<itemtypes> tables in the
1269 Koha database. Other keys include:
1270
1271 =over 2
1272
1273 =item C<$data-E<gt>{branchname}>
1274
1275 The name (not the code) of the branch to which the book belongs.
1276
1277 =item C<$data-E<gt>{datelastseen}>
1278
1279 This is simply C<items.datelastseen>, except that while the date is
1280 stored in YYYY-MM-DD format in the database, here it is converted to
1281 DD/MM/YYYY format. A NULL date is returned as C<//>.
1282
1283 =item C<$data-E<gt>{datedue}>
1284
1285 =item C<$data-E<gt>{class}>
1286
1287 This is the concatenation of C<biblioitems.classification>, the book's
1288 Dewey code, and C<biblioitems.subclass>.
1289
1290 =item C<$data-E<gt>{ocount}>
1291
1292 I think this is the number of copies of the book available.
1293
1294 =item C<$data-E<gt>{order}>
1295
1296 If this is set, it is set to C<One Order>.
1297
1298 =back
1299
1300 =cut
1301
1302 sub GetItemsInfo {
1303     my ( $biblionumber ) = @_;
1304     my $dbh   = C4::Context->dbh;
1305     # note biblioitems.* must be avoided to prevent large marc and marcxml fields from killing performance.
1306     require C4::Languages;
1307     my $language = C4::Languages::getlanguage();
1308     my $query = "
1309     SELECT items.*,
1310            biblio.*,
1311            biblioitems.volume,
1312            biblioitems.number,
1313            biblioitems.itemtype,
1314            biblioitems.isbn,
1315            biblioitems.issn,
1316            biblioitems.publicationyear,
1317            biblioitems.publishercode,
1318            biblioitems.volumedate,
1319            biblioitems.volumedesc,
1320            biblioitems.lccn,
1321            biblioitems.url,
1322            items.notforloan as itemnotforloan,
1323            issues.borrowernumber,
1324            issues.date_due as datedue,
1325            issues.onsite_checkout,
1326            borrowers.cardnumber,
1327            borrowers.surname,
1328            borrowers.firstname,
1329            borrowers.branchcode as bcode,
1330            serial.serialseq,
1331            serial.publisheddate,
1332            itemtypes.description,
1333            COALESCE( localization.translation, itemtypes.description ) AS translated_description,
1334            itemtypes.notforloan as notforloan_per_itemtype,
1335            holding.branchurl,
1336            holding.branchname,
1337            holding.opac_info as holding_branch_opac_info,
1338            home.opac_info as home_branch_opac_info
1339     ";
1340     $query .= "
1341      FROM items
1342      LEFT JOIN branches AS holding ON items.holdingbranch = holding.branchcode
1343      LEFT JOIN branches AS home ON items.homebranch=home.branchcode
1344      LEFT JOIN biblio      ON      biblio.biblionumber     = items.biblionumber
1345      LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
1346      LEFT JOIN issues USING (itemnumber)
1347      LEFT JOIN borrowers USING (borrowernumber)
1348      LEFT JOIN serialitems USING (itemnumber)
1349      LEFT JOIN serial USING (serialid)
1350      LEFT JOIN itemtypes   ON   itemtypes.itemtype         = "
1351      . (C4::Context->preference('item-level_itypes') ? 'items.itype' : 'biblioitems.itemtype');
1352     $query .= q|
1353     LEFT JOIN localization ON itemtypes.itemtype = localization.code
1354         AND localization.entity = 'itemtypes'
1355         AND localization.lang = ?
1356     |;
1357
1358     $query .= " WHERE items.biblionumber = ? ORDER BY home.branchname, items.enumchron, LPAD( items.copynumber, 8, '0' ), items.dateaccessioned DESC" ;
1359     my $sth = $dbh->prepare($query);
1360     $sth->execute($language, $biblionumber);
1361     my $i = 0;
1362     my @results;
1363     my $serial;
1364
1365     my $userenv = C4::Context->userenv;
1366     my $want_not_same_branch = C4::Context->preference("IndependentBranches") && !C4::Context->IsSuperLibrarian();
1367     while ( my $data = $sth->fetchrow_hashref ) {
1368         if ( $data->{borrowernumber} && $want_not_same_branch) {
1369             $data->{'NOTSAMEBRANCH'} = $data->{'bcode'} ne $userenv->{branch};
1370         }
1371
1372         $serial ||= $data->{'serial'};
1373
1374         # get notforloan complete status if applicable
1375         if ( my $code = C4::Koha::GetAuthValCode( 'items.notforloan', $data->{frameworkcode} ) ) {
1376             $data->{notforloanvalue}     = C4::Koha::GetKohaAuthorisedValueLib( $code, $data->{itemnotforloan} );
1377             $data->{notforloanvalueopac} = C4::Koha::GetKohaAuthorisedValueLib( $code, $data->{itemnotforloan}, 1 );
1378         }
1379
1380         # get restricted status and description if applicable
1381         if ( my $code = C4::Koha::GetAuthValCode( 'items.restricted', $data->{frameworkcode} ) ) {
1382             $data->{restrictedopac} = C4::Koha::GetKohaAuthorisedValueLib( $code, $data->{restricted}, 1 );
1383             $data->{restricted}     = C4::Koha::GetKohaAuthorisedValueLib( $code, $data->{restricted} );
1384         }
1385
1386         # my stack procedures
1387         if ( my $code = C4::Koha::GetAuthValCode( 'items.stack', $data->{frameworkcode} ) ) {
1388             $data->{stack}          = C4::Koha::GetKohaAuthorisedValueLib( $code, $data->{stack} );
1389         }
1390
1391         # Find the last 3 people who borrowed this item.
1392         my $sth2 = $dbh->prepare("SELECT * FROM old_issues,borrowers
1393                                     WHERE itemnumber = ?
1394                                     AND old_issues.borrowernumber = borrowers.borrowernumber
1395                                     ORDER BY returndate DESC
1396                                     LIMIT 3");
1397         $sth2->execute($data->{'itemnumber'});
1398         my $ii = 0;
1399         while (my $data2 = $sth2->fetchrow_hashref()) {
1400             $data->{"timestamp$ii"} = $data2->{'timestamp'} if $data2->{'timestamp'};
1401             $data->{"card$ii"}      = $data2->{'cardnumber'} if $data2->{'cardnumber'};
1402             $data->{"borrower$ii"}  = $data2->{'borrowernumber'} if $data2->{'borrowernumber'};
1403             $ii++;
1404         }
1405
1406         $results[$i] = $data;
1407         $i++;
1408     }
1409
1410     return $serial
1411         ? sort { ($b->{'publisheddate'} || $b->{'enumchron'}) cmp ($a->{'publisheddate'} || $a->{'enumchron'}) } @results
1412         : @results;
1413 }
1414
1415 =head2 GetItemsLocationInfo
1416
1417   my @itemlocinfo = GetItemsLocationInfo($biblionumber);
1418
1419 Returns the branch names, shelving location and itemcallnumber for each item attached to the biblio in question
1420
1421 C<GetItemsInfo> returns a list of references-to-hash. Data returned:
1422
1423 =over 2
1424
1425 =item C<$data-E<gt>{homebranch}>
1426
1427 Branch Name of the item's homebranch
1428
1429 =item C<$data-E<gt>{holdingbranch}>
1430
1431 Branch Name of the item's holdingbranch
1432
1433 =item C<$data-E<gt>{location}>
1434
1435 Item's shelving location code
1436
1437 =item C<$data-E<gt>{location_intranet}>
1438
1439 The intranet description for the Shelving Location as set in authorised_values 'LOC'
1440
1441 =item C<$data-E<gt>{location_opac}>
1442
1443 The OPAC description for the Shelving Location as set in authorised_values 'LOC'.  Falls back to intranet description if no OPAC
1444 description is set.
1445
1446 =item C<$data-E<gt>{itemcallnumber}>
1447
1448 Item's itemcallnumber
1449
1450 =item C<$data-E<gt>{cn_sort}>
1451
1452 Item's call number normalized for sorting
1453
1454 =back
1455
1456 =cut
1457
1458 sub GetItemsLocationInfo {
1459         my $biblionumber = shift;
1460         my @results;
1461
1462         my $dbh = C4::Context->dbh;
1463         my $query = "SELECT a.branchname as homebranch, b.branchname as holdingbranch,
1464                             location, itemcallnumber, cn_sort
1465                      FROM items, branches as a, branches as b
1466                      WHERE homebranch = a.branchcode AND holdingbranch = b.branchcode
1467                      AND biblionumber = ?
1468                      ORDER BY cn_sort ASC";
1469         my $sth = $dbh->prepare($query);
1470         $sth->execute($biblionumber);
1471
1472         while ( my $data = $sth->fetchrow_hashref ) {
1473              $data->{location_intranet} = GetKohaAuthorisedValueLib('LOC', $data->{location});
1474              $data->{location_opac}= GetKohaAuthorisedValueLib('LOC', $data->{location}, 1);
1475              push @results, $data;
1476         }
1477         return @results;
1478 }
1479
1480 =head2 GetHostItemsInfo
1481
1482         $hostiteminfo = GetHostItemsInfo($hostfield);
1483         Returns the iteminfo for items linked to records via a host field
1484
1485 =cut
1486
1487 sub GetHostItemsInfo {
1488         my ($record) = @_;
1489         my @returnitemsInfo;
1490
1491         if (C4::Context->preference('marcflavour') eq 'MARC21' ||
1492         C4::Context->preference('marcflavour') eq 'NORMARC'){
1493             foreach my $hostfield ( $record->field('773') ) {
1494                 my $hostbiblionumber = $hostfield->subfield("0");
1495                 my $linkeditemnumber = $hostfield->subfield("9");
1496                 my @hostitemInfos = GetItemsInfo($hostbiblionumber);
1497                 foreach my $hostitemInfo (@hostitemInfos){
1498                         if ($hostitemInfo->{itemnumber} eq $linkeditemnumber){
1499                                 push (@returnitemsInfo,$hostitemInfo);
1500                                 last;
1501                         }
1502                 }
1503             }
1504         } elsif ( C4::Context->preference('marcflavour') eq 'UNIMARC'){
1505             foreach my $hostfield ( $record->field('461') ) {
1506                 my $hostbiblionumber = $hostfield->subfield("0");
1507                 my $linkeditemnumber = $hostfield->subfield("9");
1508                 my @hostitemInfos = GetItemsInfo($hostbiblionumber);
1509                 foreach my $hostitemInfo (@hostitemInfos){
1510                         if ($hostitemInfo->{itemnumber} eq $linkeditemnumber){
1511                                 push (@returnitemsInfo,$hostitemInfo);
1512                                 last;
1513                         }
1514                 }
1515             }
1516         }
1517         return @returnitemsInfo;
1518 }
1519
1520
1521 =head2 GetLastAcquisitions
1522
1523   my $lastacq = GetLastAcquisitions({'branches' => ('branch1','branch2'),
1524                                     'itemtypes' => ('BK','BD')}, 10);
1525
1526 =cut
1527
1528 sub  GetLastAcquisitions {
1529         my ($data,$max) = @_;
1530
1531         my $itemtype = C4::Context->preference('item-level_itypes') ? 'itype' : 'itemtype';
1532
1533         my $number_of_branches = @{$data->{branches}};
1534         my $number_of_itemtypes   = @{$data->{itemtypes}};
1535
1536
1537         my @where = ('WHERE 1 ');
1538         $number_of_branches and push @where
1539            , 'AND holdingbranch IN ('
1540            , join(',', ('?') x $number_of_branches )
1541            , ')'
1542          ;
1543
1544         $number_of_itemtypes and push @where
1545            , "AND $itemtype IN ("
1546            , join(',', ('?') x $number_of_itemtypes )
1547            , ')'
1548          ;
1549
1550         my $query = "SELECT biblio.biblionumber as biblionumber, title, dateaccessioned
1551                                  FROM items RIGHT JOIN biblio ON (items.biblionumber=biblio.biblionumber)
1552                                     RIGHT JOIN biblioitems ON (items.biblioitemnumber=biblioitems.biblioitemnumber)
1553                                     @where
1554                                     GROUP BY biblio.biblionumber
1555                                     ORDER BY dateaccessioned DESC LIMIT $max";
1556
1557         my $dbh = C4::Context->dbh;
1558         my $sth = $dbh->prepare($query);
1559
1560     $sth->execute((@{$data->{branches}}, @{$data->{itemtypes}}));
1561
1562         my @results;
1563         while( my $row = $sth->fetchrow_hashref){
1564                 push @results, {date => $row->{dateaccessioned}
1565                                                 , biblionumber => $row->{biblionumber}
1566                                                 , title => $row->{title}};
1567         }
1568
1569         return @results;
1570 }
1571
1572 =head2 GetItemnumbersForBiblio
1573
1574   my $itemnumbers = GetItemnumbersForBiblio($biblionumber);
1575
1576 Given a single biblionumber, return an arrayref of all the corresponding itemnumbers
1577
1578 =cut
1579
1580 sub GetItemnumbersForBiblio {
1581     my $biblionumber = shift;
1582     my @items;
1583     my $dbh = C4::Context->dbh;
1584     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
1585     $sth->execute($biblionumber);
1586     while (my $result = $sth->fetchrow_hashref) {
1587         push @items, $result->{'itemnumber'};
1588     }
1589     return \@items;
1590 }
1591
1592 =head2 get_itemnumbers_of
1593
1594   my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1595
1596 Given a list of biblionumbers, return the list of corresponding itemnumbers
1597 for each biblionumber.
1598
1599 Return a reference on a hash where keys are biblionumbers and values are
1600 references on array of itemnumbers.
1601
1602 =cut
1603
1604 sub get_itemnumbers_of {
1605     my @biblionumbers = @_;
1606
1607     my $dbh = C4::Context->dbh;
1608
1609     my $query = '
1610         SELECT itemnumber,
1611             biblionumber
1612         FROM items
1613         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1614     ';
1615     my $sth = $dbh->prepare($query);
1616     $sth->execute(@biblionumbers);
1617
1618     my %itemnumbers_of;
1619
1620     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1621         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1622     }
1623
1624     return \%itemnumbers_of;
1625 }
1626
1627 =head2 get_hostitemnumbers_of
1628
1629   my @itemnumbers_of = get_hostitemnumbers_of($biblionumber);
1630
1631 Given a biblionumber, return the list of corresponding itemnumbers that are linked to it via host fields
1632
1633 Return a reference on a hash where key is a biblionumber and values are
1634 references on array of itemnumbers.
1635
1636 =cut
1637
1638
1639 sub get_hostitemnumbers_of {
1640         my ($biblionumber) = @_;
1641         my $marcrecord = GetMarcBiblio($biblionumber);
1642         my (@returnhostitemnumbers,$tag, $biblio_s, $item_s);
1643
1644         my $marcflavor = C4::Context->preference('marcflavour');
1645         if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1646         $tag='773';
1647         $biblio_s='0';
1648         $item_s='9';
1649     } elsif ($marcflavor eq 'UNIMARC') {
1650         $tag='461';
1651         $biblio_s='0';
1652         $item_s='9';
1653     }
1654
1655     foreach my $hostfield ( $marcrecord->field($tag) ) {
1656         my $hostbiblionumber = $hostfield->subfield($biblio_s);
1657         my $linkeditemnumber = $hostfield->subfield($item_s);
1658         my @itemnumbers;
1659         if (my $itemnumbers = get_itemnumbers_of($hostbiblionumber)->{$hostbiblionumber})
1660         {
1661             @itemnumbers = @$itemnumbers;
1662         }
1663         foreach my $itemnumber (@itemnumbers){
1664             if ($itemnumber eq $linkeditemnumber){
1665                 push (@returnhostitemnumbers,$itemnumber);
1666                 last;
1667             }
1668         }
1669     }
1670     return @returnhostitemnumbers;
1671 }
1672
1673
1674 =head2 GetItemnumberFromBarcode
1675
1676   $result = GetItemnumberFromBarcode($barcode);
1677
1678 =cut
1679
1680 sub GetItemnumberFromBarcode {
1681     my ($barcode) = @_;
1682     my $dbh = C4::Context->dbh;
1683
1684     my $rq =
1685       $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?");
1686     $rq->execute($barcode);
1687     my ($result) = $rq->fetchrow;
1688     return ($result);
1689 }
1690
1691 =head2 GetBarcodeFromItemnumber
1692
1693   $result = GetBarcodeFromItemnumber($itemnumber);
1694
1695 =cut
1696
1697 sub GetBarcodeFromItemnumber {
1698     my ($itemnumber) = @_;
1699     my $dbh = C4::Context->dbh;
1700
1701     my $rq =
1702       $dbh->prepare("SELECT barcode FROM items WHERE items.itemnumber=?");
1703     $rq->execute($itemnumber);
1704     my ($result) = $rq->fetchrow;
1705     return ($result);
1706 }
1707
1708 =head2 GetHiddenItemnumbers
1709
1710     my @itemnumbers_to_hide = GetHiddenItemnumbers(@items);
1711
1712 Given a list of items it checks which should be hidden from the OPAC given
1713 the current configuration. Returns a list of itemnumbers corresponding to
1714 those that should be hidden.
1715
1716 =cut
1717
1718 sub GetHiddenItemnumbers {
1719     my (@items) = @_;
1720     my @resultitems;
1721
1722     my $yaml = C4::Context->preference('OpacHiddenItems');
1723     return () if (! $yaml =~ /\S/ );
1724     $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1725     my $hidingrules;
1726     eval {
1727         $hidingrules = YAML::Load($yaml);
1728     };
1729     if ($@) {
1730         warn "Unable to parse OpacHiddenItems syspref : $@";
1731         return ();
1732     }
1733     my $dbh = C4::Context->dbh;
1734
1735     # For each item
1736     foreach my $item (@items) {
1737
1738         # We check each rule
1739         foreach my $field (keys %$hidingrules) {
1740             my $val;
1741             if (exists $item->{$field}) {
1742                 $val = $item->{$field};
1743             }
1744             else {
1745                 my $query = "SELECT $field from items where itemnumber = ?";
1746                 $val = $dbh->selectrow_array($query, undef, $item->{'itemnumber'});
1747             }
1748             $val = '' unless defined $val;
1749
1750             # If the results matches the values in the yaml file
1751             if (any { $val eq $_ } @{$hidingrules->{$field}}) {
1752
1753                 # We add the itemnumber to the list
1754                 push @resultitems, $item->{'itemnumber'};
1755
1756                 # If at least one rule matched for an item, no need to test the others
1757                 last;
1758             }
1759         }
1760     }
1761     return @resultitems;
1762 }
1763
1764 =head3 get_item_authorised_values
1765
1766 find the types and values for all authorised values assigned to this item.
1767
1768 parameters: itemnumber
1769
1770 returns: a hashref malling the authorised value to the value set for this itemnumber
1771
1772     $authorised_values = {
1773              'CCODE'      => undef,
1774              'DAMAGED'    => '0',
1775              'LOC'        => '3',
1776              'LOST'       => '0'
1777              'NOT_LOAN'   => '0',
1778              'RESTRICTED' => undef,
1779              'STACK'      => undef,
1780              'WITHDRAWN'  => '0',
1781              'branches'   => 'CPL',
1782              'cn_source'  => undef,
1783              'itemtypes'  => 'SER',
1784            };
1785
1786 Notes: see C4::Biblio::get_biblio_authorised_values for a similar method at the biblio level.
1787
1788 =cut
1789
1790 sub get_item_authorised_values {
1791     my $itemnumber = shift;
1792
1793     # assume that these entries in the authorised_value table are item level.
1794     my $query = q(SELECT distinct authorised_value, kohafield
1795                     FROM marc_subfield_structure
1796                     WHERE kohafield like 'item%'
1797                       AND authorised_value != '' );
1798
1799     my $itemlevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
1800     my $iteminfo = GetItem( $itemnumber );
1801     # warn( Data::Dumper->Dump( [ $itemlevel_authorised_values ], [ 'itemlevel_authorised_values' ] ) );
1802     my $return;
1803     foreach my $this_authorised_value ( keys %$itemlevel_authorised_values ) {
1804         my $field = $itemlevel_authorised_values->{ $this_authorised_value }->{'kohafield'};
1805         $field =~ s/^items\.//;
1806         if ( exists $iteminfo->{ $field } ) {
1807             $return->{ $this_authorised_value } = $iteminfo->{ $field };
1808         }
1809     }
1810     # warn( Data::Dumper->Dump( [ $return ], [ 'return' ] ) );
1811     return $return;
1812 }
1813
1814 =head3 get_authorised_value_images
1815
1816 find a list of icons that are appropriate for display based on the
1817 authorised values for a biblio.
1818
1819 parameters: listref of authorised values, such as comes from
1820 get_item_authorised_values or
1821 from C4::Biblio::get_biblio_authorised_values
1822
1823 returns: listref of hashrefs for each image. Each hashref looks like this:
1824
1825       { imageurl => '/intranet-tmpl/prog/img/itemtypeimg/npl/WEB.gif',
1826         label    => '',
1827         category => '',
1828         value    => '', }
1829
1830 Notes: Currently, I put on the full path to the images on the staff
1831 side. This should either be configurable or not done at all. Since I
1832 have to deal with 'intranet' or 'opac' in
1833 get_biblio_authorised_values, perhaps I should be passing it in.
1834
1835 =cut
1836
1837 sub get_authorised_value_images {
1838     my $authorised_values = shift;
1839
1840     my @imagelist;
1841
1842     my $authorised_value_list = GetAuthorisedValues();
1843     # warn ( Data::Dumper->Dump( [ $authorised_value_list ], [ 'authorised_value_list' ] ) );
1844     foreach my $this_authorised_value ( @$authorised_value_list ) {
1845         if ( exists $authorised_values->{ $this_authorised_value->{'category'} }
1846              && $authorised_values->{ $this_authorised_value->{'category'} } eq $this_authorised_value->{'authorised_value'} ) {
1847             # warn ( Data::Dumper->Dump( [ $this_authorised_value ], [ 'this_authorised_value' ] ) );
1848             if ( defined $this_authorised_value->{'imageurl'} ) {
1849                 push @imagelist, { imageurl => C4::Koha::getitemtypeimagelocation( 'intranet', $this_authorised_value->{'imageurl'} ),
1850                                    label    => $this_authorised_value->{'lib'},
1851                                    category => $this_authorised_value->{'category'},
1852                                    value    => $this_authorised_value->{'authorised_value'}, };
1853             }
1854         }
1855     }
1856
1857     # warn ( Data::Dumper->Dump( [ \@imagelist ], [ 'imagelist' ] ) );
1858     return \@imagelist;
1859
1860 }
1861
1862 =head1 LIMITED USE FUNCTIONS
1863
1864 The following functions, while part of the public API,
1865 are not exported.  This is generally because they are
1866 meant to be used by only one script for a specific
1867 purpose, and should not be used in any other context
1868 without careful thought.
1869
1870 =cut
1871
1872 =head2 GetMarcItem
1873
1874   my $item_marc = GetMarcItem($biblionumber, $itemnumber);
1875
1876 Returns MARC::Record of the item passed in parameter.
1877 This function is meant for use only in C<cataloguing/additem.pl>,
1878 where it is needed to support that script's MARC-like
1879 editor.
1880
1881 =cut
1882
1883 sub GetMarcItem {
1884     my ( $biblionumber, $itemnumber ) = @_;
1885
1886     # GetMarcItem has been revised so that it does the following:
1887     #  1. Gets the item information from the items table.
1888     #  2. Converts it to a MARC field for storage in the bib record.
1889     #
1890     # The previous behavior was:
1891     #  1. Get the bib record.
1892     #  2. Return the MARC tag corresponding to the item record.
1893     #
1894     # The difference is that one treats the items row as authoritative,
1895     # while the other treats the MARC representation as authoritative
1896     # under certain circumstances.
1897
1898     my $itemrecord = GetItem($itemnumber);
1899
1900     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
1901     # Also, don't emit a subfield if the underlying field is blank.
1902
1903
1904     return Item2Marc($itemrecord,$biblionumber);
1905
1906 }
1907 sub Item2Marc {
1908         my ($itemrecord,$biblionumber)=@_;
1909     my $mungeditem = {
1910         map {
1911             defined($itemrecord->{$_}) && $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()
1912         } keys %{ $itemrecord }
1913     };
1914     my $itemmarc = TransformKohaToMarc($mungeditem);
1915     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",GetFrameworkCode($biblionumber)||'');
1916
1917     my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($mungeditem->{'items.more_subfields_xml'});
1918     if (defined $unlinked_item_subfields and $#$unlinked_item_subfields > -1) {
1919                 foreach my $field ($itemmarc->field($itemtag)){
1920             $field->add_subfields(@$unlinked_item_subfields);
1921         }
1922     }
1923         return $itemmarc;
1924 }
1925
1926 =head1 PRIVATE FUNCTIONS AND VARIABLES
1927
1928 The following functions are not meant to be called
1929 directly, but are documented in order to explain
1930 the inner workings of C<C4::Items>.
1931
1932 =cut
1933
1934 =head2 %derived_columns
1935
1936 This hash keeps track of item columns that
1937 are strictly derived from other columns in
1938 the item record and are not meant to be set
1939 independently.
1940
1941 Each key in the hash should be the name of a
1942 column (as named by TransformMarcToKoha).  Each
1943 value should be hashref whose keys are the
1944 columns on which the derived column depends.  The
1945 hashref should also contain a 'BUILDER' key
1946 that is a reference to a sub that calculates
1947 the derived value.
1948
1949 =cut
1950
1951 my %derived_columns = (
1952     'items.cn_sort' => {
1953         'itemcallnumber' => 1,
1954         'items.cn_source' => 1,
1955         'BUILDER' => \&_calc_items_cn_sort,
1956     }
1957 );
1958
1959 =head2 _set_derived_columns_for_add
1960
1961   _set_derived_column_for_add($item);
1962
1963 Given an item hash representing a new item to be added,
1964 calculate any derived columns.  Currently the only
1965 such column is C<items.cn_sort>.
1966
1967 =cut
1968
1969 sub _set_derived_columns_for_add {
1970     my $item = shift;
1971
1972     foreach my $column (keys %derived_columns) {
1973         my $builder = $derived_columns{$column}->{'BUILDER'};
1974         my $source_values = {};
1975         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1976             next if $source_column eq 'BUILDER';
1977             $source_values->{$source_column} = $item->{$source_column};
1978         }
1979         $builder->($item, $source_values);
1980     }
1981 }
1982
1983 =head2 _set_derived_columns_for_mod
1984
1985   _set_derived_column_for_mod($item);
1986
1987 Given an item hash representing a new item to be modified.
1988 calculate any derived columns.  Currently the only
1989 such column is C<items.cn_sort>.
1990
1991 This routine differs from C<_set_derived_columns_for_add>
1992 in that it needs to handle partial item records.  In other
1993 words, the caller of C<ModItem> may have supplied only one
1994 or two columns to be changed, so this function needs to
1995 determine whether any of the columns to be changed affect
1996 any of the derived columns.  Also, if a derived column
1997 depends on more than one column, but the caller is not
1998 changing all of then, this routine retrieves the unchanged
1999 values from the database in order to ensure a correct
2000 calculation.
2001
2002 =cut
2003
2004 sub _set_derived_columns_for_mod {
2005     my $item = shift;
2006
2007     foreach my $column (keys %derived_columns) {
2008         my $builder = $derived_columns{$column}->{'BUILDER'};
2009         my $source_values = {};
2010         my %missing_sources = ();
2011         my $must_recalc = 0;
2012         foreach my $source_column (keys %{ $derived_columns{$column} }) {
2013             next if $source_column eq 'BUILDER';
2014             if (exists $item->{$source_column}) {
2015                 $must_recalc = 1;
2016                 $source_values->{$source_column} = $item->{$source_column};
2017             } else {
2018                 $missing_sources{$source_column} = 1;
2019             }
2020         }
2021         if ($must_recalc) {
2022             foreach my $source_column (keys %missing_sources) {
2023                 $source_values->{$source_column} = _get_single_item_column($source_column, $item->{'itemnumber'});
2024             }
2025             $builder->($item, $source_values);
2026         }
2027     }
2028 }
2029
2030 =head2 _do_column_fixes_for_mod
2031
2032   _do_column_fixes_for_mod($item);
2033
2034 Given an item hashref containing one or more
2035 columns to modify, fix up certain values.
2036 Specifically, set to 0 any passed value
2037 of C<notforloan>, C<damaged>, C<itemlost>, or
2038 C<withdrawn> that is either undefined or
2039 contains the empty string.
2040
2041 =cut
2042
2043 sub _do_column_fixes_for_mod {
2044     my $item = shift;
2045
2046     if (exists $item->{'notforloan'} and
2047         (not defined $item->{'notforloan'} or $item->{'notforloan'} eq '')) {
2048         $item->{'notforloan'} = 0;
2049     }
2050     if (exists $item->{'damaged'} and
2051         (not defined $item->{'damaged'} or $item->{'damaged'} eq '')) {
2052         $item->{'damaged'} = 0;
2053     }
2054     if (exists $item->{'itemlost'} and
2055         (not defined $item->{'itemlost'} or $item->{'itemlost'} eq '')) {
2056         $item->{'itemlost'} = 0;
2057     }
2058     if (exists $item->{'withdrawn'} and
2059         (not defined $item->{'withdrawn'} or $item->{'withdrawn'} eq '')) {
2060         $item->{'withdrawn'} = 0;
2061     }
2062     if (exists $item->{location}
2063         and $item->{location} ne 'CART'
2064         and $item->{location} ne 'PROC'
2065         and not $item->{permanent_location}
2066     ) {
2067         $item->{'permanent_location'} = $item->{'location'};
2068     }
2069     if (exists $item->{'timestamp'}) {
2070         delete $item->{'timestamp'};
2071     }
2072 }
2073
2074 =head2 _get_single_item_column
2075
2076   _get_single_item_column($column, $itemnumber);
2077
2078 Retrieves the value of a single column from an C<items>
2079 row specified by C<$itemnumber>.
2080
2081 =cut
2082
2083 sub _get_single_item_column {
2084     my $column = shift;
2085     my $itemnumber = shift;
2086
2087     my $dbh = C4::Context->dbh;
2088     my $sth = $dbh->prepare("SELECT $column FROM items WHERE itemnumber = ?");
2089     $sth->execute($itemnumber);
2090     my ($value) = $sth->fetchrow();
2091     return $value;
2092 }
2093
2094 =head2 _calc_items_cn_sort
2095
2096   _calc_items_cn_sort($item, $source_values);
2097
2098 Helper routine to calculate C<items.cn_sort>.
2099
2100 =cut
2101
2102 sub _calc_items_cn_sort {
2103     my $item = shift;
2104     my $source_values = shift;
2105
2106     $item->{'items.cn_sort'} = GetClassSort($source_values->{'items.cn_source'}, $source_values->{'itemcallnumber'}, "");
2107 }
2108
2109 =head2 _set_defaults_for_add
2110
2111   _set_defaults_for_add($item_hash);
2112
2113 Given an item hash representing an item to be added, set
2114 correct default values for columns whose default value
2115 is not handled by the DBMS.  This includes the following
2116 columns:
2117
2118 =over 2
2119
2120 =item *
2121
2122 C<items.dateaccessioned>
2123
2124 =item *
2125
2126 C<items.notforloan>
2127
2128 =item *
2129
2130 C<items.damaged>
2131
2132 =item *
2133
2134 C<items.itemlost>
2135
2136 =item *
2137
2138 C<items.withdrawn>
2139
2140 =back
2141
2142 =cut
2143
2144 sub _set_defaults_for_add {
2145     my $item = shift;
2146     $item->{dateaccessioned} ||= output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
2147     $item->{$_} ||= 0 for (qw( notforloan damaged itemlost withdrawn));
2148 }
2149
2150 =head2 _koha_new_item
2151
2152   my ($itemnumber,$error) = _koha_new_item( $item, $barcode );
2153
2154 Perform the actual insert into the C<items> table.
2155
2156 =cut
2157
2158 sub _koha_new_item {
2159     my ( $item, $barcode ) = @_;
2160     my $dbh=C4::Context->dbh;
2161     my $error;
2162     $item->{permanent_location} //= $item->{location};
2163     my $query =
2164            "INSERT INTO items SET
2165             biblionumber        = ?,
2166             biblioitemnumber    = ?,
2167             barcode             = ?,
2168             dateaccessioned     = ?,
2169             booksellerid        = ?,
2170             homebranch          = ?,
2171             price               = ?,
2172             replacementprice    = ?,
2173             replacementpricedate = ?,
2174             datelastborrowed    = ?,
2175             datelastseen        = ?,
2176             stack               = ?,
2177             notforloan          = ?,
2178             damaged             = ?,
2179             itemlost            = ?,
2180             withdrawn           = ?,
2181             itemcallnumber      = ?,
2182             coded_location_qualifier = ?,
2183             restricted          = ?,
2184             itemnotes           = ?,
2185             itemnotes_nonpublic = ?,
2186             holdingbranch       = ?,
2187             paidfor             = ?,
2188             location            = ?,
2189             permanent_location  = ?,
2190             onloan              = ?,
2191             issues              = ?,
2192             renewals            = ?,
2193             reserves            = ?,
2194             cn_source           = ?,
2195             cn_sort             = ?,
2196             ccode               = ?,
2197             itype               = ?,
2198             materials           = ?,
2199             uri                 = ?,
2200             enumchron           = ?,
2201             more_subfields_xml  = ?,
2202             copynumber          = ?,
2203             stocknumber         = ?,
2204             new                 = ?
2205           ";
2206     my $sth = $dbh->prepare($query);
2207     my $today = output_pref({ dt => dt_from_string, dateformat => 'iso', dateonly => 1 });
2208    $sth->execute(
2209             $item->{'biblionumber'},
2210             $item->{'biblioitemnumber'},
2211             $barcode,
2212             $item->{'dateaccessioned'},
2213             $item->{'booksellerid'},
2214             $item->{'homebranch'},
2215             $item->{'price'},
2216             $item->{'replacementprice'},
2217             $item->{'replacementpricedate'} || $today,
2218             $item->{datelastborrowed},
2219             $item->{datelastseen} || $today,
2220             $item->{stack},
2221             $item->{'notforloan'},
2222             $item->{'damaged'},
2223             $item->{'itemlost'},
2224             $item->{'withdrawn'},
2225             $item->{'itemcallnumber'},
2226             $item->{'coded_location_qualifier'},
2227             $item->{'restricted'},
2228             $item->{'itemnotes'},
2229             $item->{'itemnotes_nonpublic'},
2230             $item->{'holdingbranch'},
2231             $item->{'paidfor'},
2232             $item->{'location'},
2233             $item->{'permanent_location'},
2234             $item->{'onloan'},
2235             $item->{'issues'},
2236             $item->{'renewals'},
2237             $item->{'reserves'},
2238             $item->{'items.cn_source'},
2239             $item->{'items.cn_sort'},
2240             $item->{'ccode'},
2241             $item->{'itype'},
2242             $item->{'materials'},
2243             $item->{'uri'},
2244             $item->{'enumchron'},
2245             $item->{'more_subfields_xml'},
2246             $item->{'copynumber'},
2247             $item->{'stocknumber'},
2248             $item->{'new'},
2249     );
2250
2251     my $itemnumber;
2252     if ( defined $sth->errstr ) {
2253         $error.="ERROR in _koha_new_item $query".$sth->errstr;
2254     }
2255     else {
2256         $itemnumber = $dbh->{'mysql_insertid'};
2257     }
2258
2259     return ( $itemnumber, $error );
2260 }
2261
2262 =head2 MoveItemFromBiblio
2263
2264   MoveItemFromBiblio($itenumber, $frombiblio, $tobiblio);
2265
2266 Moves an item from a biblio to another
2267
2268 Returns undef if the move failed or the biblionumber of the destination record otherwise
2269
2270 =cut
2271
2272 sub MoveItemFromBiblio {
2273     my ($itemnumber, $frombiblio, $tobiblio) = @_;
2274     my $dbh = C4::Context->dbh;
2275     my ( $tobiblioitem ) = $dbh->selectrow_array(q|
2276         SELECT biblioitemnumber
2277         FROM biblioitems
2278         WHERE biblionumber = ?
2279     |, undef, $tobiblio );
2280     my $return = $dbh->do(q|
2281         UPDATE items
2282         SET biblioitemnumber = ?,
2283             biblionumber = ?
2284         WHERE itemnumber = ?
2285             AND biblionumber = ?
2286     |, undef, $tobiblioitem, $tobiblio, $itemnumber, $frombiblio );
2287     if ($return == 1) {
2288         ModZebra( $tobiblio, "specialUpdate", "biblioserver" );
2289         ModZebra( $frombiblio, "specialUpdate", "biblioserver" );
2290             # Checking if the item we want to move is in an order
2291         require C4::Acquisition;
2292         my $order = C4::Acquisition::GetOrderFromItemnumber($itemnumber);
2293             if ($order) {
2294                     # Replacing the biblionumber within the order if necessary
2295                     $order->{'biblionumber'} = $tobiblio;
2296                 C4::Acquisition::ModOrder($order);
2297             }
2298
2299         # Update reserves, hold_fill_targets, tmp_holdsqueue and linktracker tables
2300         for my $table_name ( qw( reserves hold_fill_targets tmp_holdsqueue linktracker ) ) {
2301             $dbh->do( qq|
2302                 UPDATE $table_name
2303                 SET biblionumber = ?
2304                 WHERE itemnumber = ?
2305             |, undef, $tobiblio, $itemnumber );
2306         }
2307         return $tobiblio;
2308         }
2309     return;
2310 }
2311
2312 =head2 DelItemCheck
2313
2314    DelItemCheck($dbh, $biblionumber, $itemnumber);
2315
2316 Exported function (core API) for deleting an item record in Koha if there no current issue.
2317
2318 =cut
2319
2320 sub DelItemCheck {
2321     my ( $dbh, $biblionumber, $itemnumber ) = @_;
2322
2323     $dbh ||= C4::Context->dbh;
2324
2325     my $error;
2326
2327         my $countanalytics=GetAnalyticsCount($itemnumber);
2328
2329
2330     # check that there is no issue on this item before deletion.
2331     my $sth = $dbh->prepare(q{
2332         SELECT COUNT(*) FROM issues
2333         WHERE itemnumber = ?
2334     });
2335     $sth->execute($itemnumber);
2336     my ($onloan) = $sth->fetchrow;
2337
2338     my $item = GetItem($itemnumber);
2339
2340     if ($onloan){
2341         $error = "book_on_loan"
2342     }
2343     elsif ( defined C4::Context->userenv
2344         and !C4::Context->IsSuperLibrarian()
2345         and C4::Context->preference("IndependentBranches")
2346         and ( C4::Context->userenv->{branch} ne $item->{'homebranch'} ) )
2347     {
2348         $error = "not_same_branch";
2349     }
2350         else{
2351         # check it doesn't have a waiting reserve
2352         $sth = $dbh->prepare(q{
2353             SELECT COUNT(*) FROM reserves
2354             WHERE (found = 'W' OR found = 'T')
2355             AND itemnumber = ?
2356         });
2357         $sth->execute($itemnumber);
2358         my ($reserve) = $sth->fetchrow;
2359         if ($reserve){
2360             $error = "book_reserved";
2361         } elsif ($countanalytics > 0){
2362                 $error = "linked_analytics";
2363         } else {
2364             DelItem(
2365                 {
2366                     biblionumber => $biblionumber,
2367                     itemnumber   => $itemnumber
2368                 }
2369             );
2370             return 1;
2371         }
2372     }
2373     return $error;
2374 }
2375
2376 =head2 _koha_modify_item
2377
2378   my ($itemnumber,$error) =_koha_modify_item( $item );
2379
2380 Perform the actual update of the C<items> row.  Note that this
2381 routine accepts a hashref specifying the columns to update.
2382
2383 =cut
2384
2385 sub _koha_modify_item {
2386     my ( $item ) = @_;
2387     my $dbh=C4::Context->dbh;
2388     my $error;
2389
2390     my $query = "UPDATE items SET ";
2391     my @bind;
2392     for my $key ( keys %$item ) {
2393         next if ( $key eq 'itemnumber' );
2394         $query.="$key=?,";
2395         push @bind, $item->{$key};
2396     }
2397     $query =~ s/,$//;
2398     $query .= " WHERE itemnumber=?";
2399     push @bind, $item->{'itemnumber'};
2400     my $sth = $dbh->prepare($query);
2401     $sth->execute(@bind);
2402     if ( $sth->err ) {
2403         $error.="ERROR in _koha_modify_item $query: ".$sth->errstr;
2404         warn $error;
2405     }
2406     return ($item->{'itemnumber'},$error);
2407 }
2408
2409 =head2 _koha_delete_item
2410
2411   _koha_delete_item( $itemnum );
2412
2413 Internal function to delete an item record from the koha tables
2414
2415 =cut
2416
2417 sub _koha_delete_item {
2418     my ( $itemnum ) = @_;
2419
2420     my $dbh = C4::Context->dbh;
2421     # save the deleted item to deleteditems table
2422     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
2423     $sth->execute($itemnum);
2424     my $data = $sth->fetchrow_hashref();
2425
2426     # There is no item to delete
2427     return 0 unless $data;
2428
2429     my $query = "INSERT INTO deleteditems SET ";
2430     my @bind  = ();
2431     foreach my $key ( keys %$data ) {
2432         next if ( $key eq 'timestamp' ); # timestamp will be set by db
2433         $query .= "$key = ?,";
2434         push( @bind, $data->{$key} );
2435     }
2436     $query =~ s/\,$//;
2437     $sth = $dbh->prepare($query);
2438     $sth->execute(@bind);
2439
2440     # delete from items table
2441     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
2442     my $deleted = $sth->execute($itemnum);
2443     return ( $deleted == 1 ) ? 1 : 0;
2444 }
2445
2446 =head2 _marc_from_item_hash
2447
2448   my $item_marc = _marc_from_item_hash($item, $frameworkcode[, $unlinked_item_subfields]);
2449
2450 Given an item hash representing a complete item record,
2451 create a C<MARC::Record> object containing an embedded
2452 tag representing that item.
2453
2454 The third, optional parameter C<$unlinked_item_subfields> is
2455 an arrayref of subfields (not mapped to C<items> fields per the
2456 framework) to be added to the MARC representation
2457 of the item.
2458
2459 =cut
2460
2461 sub _marc_from_item_hash {
2462     my $item = shift;
2463     my $frameworkcode = shift;
2464     my $unlinked_item_subfields;
2465     if (@_) {
2466         $unlinked_item_subfields = shift;
2467     }
2468
2469     # Tack on 'items.' prefix to column names so lookup from MARC frameworks will work
2470     # Also, don't emit a subfield if the underlying field is blank.
2471     my $mungeditem = { map {  (defined($item->{$_}) and $item->{$_} ne '') ?
2472                                 (/^items\./ ? ($_ => $item->{$_}) : ("items.$_" => $item->{$_}))
2473                                 : ()  } keys %{ $item } };
2474
2475     my $item_marc = MARC::Record->new();
2476     foreach my $item_field ( keys %{$mungeditem} ) {
2477         my ( $tag, $subfield ) = GetMarcFromKohaField( $item_field, $frameworkcode );
2478         next unless defined $tag and defined $subfield;    # skip if not mapped to MARC field
2479         my @values = split(/\s?\|\s?/, $mungeditem->{$item_field}, -1);
2480         foreach my $value (@values){
2481             if ( my $field = $item_marc->field($tag) ) {
2482                     $field->add_subfields( $subfield => $value );
2483             } else {
2484                 my $add_subfields = [];
2485                 if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
2486                     $add_subfields = $unlinked_item_subfields;
2487             }
2488             $item_marc->add_fields( $tag, " ", " ", $subfield => $value, @$add_subfields );
2489             }
2490         }
2491     }
2492
2493     return $item_marc;
2494 }
2495
2496 =head2 _repack_item_errors
2497
2498 Add an error message hash generated by C<CheckItemPreSave>
2499 to a list of errors.
2500
2501 =cut
2502
2503 sub _repack_item_errors {
2504     my $item_sequence_num = shift;
2505     my $item_ref = shift;
2506     my $error_ref = shift;
2507
2508     my @repacked_errors = ();
2509
2510     foreach my $error_code (sort keys %{ $error_ref }) {
2511         my $repacked_error = {};
2512         $repacked_error->{'item_sequence'} = $item_sequence_num;
2513         $repacked_error->{'item_barcode'} = exists($item_ref->{'barcode'}) ? $item_ref->{'barcode'} : '';
2514         $repacked_error->{'error_code'} = $error_code;
2515         $repacked_error->{'error_information'} = $error_ref->{$error_code};
2516         push @repacked_errors, $repacked_error;
2517     }
2518
2519     return @repacked_errors;
2520 }
2521
2522 =head2 _get_unlinked_item_subfields
2523
2524   my $unlinked_item_subfields = _get_unlinked_item_subfields($original_item_marc, $frameworkcode);
2525
2526 =cut
2527
2528 sub _get_unlinked_item_subfields {
2529     my $original_item_marc = shift;
2530     my $frameworkcode = shift;
2531
2532     my $marcstructure = GetMarcStructure(1, $frameworkcode);
2533
2534     # assume that this record has only one field, and that that
2535     # field contains only the item information
2536     my $subfields = [];
2537     my @fields = $original_item_marc->fields();
2538     if ($#fields > -1) {
2539         my $field = $fields[0];
2540             my $tag = $field->tag();
2541         foreach my $subfield ($field->subfields()) {
2542             if (defined $subfield->[1] and
2543                 $subfield->[1] ne '' and
2544                 !$marcstructure->{$tag}->{$subfield->[0]}->{'kohafield'}) {
2545                 push @$subfields, $subfield->[0] => $subfield->[1];
2546             }
2547         }
2548     }
2549     return $subfields;
2550 }
2551
2552 =head2 _get_unlinked_subfields_xml
2553
2554   my $unlinked_subfields_xml = _get_unlinked_subfields_xml($unlinked_item_subfields);
2555
2556 =cut
2557
2558 sub _get_unlinked_subfields_xml {
2559     my $unlinked_item_subfields = shift;
2560
2561     my $xml;
2562     if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
2563         my $marc = MARC::Record->new();
2564         # use of tag 999 is arbitrary, and doesn't need to match the item tag
2565         # used in the framework
2566         $marc->append_fields(MARC::Field->new('999', ' ', ' ', @$unlinked_item_subfields));
2567         $marc->encoding("UTF-8");
2568         $xml = $marc->as_xml("USMARC");
2569     }
2570
2571     return $xml;
2572 }
2573
2574 =head2 _parse_unlinked_item_subfields_from_xml
2575
2576   my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($whole_item->{'more_subfields_xml'}):
2577
2578 =cut
2579
2580 sub  _parse_unlinked_item_subfields_from_xml {
2581     my $xml = shift;
2582     require C4::Charset;
2583     return unless defined $xml and $xml ne "";
2584     my $marc = MARC::Record->new_from_xml(C4::Charset::StripNonXmlChars($xml),'UTF-8');
2585     my $unlinked_subfields = [];
2586     my @fields = $marc->fields();
2587     if ($#fields > -1) {
2588         foreach my $subfield ($fields[0]->subfields()) {
2589             push @$unlinked_subfields, $subfield->[0] => $subfield->[1];
2590         }
2591     }
2592     return $unlinked_subfields;
2593 }
2594
2595 =head2 GetAnalyticsCount
2596
2597   $count= &GetAnalyticsCount($itemnumber)
2598
2599 counts Usage of itemnumber in Analytical bibliorecords.
2600
2601 =cut
2602
2603 sub GetAnalyticsCount {
2604     my ($itemnumber) = @_;
2605     require C4::Search;
2606
2607     ### ZOOM search here
2608     my $query;
2609     $query= "hi=".$itemnumber;
2610             my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10);
2611     return ($result);
2612 }
2613
2614 =head2 GetItemHolds
2615
2616   $holds = &GetItemHolds($biblionumber, $itemnumber);
2617
2618 This function return the count of holds with $biblionumber and $itemnumber
2619
2620 =cut
2621
2622 sub GetItemHolds {
2623     my ($biblionumber, $itemnumber) = @_;
2624     my $holds;
2625     my $dbh            = C4::Context->dbh;
2626     my $query          = "SELECT count(*)
2627         FROM  reserves
2628         WHERE biblionumber=? AND itemnumber=?";
2629     my $sth = $dbh->prepare($query);
2630     $sth->execute($biblionumber, $itemnumber);
2631     $holds = $sth->fetchrow;
2632     return $holds;
2633 }
2634
2635 =head2 SearchItemsByField
2636
2637     my $items = SearchItemsByField($field, $value);
2638
2639 SearchItemsByField will search for items on a specific given field.
2640 For instance you can search all items with a specific stocknumber like this:
2641
2642     my $items = SearchItemsByField('stocknumber', $stocknumber);
2643
2644 =cut
2645
2646 sub SearchItemsByField {
2647     my ($field, $value) = @_;
2648
2649     my $filters = {
2650         field => $field,
2651         query => $value,
2652     };
2653
2654     my ($results) = SearchItems($filters);
2655     return $results;
2656 }
2657
2658 sub _SearchItems_build_where_fragment {
2659     my ($filter) = @_;
2660
2661     my $dbh = C4::Context->dbh;
2662
2663     my $where_fragment;
2664     if (exists($filter->{conjunction})) {
2665         my (@where_strs, @where_args);
2666         foreach my $f (@{ $filter->{filters} }) {
2667             my $fragment = _SearchItems_build_where_fragment($f);
2668             if ($fragment) {
2669                 push @where_strs, $fragment->{str};
2670                 push @where_args, @{ $fragment->{args} };
2671             }
2672         }
2673         my $where_str = '';
2674         if (@where_strs) {
2675             $where_str = '(' . join (' ' . $filter->{conjunction} . ' ', @where_strs) . ')';
2676             $where_fragment = {
2677                 str => $where_str,
2678                 args => \@where_args,
2679             };
2680         }
2681     } else {
2682         my @columns = Koha::Database->new()->schema()->resultset('Item')->result_source->columns;
2683         push @columns, Koha::Database->new()->schema()->resultset('Biblio')->result_source->columns;
2684         push @columns, Koha::Database->new()->schema()->resultset('Biblioitem')->result_source->columns;
2685         my @operators = qw(= != > < >= <= like);
2686         my $field = $filter->{field};
2687         if ( (0 < grep /^$field$/, @columns) or (substr($field, 0, 5) eq 'marc:') ) {
2688             my $op = $filter->{operator};
2689             my $query = $filter->{query};
2690
2691             if (!$op or (0 == grep /^$op$/, @operators)) {
2692                 $op = '='; # default operator
2693             }
2694
2695             my $column;
2696             if ($field =~ /^marc:(\d{3})(?:\$(\w))?$/) {
2697                 my $marcfield = $1;
2698                 my $marcsubfield = $2;
2699                 my ($kohafield) = $dbh->selectrow_array(q|
2700                     SELECT kohafield FROM marc_subfield_structure
2701                     WHERE tagfield=? AND tagsubfield=? AND frameworkcode=''
2702                 |, undef, $marcfield, $marcsubfield);
2703
2704                 if ($kohafield) {
2705                     $column = $kohafield;
2706                 } else {
2707                     # MARC field is not linked to a DB field so we need to use
2708                     # ExtractValue on biblioitems.marcxml or
2709                     # items.more_subfields_xml, depending on the MARC field.
2710                     my $xpath;
2711                     my $sqlfield;
2712                     my ($itemfield) = GetMarcFromKohaField('items.itemnumber');
2713                     if ($marcfield eq $itemfield) {
2714                         $sqlfield = 'more_subfields_xml';
2715                         $xpath = '//record/datafield/subfield[@code="' . $marcsubfield . '"]';
2716                     } else {
2717                         $sqlfield = 'marcxml';
2718                         if ($marcfield < 10) {
2719                             $xpath = "//record/controlfield[\@tag=\"$marcfield\"]";
2720                         } else {
2721                             $xpath = "//record/datafield[\@tag=\"$marcfield\"]/subfield[\@code=\"$marcsubfield\"]";
2722                         }
2723                     }
2724                     $column = "ExtractValue($sqlfield, '$xpath')";
2725                 }
2726             } else {
2727                 $column = $field;
2728             }
2729
2730             if (ref $query eq 'ARRAY') {
2731                 if ($op eq '=') {
2732                     $op = 'IN';
2733                 } elsif ($op eq '!=') {
2734                     $op = 'NOT IN';
2735                 }
2736                 $where_fragment = {
2737                     str => "$column $op (" . join (',', ('?') x @$query) . ")",
2738                     args => $query,
2739                 };
2740             } else {
2741                 $where_fragment = {
2742                     str => "$column $op ?",
2743                     args => [ $query ],
2744                 };
2745             }
2746         }
2747     }
2748
2749     return $where_fragment;
2750 }
2751
2752 =head2 SearchItems
2753
2754     my ($items, $total) = SearchItems($filter, $params);
2755
2756 Perform a search among items
2757
2758 $filter is a reference to a hash which can be a filter, or a combination of filters.
2759
2760 A filter has the following keys:
2761
2762 =over 2
2763
2764 =item * field: the name of a SQL column in table items
2765
2766 =item * query: the value to search in this column
2767
2768 =item * operator: comparison operator. Can be one of = != > < >= <= like
2769
2770 =back
2771
2772 A combination of filters hash the following keys:
2773
2774 =over 2
2775
2776 =item * conjunction: 'AND' or 'OR'
2777
2778 =item * filters: array ref of filters
2779
2780 =back
2781
2782 $params is a reference to a hash that can contain the following parameters:
2783
2784 =over 2
2785
2786 =item * rows: Number of items to return. 0 returns everything (default: 0)
2787
2788 =item * page: Page to return (return items from (page-1)*rows to (page*rows)-1)
2789                (default: 1)
2790
2791 =item * sortby: A SQL column name in items table to sort on
2792
2793 =item * sortorder: 'ASC' or 'DESC'
2794
2795 =back
2796
2797 =cut
2798
2799 sub SearchItems {
2800     my ($filter, $params) = @_;
2801
2802     $filter //= {};
2803     $params //= {};
2804     return unless ref $filter eq 'HASH';
2805     return unless ref $params eq 'HASH';
2806
2807     # Default parameters
2808     $params->{rows} ||= 0;
2809     $params->{page} ||= 1;
2810     $params->{sortby} ||= 'itemnumber';
2811     $params->{sortorder} ||= 'ASC';
2812
2813     my ($where_str, @where_args);
2814     my $where_fragment = _SearchItems_build_where_fragment($filter);
2815     if ($where_fragment) {
2816         $where_str = $where_fragment->{str};
2817         @where_args = @{ $where_fragment->{args} };
2818     }
2819
2820     my $dbh = C4::Context->dbh;
2821     my $query = q{
2822         SELECT SQL_CALC_FOUND_ROWS items.*
2823         FROM items
2824           LEFT JOIN biblio ON biblio.biblionumber = items.biblionumber
2825           LEFT JOIN biblioitems ON biblioitems.biblioitemnumber = items.biblioitemnumber
2826     };
2827     if (defined $where_str and $where_str ne '') {
2828         $query .= qq{ WHERE $where_str };
2829     }
2830
2831     my @columns = Koha::Database->new()->schema()->resultset('Item')->result_source->columns;
2832     push @columns, Koha::Database->new()->schema()->resultset('Biblio')->result_source->columns;
2833     push @columns, Koha::Database->new()->schema()->resultset('Biblioitem')->result_source->columns;
2834     my $sortby = (0 < grep {$params->{sortby} eq $_} @columns)
2835         ? $params->{sortby} : 'itemnumber';
2836     my $sortorder = (uc($params->{sortorder}) eq 'ASC') ? 'ASC' : 'DESC';
2837     $query .= qq{ ORDER BY $sortby $sortorder };
2838
2839     my $rows = $params->{rows};
2840     my @limit_args;
2841     if ($rows > 0) {
2842         my $offset = $rows * ($params->{page}-1);
2843         $query .= qq { LIMIT ?, ? };
2844         push @limit_args, $offset, $rows;
2845     }
2846
2847     my $sth = $dbh->prepare($query);
2848     my $rv = $sth->execute(@where_args, @limit_args);
2849
2850     return unless ($rv);
2851     my ($total_rows) = $dbh->selectrow_array(q{ SELECT FOUND_ROWS() });
2852
2853     return ($sth->fetchall_arrayref({}), $total_rows);
2854 }
2855
2856
2857 =head1  OTHER FUNCTIONS
2858
2859 =head2 _find_value
2860
2861   ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2862
2863 Find the given $subfield in the given $tag in the given
2864 MARC::Record $record.  If the subfield is found, returns
2865 the (indicators, value) pair; otherwise, (undef, undef) is
2866 returned.
2867
2868 PROPOSITION :
2869 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2870 I suggest we export it from this module.
2871
2872 =cut
2873
2874 sub _find_value {
2875     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2876     my @result;
2877     my $indicator;
2878     if ( $tagfield < 10 ) {
2879         if ( $record->field($tagfield) ) {
2880             push @result, $record->field($tagfield)->data();
2881         } else {
2882             push @result, "";
2883         }
2884     } else {
2885         foreach my $field ( $record->field($tagfield) ) {
2886             my @subfields = $field->subfields();
2887             foreach my $subfield (@subfields) {
2888                 if ( @$subfield[0] eq $insubfield ) {
2889                     push @result, @$subfield[1];
2890                     $indicator = $field->indicator(1) . $field->indicator(2);
2891                 }
2892             }
2893         }
2894     }
2895     return ( $indicator, @result );
2896 }
2897
2898
2899 =head2 PrepareItemrecordDisplay
2900
2901   PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode);
2902
2903 Returns a hash with all the fields for Display a given item data in a template
2904
2905 The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided
2906
2907 =cut
2908
2909 sub PrepareItemrecordDisplay {
2910
2911     my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_;
2912
2913     my $dbh = C4::Context->dbh;
2914     $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum;
2915     my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2916     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2917
2918     # return nothing if we don't have found an existing framework.
2919     return q{} unless $tagslib;
2920     my $itemrecord;
2921     if ($itemnum) {
2922         $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum );
2923     }
2924     my @loop_data;
2925
2926     my $branch_limit = C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
2927     my $query = qq{
2928         SELECT authorised_value,lib FROM authorised_values
2929     };
2930     $query .= qq{
2931         LEFT JOIN authorised_values_branches ON ( id = av_id )
2932     } if $branch_limit;
2933     $query .= qq{
2934         WHERE category = ?
2935     };
2936     $query .= qq{ AND ( branchcode = ? OR branchcode IS NULL )} if $branch_limit;
2937     $query .= qq{ ORDER BY lib};
2938     my $authorised_values_sth = $dbh->prepare( $query );
2939     foreach my $tag ( sort keys %{$tagslib} ) {
2940         my $previous_tag = '';
2941         if ( $tag ne '' ) {
2942
2943             # loop through each subfield
2944             my $cntsubf;
2945             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2946                 next unless ref $tagslib->{$tag}{$subfield}; # Not a valid subfield (mandatory, tab, lib)
2947                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2948                 my %subfield_data;
2949                 $subfield_data{tag}           = $tag;
2950                 $subfield_data{subfield}      = $subfield;
2951                 $subfield_data{countsubfield} = $cntsubf++;
2952                 $subfield_data{kohafield}     = $tagslib->{$tag}->{$subfield}->{'kohafield'};
2953                 $subfield_data{id}            = "tag_".$tag."_subfield_".$subfield."_".int(rand(1000000));
2954
2955                 #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2956                 $subfield_data{marc_lib}   = $tagslib->{$tag}->{$subfield}->{lib};
2957                 $subfield_data{mandatory}  = $tagslib->{$tag}->{$subfield}->{mandatory};
2958                 $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable};
2959                 $subfield_data{hidden}     = "display:none"
2960                   if ( ( $tagslib->{$tag}->{$subfield}->{hidden} > 4 )
2961                     || ( $tagslib->{$tag}->{$subfield}->{hidden} < -4 ) );
2962                 my ( $x, $defaultvalue );
2963                 if ($itemrecord) {
2964                     ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord );
2965                 }
2966                 $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue;
2967                 if ( !defined $defaultvalue ) {
2968                     $defaultvalue = q||;
2969                 } else {
2970                     $defaultvalue =~ s/"/&quot;/g;
2971                 }
2972
2973                 # search for itemcallnumber if applicable
2974                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2975                     && C4::Context->preference('itemcallnumber') ) {
2976                     my $CNtag      = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2977                     my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2978                     if ( $itemrecord and my $field = $itemrecord->field($CNtag) ) {
2979                         $defaultvalue = $field->subfield($CNsubfield);
2980                     }
2981                 }
2982                 if (   $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2983                     && $defaultvalues
2984                     && $defaultvalues->{'callnumber'} ) {
2985                     if( $itemrecord and $defaultvalues and not $itemrecord->field($subfield) ){
2986                         # if the item record exists, only use default value if the item has no callnumber
2987                         $defaultvalue = $defaultvalues->{callnumber};
2988                     } elsif ( !$itemrecord and $defaultvalues ) {
2989                         # if the item record *doesn't* exists, always use the default value
2990                         $defaultvalue = $defaultvalues->{callnumber};
2991                     }
2992                 }
2993                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
2994                     && $defaultvalues
2995                     && $defaultvalues->{'branchcode'} ) {
2996                     if ( $itemrecord and $defaultvalues and not $itemrecord->field($subfield) ) {
2997                         $defaultvalue = $defaultvalues->{branchcode};
2998                     }
2999                 }
3000                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.location' )
3001                     && $defaultvalues
3002                     && $defaultvalues->{'location'} ) {
3003
3004                     if ( $itemrecord and $defaultvalues and not $itemrecord->field($subfield) ) {
3005                         # if the item record exists, only use default value if the item has no locationr
3006                         $defaultvalue = $defaultvalues->{location};
3007                     } elsif ( !$itemrecord and $defaultvalues ) {
3008                         # if the item record *doesn't* exists, always use the default value
3009                         $defaultvalue = $defaultvalues->{location};
3010                     }
3011                 }
3012                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
3013                     my @authorised_values;
3014                     my %authorised_lib;
3015
3016                     # builds list, depending on authorised value...
3017                     #---- branch
3018                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
3019                         if (   ( C4::Context->preference("IndependentBranches") )
3020                             && !C4::Context->IsSuperLibrarian() ) {
3021                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" );
3022                             $sth->execute( C4::Context->userenv->{branch} );
3023                             push @authorised_values, ""
3024                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3025                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
3026                                 push @authorised_values, $branchcode;
3027                                 $authorised_lib{$branchcode} = $branchname;
3028                             }
3029                         } else {
3030                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" );
3031                             $sth->execute;
3032                             push @authorised_values, ""
3033                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3034                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
3035                                 push @authorised_values, $branchcode;
3036                                 $authorised_lib{$branchcode} = $branchname;
3037                             }
3038                         }
3039
3040                         $defaultvalue = C4::Context->userenv ? C4::Context->userenv->{branch} : undef;
3041                         if ( $defaultvalues and $defaultvalues->{branchcode} ) {
3042                             $defaultvalue = $defaultvalues->{branchcode};
3043                         }
3044
3045                         #----- itemtypes
3046                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
3047                         my $itemtypes = GetItemTypes( style => 'array' );
3048                         push @authorised_values, ""
3049                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3050                         for my $itemtype ( @$itemtypes ) {
3051                             push @authorised_values, $itemtype->{itemtype};
3052                             $authorised_lib{$itemtype->{itemtype}} = $itemtype->{translated_description};
3053                         }
3054                         #---- class_sources
3055                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
3056                         push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3057
3058                         my $class_sources = GetClassSources();
3059                         my $default_source = C4::Context->preference("DefaultClassificationSource");
3060
3061                         foreach my $class_source (sort keys %$class_sources) {
3062                             next unless $class_sources->{$class_source}->{'used'} or
3063                                         ($class_source eq $default_source);
3064                             push @authorised_values, $class_source;
3065                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
3066                         }
3067
3068                         $defaultvalue = $default_source;
3069
3070                         #---- "true" authorised value
3071                     } else {
3072                         $authorised_values_sth->execute(
3073                             $tagslib->{$tag}->{$subfield}->{authorised_value},
3074                             $branch_limit ? $branch_limit : ()
3075                         );
3076                         push @authorised_values, ""
3077                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
3078                         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
3079                             push @authorised_values, $value;
3080                             $authorised_lib{$value} = $lib;
3081                         }
3082                     }
3083                     $subfield_data{marc_value} = {
3084                         type    => 'select',
3085                         values  => \@authorised_values,
3086                         default => "$defaultvalue",
3087                         labels  => \%authorised_lib,
3088                     };
3089                 } elsif ( $tagslib->{$tag}->{$subfield}->{value_builder} ) {
3090                 # it is a plugin
3091                     require Koha::FrameworkPlugin;
3092                     my $plugin = Koha::FrameworkPlugin->new({
3093                         name => $tagslib->{$tag}->{$subfield}->{value_builder},
3094                         item_style => 1,
3095                     });
3096                     my $pars = { dbh => $dbh, record => undef, tagslib =>$tagslib, id => $subfield_data{id}, tabloop => undef };
3097                     $plugin->build( $pars );
3098                     if( !$plugin->errstr ) {
3099                         #TODO Move html to template; see report 12176/13397
3100                         my $tab= $plugin->noclick? '-1': '';
3101                         my $class= $plugin->noclick? ' disabled': '';
3102                         my $title= $plugin->noclick? 'No popup': 'Tag editor';
3103                         $subfield_data{marc_value} = qq[<input type="text" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="50" maxlength="255" /><a href="#" id="buttonDot_$subfield_data{id}" tabindex="$tab" class="buttonDot $class" title="$title">...</a>\n].$plugin->javascript;
3104                     } else {
3105                         warn $plugin->errstr;
3106                         $subfield_data{marc_value} = qq(<input type="text" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="50" maxlength="255" />); # supply default input form
3107                     }
3108                 }
3109                 elsif ( $tag eq '' ) {       # it's an hidden field
3110                     $subfield_data{marc_value} = qq(<input type="hidden" tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="50" maxlength="255" value="$defaultvalue" />);
3111                 }
3112                 elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {   # FIXME: shouldn't input type be "hidden" ?
3113                     $subfield_data{marc_value} = qq(<input type="text" tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="50" maxlength="255" value="$defaultvalue" />);
3114                 }
3115                 elsif ( length($defaultvalue) > 100
3116                             or (C4::Context->preference("marcflavour") eq "UNIMARC" and
3117                                   300 <= $tag && $tag < 400 && $subfield eq 'a' )
3118                             or (C4::Context->preference("marcflavour") eq "MARC21"  and
3119                                   500 <= $tag && $tag < 600                     )
3120                           ) {
3121                     # oversize field (textarea)
3122                     $subfield_data{marc_value} = qq(<textarea tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="50" maxlength="255">$defaultvalue</textarea>\n");
3123                 } else {
3124                     $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
3125                 }
3126                 push( @loop_data, \%subfield_data );
3127             }
3128         }
3129     }
3130     my $itemnumber;
3131     if ( $itemrecord && $itemrecord->field($itemtagfield) ) {
3132         $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield );
3133     }
3134     return {
3135         'itemtagfield'    => $itemtagfield,
3136         'itemtagsubfield' => $itemtagsubfield,
3137         'itemnumber'      => $itemnumber,
3138         'iteminformation' => \@loop_data
3139     };
3140 }
3141
3142 =head2 columns
3143
3144   my @columns = C4::Items::columns();
3145
3146 Returns an array of items' table columns on success,
3147 and an empty array on failure.
3148
3149 =cut
3150
3151 sub columns {
3152     my $rs = Koha::Database->new->schema->resultset('Item');
3153     return $rs->result_source->columns;
3154 }
3155
3156 =head2 biblioitems_columns
3157
3158   my @columns = C4::Items::biblioitems_columns();
3159
3160 Returns an array of biblioitems' table columns on success,
3161 and an empty array on failure.
3162
3163 =cut
3164
3165 sub biblioitems_columns {
3166     my $rs = Koha::Database->new->schema->resultset('Biblioitem');
3167     return $rs->result_source->columns;
3168 }
3169
3170 sub ToggleNewStatus {
3171     my ( $params ) = @_;
3172     my @rules = @{ $params->{rules} };
3173     my $report_only = $params->{report_only};
3174
3175     my $dbh = C4::Context->dbh;
3176     my @errors;
3177     my @item_columns = map { "items.$_" } C4::Items::columns;
3178     my @biblioitem_columns = map { "biblioitems.$_" } C4::Items::biblioitems_columns;
3179     my $report;
3180     for my $rule ( @rules ) {
3181         my $age = $rule->{age};
3182         my $conditions = $rule->{conditions};
3183         my $substitutions = $rule->{substitutions};
3184         my @params;
3185
3186         my $query = q|
3187             SELECT items.biblionumber, items.itemnumber
3188             FROM items
3189             LEFT JOIN biblioitems ON biblioitems.biblionumber = items.biblionumber
3190             WHERE 1
3191         |;
3192         for my $condition ( @$conditions ) {
3193             if (
3194                  grep {/^$condition->{field}$/} @item_columns
3195               or grep {/^$condition->{field}$/} @biblioitem_columns
3196             ) {
3197                 if ( $condition->{value} =~ /\|/ ) {
3198                     my @values = split /\|/, $condition->{value};
3199                     $query .= qq| AND $condition->{field} IN (|
3200                         . join( ',', ('?') x scalar @values )
3201                         . q|)|;
3202                     push @params, @values;
3203                 } else {
3204                     $query .= qq| AND $condition->{field} = ?|;
3205                     push @params, $condition->{value};
3206                 }
3207             }
3208         }
3209         if ( defined $age ) {
3210             $query .= q| AND TO_DAYS(NOW()) - TO_DAYS(dateaccessioned) >= ? |;
3211             push @params, $age;
3212         }
3213         my $sth = $dbh->prepare($query);
3214         $sth->execute( @params );
3215         while ( my $values = $sth->fetchrow_hashref ) {
3216             my $biblionumber = $values->{biblionumber};
3217             my $itemnumber = $values->{itemnumber};
3218             my $item = C4::Items::GetItem( $itemnumber );
3219             for my $substitution ( @$substitutions ) {
3220                 next unless $substitution->{field};
3221                 C4::Items::ModItem( {$substitution->{field} => $substitution->{value}}, $biblionumber, $itemnumber )
3222                     unless $report_only;
3223                 push @{ $report->{$itemnumber} }, $substitution;
3224             }
3225         }
3226     }
3227
3228     return $report;
3229 }
3230
3231
3232 1;