Business-Barcode-EAN13

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

NAME
    Business::Barcode::EAN13 - Perform simple validation of an EAN-13
    barcode

SYNOPSIS
      use Business::Barcode::EAN13 qw/valid_barcode check_digit issuer_ccode best_barcode/;

      my $is_valid     = valid_barcode("5023965006028");
      my $check_digit  = check_digit("502396500602"); 
      my $country_code = issuer_ccode("5023965006028");
      my $best_code    = best_barcode(\@barcodes, \@prefs);

DESCRIPTION
    These subroutines will tell you whether or not an EAN-13 barcode is
    self-consistent: i.e. whether or not it checksums correctly. If provided
    with the 12 digit stem of a barcode it will also return the correct
    check digit.

    We can also return the country in which the manufacturer's identifcation
    code was registered, and a method for picking a "most preferred" barcode
    from a list, given a preferred country list.

README  view on Meta::CPAN

    my $country_code = issuer_ccode("5023965006028"); # "uk"

    Returns the ISO 2 digit country code (you could use Locale::Country, or
    equivalent, to convert to the country name, if required) of the barcode
    issuer. (Note: This is not necessarily the same as the country of
    manufacture of the goods).

    This does not test the validity of the barcode.

  best_barcode
    my $best_barcode = best_barcode(\@list_of_barcodes, \@optional_prefs);

    Given an arrayref of barcodes, this will return the "most preferred"
    barcode from the list.

    If you don't pass any preferences, this will be the first valid barcode
    in the list. With a list of "preferred prefixes", this will return the
    best match from your list in order of preference of your prefix. A
    prefix can either be a numeric barcode stem, or a 2 letter country code,
    which will be expanded into the list of current barcode stems available
    to that country.

lib/Business/Barcode/EAN13.pm  view on Meta::CPAN

Business::Barcode::EAN13 - Perform simple validation of an EAN-13 barcode

=head1 SYNOPSIS

  use Business::Barcode::EAN13 qw/valid_barcode check_digit issuer_ccode best_barcode/;

  my $is_valid     = valid_barcode("5023965006028");
  my $check_digit  = check_digit("502396500602"); 
  my $country_code = issuer_ccode("5023965006028");
  my $best_code    = best_barcode(\@barcodes, \@prefs);

=head1 DESCRIPTION

These subroutines will tell you whether or not an EAN-13 barcode is
self-consistent: i.e. whether or not it checksums correctly. 
If provided with the 12 digit stem of a barcode it will also return the
correct check digit.

We can also return the country in which the manufacturer's identifcation
code was registered, and a method for picking a "most preferred" barcode

lib/Business/Barcode/EAN13.pm  view on Meta::CPAN

	_build_prefix() unless %prefix;

	foreach (keys %prefix) {
		return $_ if (my @match = grep { $bcode =~ /^$_/ } @{ $prefix{$_} });
	}
	return "";
}

=head2 best_barcode

my $best_barcode = best_barcode(\@list_of_barcodes, \@optional_prefs);

Given an arrayref of barcodes, this will return the "most preferred"
barcode from the list.

If you don't pass any preferences, this will be the first valid barcode
in the list. With a list of "preferred prefixes", this will return the
best match from your list in order of preference of your prefix. A
prefix can either be a numeric barcode stem, or a 2 letter country code,
which will be expanded into the list of current barcode stems available
to that country.

lib/Business/Barcode/EAN13.pm  view on Meta::CPAN

If there are no valid barcodes in your list this will return the first
barcode which would be valid if it was zero-padded, or null if none
meet this final criterion.

=cut

sub best_barcode {
	my $bref = shift;
	my $pref_ref = shift || [];
	_build_prefix() unless %prefix;
	my @prefs = map { @{ $prefix{$_} || [$_] } } @$pref_ref;

	my $best = "";
	my @invalids;
	BARCODE: foreach my $barcode (@$bref) {
		unless (valid_barcode($barcode)) {
			push @invalids => $barcode if (length $barcode < 13);
			next BARCODE;
		}

		# if we have no conditions, then any valid match wins ...
		return $barcode unless @prefs;
		PREF: foreach my $pref (0 .. @prefs - 1) {
			next PREF unless ($barcode =~ /^$prefs[$pref]/);
			return $barcode if ($pref == 0);
			$best = $barcode;
			splice @prefs, $pref;
			next BARCODE;
		}
		$best = $barcode;
	}

	# We have no valid matches, so check the invalids.
	# We should really check the preferences again here,
	# perhaps with something like:
	#  return $best if $best;
	#  return undef unless @invalids;

t/01.t  view on Meta::CPAN

  my @barcodes = qw/5391500385083 5014138036041/;
  is best_barcode(\@barcodes, ["uk", "ie"]), "5014138036041", "best barcode UK vs IE named";
}

# Picks correct barcode from a list
{
  my @barcodes = qw/5391500385083 5014138036041/;
  is best_barcode(\@barcodes, ["ie", "uk"]), "5391500385083", "best barcode IE vs UK named";
}

# Fails to pick a best barcode cos none are valid (no prefs)
{
  my @barcodes = qw/5023965006027 602396500602 50239650060289/;
  is undef, best_barcode(\@barcodes), "no best barcode, no prefs";
}

# Fails to pick a best barcode cos none are valid (UK prefs)
{
  my @barcodes = qw/5023965006027 602396500602 50239650060289/;
  my @prefs = qw/50/;
  is undef, best_barcode(\@barcodes, \@prefs), "no best barcode, prefs";
}

# Fails to pick a best barcode cos none are valid (named prefs)
{
  my @barcodes = qw/5023965006027 602396500602 50239650060289/;
  my @prefs = qw/uk ie/;
  is undef, best_barcode(\@barcodes, \@prefs), "no best barcode, named prefs";
}

# Picks correct barcode from a list, with no preferences
# and only one valid barcode
{
  my @barcodes = qw/5023965006028 5023965006027 502396500602 50239650060289/;
  is best_barcode(\@barcodes), "5023965006028", "best barcode, no prefs";
}

# Picks correct barcode from a list, with UK preference, but
# only one valid barcode
{
  my @prefs = qw/50/;
  my @barcodes = qw/5023965006028 5023965006027 502396500602 50239650060289/;
  is best_barcode(\@barcodes, \@prefs), "5023965006028", "best barcode, top pref";
}

# Picks correct barcode from a list, with non-existing preference, but
# only one valid barcode
{
  my @prefs = qw/70/;
  my @barcodes = qw/5023965006026 5023965006028 5023965006027 502396500602 50239650060289/;
  is best_barcode(\@barcodes, \@prefs), "5023965006028", "best barcode, none in prefs";
}

# Add some tests for fall through to invalids ...

# Test issuing country
is issuer_ccode("5023965006028"), "uk", "issuing country: uk";
is issuer_ccode("4303391576359"), "de", "issuing country: de";
is issuer_ccode("4601620100277"), "ru", "issuing country: ru";
is issuer_ccode("9999999999999"), "", "issuing country: n/a";