File Coverage

blib/lib/Business/BR/IE.pm

Criterion	Covered	Total	%
statement	320	361	88.6
branch	137	194	70.6
condition	40	66	60.6
subroutine	73	92	79.3
pod	0	76	0.0
total	570	789	72.2

package Business::BR::IE;

use 5;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT_OK = qw( canon_ie format_ie parse_ie random_ie );
our @EXPORT = qw( test_ie );

our $VERSION = '0.0022';
$VERSION = eval $VERSION;

use Business::BR::Ids::Common qw( _dot _dot_10 _canon_id );

### AC ###

# http://www.sintegra.gov.br/Cad_Estados/cad_AC.html

sub canon_ie_ac {
  return _canon_id(shift, size => 13);
}
sub test_ie_ac {
  my $ie = canon_ie_ac shift;
  return undef if length $ie != 13;
  return 0 unless $ie =~ /^01/;
  my @ie = split '', $ie;
  my $s1 = _dot([4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0], \@ie) % 11;
  unless ($s1==0 || $s1==1 && $ie[11]==0) {
    return 0;
  }
  my $s2 = _dot([5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 1], \@ie) % 11;
  return ($s2==0 || $s2==1 && $ie[12]==0) ? 1 : 0;

}
sub format_ie_ac {
  my $ie = canon_ie_ac shift;
  $ie =~ s|^(..)(...)(...)(...)(..).*|$1.$2.$3/$4-$5|; # 01.004.823/001-12
  return $ie;
}
sub _dv_ie_ac {
	my $base = shift; # expected to be canon'ed already ?!
	my $valid = @_ ? shift : 1;
	my $dev = $valid ? 0 : 2; # deviation (to make IE-PR invalid)
	my @base = split '', substr($base, 0, 11);
	my $dv1 = -_dot([4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2], \@base) % 11 % 10;
	my $dv2 = (-_dot([5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2], [ @base, $dv1 ]) + $dev) % 11 % 10;
	return ($dv1, $dv2) if wantarray;
	substr($base, 11, 2) = "$dv1$dv2";
	return $base;
}
sub random_ie_ac {
	my $valid = @_ ? shift : 1; # valid IE-SP by default
	my $base = sprintf "01%09s", int(rand(1E9)); # '01' and 9 digits
	return scalar _dv_ie_ac($base, $valid);
}
sub parse_ie_ac {
  my $ie = canon_ie_ac shift;
  my ($base, $dv) = $ie =~ /(\d{11})(\d{2})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return { base => $base, dv => $dv };
}

### AL ###

# http://www.sefaz.al.gov.br/sintegra/cad_AL.asp
# http://www.sintegra.gov.br/Cad_Estados/cad_AL.html

my %AL_TYPES = (
  0 => "normal",
  1 => "normal",
  3 => "produtor rural",
  5 => "substituta",
  6 => "empresa pequeno porte",
  7 => "micro empresa ambulante",
  8 => "micro empresa",
  9 => "especial"
);
my @AL_TYPES = keys %AL_TYPES;

sub canon_ie_al {
  return _canon_id(shift, size => 9);
}
sub test_ie_al {
  my $ie = canon_ie_al shift;
  return undef if length $ie != 9;
  return 0 unless $ie =~ /^24/;
  my @ie = split '', $ie;
  return 0 unless $AL_TYPES{$ie[2]};
  my $s1 = _dot([90, 80, 70, 60, 50, 40, 30, 20, -1], \@ie) % 11;
  #print "ie: $ie, s1: $s1\n";
  return ($s1==0 || $s1==10 && $ie[8]==0) ? 1 : 0;

}
sub format_ie_al {
  my $ie = canon_ie_al shift;
  $ie =~ s|^(..)(...)(...)(.).*|$1.$2.$3-$4|; # 24.000.004-8
  return $ie;
}
sub _dv_ie_al {
	my $base = shift; # expected to be canon'ed already ?!
	my $valid = @_ ? shift : 1;
	my $dev = $valid ? 0 : 2; # deviation (to make IE-AL invalid)
	my @base = split '', $base;
	my $dv1 = (_dot([90, 80, 70, 60, 50, 40, 30, 20], \@base) + $dev) % 11 % 10;
	return ($dv1) if wantarray;
	substr($base, 8, 1) = $dv1;
	return $base;
}
sub random_ie_al {
	my $valid = @_ ? shift : 1; # valid IE-AL by default
	my $base = sprintf "24%1s%05s",
		               $AL_TYPES[int(rand(@AL_TYPES))],
		               int(rand(1E5)); # '24', type and 5 digits
	return scalar _dv_ie_al($base, $valid);
}
sub parse_ie_al {
  my $ie = canon_ie_al shift;
  my ($base, $dv) = $ie =~ /(\d{8})(\d{1})/;
  if (wantarray) {
    return ($base, $dv);
  }
  my $type = substr($ie, 2, 1);
  return {
	  base => $base,
	  dv => $dv,
	  type => $type,
	  t_name => $AL_TYPES{$type}

  };
}

### AP ###

#***

sub canon_ie_ap {
  return _canon_id(shift, size => 9);
}
sub test_ie_ap {
  my $ie = canon_ie_ap shift;
  return undef if length $ie != 9;
  return 0 unless $ie =~ /^03/;

  my $nr_empresa = substr($ie, 2, -1);
  my ($p, $d) = ($nr_empresa >= 1) && ($nr_empresa <= 17000) ? (5, 0) : # 1st class, 03.000.001-x up to 03.017.000-x
                ($nr_empresa >= 17001) && ($nr_empresa <= 19022) ? (9, 1) : # 2nd class, 03.017.001-x up to 03.019.022-x
                (0, 0); # 3rd class, from 03.019.023-x and on
#  print "(p, d) = ($p, $d)\n";

  my @ie = split '', $ie;
  my $sum = -($p + _dot([9, 8, 7, 6, 5, 4, 3, 2, 1], \@ie)) % 11;

#  print "# ie: $ie, sum: $sum\n"; # ***
  return ($sum==0 || $sum==10 && $ie[8]==0) ? 1 : 0;

} # FIXME: this is not QUITE RIGHT !!!!!!!!!
sub format_ie_ap {
  my $ie = canon_ie_ap shift;
  $ie =~ s|^(..)(...)(...)(.).*|$1.$2.$3-$4|; # 03.012.245-9
  return $ie;
}
sub _dv_ie_ap {
  my $base = shift; # expected to be canon'ed already ?!
  my $valid = @_ ? shift : 1;
  my $dev = $valid ? 0 : 3; # deviation (to make IE-AP invalid)
  my @base = split '', $base;

  my $nr_empresa = substr($base, 2, -1);
  my ($p, $d) = ($nr_empresa >= 1) && ($nr_empresa <= 17000) ? (5, 0) : # 1st class, 03.000.001-x up to 03.017.000-x
                ($nr_empresa >= 17001) && ($nr_empresa <= 19022) ? (9, 1) : # 2nd class, 03.017.001-x up to 03.019.022-x
                (0, 0); # 3rd class, from 03.019.023-x and on

  my $dv1 = -($p + _dot([9, 8, 7, 6, 5, 4, 3, 2, 0], \@base) + $dev) % 11 % 10;
  return ($dv1) if wantarray;
  substr($base, 8, 1) = $dv1;
  return $base;
}
sub random_ie_ap {
  my $valid = @_ ? shift : 1; # valid IE-AP by default
  my $base = sprintf "03%06d*",
                   int(rand(1E6)); # '03', 6 digits, dv
  return scalar _dv_ie_ap($base, $valid);
}
sub parse_ie_ap {
  my $ie = canon_ie_ap shift;
  my ($base, $dv) = $ie =~ /(\d{8})(\d{1})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return {
    base => $base,
    dv => $dv,
    range => '?'
  };

}



### AM ###

# http://www.sintegra.gov.br/Cad_Estados/cad_AM.html

sub canon_ie_am {
  return _canon_id( shift, size => 9 );
}
sub test_ie_am {
  my $ie = canon_ie_am(shift);
  return undef if length $ie != 9;

  my @ie = split '', $ie;
  my $s1 = _dot( [ 9, 8, 7, 6, 5, 4, 3, 2, 1 ], \@ie ) % 11;
  return ( $s1==0 || $s1==1 && $ie[8]==0 ) ? 1 : 0;
}
sub format_ie_am {
  my $ie = canon_ie_am(shift);
  $ie =~ s|^(..)(...)(...)(.).*|$1.$2.$3-$4|; # 11.111.111-0
  return $ie;
}
sub parse_ie_am {
  my $ie = canon_ie_am(shift);
  my ($base, $dv) = $ie =~ /(\d{8})(\d{1})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return {
    base => $base,
    dv => $dv,
  };
}
sub _dv_ie_am {
  my $base = shift; # expected to be canon'ed already ?!
  my $valid = @_ ? shift : 1;
  my $dev = $valid ? 0 : 2; # deviation (to make IE/AM invalid)
  my @base = split '', substr($base, 0, 8);
  my $dv1 = (-_dot([9, 8, 7, 6, 5, 4, 3, 2], \@base)+$dev) % 11 % 10;
  return ($dv1) if wantarray;
  substr($base, 8, 1) = $dv1;
  return $base;
}
sub random_ie_am {
  my $valid = @_ ? shift : 1; # valid IE-SP by default
  my $base = sprintf "%08s", int(rand(1E8)); # 8 digits # XXX IE/AM begins with '04'?
  return scalar _dv_ie_am($base, $valid);
}

### BA ###

# http://www.sintegra.gov.br/Cad_Estados/cad_BA.html

sub canon_ie_ba {
  return _canon_id(shift, size => 8);
}
sub test_ie_ba {
  my $ie = canon_ie_ba(shift);
  return undef if length $ie != 8;

  my @ie = split '', $ie;
  if ( $ie =~ /^[0123458]/ ) { # calculo pelo modulo 10

    my $s2 = _dot( [ 7, 6, 5, 4, 3, 2, undef, 1 ], \@ie ) % 10;
    unless ( $s2==0 ) {
      return 0;
    }
    my $s1 = _dot( [ 8, 7, 6, 5, 4, 3, 1, 2 ], \@ie ) % 10;
    return ( $s1==0 ) ? 1 : 0;

  } else { # $ie =~ /^[679]/ # calculo pelo modulo 11

    my $s2 = _dot( [ 7, 6, 5, 4, 3, 2, undef, 1 ], \@ie ) % 11;
    unless ( $s2==0 || $s2==1 && $ie[7]==0 ) {
      return 0;
    }
    my $s1 = _dot( [ 8, 7, 6, 5, 4, 3, 1, 2 ], \@ie ) % 11;
    return ( $s1==0 || $s1==1 && $ie[6]==0 ) ? 1 : 0;

  }
}
sub format_ie_ba {
  my $ie = canon_ie_ba(shift);
  $ie =~ s|^(......)(..).*|$1-$2|; # 123456-63
  return $ie;
}
sub parse_ie_ba {
  my $ie = canon_ie_ba(shift);
  my ($base, $dv) = $ie =~ /^(\d{6})(\d{2})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return {
    base => $base,
    dv => $dv,
  };
}
# ???
sub _dv_ie_ba {
  my $base = shift; # expected to be canon'ed already ?!
  my $valid = @_ ? shift : 1;
  my $dev = $valid ? 0 : 2; # deviation (to make IE/BA invalid)
  my @base = split '', substr($base, 0, 6);

  if ( $base =~ /^[0123458]/ ) { # calculo pelo modulo 10)

    my $dv2 = -_dot( [ 7, 6, 5, 4, 3, 2 ], \@base) % 10;
    my $dv1 = (-_dot( [ 8, 7, 6, 5, 4, 3, 2 ], [ @base, $dv2 ])+$dev) % 10;
    return ($dv1, $dv2) if wantarray;
    substr($base, 6, 2) = "$dv1$dv2";
    return $base;

  } else { # =~ /^[679]/ # calculo pelo modulo 11

    my $dv2 = -_dot( [ 7, 6, 5, 4, 3, 2 ], \@base) % 11 % 10;
    my $dv1 = (-_dot( [ 8, 7, 6, 5, 4, 3, 2 ], [ @base, $dv2 ])+$dev) % 11 % 10;
    return ($dv1, $dv2) if wantarray;
    substr($base, 6, 2) = "$dv1$dv2";
    return $base;

  }
}
sub random_ie_ba {
  my $valid = @_ ? shift : 1; # valid IE/BA by default
  my $base = sprintf "%06s", int(rand(1E6)); # 6 digits
  return scalar _dv_ie_ba($base, $valid);
}


### CE ###

sub canon_ie_ce {
  return _canon_id(shift, size => 9);
}

### DF ###

sub canon_ie_df {
  return _canon_id(shift, size => 13);
}

### ES ###

sub canon_ie_es {
  return _canon_id(shift, size => 9);
}

### GO ###

sub canon_ie_go {
  return _canon_id(shift, size => 9);
}

### MA ###

# http://www.sintegra.gov.br/Cad_Estados/cad_MA.html

sub canon_ie_ma {
  return _canon_id(shift, size => 9);
}
sub test_ie_ma {
  my $ie = canon_ie_ma shift;
  return undef if length $ie != 9;
  return 0 unless $ie =~ /^12/;
  my @ie = split '', $ie;
  my $s1 = _dot([9, 8, 7, 6, 5, 4, 3, 2, 1], \@ie) % 11;
  return ($s1==0 || $s1==1 && $ie[8]==0) ? 1 : 0;

}
sub format_ie_ma {
  my $ie = canon_ie_ma shift;
  $ie =~ s|^(..)(...)(...)(.).*|$1.$2.$3-$4|; # 12.000.038-5
  return $ie;
}
sub _dv_ie_ma {
  my $base = shift; # expected to be canon'ed already ?!
  my $valid = @_ ? shift : 1;
  my $dev = $valid ? 0 : 2; # deviation (to make IE-MA invalid)
  my @base = split '', substr($base, 0, 8);
  my $dv1 = (-_dot([9, 8, 7, 6, 5, 4, 3, 2], \@base)+$dev) % 11 % 10;
  return ($dv1) if wantarray;
  substr($base, 8, 1) = $dv1;
  return $base;
}
sub random_ie_ma {
  my $valid = @_ ? shift : 1; # valid IE-SP by default
  my $base = sprintf "12%06s", int(rand(1E6)); # '12' and 6 digits
  return scalar _dv_ie_ma($base, $valid);
}
sub parse_ie_ma {
  my $ie = canon_ie_ma shift;
  my ($base, $dv) = $ie =~ /(\d{8})(\d{1})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return { base => $base, dv => $dv };
}

### MT ###

sub canon_ie_mt {
  return _canon_id(shift, size => 11);
}

### MS ###

sub canon_ie_ms {
  return _canon_id(shift, size => 9);
}

### MG ###

# http://www.sintegra.gov.br/Cad_Estados/cad_MG.html

sub canon_ie_mg {
  return _canon_id( shift, size => 13 );
}

sub test_ie_mg {
  my $ie = canon_ie_mg( shift );
  return undef if length $ie != 13;
  my @ie = split '', $ie;

  my $c1 = - _dot_10( [1, 2, 1,  1, 2, 1, 2, 1, 2, 1, 2, undef, undef], \@ie ) % 10;
  unless ( $ie[11] eq $c1 ) {
    return 0;
  }

  my $s2 = _dot( [ 3, 2, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ], \@ie ) % 11;
  return ( $s2==0 || $s2==1 && $ie[12]==0 ) ? 1 : 0;
}

sub format_ie_mg {
  my $ie = canon_ie_mg shift;
  $ie =~ s|^(...)(...)(...)(..)(..).*|$1.$2.$3/$4$5|; # 062.307.904/0081
  return $ie;
}

sub parse_ie_mg {
  my $ie = canon_ie_mg shift;
  my ($municipio, $inscricao, $ordem, $dv) = $ie =~ /(\d{3})(\d{6})(\d{2})(\d{2})/;
  if (wantarray) {
    return ($municipio, $inscricao, $ordem, $dv);
  }
  return {
    municipio => $municipio,
    inscricao => $inscricao,
    ordem     => $ordem,
    dv        => $dv,
  };
}

sub _dv_ie_mg {
  my $base = shift; # expected to be canon'ed already ?!
  my $valid = @_ ? shift : 1;
  my $dev = $valid ? 0 : 2; # deviation (to make IE/MG invalid)
  my @base = split '', substr($base, 0, 11);
  my $dv1 = -_dot_10([ 1, 2, 1,  1, 2, 1, 2, 1, 2, 1, 2 ], \@base) % 10;
  my $dv2 = (-_dot([ 3, 2, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2 ], [ @base, $dv1 ]) + $dev) % 11 % 10;
  return ($dv1, $dv2) if wantarray;
  substr($base, 11, 2) = "$dv1$dv2";
  return $base;
}
sub random_ie_mg {
  my $valid = @_ ? shift : 1; # valid IE/MG by default
  my $base = sprintf "%011s", int(rand(1E11)); # 11 digits
  return scalar _dv_ie_mg($base, $valid);
}


### PA ###

sub canon_ie_pa {
  return _canon_id(shift, size => 9);
}

### PB ###

sub canon_ie_pb {
  return _canon_id(shift, size => 9);
}

### PR ###

#PR - http://www.fazenda.pr.gov.br/icms/calc_dgv.asp
#     Formato da Inscrição: NNN NNN NN-DD (10 dígitos)
#     Cálculo do Primeiro Dígito: Módulo 11 com pesos de 2 a 7, aplicados da direita para esquerda, sobre as 8 primeiras posições.
#     Cálculo do Segundo Dígito: Módulo 11 com pesos de 2 a 7, aplicados da direita para esquerda, sobre as 9 primeiras posições (inclui o primeiro dígito).
#     Exemplo: CAD 123.45678-50

#PR - http://www.sintegra.gov.br/Cad_Estados/cad_PR.html
#     Formato da Inscrição NNN.NNNNN-DD (1o dígitos) [ NNN NNN NN-DD ]
#     Exemplo: 123.45678-50


sub canon_ie_pr {
  return _canon_id(shift, size => 10);
}
sub test_ie_pr {
  my $ie = canon_ie_pr shift;
  return undef if length $ie != 10;
  my @ie = split '', $ie;
  my $s1 = _dot([3, 2, 7, 6, 5, 4, 3, 2, 1, 0], \@ie) % 11;
  my $s2 = _dot([4, 3, 2, 7, 6, 5, 4, 3, 2, 1], \@ie) % 11;
  unless ($s1==0 || $s1==1 && $ie[8]==0) {
    return 0;
  }
  return ($s2==0 || $s2==1 && $ie[9]==0) ? 1 : 0;

}
sub format_ie_pr {
  my $ie = canon_ie_pr shift;
  $ie =~ s|^(...)(.....)(..).*|$1.$2-$3|;
  return $ie;
}
sub _dv_ie_pr {
	my $base = shift; # expected to be canon'ed already ?!
	my $valid = @_ ? shift : 1;
	my $dev = $valid ? 0 : 2; # deviation (to make IE-PR invalid)
	my @base = split '', substr($base, 0, 8);
	my $dv1 = -_dot([3, 2, 7, 6, 5, 4, 3, 2], \@base) % 11 % 10;
	my $dv2 = (-_dot([4, 3, 2, 7, 6, 5, 4, 3, 2], [ @base, $dv1 ]) + $dev) % 11 % 10;
	return ($dv1, $dv2) if wantarray;
	substr($base, 8, 2) = "$dv1$dv2";
	return $base;
}
sub random_ie_pr {
	my $valid = @_ ? shift : 1; # valid IE-SP by default
	my $base = sprintf "%08s", int(rand(1E8)); # 8 dígitos
	return scalar _dv_ie_pr($base, $valid);
}
sub parse_ie_pr {
  my $ie = canon_ie_pr shift;
  my ($base, $dv) = $ie =~ /(\d{8})(\d{2})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return { base => $base, dv => $dv };
}

### PE ###

sub canon_ie_pe {
  return _canon_id(shift, size => 14);
}

### PI ###

sub canon_ie_pi {
  return _canon_id(shift, size => 9);
}

### RJ ###

sub canon_ie_rj {
  return _canon_id(shift, size => 9);
}

### RN ###

sub canon_ie_rn {
  return _canon_id(shift, size => 9);
}

### RS ###

sub canon_ie_rs {
  return _canon_id(shift, size => 10);
}

### RO ###

# http://www.sintegra.gov.br/Cad_Estados/cad_RO.html

sub canon_ie_ro {
  return _canon_id(shift, size => 14);
}
sub test_ie_ro {
  my $ie = canon_ie_ro shift;
  return undef if length $ie != 14;
  my @ie = split '', $ie;
  my $s1 = _dot([6, 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 1], \@ie) % 11;
  return $s1==0 || $ie[13]==0 && $s1==1;
}
sub format_ie_ro {
  my $ie = canon_ie_ro shift;
  $ie =~ s|^(.............)(.).*|$1-$2|;
  return $ie;
}
sub _dv_ie_ro {
	my $base = shift; # expected to be canon'ed already ?!
	my $valid = @_ ? shift : 1;
	my $dev = $valid ? 0 : 2; # deviation (to make IE-RO invalid)
	my @base = split '', substr($base, 0, 13);
	my $dv = (-_dot([6, 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2], \@base)+$dev) % 11 % 10;
	return ($dv) if wantarray;
	substr($base, 13, 1) = $dv;
	return $base;
}
sub random_ie_ro {
	my $valid = @_ ? shift : 1; # valid IE-RO by default
	my $base = sprintf "%013s", int(rand(1E13)); # 13 dígitos   # devia ter maior probabilidade para 000 00000 AAAAA D
	return scalar _dv_ie_ro($base, $valid);
}
sub parse_ie_ro {
  my $ie = canon_ie_ro shift;
  my ($base, $dv) = $ie =~ /(\d{13})(\d{1})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return { base => $base, dv => $dv };
}

### RR ###

# http://www.sintegra.gov.br/Cad_Estados/cad_RR.html

sub canon_ie_rr {
  return _canon_id(shift, size => 9);
}
sub test_ie_rr {
  my $ie = canon_ie_rr shift;
  return undef if length $ie != 9;
  return 0 unless $ie =~ /^24/;
  my @ie = split '', $ie;
  my $s1 = _dot([1, 2, 3, 4, 5, 6, 7, 8, -1], \@ie) % 9;
  return $s1==0 ? 1 : 0;

}
sub format_ie_rr {
  my $ie = canon_ie_rr shift;
  $ie =~ s|^(..)(...)(...)(.).*|$1.$2.$3-$4|; # 24.006.628-1
  return $ie;
}
sub _dv_ie_rr {
	my $base = shift; # expected to be canon'ed already ?!
	my $valid = @_ ? shift : 1;
	my $dev = $valid ? 0 : 2; # deviation (to make IE-PR invalid)
	my @base = split '', substr($base, 0, 8);
	my $dv1 = (_dot([1, 2, 3, 4, 5, 6, 7, 8], \@base)+$dev) % 9;
	return ($dv1) if wantarray;
	substr($base, 8, 1) = $dv1;
	return $base;
}
sub random_ie_rr {
	my $valid = @_ ? shift : 1; # valid IE-SP by default
	my $base = sprintf "24%06s", int(rand(1E6)); # '24' and 6 digits
	return scalar _dv_ie_rr($base, $valid);
}
sub parse_ie_rr {
  my $ie = canon_ie_rr shift;
  my ($base, $dv) = $ie =~ /(\d{8})(\d{1})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return { base => $base, dv => $dv };
}

### SC ###

sub canon_ie_sc {
  return _canon_id(shift, size => 9);
}

### SP ###

sub canon_ie_sp {
  return _canon_id(shift, size => 12);
}

#SP - http://www.csharpbr.com.br/arquivos/csharp_mostra_materias.asp?escolha=0021
#     Exemplo: Inscrição Estadual 110.042.490.114
#     12 dígitos, 9o. e 12o. são DVs
#     dv[1] = (1, 3, 4, 5, 6, 7, 8, 10) .* (c[1] c[2] c[3] c[4] c[5] c[6] c[7] c[8]) (mod 11)
#     dv[2] = (3 2 10 9 8 7 6 5 4 3 2 1) .* (c[1] ... c[11]) (mod 11)

sub test_ie_sp {
	my $ie = canon_ie_sp shift;
	return undef if length $ie != 12;
	my @ie = split '', $ie;
	my $s1 = _dot([1, 3, 4, 5, 6, 7, 8, 10, -1, 0, 0, 0], \@ie) % 11;
	unless ($s1==0 || $s1==10 && $ie[8]==0) {
	  return 0;
	}
	my $s2 = _dot([3, 2, 10, 9, 8, 7, 6, 5, 4, 3, 2, -1], \@ie) % 11;
	return ($s2==0 || $s2==10 && $ie[11]==0) ? 1 : 0;

}

sub format_ie_sp {
  my $ie = canon_ie_sp shift;
  $ie =~ s|^(...)(...)(...)(...).*|$1.$2.$3.$4|;
  return $ie;
}

# my ($dv1, $dv2) = _dv_ie_sp('') # => $dv1 = ?, $dv2 = ?
# my ($dv1, $dv2) = _dv_ie_sp('', 0) # computes non-valid check digits
#
# computes the check digits of the candidate IE-SP number given as argument
# (only the first 12 digits enter the computation) (9th and 12nd are ignored)
#
# In list context, it returns the check digits.
# In scalar context, it returns the complete IE-SP (base and check digits)
sub _dv_ie_sp {
	my $base = shift; # expected to be canon'ed already ?!
	my $valid = @_ ? shift : 1;
	my $dev = $valid ? 0 : 2; # deviation (to make IE-SP invalid)
	my @base = split '', substr($base, 0, 12);
	my $dv1 = _dot([1, 3, 4, 5, 6, 7, 8, 10, 0, 0, 0, 0], \@base) % 11 % 10;
	my $dv2 = (_dot([3, 2, 10, 9, 8, 7, 6, 5, 0, 3, 2, 0], \@base) + 4*$dv1 + $dev) % 11 % 10;
	return ($dv1, $dv2) if wantarray;
	substr($base, 8, 1) = $dv1;
	substr($base, 11, 1) = $dv2;
	return $base
}

# generates a random (correct or incorrect) IE-SP
# $ie = rand_ie_sp();
# $ie = rand_ie_sp($valid);
#
# if $valid==0, produces an invalid IE-SP
sub random_ie_sp {
	my $valid = @_ ? shift : 1; # correct IE-SP by default
	my $ie = sprintf "%08s0%02s0", int(rand(1E8)), int(rand(1E2)); # 10 dígitos aleatórios
	return scalar _dv_ie_sp($ie, $valid);
}

sub parse_ie_sp {
  my $ie = canon_ie_sp shift;
  my ($base, $dv) = $ie =~ /(\d{8})(\d{2})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return { base => $base, dv => $dv };
}

### SE ###

sub canon_ie_se {
  return _canon_id(shift, size => 9);
}

### TO ###

sub canon_ie_to {
  return _canon_id(shift, size => 11);
}

# a dispatch table is used here, because we know beforehand
# the list of Brazilian states. I am not sure it is
# better than using symbolic references.

my %dispatch_table = (
  # AC
  test_ie_ac => \&test_ie_ac,
  canon_ie_ac => \&canon_ie_ac,
  format_ie_ac => \&format_ie_ac,
  random_ie_ac => \&random_ie_ac,
  parse_ie_ac => \&parse_ie_ac,

  # AL
  test_ie_al => \&test_ie_al,
  canon_ie_al => \&canon_ie_al,
  format_ie_al => \&format_ie_al,
  random_ie_al => \&random_ie_al,
  parse_ie_al => \&parse_ie_al,

  # AM
  test_ie_am => \&test_ie_am,
  canon_ie_am => \&canon_ie_am,
  format_ie_am => \&format_ie_am,
  random_ie_am => \&random_ie_am,
  parse_ie_am => \&parse_ie_am,

  # AP
  test_ie_ap => \&test_ie_ap,
  canon_ie_ap => \&canon_ie_ap,
  format_ie_ap => \&format_ie_ap,
  random_ie_ap => \&random_ie_ap,
  parse_ie_ap => \&parse_ie_ap,

  # BA
  test_ie_ba => \&test_ie_ba,
  canon_ie_ba => \&canon_ie_ba,
  format_ie_ba => \&format_ie_ba,
  random_ie_ba => \&random_ie_ba,
  parse_ie_ba => \&parse_ie_ba,

  # CE
  canon_ie_ce => \&canon_ie_ce,

  # DF
  canon_ie_df => \&canon_ie_df,

  # ES
  canon_ie_es => \&canon_ie_es,

  # GO
  canon_ie_go => \&canon_ie_go,

  # MA
  test_ie_ma => \&test_ie_ma,
  canon_ie_ma => \&canon_ie_ma,
  format_ie_ma => \&format_ie_ma,
  random_ie_ma => \&random_ie_ma,
  parse_ie_ma => \&parse_ie_ma,

  # MG
  test_ie_mg => \&test_ie_mg,
  canon_ie_mg => \&canon_ie_mg,
  format_ie_mg => \&format_ie_mg,
  random_ie_mg => \&random_ie_mg,
  parse_ie_mg => \&parse_ie_mg,

  # MT
  canon_ie_mt => \&canon_ie_mt,

  # MS
  canon_ie_ms => \&canon_ie_ms,

  # PE
  canon_ie_pe => \&canon_ie_pe,

  # PA
  canon_ie_pa => \&canon_ie_pa,

  # PB
  canon_ie_pb => \&canon_ie_pb,

  # PI
  canon_ie_pi => \&canon_ie_pi,

  # PR
  test_ie_pr => \&test_ie_pr,
  canon_ie_pr => \&canon_ie_pr,
  format_ie_pr => \&format_ie_pr,
  random_ie_pr => \&random_ie_pr,
  parse_ie_pr => \&parse_ie_pr,

  # RJ
  canon_ie_rj => \&canon_ie_rj,

  # RN
  canon_ie_rn => \&canon_ie_rn,

  # RO
  test_ie_ro => \&test_ie_ro,
  canon_ie_ro => \&canon_ie_ro,
  format_ie_ro => \&format_ie_ro,
  random_ie_ro => \&random_ie_ro,
  parse_ie_ro => \&parse_ie_ro,
  # RR
  test_ie_rr => \&test_ie_rr,
  canon_ie_rr => \&canon_ie_rr,
  format_ie_rr => \&format_ie_rr,
  random_ie_rr => \&random_ie_rr,
  parse_ie_rr => \&parse_ie_rr,
  # RS
  canon_ie_rs => \&canon_ie_rs,
  # SC
  canon_ie_sc => \&canon_ie_sc,
  # SE
  canon_ie_se => \&canon_ie_se,
  # SP
  test_ie_sp => \&test_ie_sp,
  canon_ie_sp => \&canon_ie_sp,
  format_ie_sp => \&format_ie_sp,
  random_ie_sp => \&random_ie_sp,
  #parse_ie_sp
  # TO
  canon_ie_to => \&canon_ie_to,

);

sub _invoke {
	my $subname = shift;
	my $sub = $dispatch_table{$subname};
    die "$subname not implemented" unless $sub;
	return &$sub(@_);
}

sub test_ie {
	my $uf = lc shift;
	return _invoke("test_ie_$uf", @_);
}
sub canon_ie {
	my $uf = lc shift;
	return _invoke("canon_ie_$uf", @_);
}
sub format_ie {
	my $uf = lc shift;
	return _invoke("format_ie_$uf", @_);
}
sub random_ie {
	my $uf = lc shift;
	return _invoke("random_ie_$uf", @_);
}

sub parse_ie {
	my $uf = lc shift;
	return _invoke("parse_ie_$uf", @_);
}



1;

__END__