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);
164 my @uploadedbarcodes;
166 my $sth = $dbh->column_info(undef,undef,"items","barcode");
167 my $barcode_def = $sth->fetchall_hashref('COLUMN_NAME');
168 my $barcode_size = $barcode_def->{barcode
}->{COLUMN_SIZE
};
172 binmode($uploadbarcodes, ":encoding(UTF-8)");
173 while (my $barcode=<$uploadbarcodes>) {
174 $barcode =~ s/\r/\n/g;
175 $barcode =~ s/\n\n/\n/g;
176 my @data = split(/\n/,$barcode);
177 push @uploadedbarcodes, @data;
179 for my $barcode (@uploadedbarcodes) {
180 next unless $barcode;
182 if (length($barcode)>$barcode_size) {
185 my $check_barcode = $barcode;
186 $check_barcode =~ s/\p{Print}//g;
187 if (length($check_barcode)>0) { # Only printable unicode characters allowed.
190 next if length($barcode)>$barcode_size;
191 next if ( length($check_barcode)>0 );
192 push @barcodes,$barcode;
194 $template->param( LinesRead
=> $lines_read );
196 push @errorloop, {'barcode'=>'No valid barcodes!'};
197 $op=''; # force the initial inventory screen again.
200 $template->param( err_length
=> $err_length,
201 err_data
=> $err_data );
203 foreach my $barcode (@barcodes) {
204 if ( $qwithdrawn->execute($barcode) && $qwithdrawn->rows ) {
205 push @errorloop, { 'barcode' => $barcode, 'ERR_WTHDRAWN' => 1 };
207 my $item = GetItem
( '', $barcode );
208 if ( defined $item && $item->{'itemnumber'} ) {
209 ModItem
( { datelastseen
=> $date }, undef, $item->{'itemnumber'} );
210 push @scanned_items, $item;
212 $qonloan->execute($barcode);
214 my $data = $qonloan->fetchrow_hashref;
215 my ($doreturn, $messages, $iteminformation, $borrower) =AddReturn
($barcode, $data->{homebranch
});
217 push @errorloop, {'barcode'=>$barcode,'ERR_ONLOAN_RET'=>1}
219 push @errorloop, {'barcode'=>$barcode,'ERR_ONLOAN_NOT_RET'=>1}
223 push @errorloop, {'barcode'=>$barcode,'ERR_BARCODE'=>1};
229 $template->param( date
=> $date, Number
=> $count );
230 $template->param( errorloop
=> \
@errorloop ) if (@errorloop);
233 # now build the result list: inventoried items if requested, and mis-placed items -always-
236 my @items_with_problems;
237 if ( $markseen or $op ) {
238 # retrieve all items in this range.
241 # We use datelastseen only when comparing the results to the barcode file.
242 my $paramdatelastseen = ($compareinv2barcd) ?
$datelastseen : '';
243 ($inventorylist, $totalrecords) = GetItemsForInventory
($minlocation, $maxlocation, $location, $itemtype, $ignoreissued, $paramdatelastseen, $branchcode, $branch, 0, undef, $staton);
245 # For the items that may be marked as "wrong place", we only check the location (callnumbers, location and branch)
246 ($wrongplacelist, $totalrecords) = GetItemsForInventory
($minlocation, $maxlocation, $location, undef, undef, undef, $branchcode, $branch, 0, undef, undef);
250 # If "compare barcodes list to results" has been checked, we want to alert for missing items
251 if ( $compareinv2barcd ) {
252 # set "missing" flags for all items with a datelastseen (dls) before the choosen datelastseen (cdls)
253 my $dls = output_pref
( { dt
=> dt_from_string
( $datelastseen ),
254 dateformat
=> 'iso' } );
255 foreach my $item ( @
$inventorylist ) {
256 my $cdls = output_pref
( { dt
=> dt_from_string
( $item->{datelastseen
} ),
257 dateformat
=> 'iso' } );
258 if ( $cdls lt $dls ) {
259 $item->{problem
} = 'missingitem';
260 # We have to push a copy of the item, not the reference
261 push @items_with_problems, { %$item };
268 # insert "wrongplace" to all scanned items that are not supposed to be in this range
269 # note this list is always displayed, whatever the librarian has choosen for comparison
270 my $moddatecount = 0;
271 foreach my $item ( @scanned_items ) {
273 # Saving notforloan code before it's replaced by it's authorised value for later comparison
274 $item->{notforloancode
} = $item->{notforloan
};
276 # Populating with authorised values
277 foreach my $field ( keys %$item ) {
278 # If the koha field is mapped to a marc field
279 my $fc = $item->{'frameworkcode'} || '';
280 my ($f, $sf) = GetMarcFromKohaField
("items.$field", $fc);
282 # We replace the code with it's description
283 my $authvals = C4
::Koha
::GetKohaAuthorisedValuesFromField
($f, $sf, $fc);
284 if ($authvals and defined $item->{$field} and defined $authvals->{$item->{$field}}) {
285 $item->{$field} = $authvals->{$item->{$field}};
290 next if $item->{onloan
}; # skip checked out items
292 # If we have scanned items with a non-matching notforloan value
293 if (none
{ $item->{'notforloancode'} eq $_ } @notforloans) {
294 $item->{problem
} = 'changestatus';
295 push @items_with_problems, { %$item };
297 if (none
{ $item->{barcode
} eq $_->{barcode
} && !$_->{'onloan'} } @
$wrongplacelist) {
298 $item->{problem
} = 'wrongplace';
299 push @items_with_problems, { %$item };
302 # Modify date last seen for scanned items
303 ModDateLastSeen
($item->{'itemnumber'});
307 if ( $compareinv2barcd ) {
308 my @scanned_barcodes = map {$_->{barcode
}} @scanned_items;
309 for my $should_be_scanned ( @
$inventorylist ) {
310 my $barcode = $should_be_scanned->{barcode
};
311 unless ( grep /^$barcode$/, @scanned_barcodes ) {
312 $should_be_scanned->{problem
} = 'not_scanned';
313 push @items_with_problems, { %$should_be_scanned };
318 for my $item ( @items_with_problems ) {
319 my $biblio = C4
::Biblio
::GetBiblioData
($item->{biblionumber
});
320 $item->{title
} = $biblio->{title
};
321 $item->{author
} = $biblio->{author
};
324 # If a barcode file is given, we want to show problems, else all items
326 @results = $uploadbarcodes
327 ?
@items_with_problems
333 moddatecount
=> $moddatecount,
338 if (defined $input->param('CSVexport') && $input->param('CSVexport') eq 'on'){
339 eval {use Text
::CSV
};
340 my $csv = Text
::CSV
->new or
341 die Text
::CSV
->error_diag ();
342 binmode STDOUT
, ":encoding(UTF-8)";
343 print $input->header(
345 -attachment
=> 'inventory.csv',
348 my $columns_def_hashref = C4
::Reports
::Guided
::_get_column_defs
($input);
349 foreach my $key ( keys %$columns_def_hashref ) {
351 $key =~ s/[^\.]*\.//;
352 $columns_def_hashref->{$initkey}=NormalizeString
($columns_def_hashref->{$initkey} // '');
353 $columns_def_hashref->{$key} = $columns_def_hashref->{$initkey};
357 for my $key (qw
/ biblioitems
.title biblio
.author
358 items
.barcode items
.itemnumber
359 items
.homebranch items
.location
360 items
.itemcallnumber items
.notforloan
361 items
.itemlost items
.damaged
362 items
.withdrawn items
.stocknumber
364 push @translated_keys, $columns_def_hashref->{$key};
366 push @translated_keys, 'problem' if $uploadbarcodes;
368 $csv->combine(@translated_keys);
369 print $csv->string, "\n";
371 my @keys = qw
/ title author barcode itemnumber homebranch location itemcallnumber notforloan lost damaged withdrawn stocknumber /;
372 for my $item ( @results ) {
374 for my $key (@keys) {
375 push @line, $item->{$key};
377 if ( defined $item->{problem
} ) {
378 if ( $item->{problem
} eq 'wrongplace' ) {
379 push @line, "wrong place";
380 } elsif ( $item->{problem
} eq 'missingitem' ) {
381 push @line, "missing item";
382 } elsif ( $item->{problem
} eq 'changestatus' ) {
383 push @line, "change item status";
384 } elsif ($item->{problem
} eq 'not_scanned' ) {
385 push @line, "item not scanned";
388 $csv->combine(@line);
389 print $csv->string, "\n";
391 # Adding not found barcodes
392 foreach my $error (@errorloop) {
394 if ($error->{'ERR_BARCODE'}) {
395 push @line, map { $_ eq 'barcode' ?
$error->{'barcode'} : ''} @keys;
396 push @line, "barcode not found";
397 $csv->combine(@line);
398 print $csv->string, "\n";
404 output_html_with_http_headers
$input, $cookie, $template->output;