File Coverage

blib/lib/Business/BR/CNPJ.pm

Criterion	Covered	Total	%
statement	33	41	80.4
branch	13	18	72.2
condition	6	9	66.6
subroutine	8	10	80.0
pod	5	5	100.0
total	65	83	78.3

package Business::BR::CNPJ;

use 5;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

#our %EXPORT_TAGS = ( 'all' => [ qw() ] );
#our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
#our @EXPORT = qw();

our @EXPORT_OK = qw( canon_cnpj format_cnpj parse_cnpj random_cnpj );
our @EXPORT = qw( test_cnpj );

our $VERSION = '0.00_16';

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

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

# there is a subtle difference here between the return for
# for an input which is not 14 digits long (undef)
# and one that does not satisfy the check equations (0).
# Correct CNPJ numbers return 1.
sub test_cnpj {
  my $cnpj = canon_cnpj shift;
  return undef if length $cnpj != 14;
  my @cnpj = split '', $cnpj;
  my $s1 = _dot([5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0], \@cnpj) % 11;
  my $s2 = _dot([6, 5, 4, 3, 2, 9, 8, 7, 6, 5, 4, 3, 2, 1], \@cnpj) % 11;
  unless ($s1==0 || $s1==1 && $cnpj[12]==0) {
    return 0;
  }
  return ($s2==0 || $s2==1 && $cnpj[13]==0) ? 1 : 0;
}


sub format_cnpj {
  my $cnpj = canon_cnpj shift;
  $cnpj =~ s|^(..)(...)(...)(....)(..).*|$1.$2.$3/$4-$5|;
  return $cnpj;
}

sub parse_cnpj {
  my $cnpj = canon_cnpj shift;
  my ($base, $filial, $dv) = $cnpj =~ /(\d{8})(\d{4})(\d{2})/;
  if (wantarray) {
    return ($base, $filial, $dv);
  }
  return { base => $base, filial => $filial, dv => $dv };
}

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

}

# generates a random (correct or incorrect) CNPJ
# $cpf = rand_cnpj();
# $cpf = rand_cnpj($valid);
#
# if $valid==0, produces an invalid CNPJ.
sub random_cnpj {
	my $valid = @_ ? shift : 1; # valid CNPJ by default
	my $base = sprintf "%08s", int(rand(1E8)); # 8 dígitos
	my $var = sprintf "%04s", ((rand()<0.95) ? "0001" : int(sqrt rand(1E8)));
	return scalar _dv_cnpj("$base$var", $valid);
}


1;

__END__