| Business-DK-CVR documentation | Contained in the Business-DK-CVR distribution. |
Business::DK::CVR - Danish CVR (VAT Registration) code generator/validator
This documentation describes version 0.06 of Business::DK::CVR
use Business::DK::CVR qw(validate);
my $rv;
eval { $rv = validate(27355021); };
if ($@) {
die "Code is not of the expected format - $@";
}
if ($rv) {
print "Code is valid";
} else {
print "Code is not valid";
}
#Using with Params::Validate
#See also examples/
use Params::Validate qw(:all);
use Business::DK::CVR qw(validateCVR);
eval {
check_cvr(cvr => 27355021);
};
if ($@) {
print "CVR is not valid - $@\n";
}
eval {
check_cvr(cvr => 27355020);
};
if ($@) {
print "CVR is not valid - $@\n";
}
sub check_cvr {
validate( @_,
{ cvr =>
{ callbacks =>
{ 'validate_cvr' => sub { validateCVR($_[0]); } } } } );
print $_[1]." is a valid CVR\n";
}
CVR is a company registration number used in conjuction with VAT handling in Denmark.
If you want to use this module in conjunction please check: Data::FormValidator::Constraints::Business::DK::CVR
The function takes a single argument, a 10 digit CVR number.
The function returns 1 (true) in case of a valid CVR number argument and 0 (false) in case of an invalid CVR number argument.
If the argument is a valid argument the sum is calculated by _calculate_sum based on the argument and the controlcifers array.
The sum returned is checked using a modulus caluculation and based on its validity either 1 or 0 is returned.
Better name for export. This is just a wrapper for validate
Generate is a function which generates valid CVR numbers, it is by no means an authority, since CVRs are generated and distributed by danish tax authorities, but it can be used to generate example CVRs for testing and so on.
This function takes an integer and calculates the sum bases on the the controlcifer array.
Business::DK::CVR exports on request:
The number of valid CVRs are limited, so if the user requests a number of CVRs to be generated which exceeds the upper limit, this error is instantiated. See: generate.
The module requires no special configuration or environment to run.
The module has no known incompatibilities.
The module has no known bugs or limitations.
Coverage of the test suite is at 100%
Please report issues via CPAN RT:
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Business-DK-CVR
or by sending mail to
bug-Business-DK-CVR@rt.cpan.org
Jonas B. Nielsen, (jonasbn) - <jonasbn@cpan.org>
Business-DK-CVR is (C) by Jonas B. Nielsen, (jonasbn) 2006-2011
Business-DK-CVR is released under the artistic license
The distribution is licensed under the Artistic License, as specified by the Artistic file in the standard perl distribution (http://www.perl.com/language/misc/Artistic.html).
| Business-DK-CVR documentation | Contained in the Business-DK-CVR distribution. |
package Business::DK::CVR; # $Id: CVR.pm,v 1.7 2008-06-11 08:08:00 jonasbn Exp $ 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 base qw(Exporter); $VERSION = '0.06'; @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__