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>.
24 #need to open cgi and get the fh before anything else opens a new cgi context (see C4::Auth)
27 my $uploadbarcodes = $input->param('uploadbarcodes');
36 use C4
::Reports
::Guided
; #_get_column_defs
39 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 $itemtype=$input->param('itemtype'); # FIXME note, template does not currently supply this
47 my $ignoreissued=$input->param('ignoreissued');
48 my $datelastseen = $input->param('datelastseen');
49 my $markseen = $input->param('markseen');
50 my $branchcode = $input->param('branchcode') || '';
51 my $branch = $input->param('branch');
52 my $op = $input->param('op');
53 my $compareinv2barcd = $input->param('compareinv2barcd');
54 my $dont_checkin = $input->param('dont_checkin');
56 my ( $template, $borrowernumber, $cookie ) = get_template_and_user
(
57 { template_name
=> "tools/inventory.tt",
61 flagsrequired
=> { tools
=> 'inventory' },
66 my @authorised_value_list;
67 my $authorisedvalue_categories = '';
69 my $frameworks = getframeworks
();
70 $frameworks->{''} = {frameworkcode
=> ''}; # Add the default framework
72 for my $fwk (keys %$frameworks){
73 my $fwkcode = $frameworks->{$fwk}->{'frameworkcode'};
74 my $authcode = GetAuthValCode
('items.location', $fwkcode);
75 if ($authcode && $authorisedvalue_categories!~/\b$authcode\W/){
76 $authorisedvalue_categories.="$authcode ";
77 my $data=GetAuthorisedValues
($authcode);
78 foreach my $value (@
$data){
79 $value->{selected
}=1 if ($value->{authorised_value
} eq ($location));
81 push @authorised_value_list,@
$data;
86 for my $statfield (qw
/items.notforloan items.itemlost items.withdrawn items.damaged/){
88 $hash->{fieldname
} = $statfield;
89 $hash->{authcode
} = GetAuthValCode
($statfield);
90 if ($hash->{authcode
}){
91 my $arr = GetAuthorisedValues
($hash->{authcode
});
92 $hash->{values} = $arr;
93 push @
$statuses, $hash;
98 $template->param( statuses
=> $statuses );
99 my $staton = {}; #authorized values that are ticked
100 for my $authvfield (@
$statuses) {
101 $staton->{$authvfield->{fieldname
}} = [];
102 for my $authval (@
{$authvfield->{values}}){
103 if ( defined $input->param('status-' . $authvfield->{fieldname
} . '-' . $authval->{authorised_value
}) && $input->param('status-' . $authvfield->{fieldname
} . '-' . $authval->{authorised_value
}) eq 'on' ){
104 push @
{$staton->{$authvfield->{fieldname
}}}, $authval->{authorised_value
};
111 for my $authvfield (@
$statuses) {
112 if ( scalar @
{$staton->{$authvfield->{fieldname
}}} > 0 ){
113 my $joinedvals = join ',', @
{$staton->{$authvfield->{fieldname
}}};
114 $statussth .= "$authvfield->{fieldname} in ($joinedvals) and ";
115 $notforloanlist = $joinedvals if ($authvfield->{fieldname
} eq "items.notforloan");
118 $statussth =~ s
, and $,,g
;
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 notforloanlist
=> $notforloanlist
134 if (defined $notforloanlist) {
135 @notforloans = split(/,/, $notforloanlist);
140 if ( $uploadbarcodes && length($uploadbarcodes) > 0 ) {
141 my $dbh = C4
::Context
->dbh;
142 my $date = dt_from_string
( scalar $input->param('setdate') );
143 $date = output_pref
( { dt
=> $date, dateformat
=> 'iso' } );
145 my $strsth = "select * from issues, items where items.itemnumber=issues.itemnumber and items.barcode =?";
146 my $qonloan = $dbh->prepare($strsth);
147 $strsth="select * from items where items.barcode =? and items.withdrawn = 1";
148 my $qwithdrawn = $dbh->prepare($strsth);
153 my @uploadedbarcodes;
155 my $sth = $dbh->column_info(undef,undef,"items","barcode");
156 my $barcode_def = $sth->fetchall_hashref('COLUMN_NAME');
157 my $barcode_size = $barcode_def->{barcode
}->{COLUMN_SIZE
};
161 binmode($uploadbarcodes, ":encoding(UTF-8)");
162 while (my $barcode=<$uploadbarcodes>) {
163 $barcode =~ s/\r/\n/g;
164 $barcode =~ s/\n\n/\n/g;
165 my @data = split(/\n/,$barcode);
166 push @uploadedbarcodes, @data;
168 for my $barcode (@uploadedbarcodes) {
169 next unless $barcode;
171 if (length($barcode)>$barcode_size) {
174 my $check_barcode = $barcode;
175 $check_barcode =~ s/\p{Print}//g;
176 if (length($check_barcode)>0) { # Only printable unicode characters allowed.
179 next if length($barcode)>$barcode_size;
180 next if ( length($check_barcode)>0 );
181 push @barcodes,$barcode;
183 $template->param( LinesRead
=> $lines_read );
185 push @errorloop, {'barcode'=>'No valid barcodes!'};
186 $op=''; # force the initial inventory screen again.
189 $template->param( err_length
=> $err_length,
190 err_data
=> $err_data );
192 foreach my $barcode (@barcodes) {
193 if ( $qwithdrawn->execute($barcode) && $qwithdrawn->rows ) {
194 push @errorloop, { 'barcode' => $barcode, 'ERR_WTHDRAWN' => 1 };
196 my $item = GetItem
( '', $barcode );
197 if ( defined $item && $item->{'itemnumber'} ) {
198 ModItem
( { datelastseen
=> $date }, undef, $item->{'itemnumber'} );
199 push @scanned_items, $item;
201 unless ( $dont_checkin ) {
202 $qonloan->execute($barcode);
204 my $data = $qonloan->fetchrow_hashref;
205 my ($doreturn, $messages, $iteminformation, $borrower) =AddReturn
($barcode, $data->{homebranch
});
207 push @errorloop, {'barcode'=>$barcode,'ERR_ONLOAN_RET'=>1}
209 push @errorloop, {'barcode'=>$barcode,'ERR_ONLOAN_NOT_RET'=>1}
214 push @errorloop, {'barcode'=>$barcode,'ERR_BARCODE'=>1};
220 $template->param( date
=> $date, Number
=> $count );
221 $template->param( errorloop
=> \
@errorloop ) if (@errorloop);
224 # now build the result list: inventoried items if requested, and mis-placed items -always-
227 my @items_with_problems;
228 if ( $markseen or $op ) {
229 # retrieve all items in this range.
232 # We use datelastseen only when comparing the results to the barcode file.
233 my $paramdatelastseen = ($compareinv2barcd) ?
$datelastseen : '';
234 ($inventorylist, $totalrecords) = GetItemsForInventory
( {
235 minlocation
=> $minlocation,
236 maxlocation
=> $maxlocation,
237 location
=> $location,
238 itemtype
=> $itemtype,
239 ignoreissued
=> $ignoreissued,
240 datelastseen
=> $paramdatelastseen,
241 branchcode
=> $branchcode,
245 statushash
=> $staton,
246 interface
=> 'staff',
249 # For the items that may be marked as "wrong place", we only check the location (callnumbers, location and branch)
250 ($wrongplacelist, $totalrecords) = GetItemsForInventory
( {
251 minlocation
=> $minlocation,
252 maxlocation
=> $maxlocation,
253 location
=> $location,
255 ignoreissued
=> undef,
256 datelastseen
=> undef,
257 branchcode
=> $branchcode,
262 interface
=> 'staff',
267 # If "compare barcodes list to results" has been checked, we want to alert for missing items
268 if ( $compareinv2barcd ) {
269 # set "missing" flags for all items with a datelastseen (dls) before the chosen datelastseen (cdls)
270 my $dls = output_pref
( { dt
=> dt_from_string
( $datelastseen ),
271 dateformat
=> 'iso' } );
272 foreach my $item ( @
$inventorylist ) {
273 my $cdls = output_pref
( { dt
=> dt_from_string
( $item->{datelastseen
} ),
274 dateformat
=> 'iso' } );
275 if ( $cdls lt $dls ) {
276 $item->{problem
} = 'missingitem';
277 # We have to push a copy of the item, not the reference
278 push @items_with_problems, { %$item };
285 # insert "wrongplace" to all scanned items that are not supposed to be in this range
286 # note this list is always displayed, whatever the librarian has chosen for comparison
287 my $moddatecount = 0;
288 foreach my $item ( @scanned_items ) {
290 # Saving notforloan code before it's replaced by it's authorised value for later comparison
291 $item->{notforloancode
} = $item->{notforloan
};
293 # Populating with authorised values
294 foreach my $field ( keys %$item ) {
295 # If the koha field is mapped to a marc field
296 my $fc = $item->{'frameworkcode'} || '';
297 my ($f, $sf) = GetMarcFromKohaField
("items.$field", $fc);
299 # We replace the code with it's description
300 my $authvals = C4
::Koha
::GetKohaAuthorisedValuesFromField
($f, $sf, $fc);
301 if ($authvals and defined $item->{$field} and defined $authvals->{$item->{$field}}) {
302 $item->{$field} = $authvals->{$item->{$field}};
307 next if $item->{onloan
}; # skip checked out items
309 # If we have scanned items with a non-matching notforloan value
310 if (none
{ $item->{'notforloancode'} eq $_ } @notforloans) {
311 $item->{problem
} = 'changestatus';
312 push @items_with_problems, { %$item };
314 if (none
{ $item->{barcode
} eq $_->{barcode
} && !$_->{'onloan'} } @
$wrongplacelist) {
315 $item->{problem
} = 'wrongplace';
316 push @items_with_problems, { %$item };
319 # Modify date last seen for scanned items
320 ModDateLastSeen
($item->{'itemnumber'});
324 if ( $compareinv2barcd ) {
325 my @scanned_barcodes = map {$_->{barcode
}} @scanned_items;
326 for my $should_be_scanned ( @
$inventorylist ) {
327 my $barcode = $should_be_scanned->{barcode
};
328 unless ( grep /^$barcode$/, @scanned_barcodes ) {
329 $should_be_scanned->{problem
} = 'not_scanned';
330 push @items_with_problems, { %$should_be_scanned };
335 for my $item ( @items_with_problems ) {
336 my $biblio = C4
::Biblio
::GetBiblioData
($item->{biblionumber
});
337 $item->{title
} = $biblio->{title
};
338 $item->{author
} = $biblio->{author
};
341 # If a barcode file is given, we want to show problems, else all items
343 @results = $uploadbarcodes
344 ?
@items_with_problems
350 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 lost damaged withdrawn stocknumber /;
389 for my $item ( @results ) {
391 for my $key (@keys) {
392 push @line, $item->{$key};
394 if ( defined $item->{problem
} ) {
395 if ( $item->{problem
} eq 'wrongplace' ) {
396 push @line, "wrong place";
397 } elsif ( $item->{problem
} eq 'missingitem' ) {
398 push @line, "missing item";
399 } elsif ( $item->{problem
} eq 'changestatus' ) {
400 push @line, "change item status";
401 } elsif ($item->{problem
} eq 'not_scanned' ) {
402 push @line, "item not scanned";
405 $csv->combine(@line);
406 print $csv->string, "\n";
408 # Adding not found barcodes
409 foreach my $error (@errorloop) {
411 if ($error->{'ERR_BARCODE'}) {
412 push @line, map { $_ eq 'barcode' ?
$error->{'barcode'} : ''} @keys;
413 push @line, "barcode not found";
414 $csv->combine(@line);
415 print $csv->string, "\n";
421 output_html_with_http_headers
$input, $cookie, $template->output;