view release on metacpan or  search on metacpan

lib/Business/IS/PIN.pm  view on Meta::CPAN

    # Functional interface
    use Business::IS::PIN qw(:all);

    my $kt = '0902862349'; # Yours truly

    if (valid $kt) {
        # Extract YYYY-MM-DD
        my $year  = year  $kt;
        my $month = month $kt
        my $day   = day   $kt;

        # ...
    }

    # OO interface that doesn't pollute your namespace
    use Business::IS::PIN;

    my $kt = Business::IS::PIN->new('0902862349');

    if ($kt->valid and $kt->person) {
        printf "You are a Real Boy(TM) born on %d-%d-%d\n",
            $kt->year, $kt->month, $kt->day;
    } elsif ($kt->valid and $kt->company) {
        warn "Begone, you spawn of capitalism!";
    } else {
        die "EEEK!";
    }

=head1 DESCRIPTION

This module provides an interface for validating the syntax of and
extracting information from Icelandic personal identification numbers
(Icelandic: I<kennitala>). These are unique 10-digit numbers assigned
to all Icelandic citizens, foreign citizens with permanent residence
and corporations (albeit with a slightly different format, L<see
below|/Format>).

=head1 LIMITATIONS

The National Statistical Institute of Iceland (Icelandic: I<Hagstofa>)
- a goverment organization - handles the assignment of these
numbers. This module will tell you whether the formatting of a given
number is valid, not whether it was actually assigned to someone. For
that you need to pay through the nose to the NSIoI, or cleverly leech
on someone who is:)

=cut

use overload '""' => sub { ${ +shift } };

=head1 EXPORT

None by default, every function in this package except for L</new> can
be exported individually, B<:all> exports them all.

=head1 METHODS & FUNCTIONS

=head2 new

Optional constructor which takes a valid kennitala or a fragment of
one as its argument. Returns an object that L<stringifies|overload> to
whatever string is provided.

If a fragment is provided functions in this package that need
information from the omitted part (such as L</year>) will not work.

=cut

sub new
{
    my ( $pkg, $kt ) = @_;

    bless \$kt => $pkg;
}

=head2 valid

Takes a 9-10 character kennitala and returns true if its checksum is
valid, false otherwise.

=cut

sub checksum; # pre-declare to duck error
sub valid
{
    my $kt = ref $_[0] ? ${$_[0]} : $_[0];

    my $summed   = substr $kt, 0, 9;
    my $unsummed = substr $kt, 0, 8;
    my $sum = checksum $unsummed;

    $summed eq $unsummed . $sum;
}

=head2 checksum

Takes a the first 8 characters of a kennitala and returns the 9th
checksum digit.

=cut

sub checksum
{
    my $kt = ref $_[0] ? ${$_[0]} : $_[0];
    my @num = split //, $kt;

    my $sum =
        sum
            # Day
            3 * $num[0],
            2 * $num[1],
            # Month
            7 * $num[2],
            6 * $num[3],
            # Year
            5 * $num[4],
            4 * $num[5],
            # Serial
            3 * $num[6],
            2 * $num[7];

    (11 - $sum % 11) % 11;
}