File Coverage

blib/lib/Class/Business/DK/CPR.pm

Criterion	Covered	Total	%
statement	51	57	89.4
branch	12	14	85.7
condition	7	9	77.7
subroutine	11	15	73.3
pod	8	8	100.0
total	89	103	86.4

package Class::Business::DK::CPR;

use strict;
use warnings;
use Class::InsideOut qw( private register id );
use Carp qw(croak);
use English qw(-no_match_vars);
use 5.010;    #5.10.0

use Business::DK::CPR qw(validate1968 validate2007);

our $VERSION = '0.15';

private number    => my %number;       # read-only accessor: number()
private gender    => my %gender;       # read-only accessor: gender()
private algorithm => my %algorithm;    # read-only accessor: algorithm()

sub new {
    my ( $class, $number ) = @_;

    if (not $number) {
        croak 'You must provide a CPR number';
    }

    ## no critic (Variables::ProhibitUnusedVariables)
    my $self = \( my $scalar );

    bless $self, $class;

    register($self);

    $self->set_number($number);

    return $self;
}

## no critic (Subroutines::RequireFinalReturn)
sub number { $number{ id $_[0] } }

sub get_number { $number{ id $_[0] } }

sub set_number {
    my ( $self, $unvalidated_cpr ) = @_;

    my $rv = 0;
    my @algorithms;

    if ($unvalidated_cpr) {
        eval { $rv = validate1968($unvalidated_cpr); 1; };

        if ( $rv && $rv % 2 ) {
            push @algorithms, '1968';
        }
        elsif ($rv) {
            push @algorithms, '1968';
        }

        eval { $rv = validate2007($unvalidated_cpr); 1; };

        if ( $rv && $rv % 2 ) {
            push @algorithms, '2007';
        }
        elsif ($rv) {
            push @algorithms, '2007';
        }

        if ( $EVAL_ERROR or not $rv ) {
            croak 'Invalid CPR number parameter';

        }
        else {

            $number{ id $self }    = $unvalidated_cpr;
            $gender{ id $self }    = $rv;
            $algorithm{ id $self } = ( join ', ', @algorithms );

            return 1;
        }
    }
    else {
        croak 'You must provide a CPR number';
    }
}

sub gender { $gender{ id $_[0] } }

sub get_gender { $gender{ id $_[0] } }

sub algorithm { $algorithm{ id $_[0] } }

sub get_algorithm { $algorithm{ id $_[0] } }

1;

__END__