view release on metacpan or  search on metacpan

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

      G => 15,
      H => 17,
      I => 19,
      J => 21,
      K => 2,
      L => 4,
      M => 18,
      N => 20,
      O => 11,
      P => 3,
      Q => 6,
      R => 8,
      S => 12,
      T => 14,
      U => 16,
      V => 10,
      W => 22,
      X => 25,
      Y => 24,
      Z => 23,
     },
     my $even_checksums = {
      0 => 0,
      1 => 1,
      2 => 2,
      3 => 3,
      4 => 4,
      5 => 5,
      6 => 6,
      7 => 7,
      8 => 8,
      9 => 9,
      A => 0,
      B => 1,
      C => 2,
      D => 3,
      E => 4,
      F => 5,
      G => 6,
      H => 7,
      I => 8,
      J => 9,
      K => 10,
      L => 11,
      M => 12,
      N => 13,
      O => 14,
      P => 15,
      Q => 16,
      R => 17,
      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;

   # century: the initial digits of a year
   if (defined(my $years_baseline = ($opts // {})->{years_baseline})) {
      $y += $years_baseline;
   }
   else {    # whatever in the last 100 years
      my $this_year = 1900 + (localtime)[5];
      $y += 100 * int($this_year / 100);
      $y -= 100 if $y > $this_year;
   }

   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];
}

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';
      (my $json = readline(DATA)) =~ s{\n+}{}gmxs;
      decode_json($json);
   };
}

sub _place_name_for ($place, $birthdate) {
   state $place_for = _places();
   my $record = $place_for->{_normalized_birthplace($place)} or return;
   return "[$record->[-1]{name}]" unless defined($birthdate);
   for my $candidate ($record->@*) {
      next if $birthdate gt $candidate->{end};
      last if $birthdate lt $candidate->{start};
      return $candidate->{name};
   }
   return;
} ## end sub _place_name_for

1;

__DATA__
{"G935":[{"start":"1957-04-07","end":"9999-12-31","name":"POSTA FIBRENO"}],"
G846":[{"start":"1866-11-19","end":"1902-02-06","name":"PONTE DI PIAVE"},{"n
ame":"PONTE DI PIAVE","start":"1902-02-07","end":"1907-05-09"},{"name":"PONT
E DI PIAVE","start":"1907-05-10","end":"9999-12-31"}],"M082":[{"name":"VITER
BO","end":"1927-01-11","start":"1871-01-15"},{"name":"VITERBO","start":"1927
-01-12","end":"1928-05-18"},{"name":"VITERBO","start":"1928-05-19","end":"19
46-11-11"},{"end":"9999-12-31","start":"1946-11-12","name":"VITERBO"}],"B508
":[{"end":"1927-01-11","start":"1863-04-23","name":"CAMPIGLIA CERVO"},{"star
t":"1927-01-12","end":"1992-04-15","name":"CAMPIGLIA CERVO"},{"start":"1992-
04-16","end":"2015-12-31","name":"CAMPIGLIA CERVO"}],"A402":[{"start":"1861-
03-17","end":"9999-12-31","name":"ARIELLI"}],"I608":[{"end":"9999-12-31","st
art":"1861-03-17","name":"SENIGALLIA"}],"B255":[{"start":"1863-07-13","end":
"9999-12-31","name":"BUGLIO IN MONTE"}],"E780":[{"name":"MACCHIA VALFORTORE"
,"end":"1928-06-30","start":"1861-03-17"},{"name":"MACCHIA VALFORTORE","star
t":"1946-04-09","end":"1970-03-02"},{"name":"MACCHIA VALFORTORE","start":"19
70-03-03","end":"9999-12-31"}],"G831":[{"name":"PONTEBBA","start":"1866-11-1
9","end":"1924-08-29"},{"end":"1928-05-18","start":"1924-08-30","name":"PONT
EBBA"},{"end":"1968-04-05","start":"1928-05-19","name":"PONTEBBA"},{"name":"
PONTEBBA","start":"1968-04-06","end":"9999-12-31"}],"F153":[{"start":"1861-0
3-17","end":"9999-12-31","name":"MESE"}],"L292":[{"start":"1863-03-30","end"
:"1928-10-15","name":"TORRICELLA VERZATE"},{"name":"TORRICELLA VERZATE","sta
rt":"1946-12-19","end":"9999-12-31"}],"L321":[{"name":"TRAMATZA","start":"18
61-03-17","end":"1928-05-12"},{"end":"1974-08-19","start":"1951-01-12","name
":"TRAMATZA"},{"start":"1974-08-20","end":"9999-12-31","name":"TRAMATZA"}],"
E495":[{"end":"1927-01-11","start":"1861-03-17","name":"LAVENO"},{"start":"1
927-01-12","end":"1928-01-27","name":"LAVENO"}],"F942":[{"end":"9999-12-31",
"start":"1861-03-17","name":"NOTARESCO"}],"C274":[{"start":"1861-03-17","end
":"1928-12-31","name":"CASTELSPINA"},{"end":"9999-12-31","start":"1954-01-24
","name":"CASTELSPINA"}],"L899":[{"name":"VIGONOVO","end":"9999-12-31","star
t":"1866-11-19"}],"A024":[{"name":"ACERRA","start":"1861-03-17","end":"1927-