Merge remote-tracking branch 'origin/new/bug_5347'
[koha.git] / C4 / Items.pm
1 package C4::Items;
2
3 # Copyright 2007 LibLime, Inc.
4 # Parts Copyright Biblibre 2010
5 #
6 # This file is part of Koha.
7 #
8 # Koha is free software; you can redistribute it and/or modify it under the
9 # terms of the GNU General Public License as published by the Free Software
10 # Foundation; either version 2 of the License, or (at your option) any later
11 # version.
12 #
13 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
14 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
15 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License along
18 # with Koha; if not, write to the Free Software Foundation, Inc.,
19 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20
21 use strict;
22 #use warnings; FIXME - Bug 2505
23
24 use Carp;
25 use C4::Context;
26 use C4::Koha;
27 use C4::Biblio;
28 use C4::Dates qw/format_date format_date_in_iso/;
29 use MARC::Record;
30 use C4::ClassSource;
31 use C4::Log;
32 use List::MoreUtils qw/any/;
33 use Data::Dumper; # used as part of logging item record changes, not just for
34                   # debugging; so please don't remove this
35
36 use vars qw($VERSION @ISA @EXPORT);
37
38 BEGIN {
39     $VERSION = 3.01;
40
41         require Exporter;
42     @ISA = qw( Exporter );
43
44     # function exports
45     @EXPORT = qw(
46         GetItem
47         AddItemFromMarc
48         AddItem
49         AddItemBatchFromMarc
50         ModItemFromMarc
51                 Item2Marc
52         ModItem
53         ModDateLastSeen
54         ModItemTransfer
55         DelItem
56     
57         CheckItemPreSave
58     
59         GetItemStatus
60         GetItemLocation
61         GetLostItems
62         GetItemsForInventory
63         GetItemsCount
64         GetItemInfosOf
65         GetItemsByBiblioitemnumber
66         GetItemsInfo
67         GetItemsLocationInfo
68         GetHostItemsInfo
69         GetItemnumbersForBiblio
70         get_itemnumbers_of
71         get_hostitemnumbers_of
72         GetItemnumberFromBarcode
73         GetBarcodeFromItemnumber
74         GetHiddenItemnumbers
75                 DelItemCheck
76                 MoveItemFromBiblio 
77                 GetLatestAcquisitions
78         CartToShelf
79
80         GetAnalyticsCount
81         GetItemHolds
82
83
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 GetItemnumbersForBiblio
1500
1501   my $itemnumbers = GetItemnumbersForBiblio($biblionumber);
1502
1503 Given a single biblionumber, return an arrayref of all the corresponding itemnumbers
1504
1505 =cut
1506
1507 sub GetItemnumbersForBiblio {
1508     my $biblionumber = shift;
1509     my @items;
1510     my $dbh = C4::Context->dbh;
1511     my $sth = $dbh->prepare("SELECT itemnumber FROM items WHERE biblionumber = ?");
1512     $sth->execute($biblionumber);
1513     while (my $result = $sth->fetchrow_hashref) {
1514         push @items, $result->{'itemnumber'};
1515     }
1516     return \@items;
1517 }
1518
1519 =head2 get_itemnumbers_of
1520
1521   my @itemnumbers_of = get_itemnumbers_of(@biblionumbers);
1522
1523 Given a list of biblionumbers, return the list of corresponding itemnumbers
1524 for each biblionumber.
1525
1526 Return a reference on a hash where keys are biblionumbers and values are
1527 references on array of itemnumbers.
1528
1529 =cut
1530
1531 sub get_itemnumbers_of {
1532     my @biblionumbers = @_;
1533
1534     my $dbh = C4::Context->dbh;
1535
1536     my $query = '
1537         SELECT itemnumber,
1538             biblionumber
1539         FROM items
1540         WHERE biblionumber IN (?' . ( ',?' x scalar @biblionumbers - 1 ) . ')
1541     ';
1542     my $sth = $dbh->prepare($query);
1543     $sth->execute(@biblionumbers);
1544
1545     my %itemnumbers_of;
1546
1547     while ( my ( $itemnumber, $biblionumber ) = $sth->fetchrow_array ) {
1548         push @{ $itemnumbers_of{$biblionumber} }, $itemnumber;
1549     }
1550
1551     return \%itemnumbers_of;
1552 }
1553
1554 =head2 get_hostitemnumbers_of
1555
1556   my @itemnumbers_of = get_hostitemnumbers_of($biblionumber);
1557
1558 Given a biblionumber, return the list of corresponding itemnumbers that are linked to it via host fields
1559
1560 Return a reference on a hash where key is a biblionumber and values are
1561 references on array of itemnumbers.
1562
1563 =cut
1564
1565
1566 sub get_hostitemnumbers_of {
1567         my ($biblionumber) = @_;
1568         my $marcrecord = GetMarcBiblio($biblionumber);
1569         my (@returnhostitemnumbers,$tag, $biblio_s, $item_s);
1570         
1571         my $marcflavor = C4::Context->preference('marcflavour');
1572         if ($marcflavor eq 'MARC21' || $marcflavor eq 'NORMARC') {
1573         $tag='773';
1574         $biblio_s='0';
1575         $item_s='9';
1576     } elsif ($marcflavor eq 'UNIMARC') {
1577         $tag='461';
1578         $biblio_s='0';
1579         $item_s='9';
1580     }
1581
1582     foreach my $hostfield ( $marcrecord->field($tag) ) {
1583         my $hostbiblionumber = $hostfield->subfield($biblio_s);
1584         my $linkeditemnumber = $hostfield->subfield($item_s);
1585         my @itemnumbers;
1586         if (my $itemnumbers = get_itemnumbers_of($hostbiblionumber)->{$hostbiblionumber})
1587         {
1588             @itemnumbers = @$itemnumbers;
1589         }
1590         foreach my $itemnumber (@itemnumbers){
1591             if ($itemnumber eq $linkeditemnumber){
1592                 push (@returnhostitemnumbers,$itemnumber);
1593                 last;
1594             }
1595         }
1596     }
1597     return @returnhostitemnumbers;
1598 }
1599
1600
1601 =head2 GetItemnumberFromBarcode
1602
1603   $result = GetItemnumberFromBarcode($barcode);
1604
1605 =cut
1606
1607 sub GetItemnumberFromBarcode {
1608     my ($barcode) = @_;
1609     my $dbh = C4::Context->dbh;
1610
1611     my $rq =
1612       $dbh->prepare("SELECT itemnumber FROM items WHERE items.barcode=?");
1613     $rq->execute($barcode);
1614     my ($result) = $rq->fetchrow;
1615     return ($result);
1616 }
1617
1618 =head2 GetBarcodeFromItemnumber
1619
1620   $result = GetBarcodeFromItemnumber($itemnumber);
1621
1622 =cut
1623
1624 sub GetBarcodeFromItemnumber {
1625     my ($itemnumber) = @_;
1626     my $dbh = C4::Context->dbh;
1627
1628     my $rq =
1629       $dbh->prepare("SELECT barcode FROM items WHERE items.itemnumber=?");
1630     $rq->execute($itemnumber);
1631     my ($result) = $rq->fetchrow;
1632     return ($result);
1633 }
1634
1635 =head2 GetHiddenItemnumbers
1636
1637 =over 4
1638
1639 $result = GetHiddenItemnumbers(@items);
1640
1641 =back
1642
1643 =cut
1644
1645 sub GetHiddenItemnumbers {
1646     my (@items) = @_;
1647     my @resultitems;
1648
1649     my $yaml = C4::Context->preference('OpacHiddenItems');
1650     $yaml = "$yaml\n\n"; # YAML is anal on ending \n. Surplus does not hurt
1651     my $hidingrules;
1652     eval {
1653         $hidingrules = YAML::Load($yaml);
1654     };
1655     if ($@) {
1656         warn "Unable to parse OpacHiddenItems syspref : $@";
1657         return ();
1658     }
1659     my $dbh = C4::Context->dbh;
1660
1661     # For each item
1662     foreach my $item (@items) {
1663
1664         # We check each rule
1665         foreach my $field (keys %$hidingrules) {
1666             my $val;
1667             if (exists $item->{$field}) {
1668                 $val = $item->{$field};
1669             }
1670             else {
1671                 my $query = "SELECT $field from items where itemnumber = ?";
1672                 $val = $dbh->selectrow_array($query, undef, $item->{'itemnumber'});
1673             }
1674             $val = '' unless defined $val;
1675
1676             # If the results matches the values in the yaml file
1677             if (any { $val eq $_ } @{$hidingrules->{$field}}) {
1678
1679                 # We add the itemnumber to the list
1680                 push @resultitems, $item->{'itemnumber'};
1681
1682                 # If at least one rule matched for an item, no need to test the others
1683                 last;
1684             }
1685         }
1686     }
1687     return @resultitems;
1688 }
1689
1690 =head3 get_item_authorised_values
1691
1692 find the types and values for all authorised values assigned to this item.
1693
1694 parameters: itemnumber
1695
1696 returns: a hashref malling the authorised value to the value set for this itemnumber
1697
1698     $authorised_values = {
1699              'CCODE'      => undef,
1700              'DAMAGED'    => '0',
1701              'LOC'        => '3',
1702              'LOST'       => '0'
1703              'NOT_LOAN'   => '0',
1704              'RESTRICTED' => undef,
1705              'STACK'      => undef,
1706              'WITHDRAWN'  => '0',
1707              'branches'   => 'CPL',
1708              'cn_source'  => undef,
1709              'itemtypes'  => 'SER',
1710            };
1711
1712 Notes: see C4::Biblio::get_biblio_authorised_values for a similar method at the biblio level.
1713
1714 =cut
1715
1716 sub get_item_authorised_values {
1717     my $itemnumber = shift;
1718
1719     # assume that these entries in the authorised_value table are item level.
1720     my $query = q(SELECT distinct authorised_value, kohafield
1721                     FROM marc_subfield_structure
1722                     WHERE kohafield like 'item%'
1723                       AND authorised_value != '' );
1724
1725     my $itemlevel_authorised_values = C4::Context->dbh->selectall_hashref( $query, 'authorised_value' );
1726     my $iteminfo = GetItem( $itemnumber );
1727     # warn( Data::Dumper->Dump( [ $itemlevel_authorised_values ], [ 'itemlevel_authorised_values' ] ) );
1728     my $return;
1729     foreach my $this_authorised_value ( keys %$itemlevel_authorised_values ) {
1730         my $field = $itemlevel_authorised_values->{ $this_authorised_value }->{'kohafield'};
1731         $field =~ s/^items\.//;
1732         if ( exists $iteminfo->{ $field } ) {
1733             $return->{ $this_authorised_value } = $iteminfo->{ $field };
1734         }
1735     }
1736     # warn( Data::Dumper->Dump( [ $return ], [ 'return' ] ) );
1737     return $return;
1738 }
1739
1740 =head3 get_authorised_value_images
1741
1742 find a list of icons that are appropriate for display based on the
1743 authorised values for a biblio.
1744
1745 parameters: listref of authorised values, such as comes from
1746 get_item_authorised_values or
1747 from C4::Biblio::get_biblio_authorised_values
1748
1749 returns: listref of hashrefs for each image. Each hashref looks like this:
1750
1751       { imageurl => '/intranet-tmpl/prog/img/itemtypeimg/npl/WEB.gif',
1752         label    => '',
1753         category => '',
1754         value    => '', }
1755
1756 Notes: Currently, I put on the full path to the images on the staff
1757 side. This should either be configurable or not done at all. Since I
1758 have to deal with 'intranet' or 'opac' in
1759 get_biblio_authorised_values, perhaps I should be passing it in.
1760
1761 =cut
1762
1763 sub get_authorised_value_images {
1764     my $authorised_values = shift;
1765
1766     my @imagelist;
1767
1768     my $authorised_value_list = GetAuthorisedValues();
1769     # warn ( Data::Dumper->Dump( [ $authorised_value_list ], [ 'authorised_value_list' ] ) );
1770     foreach my $this_authorised_value ( @$authorised_value_list ) {
1771         if ( exists $authorised_values->{ $this_authorised_value->{'category'} }
1772              && $authorised_values->{ $this_authorised_value->{'category'} } eq $this_authorised_value->{'authorised_value'} ) {
1773             # warn ( Data::Dumper->Dump( [ $this_authorised_value ], [ 'this_authorised_value' ] ) );
1774             if ( defined $this_authorised_value->{'imageurl'} ) {
1775                 push @imagelist, { imageurl => C4::Koha::getitemtypeimagelocation( 'intranet', $this_authorised_value->{'imageurl'} ),
1776                                    label    => $this_authorised_value->{'lib'},
1777                                    category => $this_authorised_value->{'category'},
1778                                    value    => $this_authorised_value->{'authorised_value'}, };
1779             }
1780         }
1781     }
1782
1783     # warn ( Data::Dumper->Dump( [ \@imagelist ], [ 'imagelist' ] ) );
1784     return \@imagelist;
1785
1786 }
1787
1788 =head1 LIMITED USE FUNCTIONS
1789
1790 The following functions, while part of the public API,
1791 are not exported.  This is generally because they are
1792 meant to be used by only one script for a specific
1793 purpose, and should not be used in any other context
1794 without careful thought.
1795
1796 =cut
1797
1798 =head2 GetMarcItem
1799
1800   my $item_marc = GetMarcItem($biblionumber, $itemnumber);
1801
1802 Returns MARC::Record of the item passed in parameter.
1803 This function is meant for use only in C<cataloguing/additem.pl>,
1804 where it is needed to support that script's MARC-like
1805 editor.
1806
1807 =cut
1808
1809 sub GetMarcItem {
1810     my ( $biblionumber, $itemnumber ) = @_;
1811
1812     # GetMarcItem has been revised so that it does the following:
1813     #  1. Gets the item information from the items table.
1814     #  2. Converts it to a MARC field for storage in the bib record.
1815     #
1816     # The previous behavior was:
1817     #  1. Get the bib record.
1818     #  2. Return the MARC tag corresponding to the item record.
1819     #
1820     # The difference is that one treats the items row as authoritative,
1821     # while the other treats the MARC representation as authoritative
1822     # under certain circumstances.
1823
1824     my $itemrecord = GetItem($itemnumber);
1825
1826     # Tack on 'items.' prefix to column names so that TransformKohaToMarc will work.
1827     # Also, don't emit a subfield if the underlying field is blank.
1828
1829     
1830     return Item2Marc($itemrecord,$biblionumber);
1831
1832 }
1833 sub Item2Marc {
1834         my ($itemrecord,$biblionumber)=@_;
1835     my $mungeditem = { 
1836         map {  
1837             defined($itemrecord->{$_}) && $itemrecord->{$_} ne '' ? ("items.$_" => $itemrecord->{$_}) : ()  
1838         } keys %{ $itemrecord } 
1839     };
1840     my $itemmarc = TransformKohaToMarc($mungeditem);
1841     my ( $itemtag, $itemsubfield ) = GetMarcFromKohaField("items.itemnumber",GetFrameworkCode($biblionumber)||'');
1842
1843     my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($mungeditem->{'items.more_subfields_xml'});
1844     if (defined $unlinked_item_subfields and $#$unlinked_item_subfields > -1) {
1845                 foreach my $field ($itemmarc->field($itemtag)){
1846             $field->add_subfields(@$unlinked_item_subfields);
1847         }
1848     }
1849         return $itemmarc;
1850 }
1851
1852 =head1 PRIVATE FUNCTIONS AND VARIABLES
1853
1854 The following functions are not meant to be called
1855 directly, but are documented in order to explain
1856 the inner workings of C<C4::Items>.
1857
1858 =cut
1859
1860 =head2 %derived_columns
1861
1862 This hash keeps track of item columns that
1863 are strictly derived from other columns in
1864 the item record and are not meant to be set
1865 independently.
1866
1867 Each key in the hash should be the name of a
1868 column (as named by TransformMarcToKoha).  Each
1869 value should be hashref whose keys are the
1870 columns on which the derived column depends.  The
1871 hashref should also contain a 'BUILDER' key
1872 that is a reference to a sub that calculates
1873 the derived value.
1874
1875 =cut
1876
1877 my %derived_columns = (
1878     'items.cn_sort' => {
1879         'itemcallnumber' => 1,
1880         'items.cn_source' => 1,
1881         'BUILDER' => \&_calc_items_cn_sort,
1882     }
1883 );
1884
1885 =head2 _set_derived_columns_for_add 
1886
1887   _set_derived_column_for_add($item);
1888
1889 Given an item hash representing a new item to be added,
1890 calculate any derived columns.  Currently the only
1891 such column is C<items.cn_sort>.
1892
1893 =cut
1894
1895 sub _set_derived_columns_for_add {
1896     my $item = shift;
1897
1898     foreach my $column (keys %derived_columns) {
1899         my $builder = $derived_columns{$column}->{'BUILDER'};
1900         my $source_values = {};
1901         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1902             next if $source_column eq 'BUILDER';
1903             $source_values->{$source_column} = $item->{$source_column};
1904         }
1905         $builder->($item, $source_values);
1906     }
1907 }
1908
1909 =head2 _set_derived_columns_for_mod 
1910
1911   _set_derived_column_for_mod($item);
1912
1913 Given an item hash representing a new item to be modified.
1914 calculate any derived columns.  Currently the only
1915 such column is C<items.cn_sort>.
1916
1917 This routine differs from C<_set_derived_columns_for_add>
1918 in that it needs to handle partial item records.  In other
1919 words, the caller of C<ModItem> may have supplied only one
1920 or two columns to be changed, so this function needs to
1921 determine whether any of the columns to be changed affect
1922 any of the derived columns.  Also, if a derived column
1923 depends on more than one column, but the caller is not
1924 changing all of then, this routine retrieves the unchanged
1925 values from the database in order to ensure a correct
1926 calculation.
1927
1928 =cut
1929
1930 sub _set_derived_columns_for_mod {
1931     my $item = shift;
1932
1933     foreach my $column (keys %derived_columns) {
1934         my $builder = $derived_columns{$column}->{'BUILDER'};
1935         my $source_values = {};
1936         my %missing_sources = ();
1937         my $must_recalc = 0;
1938         foreach my $source_column (keys %{ $derived_columns{$column} }) {
1939             next if $source_column eq 'BUILDER';
1940             if (exists $item->{$source_column}) {
1941                 $must_recalc = 1;
1942                 $source_values->{$source_column} = $item->{$source_column};
1943             } else {
1944                 $missing_sources{$source_column} = 1;
1945             }
1946         }
1947         if ($must_recalc) {
1948             foreach my $source_column (keys %missing_sources) {
1949                 $source_values->{$source_column} = _get_single_item_column($source_column, $item->{'itemnumber'});
1950             }
1951             $builder->($item, $source_values);
1952         }
1953     }
1954 }
1955
1956 =head2 _do_column_fixes_for_mod
1957
1958   _do_column_fixes_for_mod($item);
1959
1960 Given an item hashref containing one or more
1961 columns to modify, fix up certain values.
1962 Specifically, set to 0 any passed value
1963 of C<notforloan>, C<damaged>, C<itemlost>, or
1964 C<wthdrawn> that is either undefined or
1965 contains the empty string.
1966
1967 =cut
1968
1969 sub _do_column_fixes_for_mod {
1970     my $item = shift;
1971
1972     if (exists $item->{'notforloan'} and
1973         (not defined $item->{'notforloan'} or $item->{'notforloan'} eq '')) {
1974         $item->{'notforloan'} = 0;
1975     }
1976     if (exists $item->{'damaged'} and
1977         (not defined $item->{'damaged'} or $item->{'damaged'} eq '')) {
1978         $item->{'damaged'} = 0;
1979     }
1980     if (exists $item->{'itemlost'} and
1981         (not defined $item->{'itemlost'} or $item->{'itemlost'} eq '')) {
1982         $item->{'itemlost'} = 0;
1983     }
1984     if (exists $item->{'wthdrawn'} and
1985         (not defined $item->{'wthdrawn'} or $item->{'wthdrawn'} eq '')) {
1986         $item->{'wthdrawn'} = 0;
1987     }
1988     if (exists $item->{'location'} && !exists $item->{'permanent_location'}) {
1989         $item->{'permanent_location'} = $item->{'location'};
1990     }
1991     if (exists $item->{'timestamp'}) {
1992         delete $item->{'timestamp'};
1993     }
1994 }
1995
1996 =head2 _get_single_item_column
1997
1998   _get_single_item_column($column, $itemnumber);
1999
2000 Retrieves the value of a single column from an C<items>
2001 row specified by C<$itemnumber>.
2002
2003 =cut
2004
2005 sub _get_single_item_column {
2006     my $column = shift;
2007     my $itemnumber = shift;
2008     
2009     my $dbh = C4::Context->dbh;
2010     my $sth = $dbh->prepare("SELECT $column FROM items WHERE itemnumber = ?");
2011     $sth->execute($itemnumber);
2012     my ($value) = $sth->fetchrow();
2013     return $value; 
2014 }
2015
2016 =head2 _calc_items_cn_sort
2017
2018   _calc_items_cn_sort($item, $source_values);
2019
2020 Helper routine to calculate C<items.cn_sort>.
2021
2022 =cut
2023
2024 sub _calc_items_cn_sort {
2025     my $item = shift;
2026     my $source_values = shift;
2027
2028     $item->{'items.cn_sort'} = GetClassSort($source_values->{'items.cn_source'}, $source_values->{'itemcallnumber'}, "");
2029 }
2030
2031 =head2 _set_defaults_for_add 
2032
2033   _set_defaults_for_add($item_hash);
2034
2035 Given an item hash representing an item to be added, set
2036 correct default values for columns whose default value
2037 is not handled by the DBMS.  This includes the following
2038 columns:
2039
2040 =over 2
2041
2042 =item * 
2043
2044 C<items.dateaccessioned>
2045
2046 =item *
2047
2048 C<items.notforloan>
2049
2050 =item *
2051
2052 C<items.damaged>
2053
2054 =item *
2055
2056 C<items.itemlost>
2057
2058 =item *
2059
2060 C<items.wthdrawn>
2061
2062 =back
2063
2064 =cut
2065
2066 sub _set_defaults_for_add {
2067     my $item = shift;
2068     $item->{dateaccessioned} ||= C4::Dates->new->output('iso');
2069     $item->{$_} ||= 0 for (qw( notforloan damaged itemlost wthdrawn));
2070 }
2071
2072 =head2 _koha_new_item
2073
2074   my ($itemnumber,$error) = _koha_new_item( $item, $barcode );
2075
2076 Perform the actual insert into the C<items> table.
2077
2078 =cut
2079
2080 sub _koha_new_item {
2081     my ( $item, $barcode ) = @_;
2082     my $dbh=C4::Context->dbh;  
2083     my $error;
2084     my $query =
2085            "INSERT INTO items SET
2086             biblionumber        = ?,
2087             biblioitemnumber    = ?,
2088             barcode             = ?,
2089             dateaccessioned     = ?,
2090             booksellerid        = ?,
2091             homebranch          = ?,
2092             price               = ?,
2093             replacementprice    = ?,
2094             replacementpricedate = ?,
2095             datelastborrowed    = ?,
2096             datelastseen        = ?,
2097             stack               = ?,
2098             notforloan          = ?,
2099             damaged             = ?,
2100             itemlost            = ?,
2101             wthdrawn            = ?,
2102             itemcallnumber      = ?,
2103             restricted          = ?,
2104             itemnotes           = ?,
2105             holdingbranch       = ?,
2106             paidfor             = ?,
2107             location            = ?,
2108             permanent_location            = ?,
2109             onloan              = ?,
2110             issues              = ?,
2111             renewals            = ?,
2112             reserves            = ?,
2113             cn_source           = ?,
2114             cn_sort             = ?,
2115             ccode               = ?,
2116             itype               = ?,
2117             materials           = ?,
2118             uri = ?,
2119             enumchron           = ?,
2120             more_subfields_xml  = ?,
2121             copynumber          = ?,
2122             stocknumber         = ?
2123           ";
2124     my $sth = $dbh->prepare($query);
2125     my $today = C4::Dates->today('iso');
2126    $sth->execute(
2127             $item->{'biblionumber'},
2128             $item->{'biblioitemnumber'},
2129             $barcode,
2130             $item->{'dateaccessioned'},
2131             $item->{'booksellerid'},
2132             $item->{'homebranch'},
2133             $item->{'price'},
2134             $item->{'replacementprice'},
2135             $item->{'replacementpricedate'} || $today,
2136             $item->{datelastborrowed},
2137             $item->{datelastseen} || $today,
2138             $item->{stack},
2139             $item->{'notforloan'},
2140             $item->{'damaged'},
2141             $item->{'itemlost'},
2142             $item->{'wthdrawn'},
2143             $item->{'itemcallnumber'},
2144             $item->{'restricted'},
2145             $item->{'itemnotes'},
2146             $item->{'holdingbranch'},
2147             $item->{'paidfor'},
2148             $item->{'location'},
2149             $item->{'permanent_location'},
2150             $item->{'onloan'},
2151             $item->{'issues'},
2152             $item->{'renewals'},
2153             $item->{'reserves'},
2154             $item->{'items.cn_source'},
2155             $item->{'items.cn_sort'},
2156             $item->{'ccode'},
2157             $item->{'itype'},
2158             $item->{'materials'},
2159             $item->{'uri'},
2160             $item->{'enumchron'},
2161             $item->{'more_subfields_xml'},
2162             $item->{'copynumber'},
2163             $item->{'stocknumber'},
2164     );
2165
2166     my $itemnumber;
2167     if ( defined $sth->errstr ) {
2168         $error.="ERROR in _koha_new_item $query".$sth->errstr;
2169     }
2170     else {
2171         $itemnumber = $dbh->{'mysql_insertid'};
2172     }
2173
2174     return ( $itemnumber, $error );
2175 }
2176
2177 =head2 MoveItemFromBiblio
2178
2179   MoveItemFromBiblio($itenumber, $frombiblio, $tobiblio);
2180
2181 Moves an item from a biblio to another
2182
2183 Returns undef if the move failed or the biblionumber of the destination record otherwise
2184
2185 =cut
2186
2187 sub MoveItemFromBiblio {
2188     my ($itemnumber, $frombiblio, $tobiblio) = @_;
2189     my $dbh = C4::Context->dbh;
2190     my $sth = $dbh->prepare("SELECT biblioitemnumber FROM biblioitems WHERE biblionumber = ?");
2191     $sth->execute( $tobiblio );
2192     my ( $tobiblioitem ) = $sth->fetchrow();
2193     $sth = $dbh->prepare("UPDATE items SET biblioitemnumber = ?, biblionumber = ? WHERE itemnumber = ? AND biblionumber = ?");
2194     my $return = $sth->execute($tobiblioitem, $tobiblio, $itemnumber, $frombiblio);
2195     if ($return == 1) {
2196         ModZebra( $tobiblio, "specialUpdate", "biblioserver", undef, undef );
2197         ModZebra( $frombiblio, "specialUpdate", "biblioserver", undef, undef );
2198             # Checking if the item we want to move is in an order 
2199         require C4::Acquisition;
2200         my $order = C4::Acquisition::GetOrderFromItemnumber($itemnumber);
2201             if ($order) {
2202                     # Replacing the biblionumber within the order if necessary
2203                     $order->{'biblionumber'} = $tobiblio;
2204                 C4::Acquisition::ModOrder($order);
2205             }
2206         return $tobiblio;
2207         }
2208     return;
2209 }
2210
2211 =head2 DelItemCheck
2212
2213    DelItemCheck($dbh, $biblionumber, $itemnumber);
2214
2215 Exported function (core API) for deleting an item record in Koha if there no current issue.
2216
2217 =cut
2218
2219 sub DelItemCheck {
2220     my ( $dbh, $biblionumber, $itemnumber ) = @_;
2221     my $error;
2222
2223         my $countanalytics=GetAnalyticsCount($itemnumber);
2224
2225
2226     # check that there is no issue on this item before deletion.
2227     my $sth=$dbh->prepare("select * from issues i where i.itemnumber=?");
2228     $sth->execute($itemnumber);
2229
2230     my $item = GetItem($itemnumber);
2231     my $onloan=$sth->fetchrow;
2232
2233     if ($onloan){
2234         $error = "book_on_loan" 
2235     }
2236     elsif ( !(C4::Context->userenv->{flags} & 1) and
2237             C4::Context->preference("IndependantBranches") and
2238            (C4::Context->userenv->{branch} ne
2239              $item->{C4::Context->preference("HomeOrHoldingBranch")||'homebranch'}) )
2240     {
2241         $error = "not_same_branch";
2242     }
2243         else{
2244         # check it doesnt have a waiting reserve
2245         $sth=$dbh->prepare("SELECT * FROM reserves WHERE (found = 'W' or found = 'T') AND itemnumber = ?");
2246         $sth->execute($itemnumber);
2247         my $reserve=$sth->fetchrow;
2248         if ($reserve){
2249             $error = "book_reserved";
2250         } elsif ($countanalytics > 0){
2251                 $error = "linked_analytics";
2252         } else {
2253             DelItem($dbh, $biblionumber, $itemnumber);
2254             return 1;
2255         }
2256     }
2257     return $error;
2258 }
2259
2260 =head2 _koha_modify_item
2261
2262   my ($itemnumber,$error) =_koha_modify_item( $item );
2263
2264 Perform the actual update of the C<items> row.  Note that this
2265 routine accepts a hashref specifying the columns to update.
2266
2267 =cut
2268
2269 sub _koha_modify_item {
2270     my ( $item ) = @_;
2271     my $dbh=C4::Context->dbh;  
2272     my $error;
2273
2274     my $query = "UPDATE items SET ";
2275     my @bind;
2276     for my $key ( keys %$item ) {
2277         $query.="$key=?,";
2278         push @bind, $item->{$key};
2279     }
2280     $query =~ s/,$//;
2281     $query .= " WHERE itemnumber=?";
2282     push @bind, $item->{'itemnumber'};
2283     my $sth = C4::Context->dbh->prepare($query);
2284     $sth->execute(@bind);
2285     if ( C4::Context->dbh->errstr ) {
2286         $error.="ERROR in _koha_modify_item $query".$dbh->errstr;
2287         warn $error;
2288     }
2289     return ($item->{'itemnumber'},$error);
2290 }
2291
2292 =head2 _koha_delete_item
2293
2294   _koha_delete_item( $dbh, $itemnum );
2295
2296 Internal function to delete an item record from the koha tables
2297
2298 =cut
2299
2300 sub _koha_delete_item {
2301     my ( $dbh, $itemnum ) = @_;
2302
2303     # save the deleted item to deleteditems table
2304     my $sth = $dbh->prepare("SELECT * FROM items WHERE itemnumber=?");
2305     $sth->execute($itemnum);
2306     my $data = $sth->fetchrow_hashref();
2307     my $query = "INSERT INTO deleteditems SET ";
2308     my @bind  = ();
2309     foreach my $key ( keys %$data ) {
2310         $query .= "$key = ?,";
2311         push( @bind, $data->{$key} );
2312     }
2313     $query =~ s/\,$//;
2314     $sth = $dbh->prepare($query);
2315     $sth->execute(@bind);
2316
2317     # delete from items table
2318     $sth = $dbh->prepare("DELETE FROM items WHERE itemnumber=?");
2319     $sth->execute($itemnum);
2320     return undef;
2321 }
2322
2323 =head2 _marc_from_item_hash
2324
2325   my $item_marc = _marc_from_item_hash($item, $frameworkcode[, $unlinked_item_subfields]);
2326
2327 Given an item hash representing a complete item record,
2328 create a C<MARC::Record> object containing an embedded
2329 tag representing that item.
2330
2331 The third, optional parameter C<$unlinked_item_subfields> is
2332 an arrayref of subfields (not mapped to C<items> fields per the
2333 framework) to be added to the MARC representation
2334 of the item.
2335
2336 =cut
2337
2338 sub _marc_from_item_hash {
2339     my $item = shift;
2340     my $frameworkcode = shift;
2341     my $unlinked_item_subfields;
2342     if (@_) {
2343         $unlinked_item_subfields = shift;
2344     }
2345    
2346     # Tack on 'items.' prefix to column names so lookup from MARC frameworks will work
2347     # Also, don't emit a subfield if the underlying field is blank.
2348     my $mungeditem = { map {  (defined($item->{$_}) and $item->{$_} ne '') ? 
2349                                 (/^items\./ ? ($_ => $item->{$_}) : ("items.$_" => $item->{$_})) 
2350                                 : ()  } keys %{ $item } }; 
2351
2352     my $item_marc = MARC::Record->new();
2353     foreach my $item_field ( keys %{$mungeditem} ) {
2354         my ( $tag, $subfield ) = GetMarcFromKohaField( $item_field, $frameworkcode );
2355         next unless defined $tag and defined $subfield;    # skip if not mapped to MARC field
2356         my @values = split(/\s?\|\s?/, $mungeditem->{$item_field}, -1);
2357         foreach my $value (@values){
2358             if ( my $field = $item_marc->field($tag) ) {
2359                     $field->add_subfields( $subfield => $value );
2360             } else {
2361                 my $add_subfields = [];
2362                 if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
2363                     $add_subfields = $unlinked_item_subfields;
2364             }
2365             $item_marc->add_fields( $tag, " ", " ", $subfield => $value, @$add_subfields );
2366             }
2367         }
2368     }
2369
2370     return $item_marc;
2371 }
2372
2373 =head2 _repack_item_errors
2374
2375 Add an error message hash generated by C<CheckItemPreSave>
2376 to a list of errors.
2377
2378 =cut
2379
2380 sub _repack_item_errors {
2381     my $item_sequence_num = shift;
2382     my $item_ref = shift;
2383     my $error_ref = shift;
2384
2385     my @repacked_errors = ();
2386
2387     foreach my $error_code (sort keys %{ $error_ref }) {
2388         my $repacked_error = {};
2389         $repacked_error->{'item_sequence'} = $item_sequence_num;
2390         $repacked_error->{'item_barcode'} = exists($item_ref->{'barcode'}) ? $item_ref->{'barcode'} : '';
2391         $repacked_error->{'error_code'} = $error_code;
2392         $repacked_error->{'error_information'} = $error_ref->{$error_code};
2393         push @repacked_errors, $repacked_error;
2394     } 
2395
2396     return @repacked_errors;
2397 }
2398
2399 =head2 _get_unlinked_item_subfields
2400
2401   my $unlinked_item_subfields = _get_unlinked_item_subfields($original_item_marc, $frameworkcode);
2402
2403 =cut
2404
2405 sub _get_unlinked_item_subfields {
2406     my $original_item_marc = shift;
2407     my $frameworkcode = shift;
2408
2409     my $marcstructure = GetMarcStructure(1, $frameworkcode);
2410
2411     # assume that this record has only one field, and that that
2412     # field contains only the item information
2413     my $subfields = [];
2414     my @fields = $original_item_marc->fields();
2415     if ($#fields > -1) {
2416         my $field = $fields[0];
2417             my $tag = $field->tag();
2418         foreach my $subfield ($field->subfields()) {
2419             if (defined $subfield->[1] and
2420                 $subfield->[1] ne '' and
2421                 !$marcstructure->{$tag}->{$subfield->[0]}->{'kohafield'}) {
2422                 push @$subfields, $subfield->[0] => $subfield->[1];
2423             }
2424         }
2425     }
2426     return $subfields;
2427 }
2428
2429 =head2 _get_unlinked_subfields_xml
2430
2431   my $unlinked_subfields_xml = _get_unlinked_subfields_xml($unlinked_item_subfields);
2432
2433 =cut
2434
2435 sub _get_unlinked_subfields_xml {
2436     my $unlinked_item_subfields = shift;
2437
2438     my $xml;
2439     if (defined $unlinked_item_subfields and ref($unlinked_item_subfields) eq 'ARRAY' and $#$unlinked_item_subfields > -1) {
2440         my $marc = MARC::Record->new();
2441         # use of tag 999 is arbitrary, and doesn't need to match the item tag
2442         # used in the framework
2443         $marc->append_fields(MARC::Field->new('999', ' ', ' ', @$unlinked_item_subfields));
2444         $marc->encoding("UTF-8");    
2445         $xml = $marc->as_xml("USMARC");
2446     }
2447
2448     return $xml;
2449 }
2450
2451 =head2 _parse_unlinked_item_subfields_from_xml
2452
2453   my $unlinked_item_subfields = _parse_unlinked_item_subfields_from_xml($whole_item->{'more_subfields_xml'}):
2454
2455 =cut
2456
2457 sub  _parse_unlinked_item_subfields_from_xml {
2458     my $xml = shift;
2459     require C4::Charset;
2460     return unless defined $xml and $xml ne "";
2461     my $marc = MARC::Record->new_from_xml(C4::Charset::StripNonXmlChars($xml),'UTF-8');
2462     my $unlinked_subfields = [];
2463     my @fields = $marc->fields();
2464     if ($#fields > -1) {
2465         foreach my $subfield ($fields[0]->subfields()) {
2466             push @$unlinked_subfields, $subfield->[0] => $subfield->[1];
2467         }
2468     }
2469     return $unlinked_subfields;
2470 }
2471
2472 =head2 GetAnalyticsCount
2473
2474   $count= &GetAnalyticsCount($itemnumber)
2475
2476 counts Usage of itemnumber in Analytical bibliorecords. 
2477
2478 =cut
2479
2480 sub GetAnalyticsCount {
2481     my ($itemnumber) = @_;
2482     if (C4::Context->preference('NoZebra')) {
2483         # Read the index Koha-Auth-Number for this authid and count the lines
2484         my $result = C4::Search::NZanalyse("hi=$itemnumber");
2485         my @tab = split /;/,$result;
2486         return scalar @tab;
2487     } else {
2488         ### ZOOM search here
2489         my $query;
2490         $query= "hi=".$itemnumber;
2491                 my ($err,$res,$result) = C4::Search::SimpleSearch($query,0,10);
2492         return ($result);
2493     }
2494 }
2495
2496 =head2 GetItemHolds
2497
2498 =over 4
2499 $holds = &GetItemHolds($biblionumber, $itemnumber);
2500
2501 =back
2502
2503 This function return the count of holds with $biblionumber and $itemnumber
2504
2505 =cut
2506
2507 sub GetItemHolds {
2508     my ($biblionumber, $itemnumber) = @_;
2509     my $holds;
2510     my $dbh            = C4::Context->dbh;
2511     my $query          = "SELECT count(*)
2512         FROM  reserves
2513         WHERE biblionumber=? AND itemnumber=?";
2514     my $sth = $dbh->prepare($query);
2515     $sth->execute($biblionumber, $itemnumber);
2516     $holds = $sth->fetchrow;
2517     return $holds;
2518 }
2519 =head1  OTHER FUNCTIONS
2520
2521 =head2 _find_value
2522
2523   ($indicators, $value) = _find_value($tag, $subfield, $record,$encoding);
2524
2525 Find the given $subfield in the given $tag in the given
2526 MARC::Record $record.  If the subfield is found, returns
2527 the (indicators, value) pair; otherwise, (undef, undef) is
2528 returned.
2529
2530 PROPOSITION :
2531 Such a function is used in addbiblio AND additem and serial-edit and maybe could be used in Authorities.
2532 I suggest we export it from this module.
2533
2534 =cut
2535
2536 sub _find_value {
2537     my ( $tagfield, $insubfield, $record, $encoding ) = @_;
2538     my @result;
2539     my $indicator;
2540     if ( $tagfield < 10 ) {
2541         if ( $record->field($tagfield) ) {
2542             push @result, $record->field($tagfield)->data();
2543         } else {
2544             push @result, "";
2545         }
2546     } else {
2547         foreach my $field ( $record->field($tagfield) ) {
2548             my @subfields = $field->subfields();
2549             foreach my $subfield (@subfields) {
2550                 if ( @$subfield[0] eq $insubfield ) {
2551                     push @result, @$subfield[1];
2552                     $indicator = $field->indicator(1) . $field->indicator(2);
2553                 }
2554             }
2555         }
2556     }
2557     return ( $indicator, @result );
2558 }
2559
2560
2561 =head2 PrepareItemrecordDisplay
2562
2563   PrepareItemrecordDisplay($itemrecord,$bibnum,$itemumber,$frameworkcode);
2564
2565 Returns a hash with all the fields for Display a given item data in a template
2566
2567 The $frameworkcode returns the item for the given frameworkcode, ONLY if bibnum is not provided
2568
2569 =cut
2570
2571 sub PrepareItemrecordDisplay {
2572
2573     my ( $bibnum, $itemnum, $defaultvalues, $frameworkcode ) = @_;
2574
2575     my $dbh = C4::Context->dbh;
2576     $frameworkcode = &GetFrameworkCode($bibnum) if $bibnum;
2577     my ( $itemtagfield, $itemtagsubfield ) = &GetMarcFromKohaField( "items.itemnumber", $frameworkcode );
2578     my $tagslib = &GetMarcStructure( 1, $frameworkcode );
2579
2580     # return nothing if we don't have found an existing framework.
2581     return q{} unless $tagslib;
2582     my $itemrecord;
2583     if ($itemnum) {
2584         $itemrecord = C4::Items::GetMarcItem( $bibnum, $itemnum );
2585     }
2586     my @loop_data;
2587     my $authorised_values_sth = $dbh->prepare( "SELECT authorised_value,lib FROM authorised_values WHERE category=? ORDER BY lib" );
2588     foreach my $tag ( sort keys %{$tagslib} ) {
2589         my $previous_tag = '';
2590         if ( $tag ne '' ) {
2591
2592             # loop through each subfield
2593             my $cntsubf;
2594             foreach my $subfield ( sort keys %{ $tagslib->{$tag} } ) {
2595                 next if ( subfield_is_koha_internal_p($subfield) );
2596                 next if ( $tagslib->{$tag}->{$subfield}->{'tab'} ne "10" );
2597                 my %subfield_data;
2598                 $subfield_data{tag}           = $tag;
2599                 $subfield_data{subfield}      = $subfield;
2600                 $subfield_data{countsubfield} = $cntsubf++;
2601                 $subfield_data{kohafield}     = $tagslib->{$tag}->{$subfield}->{'kohafield'};
2602                 $subfield_data{id}            = "tag_".$tag."_subfield_".$subfield."_".int(rand(1000000));
2603
2604                 #        $subfield_data{marc_lib}=$tagslib->{$tag}->{$subfield}->{lib};
2605                 $subfield_data{marc_lib}   = $tagslib->{$tag}->{$subfield}->{lib};
2606                 $subfield_data{mandatory}  = $tagslib->{$tag}->{$subfield}->{mandatory};
2607                 $subfield_data{repeatable} = $tagslib->{$tag}->{$subfield}->{repeatable};
2608                 $subfield_data{hidden}     = "display:none"
2609                   if $tagslib->{$tag}->{$subfield}->{hidden};
2610                 my ( $x, $defaultvalue );
2611                 if ($itemrecord) {
2612                     ( $x, $defaultvalue ) = _find_value( $tag, $subfield, $itemrecord );
2613                 }
2614                 $defaultvalue = $tagslib->{$tag}->{$subfield}->{defaultvalue} unless $defaultvalue;
2615                 if ( !defined $defaultvalue ) {
2616                     $defaultvalue = q||;
2617                 }
2618                 $defaultvalue =~ s/"/&quot;/g;
2619
2620                 # search for itemcallnumber if applicable
2621                 if ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2622                     && C4::Context->preference('itemcallnumber') ) {
2623                     my $CNtag      = substr( C4::Context->preference('itemcallnumber'), 0, 3 );
2624                     my $CNsubfield = substr( C4::Context->preference('itemcallnumber'), 3, 1 );
2625                     if ($itemrecord) {
2626                         my $temp = $itemrecord->field($CNtag);
2627                         if ($temp) {
2628                             $defaultvalue = $temp->subfield($CNsubfield);
2629                         }
2630                     }
2631                 }
2632                 if (   $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.itemcallnumber'
2633                     && $defaultvalues
2634                     && $defaultvalues->{'callnumber'} ) {
2635                     my $temp;
2636                     if ($itemrecord) {
2637                         $temp = $itemrecord->field($subfield);
2638                     }
2639                     unless ($temp) {
2640                         $defaultvalue = $defaultvalues->{'callnumber'} if $defaultvalues;
2641                     }
2642                 }
2643                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.holdingbranch' || $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.homebranch' )
2644                     && $defaultvalues
2645                     && $defaultvalues->{'branchcode'} ) {
2646                     my $temp;
2647                     if ($itemrecord) {
2648                         $temp = $itemrecord->field($subfield);
2649                     }
2650                     unless ($temp) {
2651                         $defaultvalue = $defaultvalues->{branchcode} if $defaultvalues;
2652                     }
2653                 }
2654                 if (   ( $tagslib->{$tag}->{$subfield}->{kohafield} eq 'items.location' )
2655                     && $defaultvalues
2656                     && $defaultvalues->{'location'} ) {
2657                     my $temp = $itemrecord->field($subfield) if ($itemrecord);
2658                     unless ($temp) {
2659                         $defaultvalue = $defaultvalues->{location} if $defaultvalues;
2660                     }
2661                 }
2662                 if ( $tagslib->{$tag}->{$subfield}->{authorised_value} ) {
2663                     my @authorised_values;
2664                     my %authorised_lib;
2665
2666                     # builds list, depending on authorised value...
2667                     #---- branch
2668                     if ( $tagslib->{$tag}->{$subfield}->{'authorised_value'} eq "branches" ) {
2669                         if (   ( C4::Context->preference("IndependantBranches") )
2670                             && ( C4::Context->userenv->{flags} % 2 != 1 ) ) {
2671                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches WHERE branchcode = ? ORDER BY branchname" );
2672                             $sth->execute( C4::Context->userenv->{branch} );
2673                             push @authorised_values, ""
2674                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2675                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2676                                 push @authorised_values, $branchcode;
2677                                 $authorised_lib{$branchcode} = $branchname;
2678                             }
2679                         } else {
2680                             my $sth = $dbh->prepare( "SELECT branchcode,branchname FROM branches ORDER BY branchname" );
2681                             $sth->execute;
2682                             push @authorised_values, ""
2683                               unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2684                             while ( my ( $branchcode, $branchname ) = $sth->fetchrow_array ) {
2685                                 push @authorised_values, $branchcode;
2686                                 $authorised_lib{$branchcode} = $branchname;
2687                             }
2688                         }
2689
2690                         #----- itemtypes
2691                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "itemtypes" ) {
2692                         my $sth = $dbh->prepare( "SELECT itemtype,description FROM itemtypes ORDER BY description" );
2693                         $sth->execute;
2694                         push @authorised_values, ""
2695                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2696                         while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) {
2697                             push @authorised_values, $itemtype;
2698                             $authorised_lib{$itemtype} = $description;
2699                         }
2700                         #---- class_sources
2701                     } elsif ( $tagslib->{$tag}->{$subfield}->{authorised_value} eq "cn_source" ) {
2702                         push @authorised_values, "" unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2703
2704                         my $class_sources = GetClassSources();
2705                         my $default_source = C4::Context->preference("DefaultClassificationSource");
2706
2707                         foreach my $class_source (sort keys %$class_sources) {
2708                             next unless $class_sources->{$class_source}->{'used'} or
2709                                         ($class_source eq $default_source);
2710                             push @authorised_values, $class_source;
2711                             $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'};
2712                         }
2713
2714                         #---- "true" authorised value
2715                     } else {
2716                         $authorised_values_sth->execute( $tagslib->{$tag}->{$subfield}->{authorised_value} );
2717                         push @authorised_values, ""
2718                           unless ( $tagslib->{$tag}->{$subfield}->{mandatory} );
2719                         while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) {
2720                             push @authorised_values, $value;
2721                             $authorised_lib{$value} = $lib;
2722                         }
2723                     }
2724                     $subfield_data{marc_value} = CGI::scrolling_list(
2725                         -name     => 'field_value',
2726                         -values   => \@authorised_values,
2727                         -default  => "$defaultvalue",
2728                         -labels   => \%authorised_lib,
2729                         -size     => 1,
2730                         -tabindex => '',
2731                         -multiple => 0,
2732                     );
2733                 } elsif ( $tagslib->{$tag}->{$subfield}->{value_builder} ) {
2734                         # opening plugin
2735                         my $plugin = C4::Context->intranetdir . "/cataloguing/value_builder/" . $tagslib->{$tag}->{$subfield}->{'value_builder'};
2736                         if (do $plugin) {
2737                             my $temp;
2738                             my $extended_param = plugin_parameters( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
2739                             my ( $function_name, $javascript ) = plugin_javascript( $dbh, $temp, $tagslib, $subfield_data{id}, undef );
2740                             $subfield_data{random}     = int(rand(1000000));    # why do we need 2 different randoms?
2741                             $subfield_data{marc_value} = qq[<input tabindex="1" id="$subfield_data{id}" name="field_value" class="input_marceditor" size="67" maxlength="255"
2742                                 onfocus="Focus$function_name($subfield_data{random}, '$subfield_data{id}');"
2743                                  onblur=" Blur$function_name($subfield_data{random}, '$subfield_data{id}');" />
2744                                 <a href="#" class="buttonDot" onclick="Clic$function_name('$subfield_data{id}'); return false;" title="Tag Editor">...</a>
2745                                 $javascript];
2746                         } else {
2747                             warn "Plugin Failed: $plugin";
2748                             $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
2749                         }
2750                 }
2751                 elsif ( $tag eq '' ) {       # it's an hidden field
2752                     $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" />);
2753                 }
2754                 elsif ( $tagslib->{$tag}->{$subfield}->{'hidden'} ) {   # FIXME: shouldn't input type be "hidden" ?
2755                     $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" />);
2756                 }
2757                 elsif ( length($defaultvalue) > 100
2758                             or (C4::Context->preference("marcflavour") eq "UNIMARC" and
2759                                   300 <= $tag && $tag < 400 && $subfield eq 'a' )
2760                             or (C4::Context->preference("marcflavour") eq "MARC21"  and
2761                                   500 <= $tag && $tag < 600                     )
2762                           ) {
2763                     # oversize field (textarea)
2764                     $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");
2765                 } else {
2766                     $subfield_data{marc_value} = "<input type=\"text\" name=\"field_value\" value=\"$defaultvalue\" size=\"50\" maxlength=\"255\" />";
2767                 }
2768                 push( @loop_data, \%subfield_data );
2769             }
2770         }
2771     }
2772     my $itemnumber;
2773     if ( $itemrecord && $itemrecord->field($itemtagfield) ) {
2774         $itemnumber = $itemrecord->subfield( $itemtagfield, $itemtagsubfield );
2775     }
2776     return {
2777         'itemtagfield'    => $itemtagfield,
2778         'itemtagsubfield' => $itemtagsubfield,
2779         'itemnumber'      => $itemnumber,
2780         'iteminformation' => \@loop_data
2781     };
2782 }
2783
2784 1;