view release on metacpan or  search on metacpan

lib/Business/DK/FI.pm  view on Meta::CPAN

    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__

=pod

=begin markdown

[![CPAN version](https://badge.fury.io/pl/Business-DK-FI.svg)](http://badge.fury.io/pl/Business-DK-FI)
[![Build Status](https://travis-ci.org/jonasbn/bdkfi.svg?branch=master)](https://travis-ci.org/jonasbn/bdkfi)
[![Coverage Status](https://coveralls.io/repos/jonasbn/bdkfi/badge.png)](https://coveralls.io/r/jonasbn/bdkfi)

=end markdown

=head1 NAME

Business::DK::FI - Danish FI number validator

=head1 VERSION

The documentation describes version 0.09

=head1 SYNOPSIS

    use Business::DK::FI qw(validate validateFI generate);

    if (validate('026840149965328')) {
        print "026840149965328 is valid\n";
    }


    my $fi_number = generate(1);

    if ($fi_number eq '000000000000018') {
        print "we have a FI number\n";
    }


=head1 DESCRIPTION