Business::CINS - Verify CUSIP International Numbering System Numbers

  use Business::CINS;
  $cn = Business::CINS->new('035231AH2');
  print "Looks good.\n" if $cn->is_valid;

  $cn = Business::CINS->new('392690QT', 1);
  $chk = $cn->check_digit;
  $cn->cins($cn->cins.$chk);
  print $cn->is_valid ? "Looks good." : "Invalid: ", $cn->error, "\n";

package Business::CINS;

use strict;
use Algorithm::LUHN ();
#  Add additional characters to Algorithm::LUHN::valid_chars so CUSIPs can be
# validated. 
{
my $ct = 10;
Algorithm::LUHN::valid_chars(map {$_ => $ct++} 'A'..'Z');
}
#Algorithm::LUHN::valid_chars('*',36, '@',37, '#',38);

use vars qw($VERSION $ERROR);

$VERSION = '1.13';

sub new {
  my ($class, $cins, $fixed_income) = @_;
  bless [$cins, ($fixed_income || 0)], $class;
}

sub cins {
  my $self = shift;
  $self->[0] = shift if @_;
  return $self->[0];
}

sub is_fixed_income {
  my $self = shift;
  $self->[1] = shift if @_;
  return $self->[1];
}

sub domicile_code {
  my $self = shift;
  return substr($self->cins, 0, 1);
}

sub issuer_num {
  my $self = shift;
  return substr($self->cins, 1, 5);
}

sub issue_num {
  my $self = shift;
  return substr($self->cins, 6, 2);
}

sub is_valid {
  my $self = shift;
  my $val = $self->cins;

  $ERROR = undef;

  # The CINS number consists of nine characters. The first six (6) positions,
  # known as the issuer number, consist of a country or regional alpha code of
  # one character, plus five positions, the last of which may be alpha or
  # numeric. A two character suffix (either numeric or alphabetic or both)
  # known as the issue number follows. The ninth character is a check digit.

  unless (length($val) == 9) {
    $ERROR = "CINS must be 9 characters long.";
    return '';
  }
  unless (Business::CINS->domicile_descr($self->domicile_code)) {
    $ERROR = "First character is not a valid domicile code.";
    return '';
  }
#    unless ($val =~ /^.\d{4}/) {
#      $ERROR = "Characters 2-5 must be numeric.";
#      return '';
#    }
  unless ($val =~ /^.[A-Z0-9]{7}/) {
    $ERROR = "Characters 2-8 must be A-Z, 0-9.";
    return '';
  }
  unless ($val =~ /\d$/) {
    $ERROR = "Character 9 (the check digit) must be numeric.";
    return '';
  }

  # From the CINS spec:

  # Issue Numbers for Fixed Income Securities: The issue number assigned to an
  # issuer's fixed income securities may consist of two alphabetic characters
  # (AA, etc.), one alphabetic character followed by one digit (A2, etc.) or
  # one digit followed by one alphabetic character (2A, etc.), assigned in that
  # order. Debt securities will be sorted in order by their maturity dates.
  if ($self->is_fixed_income) {
    my $issue_num = $self->issue_num;
    if ($issue_num !~ /^[A-Z][A-Z]$/ and
        $issue_num !~ /^[A-Z][0-9]$/ and
        $issue_num !~ /^[0-9][A-Z]$/) {
      $ERROR = "Fixed income issue number must be alpha-alpha, alpha-num or num-alpha only.";
      return '';
    }
  }

  my $r = Algorithm::LUHN::is_valid($self->cins);
  $ERROR = $Algorithm::LUHN::ERROR unless $r;
  return $r;
}

sub error {
  shift->is_valid;
  return $ERROR;
}

sub check_digit {
  my $self = shift;
  my $r = Algorithm::LUHN::check_digit(substr($self->cins(), 0, 8));
  $ERROR = $Algorithm::LUHN::ERROR unless defined $r;
  return $r;
}

{
my %domicile_cds =
  (A => 'Austria',        J => 'Japan',         S => 'South Africa',
   B => 'Belgium',        K => 'Denmark',       T => 'Italy',
   C => 'Canada',         L => 'Luxembourg',    U => 'United States',
   D => 'Germany',        M => 'Mid-East',      V => 'Africa - Other',
   E => 'Spain',          N => 'Netherlands',   W => 'Sweden',
   F => 'France',         P => 'South America', X => 'Europe-Other',
   G => 'United Kingdom', Q => 'Australia',     Y => 'Asia',
   H => 'Switzerland',    R => 'Norway',
);
sub domicile_descr {
  shift; # ignore the first argument.
  return (@_ ? $domicile_cds{$_[0]} : %domicile_cds);
}
}

1;
__END__