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');
35 use C4
::Branch
; # GetBranches
37 use C4
::Reports
::Guided
; #_get_column_defs
40 use List
::MoreUtils
qw( none );
43 my $minlocation=$input->param('minlocation') || '';
44 my $maxlocation=$input->param('maxlocation');
45 $maxlocation=$minlocation.'Z' unless ( $maxlocation || ! $minlocation );
46 my $location=$input->param('location') || '';
47 my $itemtype=$input->param('itemtype'); # FIXME note, template does not currently supply this
48 my $ignoreissued=$input->param('ignoreissued');
49 my $datelastseen = $input->param('datelastseen');
50 my $markseen = $input->param('markseen');
51 my $branchcode = $input->param('branchcode') || '';
52 my $branch = $input->param('branch');
53 my $op = $input->param('op');
54 my $compareinv2barcd = $input->param('compareinv2barcd');
56 my ( $template, $borrowernumber, $cookie ) = get_template_and_user
(
57 { template_name
=> "tools/inventory.tt",
61 flagsrequired
=> { tools
=> 'inventory' },
67 my $branches = GetBranches
();
69 for my $branch_hash (keys %$branches) {
70 push @branch_loop, {value
=> "$branch_hash",
71 branchname
=> $branches->{$branch_hash}->{'branchname'},
72 selected
=> ($branch_hash eq $branchcode?
1:0)};
75 @branch_loop = sort {$a->{branchname
} cmp $b->{branchname
}} @branch_loop;
76 my @authorised_value_list;
77 my $authorisedvalue_categories = '';
79 my $frameworks = getframeworks
();
80 $frameworks->{''} = {frameworkcode
=> ''}; # Add the default framework
82 for my $fwk (keys %$frameworks){
83 my $fwkcode = $frameworks->{$fwk}->{'frameworkcode'};
84 my $authcode = GetAuthValCode
('items.location', $fwkcode);
85 if ($authcode && $authorisedvalue_categories!~/\b$authcode\W/){
86 $authorisedvalue_categories.="$authcode ";
87 my $data=GetAuthorisedValues
($authcode);
88 foreach my $value (@
$data){
89 $value->{selected
}=1 if ($value->{authorised_value
} eq ($location));
91 push @authorised_value_list,@
$data;
96 for my $statfield (qw
/items.notforloan items.itemlost items.withdrawn items.damaged/){
98 $hash->{fieldname
} = $statfield;
99 $hash->{authcode
} = GetAuthValCode
($statfield);
100 if ($hash->{authcode
}){
101 my $arr = GetAuthorisedValues
($hash->{authcode
});
102 $hash->{values} = $arr;
103 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
};
121 for my $authvfield (@
$statuses) {
122 if ( scalar @
{$staton->{$authvfield->{fieldname
}}} > 0 ){
123 my $joinedvals = join ',', @
{$staton->{$authvfield->{fieldname
}}};
124 $statussth .= "$authvfield->{fieldname} in ($joinedvals) and ";
125 $notforloanlist = $joinedvals if ($authvfield->{fieldname
} eq "items.notforloan");
128 $statussth =~ s
, and $,,g
;
130 branchloop
=> \
@branch_loop,
131 authorised_values
=> \
@authorised_value_list,
132 today
=> dt_from_string
,
133 minlocation
=> $minlocation,
134 maxlocation
=> $maxlocation,
135 location
=> $location,
136 ignoreissued
=> $ignoreissued,
137 branchcode
=> $branchcode,
139 datelastseen
=> $datelastseen,
140 compareinv2barcd
=> $compareinv2barcd,
141 notforloanlist
=> $notforloanlist
145 if (defined $notforloanlist) {
146 @notforloans = split(/,/, $notforloanlist);
151 if ( $uploadbarcodes && length($uploadbarcodes) > 0 ) {
152 my $dbh = C4
::Context
->dbh;
153 my $date = dt_from_string
( $input->param('setdate') );
154 $date = output_pref
( { dt
=> $date, dateformat
=> 'iso' } );
156 my $strsth = "select * from issues, items where items.itemnumber=issues.itemnumber and items.barcode =?";
157 my $qonloan = $dbh->prepare($strsth);
158 $strsth="select * from items where items.barcode =? and items.withdrawn = 1";
159 my $qwithdrawn = $dbh->prepare($strsth);
165 my $sth = $dbh->column_info(undef,undef,"items","barcode");
166 my $barcode_def = $sth->fetchall_hashref('COLUMN_NAME');
167 my $barcode_size = $barcode_def->{barcode
}->{COLUMN_SIZE
};
171 binmode($uploadbarcodes, ":encoding(UTF-8)");
172 while (my $barcode=<$uploadbarcodes>){
173 $barcode =~ s/\r?\n$//;
174 next unless $barcode;
176 if (length($barcode)>$barcode_size) {
179 my $check_barcode = $barcode;
180 $check_barcode =~ s/\p{Print}//g;
181 if (length($check_barcode)>0) { # Only printable unicode characters allowed.
184 next if length($barcode)>$barcode_size;
185 next if ( length($check_barcode)>0 );
186 push @barcodes,$barcode;
188 $template->param( LinesRead
=> $lines_read );
190 push @errorloop, {'barcode'=>'No valid barcodes!'};
191 $op=''; # force the initial inventory screen again.
194 $template->param( err_length
=> $err_length,
195 err_data
=> $err_data );
197 foreach my $barcode (@barcodes) {
198 if ( $qwithdrawn->execute($barcode) && $qwithdrawn->rows ) {
199 push @errorloop, { 'barcode' => $barcode, 'ERR_WTHDRAWN' => 1 };
201 my $item = GetItem
( '', $barcode );
202 if ( defined $item && $item->{'itemnumber'} ) {
203 ModItem
( { datelastseen
=> $date }, undef, $item->{'itemnumber'} );
204 push @scanned_items, $item;
206 $qonloan->execute($barcode);
208 my $data = $qonloan->fetchrow_hashref;
209 my ($doreturn, $messages, $iteminformation, $borrower) =AddReturn
($barcode, $data->{homebranch
});
211 push @errorloop, {'barcode'=>$barcode,'ERR_ONLOAN_RET'=>1}
213 push @errorloop, {'barcode'=>$barcode,'ERR_ONLOAN_NOT_RET'=>1}
217 push @errorloop, {'barcode'=>$barcode,'ERR_BARCODE'=>1};
223 $template->param( date
=> $date, Number
=> $count );
224 $template->param( errorloop
=> \
@errorloop ) if (@errorloop);
227 # now build the result list: inventoried items if requested, and mis-placed items -always-
230 my @items_with_problems;
231 if ( $markseen or $op ) {
232 # retrieve all items in this range.
235 # We use datelastseen only when comparing the results to the barcode file.
236 my $paramdatelastseen = ($compareinv2barcd) ?
$datelastseen : '';
237 ($inventorylist, $totalrecords) = GetItemsForInventory
( {
238 minlocation
=> $minlocation,
239 maxlocation
=> $maxlocation,
240 location
=> $location,
241 itemtype
=> $itemtype,
242 ignoreissued
=> $ignoreissued,
243 datelastseen
=> $paramdatelastseen,
244 branchcode
=> $branchcode,
248 statushash
=> $staton,
249 interface
=> 'staff',
252 # For the items that may be marked as "wrong place", we only check the location (callnumbers, location and branch)
253 ($wrongplacelist, $totalrecords) = GetItemsForInventory
( {
254 minlocation
=> $minlocation,
255 maxlocation
=> $maxlocation,
256 location
=> $location,
258 ignoreissued
=> undef,
259 datelastseen
=> undef,
260 branchcode
=> $branchcode,
265 interface
=> 'staff',
270 # If "compare barcodes list to results" has been checked, we want to alert for missing items
271 if ( $compareinv2barcd ) {
272 # set "missing" flags for all items with a datelastseen (dls) before the choosen datelastseen (cdls)
273 my $dls = output_pref
( { dt
=> dt_from_string
( $datelastseen ),
274 dateformat
=> 'iso' } );
275 foreach my $item ( @
$inventorylist ) {
276 my $cdls = output_pref
( { dt
=> dt_from_string
( $_->{datelastseen
} ),
277 dateformat
=> 'iso' } );
278 if ( $cdls lt $dls ) {
279 $item->{problem
} = 'missingitem';
280 # We have to push a copy of the item, not the reference
281 push @items_with_problems, { %$item };
288 # insert "wrongplace" to all scanned items that are not supposed to be in this range
289 # note this list is always displayed, whatever the librarian has choosen for comparison
290 my $moddatecount = 0;
291 foreach my $item ( @scanned_items ) {
293 # Saving notforloan code before it's replaced by it's authorised value for later comparison
294 $item->{notforloancode
} = $item->{notforloan
};
296 # Populating with authorised values
297 foreach my $field ( keys %$item ) {
298 # If the koha field is mapped to a marc field
299 my $fc = $item->{'frameworkcode'} || '';
300 my ($f, $sf) = GetMarcFromKohaField
("items.$field", $fc);
302 # We replace the code with it's description
303 my $authvals = C4
::Koha
::GetKohaAuthorisedValuesFromField
($f, $sf, $fc);
304 if ($authvals and defined $item->{$field} and defined $authvals->{$item->{$field}}) {
305 $item->{$field} = $authvals->{$item->{$field}};
310 next if $item->{onloan
}; # skip checked out items
312 # If we have scanned items with a non-matching notforloan value
313 if (none
{ $item->{'notforloancode'} eq $_ } @notforloans) {
314 $item->{problem
} = 'changestatus';
315 push @items_with_problems, { %$item };
317 if (none
{ $item->{barcode
} eq $_->{barcode
} && !$_->{'onloan'} } @
$wrongplacelist) {
318 $item->{problem
} = 'wrongplace';
319 push @items_with_problems, { %$item };
322 # Modify date last seen for scanned items
323 ModDateLastSeen
($_->{'itemnumber'});
327 if ( $compareinv2barcd ) {
328 my @scanned_barcodes = map {$_->{barcode
}} @scanned_items;
329 for my $should_be_scanned ( @
$inventorylist ) {
330 my $barcode = $should_be_scanned->{barcode
};
331 unless ( grep /^$barcode$/, @scanned_barcodes ) {
332 $should_be_scanned->{problem
} = 'not_scanned';
333 push @items_with_problems, { %$should_be_scanned };
338 for my $item ( @items_with_problems ) {
339 my $biblio = C4
::Biblio
::GetBiblioData
($item->{biblionumber
});
340 $item->{title
} = $biblio->{title
};
341 $item->{author
} = $biblio->{author
};
344 # If a barcode file is given, we want to show problems, else all items
346 @results = $uploadbarcodes
347 ?
@items_with_problems
353 moddatecount
=> $moddatecount,
358 if (defined $input->param('CSVexport') && $input->param('CSVexport') eq 'on'){
359 eval {use Text
::CSV
};
360 my $csv = Text
::CSV
->new or
361 die Text
::CSV
->error_diag ();
362 binmode STDOUT
, ":encoding(UTF-8)";
363 print $input->header(
365 -attachment
=> 'inventory.csv',
368 my $columns_def_hashref = C4
::Reports
::Guided
::_get_column_defs
($input);
369 foreach my $key ( keys %$columns_def_hashref ) {
371 $key =~ s/[^\.]*\.//;
372 $columns_def_hashref->{$initkey}=NormalizeString
($columns_def_hashref->{$initkey} // '');
373 $columns_def_hashref->{$key} = $columns_def_hashref->{$initkey};
377 for my $key (qw
/ biblioitems
.title biblio
.author
378 items
.barcode items
.itemnumber
379 items
.homebranch items
.location
380 items
.itemcallnumber items
.notforloan
381 items
.itemlost items
.damaged
382 items
.withdrawn items
.stocknumber
384 push @translated_keys, $columns_def_hashref->{$key};
386 push @translated_keys, 'problem' if $uploadbarcodes;
388 $csv->combine(@translated_keys);
389 print $csv->string, "\n";
391 my @keys = qw
/ title author barcode itemnumber homebranch location itemcallnumber notforloan lost damaged withdrawn stocknumber /;
392 for my $item ( @results ) {
394 for my $key (@keys) {
395 push @line, $item->{$key};
397 if ( defined $item->{problem
} ) {
398 if ( $item->{problem
} eq 'wrongplace' ) {
399 push @line, "wrong place";
400 } elsif ( $item->{problem
} eq 'missingitem' ) {
401 push @line, "missing item";
402 } elsif ( $item->{problem
} eq 'changestatus' ) {
403 push @line, "change item status";
404 } elsif ($item->{problem
} eq 'not_scanned' ) {
405 push @line, "item not scanned";
408 $csv->combine(@line);
409 print $csv->string, "\n";
411 # Adding not found barcodes
412 foreach my $error (@errorloop) {
414 if ($error->{'ERR_BARCODE'}) {
415 push @line, map { $_ eq 'barcode' ?
$error->{'barcode'} : ''} @keys;
416 push @line, "barcode not found";
417 $csv->combine(@line);
418 print $csv->string, "\n";
424 output_html_with_http_headers
$input, $cookie, $template->output;