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 List
::MoreUtils
qw( none );
44 my $minlocation=$input->param('minlocation') || '';
45 my $maxlocation=$input->param('maxlocation');
46 $maxlocation=$minlocation.'Z' unless ( $maxlocation || ! $minlocation );
47 my $location=$input->param('location') || '';
48 my $ignoreissued=$input->param('ignoreissued');
49 my $ignore_waiting_holds = $input->param('ignore_waiting_holds');
50 my $datelastseen = $input->param('datelastseen'); # last inventory date
51 my $branchcode = $input->param('branchcode') || '';
52 my $branch = $input->param('branch');
53 my $op = $input->param('op');
54 my $compareinv2barcd = $input->param('compareinv2barcd');
55 my $dont_checkin = $input->param('dont_checkin');
56 my $out_of_order = $input->param('out_of_order');
58 my ( $template, $borrowernumber, $cookie ) = get_template_and_user
(
59 { template_name
=> "tools/inventory.tt",
63 flagsrequired
=> { tools
=> 'inventory' },
68 my @authorised_value_list;
69 my $authorisedvalue_categories = '';
71 my $frameworks = Koha
::BiblioFrameworks
->search({}, { order_by
=> ['frameworktext'] })->unblessed;
72 unshift @
$frameworks, { frameworkcode
=> '' };
74 for my $fwk ( @
$frameworks ){
75 my $fwkcode = $fwk->{frameworkcode
};
76 my $mss = Koha
::MarcSubfieldStructures
->search({ frameworkcode
=> $fwkcode, kohafield
=> 'items.location', authorised_value
=> [ -and => {'!=' => undef }, {'!=' => ''}] });
77 my $authcode = $mss->count ?
$mss->next->authorised_value : undef;
78 if ($authcode && $authorisedvalue_categories!~/\b$authcode\W/){
79 $authorisedvalue_categories.="$authcode ";
80 my $data=GetAuthorisedValues
($authcode);
81 foreach my $value (@
$data){
82 $value->{selected
}=1 if ($value->{authorised_value
} eq ($location));
84 push @authorised_value_list,@
$data;
90 for my $statfield (qw
/items.notforloan items.itemlost items.withdrawn items.damaged/){
92 $hash->{fieldname
} = $statfield;
93 my $mss = Koha
::MarcSubfieldStructures
->search({ frameworkcode
=> '', kohafield
=> $statfield, authorised_value
=> [ -and => {'!=' => undef }, {'!=' => ''}] });
94 $hash->{authcode
} = $mss->count ?
$mss->next->authorised_value : undef;
95 if ($hash->{authcode
}){
96 my $arr = GetAuthorisedValues
($hash->{authcode
});
97 if ( $statfield eq 'items.notforloan') {
98 # Add notforloan == 0 to the list of possible notforloan statuses
99 # The lib value is replaced in the template
100 push @
$arr, { authorised_value
=> 0, id
=> 'stat0' , lib
=> '__IGNORE__' } if ! grep { $_->{authorised_value
} eq '0' } @
$arr;
101 @notforloans = map { $_->{'authorised_value'} } @
$arr;
103 $hash->{values} = $arr;
104 push @
$statuses, $hash;
108 $template->param( statuses
=> $statuses );
109 my $staton = {}; #authorized values that are ticked
110 for my $authvfield (@
$statuses) {
111 $staton->{$authvfield->{fieldname
}} = [];
112 for my $authval (@
{$authvfield->{values}}){
113 if ( defined $input->param('status-' . $authvfield->{fieldname
} . '-' . $authval->{authorised_value
}) && $input->param('status-' . $authvfield->{fieldname
} . '-' . $authval->{authorised_value
}) eq 'on' ){
114 push @
{$staton->{$authvfield->{fieldname
}}}, $authval->{authorised_value
};
120 authorised_values
=> \
@authorised_value_list,
121 today
=> dt_from_string
,
122 minlocation
=> $minlocation,
123 maxlocation
=> $maxlocation,
124 location
=> $location,
125 ignoreissued
=> $ignoreissued,
126 branchcode
=> $branchcode,
128 datelastseen
=> $datelastseen,
129 compareinv2barcd
=> $compareinv2barcd,
130 uploadedbarcodesflag
=> $uploadbarcodes ?
1 : 0,
131 ignore_waiting_holds
=> $ignore_waiting_holds,
134 # Walk through uploaded barcodes, report errors, mark as seen, check in
138 my $moddatecount = 0;
139 if ( $uploadbarcodes && length($uploadbarcodes) > 0 ) {
140 my $dbh = C4
::Context
->dbh;
141 my $date = dt_from_string
( scalar $input->param('setdate') );
142 $date = output_pref
( { dt
=> $date, dateformat
=> 'iso' } );
144 my $strsth = "select * from issues, items where items.itemnumber=issues.itemnumber and items.barcode =?";
145 my $qonloan = $dbh->prepare($strsth);
146 $strsth="select * from items where items.barcode =? and items.withdrawn = 1";
147 my $qwithdrawn = $dbh->prepare($strsth);
150 my @uploadedbarcodes;
152 my $sth = $dbh->column_info(undef,undef,"items","barcode");
153 my $barcode_def = $sth->fetchall_hashref('COLUMN_NAME');
154 my $barcode_size = $barcode_def->{barcode
}->{COLUMN_SIZE
};
158 binmode($uploadbarcodes, ":encoding(UTF-8)");
159 while (my $barcode=<$uploadbarcodes>) {
160 push @uploadedbarcodes, grep { /\S/ } split( /[\n\r,;|-]/, $barcode );
162 for my $barcode (@uploadedbarcodes) {
163 next unless $barcode;
165 if (length($barcode)>$barcode_size) {
168 my $check_barcode = $barcode;
169 $check_barcode =~ s/\p{Print}//g;
170 if (length($check_barcode)>0) { # Only printable unicode characters allowed.
173 next if length($barcode)>$barcode_size;
174 next if ( length($check_barcode)>0 );
175 push @barcodes,$barcode;
177 $template->param( LinesRead
=> $lines_read );
179 push @errorloop, {'barcode'=>'No valid barcodes!'};
180 $op=''; # force the initial inventory screen again.
183 $template->param( err_length
=> $err_length,
184 err_data
=> $err_data );
186 foreach my $barcode (@barcodes) {
187 if ( $qwithdrawn->execute($barcode) && $qwithdrawn->rows ) {
188 push @errorloop, { 'barcode' => $barcode, 'ERR_WTHDRAWN' => 1 };
190 my $item = GetItem
( '', $barcode );
191 if ( defined $item && $item->{'itemnumber'} ) {
192 # Modify date last seen for scanned items, remove lost status
193 ModItem
( { itemlost
=> 0, datelastseen
=> $date }, undef, $item->{'itemnumber'} );
195 # update item hash accordingly
196 $item->{itemlost
} = 0;
197 $item->{datelastseen
} = $date;
198 unless ( $dont_checkin ) {
199 $qonloan->execute($barcode);
201 my $data = $qonloan->fetchrow_hashref;
202 my ($doreturn, $messages, $iteminformation, $borrower) =AddReturn
($barcode, $data->{homebranch
});
204 $item->{onloan
} = undef;
205 $item->{datelastseen
} = dt_from_string
;
207 push @errorloop, { barcode
=> $barcode, ERR_ONLOAN_NOT_RET
=> 1 };
211 push @scanned_items, $item;
213 push @errorloop, { barcode
=> $barcode, ERR_BARCODE
=> 1 };
217 $template->param( date
=> $date );
218 $template->param( errorloop
=> \
@errorloop ) if (@errorloop);
221 # Build inventorylist: used as result list when you do not pass barcodes
222 # This list is also used when you want to compare with barcodes
223 my ( $inventorylist, $rightplacelist );
224 if ( $op && ( !$uploadbarcodes || $compareinv2barcd )) {
225 ( $inventorylist ) = GetItemsForInventory
({
226 minlocation
=> $minlocation,
227 maxlocation
=> $maxlocation,
228 location
=> $location,
229 ignoreissued
=> $ignoreissued,
230 datelastseen
=> $datelastseen,
231 branchcode
=> $branchcode,
234 statushash
=> $staton,
235 ignore_waiting_holds
=> $ignore_waiting_holds,
238 # Build rightplacelist used to check if a scanned item is in the right place.
239 if( @scanned_items ) {
240 ( $rightplacelist ) = GetItemsForInventory
({
241 minlocation
=> $minlocation,
242 maxlocation
=> $maxlocation,
243 location
=> $location,
244 ignoreissued
=> undef,
245 datelastseen
=> undef,
246 branchcode
=> $branchcode,
250 ignore_waiting_holds
=> $ignore_waiting_holds,
252 # Convert the structure to a hash on barcode
254 map { $_->{barcode
} ?
( $_->{barcode
}, $_ ) : (); } @
$rightplacelist
258 # Report scanned items that are on the wrong place, or have a wrong notforloan
259 # status, or are still checked out.
260 for ( my $i = 0; $i < @scanned_items; $i++ ) {
262 my $item = $scanned_items[$i];
264 $item->{notforloancode
} = $item->{notforloan
}; # save for later use
265 my $fc = $item->{'frameworkcode'} || '';
267 # Populating with authorised values description
268 foreach my $field (qw
/ location notforloan itemlost damaged withdrawn /) {
269 my $av = Koha
::AuthorisedValues
->get_description_by_koha_field(
270 { frameworkcode
=> $fc, kohafield
=> "items.$field", authorised_value
=> $item->{$field} } );
271 if ( $av and defined $item->{$field} and defined $av->{lib
} ) {
272 $item->{$field} = $av->{lib
};
276 # If we have scanned items with a non-matching notforloan value
277 if( none
{ $item->{'notforloancode'} eq $_ } @notforloans ) {
278 $item->{problems
}->{changestatus
} = 1;
279 additemtoresults
( $item, $results );
282 # Check for items shelved out of order
285 my $previous_item = $scanned_items[ $i - 1 ];
286 if ( $previous_item && $item->{cn_sort
} lt $previous_item->{cn_sort
} ) {
287 $item->{problems
}->{out_of_order
} = 1;
288 additemtoresults
( $item, $results );
291 unless ( $i == scalar(@scanned_items) ) {
292 my $next_item = $scanned_items[ $i + 1 ];
293 if ( $next_item && $item->{cn_sort
} gt $next_item->{cn_sort
} ) {
294 $item->{problems
}->{out_of_order
} = 1;
295 additemtoresults
( $item, $results );
300 # Report an item that is checked out (unusual!) or wrongly placed
301 if( $item->{onloan
} ) {
302 $item->{problems
}->{checkedout
} = 1;
303 additemtoresults
( $item, $results );
304 next; # do not modify item
305 } elsif( !exists $rightplacelist->{ $item->{barcode
} } ) {
306 $item->{problems
}->{wrongplace
} = 1;
307 additemtoresults
( $item, $results );
311 # Compare barcodes with inventory list, report no_barcode and not_scanned.
312 # not_scanned can be interpreted as missing
313 if ( $compareinv2barcd ) {
314 my @scanned_barcodes = map {$_->{barcode
}} @scanned_items;
315 for my $item ( @
$inventorylist ) {
316 my $barcode = $item->{barcode
};
318 $item->{problems
}->{no_barcode
} = 1;
319 } elsif ( grep /^$barcode$/, @scanned_barcodes ) {
322 $item->{problems
}->{not_scanned
} = 1;
324 additemtoresults
( $item, $results );
328 # Construct final results, add biblio information
329 my $loop = $uploadbarcodes
330 ?
[ map { $results->{$_} } keys %$results ]
331 : $inventorylist // [];
332 for my $item ( @
$loop ) {
333 my $biblio = Koha
::Biblios
->find( $item->{biblionumber
} );
334 $item->{title
} = $biblio->title;
335 $item->{author
} = $biblio->author;
339 moddatecount
=> $moddatecount,
345 if (defined $input->param('CSVexport') && $input->param('CSVexport') eq 'on'){
346 eval {use Text
::CSV
};
347 my $csv = Text
::CSV
->new or
348 die Text
::CSV
->error_diag ();
349 binmode STDOUT
, ":encoding(UTF-8)";
350 print $input->header(
352 -attachment
=> 'inventory.csv',
355 my $columns_def_hashref = C4
::Reports
::Guided
::_get_column_defs
($input);
356 foreach my $key ( keys %$columns_def_hashref ) {
358 $key =~ s/[^\.]*\.//;
359 $columns_def_hashref->{$initkey}=NormalizeString
($columns_def_hashref->{$initkey} // '');
360 $columns_def_hashref->{$key} = $columns_def_hashref->{$initkey};
364 for my $key (qw
/ biblioitems
.title biblio
.author
365 items
.barcode items
.itemnumber
366 items
.homebranch items
.location
367 items
.itemcallnumber items
.notforloan
368 items
.itemlost items
.damaged
369 items
.withdrawn items
.stocknumber
371 push @translated_keys, $columns_def_hashref->{$key};
373 push @translated_keys, 'problem' if $uploadbarcodes;
375 $csv->combine(@translated_keys);
376 print $csv->string, "\n";
378 my @keys = qw
/ title author barcode itemnumber homebranch location itemcallnumber notforloan itemlost damaged withdrawn stocknumber /;
379 for my $item ( @
$loop ) {
381 for my $key (@keys) {
382 push @line, $item->{$key};
385 foreach my $key ( keys %{$item->{problems
}} ) {
386 if( $key eq 'wrongplace' ) {
387 $errstr .= "wrong place,";
388 } elsif( $key eq 'changestatus' ) {
389 $errstr .= "unknown notforloan status,";
390 } elsif( $key eq 'not_scanned' ) {
391 $errstr .= "missing,";
392 } elsif( $key eq 'no_barcode' ) {
393 $errstr .= "no barcode,";
394 } elsif( $key eq 'checkedout' ) {
395 $errstr .= "checked out,";
400 $csv->combine(@line);
401 print $csv->string, "\n";
403 # Adding not found barcodes
404 foreach my $error (@errorloop) {
406 if ($error->{'ERR_BARCODE'}) {
407 push @line, map { $_ eq 'barcode' ?
$error->{'barcode'} : ''} @keys;
408 push @line, "barcode not found";
409 $csv->combine(@line);
410 print $csv->string, "\n";
416 output_html_with_http_headers
$input, $cookie, $template->output;
418 sub additemtoresults
{
419 my ( $item, $results ) = @_;
420 my $itemno = $item->{itemnumber
};
421 # since the script appends to $item, we can just overwrite the hash entry
422 $results->{$itemno} = $item;