File Coverage

blib/lib/Business/DK/CVR.pm

Criterion	Covered	Total	%
statement	69	69	100.0
branch	12	12	100.0
condition	3	3	100.0
subroutine	16	16	100.0
pod	3	3	100.0
total	103	103	100.0

package Business::DK::CVR;

use strict;
use warnings;
use vars qw($VERSION @EXPORT_OK);
use Carp qw(croak);
use Params::Validate qw(validate_pos SCALAR OBJECT ARRAYREF );
use Readonly;
use 5.008; #5.8.0

use base qw(Exporter);

$VERSION   = '0.10';
@EXPORT_OK = qw(validate validateCVR generate _calculate_sum);

use constant MODULUS_OPERAND => 11;
use constant MAX_CVRS        => 9090908;
use constant VALID           => 1;
use constant INVALID         => 0;

Readonly my @controlcifers => qw(2 7 6 5 4 3 2 1);

sub validateCVR {
    return validate(shift);
}

sub validate {
    my ($controlnumber) = @_;

    validate_pos( @_, { type => SCALAR, regex => qr/^\d{8}$/ } );

    my $sum = _calculate_sum( $controlnumber, \@controlcifers );

    if ( $sum % MODULUS_OPERAND ) {
        return INVALID;
    } else {
        return VALID;
    }
}

sub _calculate_sum {
    my ( $number, $controlcifers ) = @_;

    validate_pos( @_,
        { type => SCALAR, regex => qr/^\d+$/ },
        { type => ARRAYREF },
    );

    my $sum = 0;
    my @numbers = split //smx, $number;

    for ( my $i = 0; $i < scalar @numbers; $i++ ) {
        $sum += $numbers[$i] * $controlcifers->[$i];
    }
    return $sum;
}

sub generate {
    my @array = validate_pos( @_,
        { type => OBJECT | SCALAR, optional => 1 },
        { type => SCALAR, optional => 1, default => 1 },
        { type => SCALAR, optional => 1, default => 1 },
    );

    my ( $self, $amount, $seed ) = @array;

    if ( defined $self and $self =~ m/\d+/ ) {
        $seed   = $amount;
        $amount = $self;
    }

    my @cvrs;
    my $cvr;

    if ( $amount > MAX_CVRS ) {
        croak 'The amount requested exceeds the maximum possible valid CVRs ('
            . MAX_CVRS . ')';
    }

    my $count = $amount;
    while ($count) {
        $cvr = sprintf '%08d', $seed;
        if ( validate($cvr) ) {
            push @cvrs, $cvr;
            $count--;
        }
        $seed++;
    }

    if (wantarray) {
        return @cvrs;
    } else {
        if ( $amount == 1 ) {
            return $cvr;
        } else {
            return \@cvrs;
        }
    }
}

1;

__END__