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