File Coverage

blib/lib/Business/DK/FI.pm

Criterion	Covered	Total	%
statement	71	71	100.0
branch	4	4	100.0
condition			n/a
subroutine	20	20	100.0
pod	3	3	100.0
total	98	98	100.0

package Business::DK::FI;

use strict;
use warnings;
use vars qw($VERSION @EXPORT_OK);
use Params::Validate qw(validate_pos SCALAR ARRAYREF);
use Readonly;
use base qw(Exporter);
use English qw( -no_match_vars );
use 5.006;

$VERSION   = '0.09';
@EXPORT_OK = qw(validate validateFI generate);

use constant MODULUS_OPERAND => 10;
use constant THRESHOLD       => 10;
use constant DEDUCTION       => 9;
use constant INVALID         => 0;
use constant VALID           => 1;

Readonly::Array my @CONTROLCIFERS   => qw(1 2 1 2 1 2 1 2 1 2 1 2 1 2);
Readonly::Scalar my $CONTROL_LENGTH => scalar @CONTROLCIFERS;

## no critic (NamingConventions::Capitalization)

sub validateFI {
    return validate(shift);
}

sub validate {
    my ($fi_number) = @ARG;

    validate_pos( @ARG, { type => SCALAR, regex => qr/^\d{15}$/xsm } );

    my ($last_digit);
    ( $fi_number, $last_digit )
        = $fi_number =~ m/^(\d{$CONTROL_LENGTH})(\d{1})$/xsm;

    my $sum = _calculate_sum( $fi_number, \@CONTROLCIFERS );
    my $checksum = _calculate_checksum($sum);

    if ( $checksum == $last_digit ) {
        return VALID;
    }
    else {
        return INVALID;
    }
}

sub _calculate_checksum {
    my ($sum) = @ARG;

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

    return ( THRESHOLD - ( $sum % MODULUS_OPERAND ) );
}

sub _calculate_sum {
    my ( $number, $CONTROLCIFERS ) = @ARG;

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

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

## no critic (ControlStructures::ProhibitCStyleForLoops)
    for ( my $i = 0; $i < scalar @numbers; $i++ ) {
        my $tmp_sum = $numbers[$i] * $CONTROLCIFERS->[$i];

        if ( $tmp_sum >= THRESHOLD ) {
            $sum += ( $tmp_sum - DEDUCTION );
        }
        else {
            $sum += $tmp_sum;
        }
    }
    return $sum;
}

sub generate {
    my ($number) = @ARG;

    #number has to be a positive number between 1 and 99999999999999
    validate_pos(
        @ARG,
        {   type      => SCALAR,
            regex     => qr/^\d+$/,
            callbacks => {
                'higher than 0' => sub { shift() >= 1 },
                'lower than 99999999999999' =>
                    sub { shift() <= 99999999999999 },
            },
        },
    );

    #padding with zeroes up to our maximum length
    my $pattern = '%0' . $CONTROL_LENGTH . 's';
    my $reformatted_number = sprintf $pattern, $number;

    #this call takes care of the check of the product of the above statement
    my $sum = _calculate_sum( $reformatted_number, \@CONTROLCIFERS );
    my $checksum = _calculate_checksum($sum);

    my $finalized_number = $reformatted_number . $checksum;

    return $finalized_number;
}

1;

__END__