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