barcodedecode() did not always return barcode
This patch amends the function to return barcode, in particular when filter is not defined. It also adds an optional 2nd argument to allow the filter to be specified by caller, enabling testing. Non-DB-dependent test script included. Note: T-prefix style barcode filter is not documented, and drops the first nonzero digit after the T. This seems mistaken, but is not corrected here to avoid any surprises. Signed-off-by: Galen Charlton <galen.charlton@liblime.com>
This commit is contained in:
Joe Atzberger
Galen Charlton
parent
76309ae328
commit
9dbd65da27
2 changed files with 75 additions and 21 deletions
|
|
@ -113,7 +113,7 @@ Also deals with stocktaking.
|
|||
|
||||
=head2 barcodedecode
|
||||
|
||||
=head3 $str = &barcodedecode($barcode);
|
||||
=head3 $str = &barcodedecode($barcode, [$filter]);
|
||||
|
||||
=over 4
|
||||
|
||||
|
|
@ -124,6 +124,10 @@ to circulation.pl that differs from the barcode stored for the item.
|
|||
For proper functioning of this filter, calling the function on the
|
||||
correct barcode string (items.barcode) should return an unaltered barcode.
|
||||
|
||||
The optional $filter argument is to allow for testing or explicit
|
||||
behavior that ignores the System Pref. Valid values are the same as the
|
||||
System Pref options.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
|
@ -132,31 +136,27 @@ correct barcode string (items.barcode) should return an unaltered barcode.
|
|||
# FIXME -- these plugins should be moved out of Circulation.pm
|
||||
#
|
||||
sub barcodedecode {
|
||||
my ($barcode) = @_;
|
||||
my $filter = C4::Context->preference('itemBarcodeInputFilter');
|
||||
if($filter eq 'whitespace') {
|
||||
my ($barcode, $filter) = @_;
|
||||
$filter = C4::Context->preference('itemBarcodeInputFilter') unless $filter;
|
||||
$filter or return $barcode; # ensure filter is defined, else return untouched barcode
|
||||
if ($filter eq 'whitespace') {
|
||||
$barcode =~ s/\s//g;
|
||||
return $barcode;
|
||||
} elsif($filter eq 'cuecat') {
|
||||
} elsif ($filter eq 'cuecat') {
|
||||
chomp($barcode);
|
||||
my @fields = split( /\./, $barcode );
|
||||
my @results = map( decode($_), @fields[ 1 .. $#fields ] );
|
||||
if ( $#results == 2 ) {
|
||||
return $results[2];
|
||||
}
|
||||
else {
|
||||
return $barcode;
|
||||
}
|
||||
} elsif($filter eq 'T-prefix') {
|
||||
if ( $barcode =~ /^[Tt]/) {
|
||||
if (substr($barcode,1,1) eq '0') {
|
||||
return $barcode;
|
||||
} else {
|
||||
$barcode = substr($barcode,2) + 0 ;
|
||||
}
|
||||
($#results == 2) and return $results[2];
|
||||
} elsif ($filter eq 'T-prefix') {
|
||||
if ($barcode =~ /^[Tt](\d)/) {
|
||||
(defined($1) and $1 eq '0') and return $barcode;
|
||||
$barcode = substr($barcode, 2) + 0; # FIXME: probably should be substr($barcode, 1)
|
||||
}
|
||||
return sprintf( "T%07d",$barcode);
|
||||
return sprintf("T%07d", $barcode);
|
||||
# FIXME: $barcode could be "T1", causing warning: substr outside of string
|
||||
# Why drop the nonzero digit after the T?
|
||||
# Why pass non-digits (or empty string) to "T%07d"?
|
||||
}
|
||||
return $barcode; # return barcode, modified or not
|
||||
}
|
||||
|
||||
=head2 decode
|
||||
|
|
@ -168,6 +168,9 @@ sub barcodedecode {
|
|||
=item Decodes a segment of a string emitted by a CueCat barcode scanner and
|
||||
returns it.
|
||||
|
||||
FIXME: Should be replaced with Barcode::Cuecat from CPAN
|
||||
or Javascript based decoding on the client side.
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
|
@ -180,7 +183,7 @@ sub decode {
|
|||
my $l = ( $#s + 1 ) % 4;
|
||||
if ($l) {
|
||||
if ( $l == 1 ) {
|
||||
warn "Error!";
|
||||
# warn "Error: Cuecat decode parsing failed!";
|
||||
return;
|
||||
}
|
||||
$l = 4 - $l;
|
||||
|
|
|
|||
51
t/Circulation_barcodedecode.t
Normal file
51
t/Circulation_barcodedecode.t
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Test::More tests => 16;
|
||||
|
||||
BEGIN {
|
||||
use_ok('C4::Circulation');
|
||||
}
|
||||
|
||||
our %inputs = (
|
||||
cuecat => ["26002315", '.C3nZC3nZC3nYD3b6ENnZCNnY.fHmc.C3D1Dxr2C3nZE3n7.', ".C3nZC3nZC3nYD3b6ENnZCNnY.fHmc.C3D1Dxr2C3nZE3n7.\r\n",
|
||||
'q.C3nZC3nZC3nWDNzYDxf2CNnY.fHmc.C3DWC3nZCNjXD3nW.', '.C3nZC3nZC3nWCxjWE3D1C3nX.cGf2.ENr7C3v7D3T3ENj3C3zYDNnZ.' ],
|
||||
whitespace => [" 26002315", "26002315 ", "\n\t26002315\n"],
|
||||
'T-prefix' => [qw(T0031472 T32)],
|
||||
other => [qw(26002315 T0031472 T32 Alphanum123), "Alpha Num 345"],
|
||||
);
|
||||
our %outputs = (
|
||||
cuecat => ["26002315", "046675000808", "046675000808", "043000112403", "978068484914051500"],
|
||||
whitespace => [qw(26002315 26002315 26002315)],
|
||||
'T-prefix' => [qw(T0031472 T0000002 )],
|
||||
other => [qw(26002315 T0031472 T32 Alphanum123), "Alpha Num 345"],
|
||||
);
|
||||
|
||||
my @filters = sort keys %inputs;
|
||||
foreach my $filter (@filters) {
|
||||
foreach my $datum (@{$inputs{$filter}}) {
|
||||
my $expect = shift @{$outputs{$filter}} or die "Internal Test Error: missing expected output for filter '$filter' on input '$datum'";
|
||||
my $output = C4::Circulation::barcodedecode($datum, $filter);
|
||||
ok($output eq $expect, sprintf("%12s: %20s => %15s", $filter, "'$datum'", "'$expect'"));
|
||||
($output eq $expect) or diag "Bad output: '$output'";
|
||||
}
|
||||
}
|
||||
|
||||
__END__
|
||||
|
||||
=head2 C4::Circulation::barcodedecode()
|
||||
|
||||
This tests avoids being dependent on the database by using the optional
|
||||
second argument to barcodedecode.
|
||||
|
||||
T-prefix style is derived from zero-padded "Follett Classic Code 3 of 9". From:
|
||||
www.fsc.follett.com/_file/File/pdf/Barcode%20Symbology%20Q%20%20A%203_05.pdf
|
||||
|
||||
~ 1 to 7 characters
|
||||
~ T, P or X followed by numeric characters
|
||||
~ No checkdigit
|
||||
|
||||
=cut
|
||||
Loading…
Reference in a new issue