From d7a0dcc55b2459a47d6371e5e849db4b36040099 Mon Sep 17 00:00:00 2001 From: Joe Atzberger Date: Fri, 2 Jan 2009 14:35:03 -0600 Subject: [PATCH] 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 --- C4/Circulation.pm | 45 ++++++++++++++++--------------- t/Circulation_barcodedecode.t | 51 +++++++++++++++++++++++++++++++++++ 2 files changed, 75 insertions(+), 21 deletions(-) create mode 100644 t/Circulation_barcodedecode.t diff --git a/C4/Circulation.pm b/C4/Circulation.pm index 15350376a3..f1ff0b8867 100644 --- a/C4/Circulation.pm +++ b/C4/Circulation.pm @@ -109,7 +109,7 @@ Also deals with stocktaking. =head2 barcodedecode -=head3 $str = &barcodedecode($barcode); +=head3 $str = &barcodedecode($barcode, [$filter]); =over 4 @@ -120,6 +120,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 @@ -128,31 +132,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 @@ -164,6 +164,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 @@ -176,7 +179,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; diff --git a/t/Circulation_barcodedecode.t b/t/Circulation_barcodedecode.t new file mode 100644 index 0000000000..5f2edc2245 --- /dev/null +++ b/t/Circulation_barcodedecode.t @@ -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 -- 2.39.5