NYTProf Profile: /home/chris/git/koha.git/C4/Items.pm

File	/home/chris/git/koha.git/C4/Items.pm
Statements Executed	42
Total Time	0.0076846 seconds

Subroutines — ordered by exclusive time
Exclusive Time	Inclusive Time	Subroutine
0s	0s	C4::Items::::AddItemC4::Items::AddItem
0s	0s	C4::Items::::AddItemBatchFromMarcC4::Items::AddItemBatchFromMarc
0s	0s	C4::Items::::AddItemFromMarcC4::Items::AddItemFromMarc
0s	0s	C4::Items::::BEGINC4::Items::BEGIN
0s	0s	C4::Items::::CheckItemPreSaveC4::Items::CheckItemPreSave
0s	0s	C4::Items::::DelItemC4::Items::DelItem
0s	0s	C4::Items::::GetItemC4::Items::GetItem
0s	0s	C4::Items::::GetItemInfosOfC4::Items::GetItemInfosOf
0s	0s	C4::Items::::GetItemLocationC4::Items::GetItemLocation
0s	0s	C4::Items::::GetItemStatusC4::Items::GetItemStatus
0s	0s	C4::Items::::GetItemnumberFromBarcodeC4::Items::GetItemnumberFromBarcode
0s	0s	C4::Items::::GetItemsByBiblioitemnumberC4::Items::GetItemsByBiblioitemnumber
0s	0s	C4::Items::::GetItemsCountC4::Items::GetItemsCount
0s	0s	C4::Items::::GetItemsForInventoryC4::Items::GetItemsForInventory
0s	0s	C4::Items::::GetItemsInfoC4::Items::GetItemsInfo
0s	0s	C4::Items::::GetLostItemsC4::Items::GetLostItems
0s	0s	C4::Items::::GetMarcItemC4::Items::GetMarcItem
0s	0s	C4::Items::::ModDateLastSeenC4::Items::ModDateLastSeen
0s	0s	C4::Items::::ModItemC4::Items::ModItem
0s	0s	C4::Items::::ModItemFromMarcC4::Items::ModItemFromMarc
0s	0s	C4::Items::::ModItemTransferC4::Items::ModItemTransfer
0s	0s	C4::Items::::_add_item_field_to_biblioC4::Items::_add_item_field_to_biblio
0s	0s	C4::Items::::_calc_items_cn_sortC4::Items::_calc_items_cn_sort
0s	0s	C4::Items::::_do_column_fixes_for_modC4::Items::_do_column_fixes_for_mod
0s	0s	C4::Items::::_get_single_item_columnC4::Items::_get_single_item_column
0s	0s	C4::Items::_get_unlinked_item_subfields
0s	0s	C4::Items::_get_unlinked_subfields_xml
0s	0s	C4::Items::::_koha_delete_itemC4::Items::_koha_delete_item
0s	0s	C4::Items::::_koha_modify_itemC4::Items::_koha_modify_item
0s	0s	C4::Items::::_koha_new_itemC4::Items::_koha_new_item
0s	0s	C4::Items::::_marc_from_item_hashC4::Items::_marc_from_item_hash
0s	0s	C4::Items::_parse_unlinked_item_subfields_from_xml
0s	0s	C4::Items::::_repack_item_errorsC4::Items::_repack_item_errors
0s	0s	C4::Items::_replace_item_field_in_biblio
0s	0s	C4::Items::::_set_defaults_for_addC4::Items::_set_defaults_for_add
0s	0s	C4::Items::_set_derived_columns_for_add
0s	0s	C4::Items::_set_derived_columns_for_mod
0s	0s	C4::Items::get_authorised_value_images
0s	0s	C4::Items::::get_item_authorised_valuesC4::Items::get_item_authorised_values
0s	0s	C4::Items::::get_itemnumbers_ofC4::Items::get_itemnumbers_of

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