view release on metacpan or  search on metacpan

UPCDatabase.pm  view on Meta::CPAN

package Net::UPCDatabase;

use 5.008;
use Frontier::Client;

our $VERSION = '0.07';

our $DEFAULTURL = 'http://www.upcdatabase.com/rpc';

=head1 NAME

Net::UPCDatabase - Simple OO interface to UPCDatabase.com

=head1 SYNOPSIS

  use Net::UPCDatabase;
  my $upcdb = Net::UPCDatabase->new;

  print "\n[lookup]\n";
  my $upc = '035000764119';
  my $item = $upcdb->lookup($upc);
  print "UPC: $item->{upc}\n";
  if ($item->{error}) {
    print "Error: $item->{error}\n";
  }
  else {
    print "Product: $item->{description}\n";
    print "Size: $item->{size}\n";
  }

  print "\n[convertUpcE]\n";
  my $upcE = '01212901';
  my $upcA = $upcdb->convertUpcE($upcE);
  print "UPCE: $upcA->{upcE}\n";
  if ($upcA->{error}) {
    print "Error: $upcA->{error}\n";
  }
  else {
    print "UPCA: $upcA->{upc}\n";
  }

  print "\n[calculateCheckDigit]\n";
  my $upcC = '01200000129C';
  my $upcA = $upcdb->calculateCheckDigit($upcE);
  print "UPCC: $upcA->{upcC}\n";
  if ($upcA->{error}) {
    print "Error: $upcA->{error}\n";
  }
  else {
    print "UPCA: $upcA->{upc}\n";
  }

=head1 DESCRIPTION

Connects to UPCDatabase.com to get information about a given UPC.

=head1 FUNCTIONS

=head2 new

  $upcObject = Net::UPCDatabase->new;

  # .. or ..

  $upcObject = Net::UPCDatabase->new( url => $aDifferentUrlThanDefault );

Accepts an B<OPTIONAL> argument, a URL to use instead of the default.  Unless you're really sure what you're doing, don't give it a URL.  It defaults to 'http://www.upcdatabase.com/rpc', which is probably the right thing.

Returns the object.

=cut

sub new {
  my $class = shift;
  my $self = bless({}, $class);
  my %arg = @_;
  $self->{_debug} = $arg{debug} || 0;
  $self->{_url} = $arg{url} || $DEFAULTURL;
  $self->{_coder} = Frontier::RPC2->new;
  $self->{_server} = Frontier::Client->new('url' => $self->{_url}, debug => $self->{_debug});
  return $self;
}

=head2 lookup

  $itemInfo = $upcObject->lookup($upc);

  # example usage
  my $ean = '0012000000133'; # pepsi 12oz can
  print "EAN: $ean\n";
  my $item = $upcdb->lookup($ean);
  die "LOOKUP-ERROR: $item->{error}\n" if $item->{error};
  print Dumper($item);

Accepts a B<REQUIRED> argument, the UPC to lookup.
The UPC can be UPC-E (8 digits), UPC-A (12 digits), or EAN (13 digits).

Returns the data about the given UPC in a hash reference.

On error, it returns the given error reason as C<< $itemInfo->{error} >>.

=cut

sub lookup
{
  my $self = shift;
  my $upc = uc(shift);
  my $response = {};
  $upc =~ s|X|C|g;
  $upc =~ s|[^0-9C]||g;
  if ($upc =~ m|^\d{8}$|)
  {
    my $upcA = $self->convertUpcE($upc);
    if ($upcA->{error})
    {
      $response = $upcA;
    }
    else
    {
      $upc = $upcA->{upc};
    }
  }
  if (!$response->{error} && $upc =~ m|C|)
  {
    my $upcC = $self->calculateCheckDigit($upc);
    if ($upcC->{error})
    {

UPCDatabase.pm  view on Meta::CPAN

    }
    elsif ($oddMissing)  # ???: Is there a better way to do this than a wasteful brute force method?
    {
      my $isDigit = 0;
      foreach $digit (0 .. 9)
      {
        my $theTotal = $evenTotal + $oddTotal + ($digit * 3);
        $theTotal -= int($theTotal / 10) * 10;
        $theTotal ||= 10;
        my $tCheck = 10 - $theTotal;
        if ($check == $tCheck)
        {
          $isDigit = $digit;
        }
      }
      $code =~ s|C|$isDigit|;
    }
    elsif ($evenMissing)
    {
      my $theTotal = $evenTotal + $oddTotal + $check;
      $theTotal -= int($theTotal / 10) * 10;
      $theTotal ||= 10;
      my $diff = 10 - $theTotal;
      $code =~ s|C|$diff|;
    }
    $response->{ean} = $code.$check;
  }
  else
  {
    $response->{error} = 'Unimplemented';
  }
  return $response;
}

=head1 DEPENDENCIES

L<Frontier::Client>
L<Frontier::RPC2>

=head1 TODO

=over

=item UPC checksum checking/creation

Clean up calculation of odd-position checkdigit calculation.
It currently uses an inefficient brute-force method of calculation for that position.
Even-position and checksum position calculation is pretty efficient.
OEOEOEOEOEOX (O=odd, E=even, X=checksum)
It's not *really* that wasteful, just not as efficient as it could be.

=back

=head1 BUGS

Report bugs on the CPAN bug tracker.
Please, do complain if something is broken.

=head1 SEE ALSO

L<http://www.upcdatabase.com/>

=head1 COPYRIGHT AND LICENSE

Copyright 2005-2009 by Dusty Wilson

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;