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
;
43 use List
::MoreUtils
qw( none );
45 my $minlocation=$input->param('minlocation') || '';
46 my $maxlocation=$input->param('maxlocation');
47 my $class_source=$input->param('class_source');
48 $maxlocation=$minlocation.'Z' unless ( $maxlocation || ! $minlocation );
49 my $location=$input->param('location') || '';
50 my $ignoreissued=$input->param('ignoreissued');
51 my $ignore_waiting_holds = $input->param('ignore_waiting_holds');
52 my $datelastseen = $input->param('datelastseen'); # last inventory date
53 my $branchcode = $input->param('branchcode') || '';
54 my $branch = $input->param('branch');
55 my $op = $input->param('op');
56 my $compareinv2barcd = $input->param('compareinv2barcd');
57 my $dont_checkin = $input->param('dont_checkin');
58 my $out_of_order = $input->param('out_of_order');
60 my ( $template, $borrowernumber, $cookie ) = get_template_and_user
(
61 { 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 push @uploadedbarcodes, grep { /\S/ } split( /[\n\r,;|-]/, $barcode );
170 for my $barcode (@uploadedbarcodes) {
171 next unless $barcode;
173 if (length($barcode)>$barcode_size) {
176 my $check_barcode = $barcode;
177 $check_barcode =~ s/\p{Print}//g;
178 if (length($check_barcode)>0) { # Only printable unicode characters allowed.
181 next if length($barcode)>$barcode_size;
182 next if ( length($check_barcode)>0 );
183 push @barcodes,$barcode;
185 $template->param( LinesRead
=> $lines_read );
187 push @errorloop, {'barcode'=>'No valid barcodes!'};
188 $op=''; # force the initial inventory screen again.
191 $template->param( err_length
=> $err_length,
192 err_data
=> $err_data );
194 foreach my $barcode (@barcodes) {
195 if ( $qwithdrawn->execute($barcode) && $qwithdrawn->rows ) {
196 push @errorloop, { 'barcode' => $barcode, 'ERR_WTHDRAWN' => 1 };
198 my $item = GetItem
( '', $barcode );
199 if ( defined $item && $item->{'itemnumber'} ) {
200 # Modify date last seen for scanned items, remove lost status
201 ModItem
( { itemlost
=> 0, datelastseen
=> $date }, undef, $item->{'itemnumber'} );
203 # update item hash accordingly
204 $item->{itemlost
} = 0;
205 $item->{datelastseen
} = $date;
206 unless ( $dont_checkin ) {
207 $qonloan->execute($barcode);
209 my $data = $qonloan->fetchrow_hashref;
210 my ($doreturn, $messages, $iteminformation, $borrower) =AddReturn
($barcode, $data->{homebranch
});
212 $item->{onloan
} = undef;
213 $item->{datelastseen
} = dt_from_string
;
215 push @errorloop, { barcode
=> $barcode, ERR_ONLOAN_NOT_RET
=> 1 };
219 push @scanned_items, $item;
221 push @errorloop, { barcode
=> $barcode, ERR_BARCODE
=> 1 };
225 $template->param( date
=> $date );
226 $template->param( errorloop
=> \
@errorloop ) if (@errorloop);
229 # Build inventorylist: used as result list when you do not pass barcodes
230 # This list is also used when you want to compare with barcodes
231 my ( $inventorylist, $rightplacelist );
232 if ( $op && ( !$uploadbarcodes || $compareinv2barcd )) {
233 ( $inventorylist ) = GetItemsForInventory
({
234 minlocation
=> $minlocation,
235 maxlocation
=> $maxlocation,
236 class_source
=> $class_source,
237 location
=> $location,
238 ignoreissued
=> $ignoreissued,
239 datelastseen
=> $datelastseen,
240 branchcode
=> $branchcode,
243 statushash
=> $staton,
244 ignore_waiting_holds
=> $ignore_waiting_holds,
247 # Build rightplacelist used to check if a scanned item is in the right place.
248 if( @scanned_items ) {
249 ( $rightplacelist ) = GetItemsForInventory
({
250 minlocation
=> $minlocation,
251 maxlocation
=> $maxlocation,
252 class_source
=> $class_source,
253 location
=> $location,
254 ignoreissued
=> undef,
255 datelastseen
=> undef,
256 branchcode
=> $branchcode,
260 ignore_waiting_holds
=> $ignore_waiting_holds,
262 # Convert the structure to a hash on barcode
264 map { $_->{barcode
} ?
( $_->{barcode
}, $_ ) : (); } @
$rightplacelist
268 # Report scanned items that are on the wrong place, or have a wrong notforloan
269 # status, or are still checked out.
270 for ( my $i = 0; $i < @scanned_items; $i++ ) {
272 my $item = $scanned_items[$i];
274 $item->{notforloancode
} = $item->{notforloan
}; # save for later use
275 my $fc = $item->{'frameworkcode'} || '';
277 # Populating with authorised values description
278 foreach my $field (qw
/ location notforloan itemlost damaged withdrawn /) {
279 my $av = Koha
::AuthorisedValues
->get_description_by_koha_field(
280 { frameworkcode
=> $fc, kohafield
=> "items.$field", authorised_value
=> $item->{$field} } );
281 if ( $av and defined $item->{$field} and defined $av->{lib
} ) {
282 $item->{$field} = $av->{lib
};
286 # If we have scanned items with a non-matching notforloan value
287 if( none
{ $item->{'notforloancode'} eq $_ } @notforloans ) {
288 $item->{problems
}->{changestatus
} = 1;
289 additemtoresults
( $item, $results );
292 # Check for items shelved out of order
295 my $previous_item = $scanned_items[ $i - 1 ];
296 if ( $previous_item && $item->{cn_sort
} lt $previous_item->{cn_sort
} ) {
297 $item->{problems
}->{out_of_order
} = 1;
298 additemtoresults
( $item, $results );
301 unless ( $i == scalar(@scanned_items) ) {
302 my $next_item = $scanned_items[ $i + 1 ];
303 if ( $next_item && $item->{cn_sort
} gt $next_item->{cn_sort
} ) {
304 $item->{problems
}->{out_of_order
} = 1;
305 additemtoresults
( $item, $results );
310 # Report an item that is checked out (unusual!) or wrongly placed
311 if( $item->{onloan
} ) {
312 $item->{problems
}->{checkedout
} = 1;
313 additemtoresults
( $item, $results );
314 next; # do not modify item
315 } elsif( !exists $rightplacelist->{ $item->{barcode
} } ) {
316 $item->{problems
}->{wrongplace
} = 1;
317 additemtoresults
( $item, $results );
321 # Compare barcodes with inventory list, report no_barcode and not_scanned.
322 # not_scanned can be interpreted as missing
323 if ( $compareinv2barcd ) {
324 my @scanned_barcodes = map {$_->{barcode
}} @scanned_items;
325 for my $item ( @
$inventorylist ) {
326 my $barcode = $item->{barcode
};
328 $item->{problems
}->{no_barcode
} = 1;
329 } elsif ( grep { $_ eq $barcode } @scanned_barcodes ) {
332 $item->{problems
}->{not_scanned
} = 1;
334 additemtoresults
( $item, $results );
338 # Construct final results, add biblio information
339 my $loop = $uploadbarcodes
340 ?
[ map { $results->{$_} } keys %$results ]
341 : $inventorylist // [];
342 for my $item ( @
$loop ) {
343 my $biblio = Koha
::Biblios
->find( $item->{biblionumber
} );
344 $item->{title
} = $biblio->title;
345 $item->{author
} = $biblio->author;
349 moddatecount
=> $moddatecount,
355 if (defined $input->param('CSVexport') && $input->param('CSVexport') eq 'on'){
356 eval {use Text
::CSV
};
357 my $csv = Text
::CSV
->new or
358 die Text
::CSV
->error_diag ();
359 binmode STDOUT
, ":encoding(UTF-8)";
360 print $input->header(
362 -attachment
=> 'inventory.csv',
365 my $columns_def_hashref = C4
::Reports
::Guided
::_get_column_defs
($input);
366 foreach my $key ( keys %$columns_def_hashref ) {
368 $key =~ s/[^\.]*\.//;
369 $columns_def_hashref->{$initkey}=NormalizeString
($columns_def_hashref->{$initkey} // '');
370 $columns_def_hashref->{$key} = $columns_def_hashref->{$initkey};
374 for my $key (qw
/ biblioitems
.title biblio
.author
375 items
.barcode items
.itemnumber
376 items
.homebranch items
.location
377 items
.itemcallnumber items
.notforloan
378 items
.itemlost items
.damaged
379 items
.withdrawn items
.stocknumber
381 push @translated_keys, $columns_def_hashref->{$key};
383 push @translated_keys, 'problem' if $uploadbarcodes;
385 $csv->combine(@translated_keys);
386 print $csv->string, "\n";
388 my @keys = qw
/ title author barcode itemnumber homebranch location itemcallnumber notforloan itemlost damaged withdrawn stocknumber /;
389 for my $item ( @
$loop ) {
391 for my $key (@keys) {
392 push @line, $item->{$key};
395 foreach my $key ( keys %{$item->{problems
}} ) {
396 if( $key eq 'wrongplace' ) {
397 $errstr .= "wrong place,";
398 } elsif( $key eq 'changestatus' ) {
399 $errstr .= "unknown notforloan status,";
400 } elsif( $key eq 'not_scanned' ) {
401 $errstr .= "missing,";
402 } elsif( $key eq 'no_barcode' ) {
403 $errstr .= "no barcode,";
404 } elsif( $key eq 'checkedout' ) {
405 $errstr .= "checked out,";
410 $csv->combine(@line);
411 print $csv->string, "\n";
413 # Adding not found barcodes
414 foreach my $error (@errorloop) {
416 if ($error->{'ERR_BARCODE'}) {
417 push @line, map { $_ eq 'barcode' ?
$error->{'barcode'} : ''} @keys;
418 push @line, "barcode not found";
419 $csv->combine(@line);
420 print $csv->string, "\n";
426 output_html_with_http_headers
$input, $cookie, $template->output;
428 sub additemtoresults
{
429 my ( $item, $results ) = @_;
430 my $itemno = $item->{itemnumber
};
431 # since the script appends to $item, we can just overwrite the hash entry
432 $results->{$itemno} = $item;