modules/override/Algorithm/CheckDigits/M97_001.pm

   1 package Algorithm::CheckDigits::M97_001;
   2
   3 use 5.006;
   4 use strict;
   5 use warnings;
   6 use integer;
   7
   8 use version; our $VERSION = 'v1.3.2';
   9
  10 our @ISA = qw(Algorithm::CheckDigits);
  11
  12 sub new {
  13         my $proto = shift;
  14         my $type  = shift;
  15         my $class = ref($proto) || $proto;
  16         my $self  = bless({}, $class);
  17         $self->{type} = lc($type);
  18         return $self;
  19 } # new()
  20
  21 sub is_valid {
  22         my ($self,$number) = @_;
  23         if ($number =~ /^(\d{7,8})?(\d\d)$/i) {
  24                 return $2 eq $self->_compute_checkdigit($1);
  25         }
  26         return ''
  27 } # is_valid()
  28
  29 sub complete {
  30         my ($self,$number) = @_;
  31         if ($number =~ /^(\d{7,8})$/i) {
  32                 return sprintf('%08d', $number) . $self->_compute_checkdigit($1);
  33         }
  34         return '';
  35 } # complete()
  36
  37 sub basenumber {
  38         my ($self,$number) = @_;
  39         if ($number =~ /^(\d{7,8})(\d\d)$/i) {
  40                 return sprintf('%08d', $1) if ($2 eq $self->_compute_checkdigit($1));
  41         }
  42         return '';
  43 } # basenumber()
  44
  45 sub checkdigit {
  46         my ($self,$number) = @_;
  47         if ($number =~ /^(\d{7,8})(\d\d)$/i) {
  48                 return $2 if (uc($2) eq $self->_compute_checkdigit($1));
  49         }
  50         return '';
  51 } # checkdigit()
  52
  53 sub _compute_checkdigit {
  54         my $self   = shift;
  55         my $number = shift;
  56
  57         if ($number =~ /^\d{7,8}$/i) {
  58                 return sprintf("%2.2d",97 - ($number % 97));
  59         }
  60         return -1;
  61 } # _compute_checkdigit()
  62
  63 # Preloaded methods go here.
  64
  65 1;
  66 __END__
  67
  68 =head1 NAME
  69
  70 CheckDigits::M97_001 - compute check digits for VAT Registration Number (BE)
  71
  72 =head1 SYNOPSIS
  73
  74   use Algorithm::CheckDigits;
  75
  76   $ustid = CheckDigits('ustid_be');
  77
  78   if ($ustid->is_valid('136695962')) {
  79         # do something
  80   }
  81
  82   $cn = $ustid->complete('1366959');
  83   # $cn = '136695962'
  84
  85   $cd = $ustid->checkdigit('136695962');
  86   # $cd = '62'
  87
  88   $bn = $ustid->basenumber('136695962');
  89   # $bn = '1366959'
  90
  91 =head1 DESCRIPTION
  92
  93 =head2 ALGORITHM
  94
  95 =over 4
  96
  97 =item 1
  98
  99 The whole number (without checksum) is taken modulo 97.
 100
 101 =item 2
 102
 103 The checksum is difference of the remainder from step 1 to 97.
 104
 105 =back
 106
 107 =head2 METHODS
 108
 109 =over 4
 110
 111 =item is_valid($number)
 112
 113 Returns true only if C<$number> consists solely of numbers and the last digit
 114 is a valid check digit according to the algorithm given above.
 115
 116 Returns false otherwise,
 117
 118 =item complete($number)
 119
 120 The check digit for C<$number> is computed and concatenated to the end
 121 of C<$number>.
 122
 123 Returns the complete number with check digit or '' if C<$number>
 124 does not consist solely of digits and spaces.
 125
 126 =item basenumber($number)
 127
 128 Returns the basenumber of C<$number> if C<$number> has a valid check
 129 digit.
 130
 131 Return '' otherwise.
 132
 133 =item checkdigit($number)
 134
 135 Returns the checkdigits of C<$number> if C<$number> has a valid check
 136 digit.
 137
 138 Return '' otherwise.
 139
 140 =back
 141
 142 =head2 EXPORT
 143
 144 None by default.
 145
 146 =head1 AUTHOR
 147
 148 Mathias Weidner, C<< <mamawe@cpan.org> >>
 149
 150 =head1 SEE ALSO
 151
 152 L<perl>,
 153 L<CheckDigits>,
 154 F<www.pruefziffernberechnung.de>.
 155
 156 =cut