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
38 use Koha
::AuthorisedValues
;
39 use Koha
::BiblioFrameworks
;
40 use List
::MoreUtils
qw( none );
42 my $minlocation=$input->param('minlocation') || '';
43 my $maxlocation=$input->param('maxlocation');
44 $maxlocation=$minlocation.'Z' unless ( $maxlocation || ! $minlocation );
45 my $location=$input->param('location') || '';
46 my $ignoreissued=$input->param('ignoreissued');
47 my $datelastseen = $input->param('datelastseen'); # last inventory date
48 my $branchcode = $input->param('branchcode') || '';
49 my $branch = $input->param('branch');
50 my $op = $input->param('op');
51 my $compareinv2barcd = $input->param('compareinv2barcd');
52 my $dont_checkin = $input->param('dont_checkin');
54 my ( $template, $borrowernumber, $cookie ) = get_template_and_user
(
55 { template_name
=> "tools/inventory.tt",
59 flagsrequired
=> { tools
=> 'inventory' },
64 my @authorised_value_list;
65 my $authorisedvalue_categories = '';
67 my $frameworks = Koha
::BiblioFrameworks
->search({}, { order_by
=> ['frameworktext'] })->unblessed;
68 unshift @
$frameworks, { frameworkcode
=> '' };
70 for my $fwk ( @
$frameworks ){
71 my $fwkcode = $fwk->{frameworkcode
};
72 my $mss = Koha
::MarcSubfieldStructures
->search({ frameworkcode
=> $fwkcode, kohafield
=> 'items.location', authorised_value
=> { not => undef } });
73 my $authcode = $mss->count ?
$mss->next->authorised_value : undef;
74 if ($authcode && $authorisedvalue_categories!~/\b$authcode\W/){
75 $authorisedvalue_categories.="$authcode ";
76 my $data=GetAuthorisedValues
($authcode);
77 foreach my $value (@
$data){
78 $value->{selected
}=1 if ($value->{authorised_value
} eq ($location));
80 push @authorised_value_list,@
$data;
86 for my $statfield (qw
/items.notforloan items.itemlost items.withdrawn items.damaged/){
88 $hash->{fieldname
} = $statfield;
89 my $mss = Koha
::MarcSubfieldStructures
->search({ frameworkcode
=> '', kohafield
=> $statfield, authorised_value
=> { not => undef } });
90 $hash->{authcode
} = $mss->count ?
$mss->next->authorised_value : undef;
91 if ($hash->{authcode
}){
92 my $arr = GetAuthorisedValues
($hash->{authcode
});
93 if ( $statfield eq 'items.notforloan') {
94 # Add notforloan == 0 to the list of possible notforloan statuses
95 # The lib value is replaced in the template
96 push @
$arr, { authorised_value
=> 0, id
=> 'stat0' , lib
=> 'ignore' } if ! grep { $_->{authorised_value
} eq '0' } @
$arr;
97 @notforloans = map { $_->{'authorised_value'} } @
$arr;
99 $hash->{values} = $arr;
100 push @
$statuses, $hash;
104 $template->param( statuses
=> $statuses );
105 my $staton = {}; #authorized values that are ticked
106 for my $authvfield (@
$statuses) {
107 $staton->{$authvfield->{fieldname
}} = [];
108 for my $authval (@
{$authvfield->{values}}){
109 if ( defined $input->param('status-' . $authvfield->{fieldname
} . '-' . $authval->{authorised_value
}) && $input->param('status-' . $authvfield->{fieldname
} . '-' . $authval->{authorised_value
}) eq 'on' ){
110 push @
{$staton->{$authvfield->{fieldname
}}}, $authval->{authorised_value
};
116 authorised_values
=> \
@authorised_value_list,
117 today
=> dt_from_string
,
118 minlocation
=> $minlocation,
119 maxlocation
=> $maxlocation,
120 location
=> $location,
121 ignoreissued
=> $ignoreissued,
122 branchcode
=> $branchcode,
124 datelastseen
=> $datelastseen,
125 compareinv2barcd
=> $compareinv2barcd,
126 uploadedbarcodesflag
=> $uploadbarcodes ?
1 : 0,
129 # Walk through uploaded barcodes, report errors, mark as seen, check in
133 my $moddatecount = 0;
134 if ( $uploadbarcodes && length($uploadbarcodes) > 0 ) {
135 my $dbh = C4
::Context
->dbh;
136 my $date = dt_from_string
( scalar $input->param('setdate') );
137 $date = output_pref
( { dt
=> $date, dateformat
=> 'iso' } );
139 my $strsth = "select * from issues, items where items.itemnumber=issues.itemnumber and items.barcode =?";
140 my $qonloan = $dbh->prepare($strsth);
141 $strsth="select * from items where items.barcode =? and items.withdrawn = 1";
142 my $qwithdrawn = $dbh->prepare($strsth);
145 my @uploadedbarcodes;
147 my $sth = $dbh->column_info(undef,undef,"items","barcode");
148 my $barcode_def = $sth->fetchall_hashref('COLUMN_NAME');
149 my $barcode_size = $barcode_def->{barcode
}->{COLUMN_SIZE
};
153 binmode($uploadbarcodes, ":encoding(UTF-8)");
154 while (my $barcode=<$uploadbarcodes>) {
155 $barcode =~ s/\r/\n/g;
156 $barcode =~ s/\n\n/\n/g;
157 my @data = split(/\n/,$barcode);
158 push @uploadedbarcodes, @data;
160 for my $barcode (@uploadedbarcodes) {
161 next unless $barcode;
163 if (length($barcode)>$barcode_size) {
166 my $check_barcode = $barcode;
167 $check_barcode =~ s/\p{Print}//g;
168 if (length($check_barcode)>0) { # Only printable unicode characters allowed.
171 next if length($barcode)>$barcode_size;
172 next if ( length($check_barcode)>0 );
173 push @barcodes,$barcode;
175 $template->param( LinesRead
=> $lines_read );
177 push @errorloop, {'barcode'=>'No valid barcodes!'};
178 $op=''; # force the initial inventory screen again.
181 $template->param( err_length
=> $err_length,
182 err_data
=> $err_data );
184 foreach my $barcode (@barcodes) {
185 if ( $qwithdrawn->execute($barcode) && $qwithdrawn->rows ) {
186 push @errorloop, { 'barcode' => $barcode, 'ERR_WTHDRAWN' => 1 };
188 my $item = GetItem
( '', $barcode );
189 if ( defined $item && $item->{'itemnumber'} ) {
190 # Modify date last seen for scanned items, remove lost status
191 ModItem
( { itemlost
=> 0, datelastseen
=> $date }, undef, $item->{'itemnumber'} );
193 # update item hash accordingly
194 $item->{itemlost
} = 0;
195 $item->{datelastseen
} = $date;
196 unless ( $dont_checkin ) {
197 $qonloan->execute($barcode);
199 my $data = $qonloan->fetchrow_hashref;
200 my ($doreturn, $messages, $iteminformation, $borrower) =AddReturn
($barcode, $data->{homebranch
});
202 $item->{onloan
} = undef;
203 $item->{datelastseen
} = dt_from_string
;
205 push @errorloop, { barcode
=> $barcode, ERR_ONLOAN_NOT_RET
=> 1 };
209 push @scanned_items, $item;
211 push @errorloop, { barcode
=> $barcode, ERR_BARCODE
=> 1 };
215 $template->param( date
=> $date );
216 $template->param( errorloop
=> \
@errorloop ) if (@errorloop);
219 # Build inventorylist: used as result list when you do not pass barcodes
220 # This list is also used when you want to compare with barcodes
221 my ( $inventorylist, $rightplacelist );
222 if ( $op && ( !$uploadbarcodes || $compareinv2barcd )) {
223 ( $inventorylist ) = GetItemsForInventory
({
224 minlocation
=> $minlocation,
225 maxlocation
=> $maxlocation,
226 location
=> $location,
227 ignoreissued
=> $ignoreissued,
228 datelastseen
=> $datelastseen,
229 branchcode
=> $branchcode,
232 statushash
=> $staton,
235 # Build rightplacelist used to check if a scanned item is in the right place.
236 if( @scanned_items ) {
237 ( $rightplacelist ) = GetItemsForInventory
({
238 minlocation
=> $minlocation,
239 maxlocation
=> $maxlocation,
240 location
=> $location,
241 ignoreissued
=> undef,
242 datelastseen
=> undef,
243 branchcode
=> $branchcode,
248 # Convert the structure to a hash on barcode
250 map { $_->{barcode
} ?
( $_->{barcode
}, $_ ) : (); } @
$rightplacelist
254 # Report scanned items that are on the wrong place, or have a wrong notforloan
255 # status, or are still checked out.
256 foreach my $item ( @scanned_items ) {
257 $item->{notforloancode
} = $item->{notforloan
}; # save for later use
258 my $fc = $item->{'frameworkcode'} || '';
260 # Populating with authorised values description
261 foreach my $field (qw
/ location notforloan itemlost damaged withdrawn /) {
262 my $av = Koha
::AuthorisedValues
->get_description_by_koha_field(
263 { frameworkcode
=> $fc, kohafield
=> "items.$field", authorised_value
=> $item->{$field} } );
264 if ( $av and defined $item->{$field} and defined $av->{lib
} ) {
265 $item->{$field} = $av->{lib
};
269 # If we have scanned items with a non-matching notforloan value
270 if( none
{ $item->{'notforloancode'} eq $_ } @notforloans ) {
271 $item->{problems
}->{changestatus
} = 1;
272 additemtoresults
( $item, $results );
275 # Report an item that is checked out (unusual!) or wrongly placed
276 if( $item->{onloan
} ) {
277 $item->{problems
}->{checkedout
} = 1;
278 additemtoresults
( $item, $results );
279 next; # do not modify item
280 } elsif( !exists $rightplacelist->{ $item->{barcode
} } ) {
281 $item->{problems
}->{wrongplace
} = 1;
282 additemtoresults
( $item, $results );
286 # Compare barcodes with inventory list, report no_barcode and not_scanned.
287 # not_scanned can be interpreted as missing
288 if ( $compareinv2barcd ) {
289 my @scanned_barcodes = map {$_->{barcode
}} @scanned_items;
290 for my $item ( @
$inventorylist ) {
291 my $barcode = $item->{barcode
};
293 $item->{problems
}->{no_barcode
} = 1;
294 } elsif ( grep /^$barcode$/, @scanned_barcodes ) {
297 $item->{problems
}->{not_scanned
} = 1;
299 additemtoresults
( $item, $results );
303 # Construct final results, add biblio information
304 my $loop = $uploadbarcodes
305 ?
[ map { $results->{$_} } keys %$results ]
306 : $inventorylist // [];
307 for my $item ( @
$loop ) {
308 my $biblio = C4
::Biblio
::GetBiblioData
($item->{biblionumber
});
309 $item->{title
} = $biblio->{title
};
310 $item->{author
} = $biblio->{author
};
314 moddatecount
=> $moddatecount,
320 if (defined $input->param('CSVexport') && $input->param('CSVexport') eq 'on'){
321 eval {use Text
::CSV
};
322 my $csv = Text
::CSV
->new or
323 die Text
::CSV
->error_diag ();
324 binmode STDOUT
, ":encoding(UTF-8)";
325 print $input->header(
327 -attachment
=> 'inventory.csv',
330 my $columns_def_hashref = C4
::Reports
::Guided
::_get_column_defs
($input);
331 foreach my $key ( keys %$columns_def_hashref ) {
333 $key =~ s/[^\.]*\.//;
334 $columns_def_hashref->{$initkey}=NormalizeString
($columns_def_hashref->{$initkey} // '');
335 $columns_def_hashref->{$key} = $columns_def_hashref->{$initkey};
339 for my $key (qw
/ biblioitems
.title biblio
.author
340 items
.barcode items
.itemnumber
341 items
.homebranch items
.location
342 items
.itemcallnumber items
.notforloan
343 items
.itemlost items
.damaged
344 items
.withdrawn items
.stocknumber
346 push @translated_keys, $columns_def_hashref->{$key};
348 push @translated_keys, 'problem' if $uploadbarcodes;
350 $csv->combine(@translated_keys);
351 print $csv->string, "\n";
353 my @keys = qw
/ title author barcode itemnumber homebranch location itemcallnumber notforloan lost damaged withdrawn stocknumber /;
354 for my $item ( @
$loop ) {
356 for my $key (@keys) {
357 push @line, $item->{$key};
360 foreach my $key ( keys %{$item->{problems
}} ) {
361 if( $key eq 'wrongplace' ) {
362 $errstr .= "wrong place,";
363 } elsif( $key eq 'changestatus' ) {
364 $errstr .= "unknown notforloan status,";
365 } elsif( $key eq 'not_scanned' ) {
366 $errstr .= "missing,";
367 } elsif( $key eq 'no_barcode' ) {
368 $errstr .= "no barcode,";
369 } elsif( $key eq 'checkedout' ) {
370 $errstr .= "checked out,";
375 $csv->combine(@line);
376 print $csv->string, "\n";
378 # Adding not found barcodes
379 foreach my $error (@errorloop) {
381 if ($error->{'ERR_BARCODE'}) {
382 push @line, map { $_ eq 'barcode' ?
$error->{'barcode'} : ''} @keys;
383 push @line, "barcode not found";
384 $csv->combine(@line);
385 print $csv->string, "\n";
391 output_html_with_http_headers
$input, $cookie, $template->output;
393 sub additemtoresults
{
394 my ( $item, $results ) = @_;
395 my $itemno = $item->{itemnumber
};
396 # since the script appends to $item, we can just overwrite the hash entry
397 $results->{$itemno} = $item;