[oak perl] Customizing a Barcode Checkdigit Subroutine

[Larry Currie]

I wonder if anyone would be willing to help me modify a checkdigit
subroutine to fit our particular circumstances.  (If you think it would
be better to send this query to the Perl Basics Mailing List, I may try
that also.)

Under our current library system, we use 14 digit patron barcodes, and
the 14th digit is determined as follows:

1.  Multiply every other digit starting with the leftmost by 2 and total

the digits of any multi-digit product.  Sum the resulting digits.

2.  Add remainder of digits (every other digit starting with the second
from the left).

3.  Add result of step 1 and step 2 and substract the rightmost digit of

the sum from 10 to obtain the check digit.

Example:

       Given:   2 1 1 1 2 0 0 0 6 9 8 1 3 C     (C to be determined)

(mult by 2)   4    2    4    0    12 16   6     sum = 26    step 1

                      1    1    0    0    9    1         sum = 12   step

2

Step 3:       26
           +    12
              -----
                 38           10 - 8 = 2 = check digit.

Back in January, I tried to modify the checkdigit subroutine
to fit our circumstances, but I'm not sure that my code was completely
successful.  Would anyone want to take a shot at modifying this
subroutine to fit our circumstances, since we would like to use our
existing patron barcodes in our new library system?

The code, as it currently stands, is given below, and is based on a
barcode number that is 9 characters long (the letter V followed by 8
digits).  A valid barcode number returns the value of "1" in the
variable $valid.

sub checkdigit {
  my ($env,$infl) =  @_;
  $infl = uc $infl;
  my @weightings = (8,4,6,3,5,2,1);
  my $sum;
  my $i = 1;
  my $valid = 0;
  #  print $infl."<br>";
  while ($i <8) {
    my $temp1 = $weightings[$i-1];
    my $temp2 = substr($infl,$i,1);
    $sum = $sum + ($temp1*$temp2);
#    print "$sum $temp1 $temp2<br>";
    $i++;
  }
  my $rem = ($sum%11);
  if ($rem == 10) {
    $rem = "X";
  }
  #print $rem."<br>";
  if ($rem eq substr($infl,8,1)) {
    $valid = 1;
  }

Larry Currie

--
Lawrence W. Currie
User Services Librarian
California Academy of Sciences
Golden Gate Park
San Francisco, CA 94118
lcurrie at calacademy.org
(415) 750-7108
(415) 750-7106 fax
http://www.calacademy.org/research/library/