3 # Copyright 2000-2009 Biblibre S.A
4 # John Soros <john.soros@biblibre.com>
6 # This file is part of Koha.
8 # Koha is free software; you can redistribute it and/or modify it
9 # under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either version 3 of the License, or
11 # (at your option) any later version.
13 # Koha is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
18 # You should have received a copy of the GNU General Public License
19 # along with Koha; if not, see <http://www.gnu.org/licenses>.
23 #need to open cgi and get the fh before anything else opens a new cgi context (see C4::Auth)
26 my $uploadbarcodes = $input->param('uploadbarcodes');
35 use C4
::Reports
::Guided
; #_get_column_defs
40 use Koha
::AuthorisedValues
;
41 use Koha
::BiblioFrameworks
;
42 use Koha
::ClassSources
;
44 use List
::MoreUtils
qw( none );
46 my $minlocation=$input->param('minlocation') || '';
47 my $maxlocation=$input->param('maxlocation');
48 my $class_source=$input->param('class_source');
49 $maxlocation=$minlocation.'Z' unless ( $maxlocation || ! $minlocation );
50 my $location=$input->param('location') || '';
51 my $ignoreissued=$input->param('ignoreissued');
52 my $ignore_waiting_holds = $input->param('ignore_waiting_holds');
53 my $datelastseen = $input->param('datelastseen'); # last inventory date
54 my $branchcode = $input->param('branchcode') || '';
55 my $branch = $input->param('branch');
56 my $op = $input->param('op');
57 my $compareinv2barcd = $input->param('compareinv2barcd');
58 my $dont_checkin = $input->param('dont_checkin');
59 my $out_of_order = $input->param('out_of_order');
61 my ( $template, $borrowernumber, $cookie ) = get_template_and_user
(
62 { template_name
=> "tools/inventory.tt",
65 flagsrequired
=> { tools
=> 'inventory' },
70 my @authorised_value_list;
71 my $authorisedvalue_categories = '';
73 my $frameworks = Koha
::BiblioFrameworks
->search({}, { order_by
=> ['frameworktext'] })->unblessed;
74 unshift @
$frameworks, { frameworkcode
=> '' };
76 for my $fwk ( @
$frameworks ){
77 my $fwkcode = $fwk->{frameworkcode
};
78 my $mss = Koha
::MarcSubfieldStructures
->search({ frameworkcode
=> $fwkcode, kohafield
=> 'items.location', authorised_value
=> [ -and => {'!=' => undef }, {'!=' => ''}] });
79 my $authcode = $mss->count ?
$mss->next->authorised_value : undef;
80 if ($authcode && $authorisedvalue_categories!~/\b$authcode\W/){
81 $authorisedvalue_categories.="$authcode ";
82 my $data=GetAuthorisedValues
($authcode);
83 foreach my $value (@
$data){
84 $value->{selected
}=1 if ($value->{authorised_value
} eq ($location));
86 push @authorised_value_list,@
$data;
92 for my $statfield (qw
/items.notforloan items.itemlost items.withdrawn items.damaged/){
94 $hash->{fieldname
} = $statfield;
95 my $mss = Koha
::MarcSubfieldStructures
->search({ frameworkcode
=> '', kohafield
=> $statfield, authorised_value
=> [ -and => {'!=' => undef }, {'!=' => ''}] });
96 $hash->{authcode
} = $mss->count ?
$mss->next->authorised_value : undef;
97 if ($hash->{authcode
}){
98 my $arr = GetAuthorisedValues
($hash->{authcode
});
99 if ( $statfield eq 'items.notforloan') {
100 # Add notforloan == 0 to the list of possible notforloan statuses
101 # The lib value is replaced in the template
102 push @
$arr, { authorised_value
=> 0, id
=> 'stat0' , lib
=> '__IGNORE__' } if ! grep { $_->{authorised_value
} eq '0' } @
$arr;
103 @notforloans = map { $_->{'authorised_value'} } @
$arr;
105 $hash->{values} = $arr;
106 push @
$statuses, $hash;
110 $template->param( statuses
=> $statuses );
111 my $staton = {}; #authorized values that are ticked
112 for my $authvfield (@
$statuses) {
113 $staton->{$authvfield->{fieldname
}} = [];
114 for my $authval (@
{$authvfield->{values}}){
115 if ( defined $input->param('status-' . $authvfield->{fieldname
} . '-' . $authval->{authorised_value
}) && $input->param('status-' . $authvfield->{fieldname
} . '-' . $authval->{authorised_value
}) eq 'on' ){
116 push @
{$staton->{$authvfield->{fieldname
}}}, $authval->{authorised_value
};
121 my @class_sources = Koha
::ClassSources
->search({ used
=> 1 });
122 my $pref_class = C4
::Context
->preference("DefaultClassificationSource");
126 authorised_values
=> \
@authorised_value_list,
127 today
=> dt_from_string
,
128 minlocation
=> $minlocation,
129 maxlocation
=> $maxlocation,
130 location
=> $location,
131 ignoreissued
=> $ignoreissued,
132 branchcode
=> $branchcode,
134 datelastseen
=> $datelastseen,
135 compareinv2barcd
=> $compareinv2barcd,
136 uploadedbarcodesflag
=> $uploadbarcodes ?
1 : 0,
137 ignore_waiting_holds
=> $ignore_waiting_holds,
138 class_sources
=> \
@class_sources,
139 pref_class
=> $pref_class
142 # Walk through uploaded barcodes, report errors, mark as seen, check in
146 my $moddatecount = 0;
147 if ( $uploadbarcodes && length($uploadbarcodes) > 0 ) {
148 my $dbh = C4
::Context
->dbh;
149 my $date = dt_from_string
( scalar $input->param('setdate') );
150 $date = output_pref
( { dt
=> $date, dateformat
=> 'iso' } );
152 my $strsth = "select * from issues, items where items.itemnumber=issues.itemnumber and items.barcode =?";
153 my $qonloan = $dbh->prepare($strsth);
154 $strsth="select * from items where items.barcode =? and items.withdrawn = 1";
155 my $qwithdrawn = $dbh->prepare($strsth);
158 my @uploadedbarcodes;
160 my $sth = $dbh->column_info(undef,undef,"items","barcode");
161 my $barcode_def = $sth->fetchall_hashref('COLUMN_NAME');
162 my $barcode_size = $barcode_def->{barcode
}->{COLUMN_SIZE
};
166 binmode($uploadbarcodes, ":encoding(UTF-8)");
167 while (my $barcode=<$uploadbarcodes>) {
168 my $split_chars = C4
::Context
->preference('BarcodeSeparators');
169 push @uploadedbarcodes, grep { /\S/ } split( /[$split_chars]/, $barcode );
171 for my $barcode (@uploadedbarcodes) {
172 next unless $barcode;
174 if (length($barcode)>$barcode_size) {
177 my $check_barcode = $barcode;
178 $check_barcode =~ s/\p{Print}//g;
179 if (length($check_barcode)>0) { # Only printable unicode characters allowed.
182 next if length($barcode)>$barcode_size;
183 next if ( length($check_barcode)>0 );
184 push @barcodes,$barcode;
186 $template->param( LinesRead
=> $lines_read );
188 push @errorloop, {'barcode'=>'No valid barcodes!'};
189 $op=''; # force the initial inventory screen again.
192 $template->param( err_length
=> $err_length,
193 err_data
=> $err_data );
195 foreach my $barcode (@barcodes) {
196 if ( $qwithdrawn->execute($barcode) && $qwithdrawn->rows ) {
197 push @errorloop, { 'barcode' => $barcode, 'ERR_WTHDRAWN' => 1 };
199 my $item = Koha
::Items
->find({barcode
=> $barcode});
201 # Modify date last seen for scanned items, remove lost status
202 $item->set({ itemlost
=> 0, datelastseen
=> $date })->store;
203 my $item_unblessed = $item->unblessed;
205 unless ( $dont_checkin ) {
206 $qonloan->execute($barcode);
208 my $data = $qonloan->fetchrow_hashref;
209 my ($doreturn, $messages, $iteminformation, $borrower) =AddReturn
($barcode, $data->{homebranch
});
211 $item_unblessed->{onloan
} = undef;
212 $item_unblessed->{datelastseen
} = dt_from_string
;
214 push @errorloop, { barcode
=> $barcode, ERR_ONLOAN_NOT_RET
=> 1 };
218 push @scanned_items, $item_unblessed;
220 push @errorloop, { barcode
=> $barcode, ERR_BARCODE
=> 1 };
224 $template->param( date
=> $date );
225 $template->param( errorloop
=> \
@errorloop ) if (@errorloop);
228 # Build inventorylist: used as result list when you do not pass barcodes
229 # This list is also used when you want to compare with barcodes
230 my ( $inventorylist, $rightplacelist );
231 if ( $op && ( !$uploadbarcodes || $compareinv2barcd )) {
232 ( $inventorylist ) = GetItemsForInventory
({
233 minlocation
=> $minlocation,
234 maxlocation
=> $maxlocation,
235 class_source
=> $class_source,
236 location
=> $location,
237 ignoreissued
=> $ignoreissued,
238 datelastseen
=> $datelastseen,
239 branchcode
=> $branchcode,
242 statushash
=> $staton,
243 ignore_waiting_holds
=> $ignore_waiting_holds,
246 # Build rightplacelist used to check if a scanned item is in the right place.
247 if( @scanned_items ) {
248 ( $rightplacelist ) = GetItemsForInventory
({
249 minlocation
=> $minlocation,
250 maxlocation
=> $maxlocation,
251 class_source
=> $class_source,
252 location
=> $location,
253 ignoreissued
=> undef,
254 datelastseen
=> undef,
255 branchcode
=> $branchcode,
259 ignore_waiting_holds
=> $ignore_waiting_holds,
261 # Convert the structure to a hash on barcode
263 map { $_->{barcode
} ?
( $_->{barcode
}, $_ ) : (); } @
$rightplacelist
267 # Report scanned items that are on the wrong place, or have a wrong notforloan
268 # status, or are still checked out.
269 for ( my $i = 0; $i < @scanned_items; $i++ ) {
271 my $item = $scanned_items[$i];
273 $item->{notforloancode
} = $item->{notforloan
}; # save for later use
274 my $fc = $item->{'frameworkcode'} || '';
276 # Populating with authorised values description
277 foreach my $field (qw
/ location notforloan itemlost damaged withdrawn /) {
278 my $av = Koha
::AuthorisedValues
->get_description_by_koha_field(
279 { frameworkcode
=> $fc, kohafield
=> "items.$field", authorised_value
=> $item->{$field} } );
280 if ( $av and defined $item->{$field} and defined $av->{lib
} ) {
281 $item->{$field} = $av->{lib
};
285 # If we have scanned items with a non-matching notforloan value
286 if( none
{ $item->{'notforloancode'} eq $_ } @notforloans ) {
287 $item->{problems
}->{changestatus
} = 1;
288 additemtoresults
( $item, $results );
291 # Check for items shelved out of order
294 my $previous_item = $scanned_items[ $i - 1 ];
295 if ( $previous_item && $item->{cn_sort
} lt $previous_item->{cn_sort
} ) {
296 $item->{problems
}->{out_of_order
} = 1;
297 additemtoresults
( $item, $results );
300 unless ( $i == scalar(@scanned_items) ) {
301 my $next_item = $scanned_items[ $i + 1 ];
302 if ( $next_item && $item->{cn_sort
} gt $next_item->{cn_sort
} ) {
303 $item->{problems
}->{out_of_order
} = 1;
304 additemtoresults
( $item, $results );
309 # Report an item that is checked out (unusual!) or wrongly placed
310 if( $item->{onloan
} ) {
311 $item->{problems
}->{checkedout
} = 1;
312 additemtoresults
( $item, $results );
313 next; # do not modify item
314 } elsif( !exists $rightplacelist->{ $item->{barcode
} } ) {
315 $item->{problems
}->{wrongplace
} = 1;
316 additemtoresults
( $item, $results );
320 # Compare barcodes with inventory list, report no_barcode and not_scanned.
321 # not_scanned can be interpreted as missing
322 if ( $compareinv2barcd ) {
323 my @scanned_barcodes = map {$_->{barcode
}} @scanned_items;
324 for my $item ( @
$inventorylist ) {
325 my $barcode = $item->{barcode
};
327 $item->{problems
}->{no_barcode
} = 1;
328 } elsif ( grep { $_ eq $barcode } @scanned_barcodes ) {
331 $item->{problems
}->{not_scanned
} = 1;
333 additemtoresults
( $item, $results );
337 # Construct final results, add biblio information
338 my $loop = $uploadbarcodes
339 ?
[ map { $results->{$_} } keys %$results ]
340 : $inventorylist // [];
341 for my $item ( @
$loop ) {
342 my $biblio = Koha
::Biblios
->find( $item->{biblionumber
} );
343 $item->{title
} = $biblio->title;
344 $item->{author
} = $biblio->author;
348 moddatecount
=> $moddatecount,
354 if (defined $input->param('CSVexport') && $input->param('CSVexport') eq 'on'){
355 eval {use Text
::CSV
};
356 my $csv = Text
::CSV
->new or
357 die Text
::CSV
->error_diag ();
358 binmode STDOUT
, ":encoding(UTF-8)";
359 print $input->header(
361 -attachment
=> 'inventory.csv',
364 my $columns_def_hashref = C4
::Reports
::Guided
::_get_column_defs
($input);
365 foreach my $key ( keys %$columns_def_hashref ) {
367 $key =~ s/[^\.]*\.//;
368 $columns_def_hashref->{$initkey}=NormalizeString
($columns_def_hashref->{$initkey} // '');
369 $columns_def_hashref->{$key} = $columns_def_hashref->{$initkey};
373 for my $key (qw
/ biblioitems
.title biblio
.author
374 items
.barcode items
.itemnumber
375 items
.homebranch items
.location
376 items
.itemcallnumber items
.notforloan
377 items
.itemlost items
.damaged
378 items
.withdrawn items
.stocknumber
380 push @translated_keys, $columns_def_hashref->{$key};
382 push @translated_keys, 'problem' if $uploadbarcodes;
384 $csv->combine(@translated_keys);
385 print $csv->string, "\n";
387 my @keys = qw
/ title author barcode itemnumber homebranch location itemcallnumber notforloan itemlost damaged withdrawn stocknumber /;
388 for my $item ( @
$loop ) {
390 for my $key (@keys) {
391 push @line, $item->{$key};
394 foreach my $key ( keys %{$item->{problems
}} ) {
395 if( $key eq 'wrongplace' ) {
396 $errstr .= "wrong place,";
397 } elsif( $key eq 'changestatus' ) {
398 $errstr .= "unknown notforloan status,";
399 } elsif( $key eq 'not_scanned' ) {
400 $errstr .= "missing,";
401 } elsif( $key eq 'no_barcode' ) {
402 $errstr .= "no barcode,";
403 } elsif( $key eq 'checkedout' ) {
404 $errstr .= "checked out,";
409 $csv->combine(@line);
410 print $csv->string, "\n";
412 # Adding not found barcodes
413 foreach my $error (@errorloop) {
415 if ($error->{'ERR_BARCODE'}) {
416 push @line, map { $_ eq 'barcode' ?
$error->{'barcode'} : ''} @keys;
417 push @line, "barcode not found";
418 $csv->combine(@line);
419 print $csv->string, "\n";
425 output_html_with_http_headers
$input, $cookie, $template->output;
427 sub additemtoresults
{
428 my ( $item, $results ) = @_;
429 my $itemno = $item->{itemnumber
};
430 # since the script appends to $item, we can just overwrite the hash entry
431 $results->{$itemno} = $item;