view release on metacpan or  search on metacpan

lib/Validate/CodiceFiscale.pm  view on Meta::CPAN

      S => 18,
      T => 19,
      U => 20,
      V => 21,
      W => 22,
      X => 23,
      Y => 24,
      Z => 25,
     };
   state $checksums_for = [$odd_checksums, $even_checksums];
   my @chars = split m{}mxs, substr($cf, 0, 15);    # no checksum
   my $sum = sum map { $checksums_for->[$_ % 2]{$chars[$_]} } 0 .. $#chars;
   chr(ord('A') + ($sum % 26));
} ## end sub _cf_checksum

sub _normalized_string ($string, @positions) {
   state $letters   = [qw< L M N P Q R S T U V >];
   state $digit_for = {map { $letters->[$_] => $_ } 0 .. $letters->$#*};
   for my $i (@positions) {
      my $current = substr($string, $i, 1);
      substr($string, $i, 1, $digit_for->{$current})
        if exists $digit_for->{$current};
   }
   return $string;
} ## end sub _normalized_string

sub _normalized_birthplace ($place) { _normalized_string($place, 1 .. 3) }
sub _normalized_birthdate ($date) { _normalized_string($date, 0, 1, 3, 4) }

sub _expand_date ($date, $opts) {
   state $mlf       = [split m{}mxs, 'ABCDEHLMPRST'];
   state $month_for = {map { $mlf->[$_] => $_ } 0 .. $mlf->$#*};

   $date = _normalized_birthdate($date);
   my ($y, $mc, $d) = $date =~ m{\A(\d\d)([ABCDEHLMPRST])(\d\d)\z}mxs
     or return;
   my $m = 1 + $month_for->{$mc};
   $_ += 0 for ($d, $y);
   my $sex = $d > 40 ? 'F' : 'M';
   $d -= 40 if $d > 40;

lib/Validate/CodiceFiscale.pm  view on Meta::CPAN

   }

   return ($y, $m, $d, $sex);
} ## end sub _expand_date

sub _is_valid_cf_date ($y, $m, $d) {
   return !!(eval { timegm(30, 30, 12, $d, $m - 1, $y); 1 });
}

sub _compact_birthdates ($birthdate) {
   state $month_letter_for = ['', split m{}mxs, 'ABCDEHLMPRST'];
   my ($y, $m, $d) = split m{\D}mxs, $birthdate;
   ($y, $d) = ($d, $y) if $d > 31;
   $y %= 100;
   $m = $month_letter_for->[$m + 0];
   map { sprintf '%02d%s%02d', $y, $m, $_ } ($d, $d + 40);
} ## end sub _compact_birthdates

sub _compact_surname ($surname) {
   my ($cs, $vs) = _consonants_and_vowels($surname);
   my @retval = ($cs->@*, $vs->@*, ('X') x 3);
   return join '', @retval[0 .. 2];

lib/Validate/CodiceFiscale.pm  view on Meta::CPAN

sub _compact_name ($name) {
   my ($cs, $vs) = _consonants_and_vowels($name);
   splice $cs->@*, 1, 1 if $cs->@* > 3;
   my @retval = ($cs->@*, $vs->@*, ('X') x 3);
   return join '', @retval[0 .. 2];
} ## end sub _compact_name

sub _consonants_and_vowels ($string) {
   my (@consonants, @vowels);
   for my $char (grep { m{[A-Z]}mxs } split m{}mxs, uc($string)) {
      if   ($char =~ m{[AEIOU]}mxs) { push @vowels,     $char }
      else                          { push @consonants, $char }
   }
   return (\@consonants, \@vowels);
} ## end sub _consonants_and_vowels

sub _places {
   state $retval = do {
      local $/;
      binmode DATA, ':raw';