[Koha-patches] [PATCH] barcodedecode() did not always return barcode

[Joe Atzberger]

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.
---
 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 9e97d47..b389804 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 0000000..5f2edc2
--- /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
-- 
1.5.5.GIT