package No::PersonNr;

require Exporter;
@ISA=qw(Exporter);
@EXPORT_OK = qw(personnr_ok er_mann er_kvinne fodt_dato);

use Carp qw(croak);
use strict;
use vars qw($VERSION);

$VERSION = sprintf("%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/);


=head1 NAME

No::PersonNr - Check Norwegian Social security numbers

=head1 SYNOPSIS

  use No::PersonNr qw(personnr_ok);

  if (personnr_ok($nr)) {
      # ...
  }

=head1 DESCRIPTION

B<This documentation is written in Norwegian.>

Denne modulen kan brukes for å sjekke norske personnummer.  De 2 siste
siffrene i personnummerene er kontrollsiffre og må stemme overens med
resten for at det skal være et gyldig nummer.  Modulen inneholder også
funksjoner for å bestemme personens kjønn og personens fødselsdato.

Ingen av rutinene eksporteres implisitt.  Du må be om dem.  Følgende
funksjoner er tilgjengelig:

=over 4

=item personnr_ok($nr)

Funksjonen personnr_ok() vil returnere FALSE hvis personnummeret gitt
som argument ikke er gyldig.  Hvis nummeret er gyldig så vil
funksjonen returnere $nr på standard form.  Nummeret som gis til
personnr_ok() kan inneholde ' ' eller '-'.

Standard form er her definert som 11 siffer uten noe skilletegn
mellom tallgrupper.

=cut

sub personnr_ok
{
    my($nr,$returndate) = @_;
    return undef unless defined($nr);
    $nr =~ s/[\s\-]+//g;
    return "" if $nr =~ /\D/;
    return "" if length($nr) != 11;
    my @nr = split(//, $nr);

    # Modulo 11 test
    my($vekt);
    for $vekt ([ 3, 7, 6, 1, 8, 9, 4, 5, 2, 1, 0 ],
	       [ 5, 4, 3, 2, 7, 6, 5, 4, 3, 2, 1 ]) {
	my $sum = 0;
	for (0..10) {
	    $sum += $nr[$_] * $vekt->[$_];
 	}
	return "" if $sum % 11;
    }

    # Extract the date part
    my @date = reverse unpack("A2A2A2A3", $nr);
    my $pnr = shift(@date);

    # H-nummer -- hjelpenummer, en virksomhetsintern, unik identifikasjon av
    # en person som ikke har fødselsnummer/D-nummer eller hvor dette er
    # ukjent.  4 er lagt til tredje siffer.
    $date[1] -= 40 if $date[1] > 40;

    # D-nummer -- For personer som ikke er bosatt i Norge, men som likevel
    # er skatte- og/eller trygdepliktig.  4 er lagt til første siffer.
    $date[2] -= 40 if $date[2] > 40;

    # Så var det det å kjenne igjen hvilket hundreår som er det riktige.
    #
    #   Individnummer  År i fødselsdato  Født
    #   500 - 749      > 54              1855 - 1899
    #   000 - 499                        1900 - 1999
    #   500 - 999      < 55              2000 - 2054
    #
    if ($pnr < 500) {
        # ingen tvetydighet; person født 1900 - 1999
        $date[0] += 1900;
    } elsif ($pnr >= 750) {
        # ingen tvetydighet; person født 2000 - 2054
	$date[0] += 2000;
    } else {
        # tvetydig; må se på de to sifrene for fødselsår
        if ($date[0] > 54) {
            # person født 1855 - 1899
            $date[0] += 1800;
        } else {
            # person født 2000 - 2054
            $date[0] += 2000;
        }
    }
    return "" unless _is_legal_date(@date);

    return $returndate ? join("-", @date) : $nr;
}


sub _is_legal_date
{
    my($y,$m,$d) = @_;
    return if $d < 1;
    return if $m < 1 || $m > 12;

    my $mdays = 31;
    if ($m == 2) {
	$mdays = (($y % 4 == 0) && ($y % 100 != 0)) || ($y % 400 == 0)
	  ? 29 : 28;
    } elsif ($m == 4 || $m == 6 || $m == 9 || $m == 11) {
	$mdays = 30;
    }
    return if $d > $mdays;
    1;
}


=item er_mann($nr)

Vil returnere TRUE hvis $nr tilhører en mann.  Rutinen vil croake hvis
nummeret er ugyldig.

=cut

sub er_mann
{
    my $nr = personnr_ok(shift);
    croak "Feil i personnummer" unless $nr;
    substr($nr, 8, 1) % 2;
}


=item er_kvinne($nr)

Vil returnere TRUE hvis $nr tilhører en kvinne.  Rutinen vil croake
hvis nummeret er ugyldig.

=cut

sub er_kvinne { !er_mann(@_); }


=item fodt_dato($nr)

Vil returnere personens fødselsdato på formen "ÅÅÅÅ-MM-DD".  Rutinen
returnerer C<""> hvis nummeret er ugyldig.

=cut

sub fodt_dato
{
    personnr_ok(shift, 1);
}

1;

=back

=head1 REFERENCES

=over 4

=item [1]

"Hjelpenummer for personer uten kjent fødselsnummer", Torbjørn Nystadnes,
Kompetansesenter for IT i helsevesenet AS (KITH).  KITH-rapport,
Rapportnummer 11/98, ISBN 82-7846-051-5, 1998-12-11.

=item [2]

"Fødselsnummeret, oppbygging - kontrollsiffer - løsning etter år 2000".
Brosjyre fra Skattedirektoratet.

=item [3]

Skattedirektoratet, Sentralkontoret for folkeregistrering,

=back

=head1 LIMITATIONS

Personnummersystemet håndterer kun årstall fra og med 1855 til og med 2054.

=head1 AUTHORS

Gisle Aas <gisle@aas.no>, Peter J. Acklam <pjacklam@online.no>, Petter
Reinholdtsen <pere@hungry.com>, Hallvard B. Furuseth
<h.b.furuseth@usit.uio.no>.

=cut