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