woc-commit

[Egon W. <eg...@us...>]

Update of /cvsroot/woc/woc/lib/perl
In directory usw-pr-cvs1:/tmp/cvs-serv30207

Added Files:
	check_digit.pm 
Log Message:
Added library for checking CAS numbers.



--- NEW FILE: check_digit.pm ---
#!/usr/local/bin/perl -w

package check_digit;

use strict;

BEGIN {
  use Exporter ();
  use vars qw( $VERSION @ISA @EXPORT);

  $VERSION = "1.00";
  @ISA         = qw( Exporter );
  @EXPORT      = qw( &check_digit );
}

sub check_digit {
  my $number = shift;

  if (($number =~ /^(\d+)\-(\d)(\d)\-(\d)$/) || ($number =~ /^WOC\-(\d+)\-(\d)(\d)\-(\d)$/)) {
    # verify check digit of CAS or WOC number
    my $firstpart = $1;
    my $sum = 2*$2 + $3;
    my $check_digit = $4;

    my $i = 3;
    while ($firstpart) {
      my $lastdigit = chop ($firstpart);
      $sum += $i * $lastdigit;
      $i++;
    }

    return ((chop ($sum) == $check_digit && "Correct"));
  } elsif (($number =~ /^(\d+)\-(\d)(\d)$/) || ($number =~ /^WOC\-(\d+)\-(\d)(\d)$/)) {
    # generate check digit for CAS or WOC number
    my $firstpart = $1;
    my $sum = 2*$2 + $3;

    my $i = 3;
    while ($firstpart) {
      my $lastdigit = chop ($firstpart);
      $sum += $i * $lastdigit;
      $i++;
    }

    return ("$number-".chop ($sum));
  } else {
    return ("Error: incorrect CAS or WOC number");
  }
}

1;