File Coverage

blib/lib/Business/BR/CPF.pm

Criterion	Covered	Total	%
statement	40	40	100.0
branch	14	16	87.5
condition	7	9	77.7
subroutine	10	10	100.0
pod	5	5	100.0
total	76	80	95.0

package Business::BR::CPF;

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_cpf format_cpf parse_cpf random_cpf );
our @EXPORT = qw( test_cpf );

our $VERSION = '0.00_16';

#use Scalar::Util qw(looks_like_number);

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

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


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


sub format_cpf {
  my $cpf = canon_cpf shift;
  $cpf =~ s/^(...)(...)(...)(..).*/$1.$2.$3-$4/;
  return $cpf;
}

sub parse_cpf {
  my $cpf = canon_cpf shift;
  my ($base, $dv) = $cpf =~ /(\d{9})(\d{2})/;
  if (wantarray) {
    return ($base, $dv);
  }
  return { base => $base, dv => $dv };
}

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

# generates a random (correct or incorrect) CPF
# $cpf = rand_cpf();
# $cpf = rand_cpf($valid);
#
# if $valid==0, produces an invalid CPF.
sub random_cpf {
	my $valid = @_ ? shift : 1; # valid CPF by default
	my $base = sprintf "%09s", int(rand(1E9)); # 9 dígitos
	return scalar _dv_cpf($base, $valid);
}

1;

__END__