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