File Coverage

blib/lib/Asmens/Kodas.pm

Criterion	Covered	Total	%
statement	17	22	77.2
branch	11	14	78.5
condition	2	3	66.6
subroutine	4	4	100.0
pod	1	2	50.0
total	35	45	77.7

#!/usr/bin/perl -w
package Asmens::Kodas;
use Exporter;
use strict;

our @ISA = qw/Exporter/;
our @EXPORT_OK = qw/tikras/;
our $VERSION = 0.02;

=head1 NAME

Asmens::Kodas - Lithuanian personal (passport) number checking

=head1 SYNOPSIS

     use Asmens::Kodas qw/tikras/;
     print tikras("38208080214") ? "tinka" : "netinka";

=head1 DESCRIPTION

This module provides a subroutine that runs a few checks which ensure
that Lithuanian personal number (I) has a correct checksum
and has sane fields.

=head2 tikras

This subroutine does the actual checking. It returns 1 if the argument can possibly
be a correct Lithuanian personal number. Otherwise it returns 0.

=head1 AUTHOR

Petras Kudaras [e-mail]

=cut

sub tikras {
	return 0 unless $_[0] =~ /^\d{11}$/;
	my @what = split //, shift;
	return 0 unless $what[0] >= 1 and $what[0] <= 6;
	return 0 unless $what[10] == checksum(@what);
	return 0 unless $what[3] * 10 + $what[4] <= 12;
	return 0 unless $what[5] * 10 + $what[6] <= 31;
	1;
}

sub checksum {
	my $c = $_[0] + $_[1] * 2 + $_[2] * 3 + $_[3] * 4 + $_[4] * 5 + $_[5] * 6;
	$c += $_[6] * 7 + $_[7] * 8 + $_[8] * 9 + $_[9];
	$c = $c % 11;
	return $c unless $c == 10;
	$c = $_[0] * 3 + $_[1] * 4 + $_[2] * 5 + $_[3] * 6 + $_[4] * 7 + $_[5] * 8;
	$c += $_[6] * 9 + $_[7] + $_[8] * 2 + $_[9] * 3;
	$c = $c % 11;
	return $c unless $c == 10;
	return 0;
}
1;