=head2 barcodedecode
-=head3 $str = &barcodedecode($barcode);
+=head3 $str = &barcodedecode($barcode, [$filter]);
=over 4
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
# 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
=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
my $l = ( $#s + 1 ) % 4;
if ($l) {
if ( $l == 1 ) {
- warn "Error!";
+ # warn "Error: Cuecat decode parsing failed!";
return;
}
$l = 4 - $l;
--- /dev/null
+#!/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