Not splitting pays time dividends:

sub checkUPCGrandFather2 {
    my $str = shift;
   
    return "should be 12 digits in length" if length ($str) != 12;
   
    my $t = 0;
    my $sum = 0;
   
    # loop through to sum even and adjusted odd chars
    for (0..10) {
        my $chr = substr $str, $_, 1;
        $sum += ($t ^= 1) ? $chr * 3 : $chr; 
    }
   
    # calculate correct check digit
    my $check = (10 - $sum % 10) % 10;
   
    # return error message if wrong check digit was initially given
    return ($check != substr $str, 11) ? "invalid checkdigit...should 
+be $check" : 'Ok';
}
[download]

gives the following improvement:

checkUPCGrandFather1: invalid checkdigit...should be 6
checkUPCGrandFather2: invalid checkdigit...should be 6
checkUPCroboticus: invalid checkdigit...should be 6
checkUPCEvanK: invalid checkdigit...should be 6
                Rate GrandFather1        EvanK    roboticus GrandFathe
+r2
GrandFather1 21630/s           --         -11%         -19%         -7
+2%
EvanK        24183/s          12%           --          -9%         -6
+9%
roboticus    26595/s          23%          10%           --         -6
+5%
GrandFather2 76965/s         256%         218%         189%           
+--
[download]

Using the autoflush buffer variable trick and the trinary operator along with modifiers and replacing the while loop by using % gives:

use warnings;
use strict;

print checkUPC('064200115896');

sub checkUPC {
    # grab and immediately split upc into array, 1 char per element
    my @chars = split //, shift;
    
    return "should be 12 digits in length" if @chars != 12;
    
    local $| = 0;
    my $sum = 0;
    
    # loop through to sum even and adjusted odd chars
    $sum += $chars[$_] * (--$| ? 3 : 1) foreach 0..10;
    
    # calculate correct check digit
    my $check = (10 - $sum % 10) % 10;
    
    # return error message if wrong check digit was initially given
    return $check != $chars[11] ? "invalid checkdigit...should be $che
+ck" : 'Ok';
}
[download]

Prints:

Ok
[download]

Note that this version returns Ok on success. Replace 'Ok' with undef for original behaviour.

Why use a special variable in an unintended and undocumented manner when you can use ($t^=1)?

Change
local $| = 0; $sum += $chars[$_] * (--$| ? 3 : 1) foreach 0..10;
to:
my $t = 0; $sum += $chars[$_] * (($t^=1) ? 3 : 1) foreach 0..10;

Update: sgifford improved this to:
my $t = 1; $sum += $chars[$_] * ($t^=2) foreach 0..10;

Update:
my $check = (10 - $sum % 10) % 10;
simplifies to
my $check = -$sum % 10;

This whole process involves separately summing the odd digits of the upc and multiplying it by 3, then the even digits, then summing the two results.

If I understand the whole process as you described it, this snippet does what you've described:

use strict;
use warnings;

use List::Util qw/sum/;

my $test_number = 123456789012;

$test_number =~ m/^\d{12}$/ or die "Invalid code.\n";

my( @even ) = reverse( $test_number ) =~ m/\d(\d)/g;
my( @odd  ) = reverse( $test_number ) =~ m/(\d)\d?/g;


my $checksum = sum( @odd ) * 3 + sum( @even );

print $checksum, "\n";
[download]

I assumed (possibly errantly) that the first digit is the right-most digit (as is the case with actual numbers), and that 'odd' starts at that digit. That's why you see the use of the reverse function; to put the starting digit at the typical 'start' side of the string of digits. If you want the first digit to be the leftmost digit, simply drop the use of reverse().

perl -le'$m=1;$s+=$_*($m^=2)for(split(//,$ARGV[0]));
print(($s%10)?"BAD":"OK");'
[download]

OK, that's probably not very helpful, but contains a few useful things for a real implementation. First, you can sum the digits as you go along; you don't have to add first, then multiply. Second, odd digits get multiplied by 3 and even by 1; you can toggle between 3 and 1 by twiddling the 2 bit (since 3 ^ 2 == 1 and 1 ^ 2 == 3). Third, taking the sum, subtracting from the next highest multiple of 10, then comparing it to the check digit is the same as adding the check digit, taking the result modulo 10, and comparing to 0. Fourth, I've only been thinking about this problem for about 10 minutes, so please correct me if I'm wrong, but it does work with the test UPC. :-)

That leads to the more reasonable code:

sub check_upc
{
  my($upc)=@_;
  my $m = 1;
  for(split(//,$upc)) {
    $s += $_ * ($m^=2);
  }
  return (($s%10)?"Invalid checkdigit; should be @{[10-($s-chop($upc))
+%10]}"
                 :undef);
}
[download]

Mine still splits & loops. I made only small changes:

#!/usr/bin/perl -w
use strict;
use warnings;

# returns error message on failure, undefined value on success
sub checkUPCrobot
{
  # grab and immediately split upc into array, 1 char per element
  my @chars = split(//, shift);

  # return error message if incorrect length
  if( $#chars != 11 )
  { return "should be 12 digits in length"; }

  # loop through to seperately sum even and odd chars
  my $odd=shift @chars;
  my $even=0;
  foreach (0..4)
  {
    $even += shift @chars;
    $odd += shift @chars;
  }

  # calculate correct check digit
  my $mult = ($odd * 3) + $even;
  my $check = 10 - ($mult%10);

  # return error message if wrong check digit was initially given
  if($check != shift @chars)
  { return "invalid checkdigit...should be $check"; }

  # otherwise, if validated, return undefined
  return;
}
#...snipped out the original checkUPC here to save space...
print &checkUPC("142687305632"), "\n";
print &checkUPCrobot("142687305632"), "\n";
[download]

UPDATE: I fiddled with it a little longer and came up with a slightly improved model:

# returns error message on failure, undefined value on success
sub checkUPCrobot2
{
  # grab and immediately split upc into array, 1 char per element
  my @chars = split //, shift;

  # return error message if incorrect length
  return "should be 12 digits in length" if $#chars != 11;

  my ($even, $odd, $check);
  foreach (0..5) {
    $odd += shift @chars;
    $check = shift @chars;
    $even += $check;
  }
  my $mult = 3*$odd+$even-$check;
  my $chk2 = 10 - ($mult%10);
  return "invalid checkdigit...should be $chk2" if $check!=$chk2;
}
[download]

Note that the second version doesn't return undef.

---

DWIM is Perl's answer to Gödel

GrandFather:

OK ... I thought that since the return didn't get to return the string that the function would return undef. So I shouldn't've removed the "return undef;" at the end.

So what is returned, then? I'm suspecting that it's the value of the condition at the end (i.e. false), but I await edification! ;^)

--roboticus

local $_ = $code;
$check = tr/1/1/ + 6*tr/2/2/ + tr/3/3/ +
         12*tr/4/4/ + tr/5/5/ + 18*tr/6/6/ +
         tr/7/7/ + 24*tr/8/8/ + tr/9/9/;
[download]

That doesn't give a correct answer for the test UPC at the link provided by the OP, 064200115896. My interpretation of the algorithm was that whether to multiply by 3 or not based on whether the digit's position is odd or even, not its value.

--
sgifford's Web page