Revision ca1a82fb
Von Moritz Bunkus vor mehr als 4 Jahren hinzugefügt
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 |
Auch abrufbar als: Unified diff
Algorithm::CheckDigits: Fix für belgische UStID-Nummern
Das Schema in Belgien wurde irgendwann von sieben auf acht
Ziffern (zzgl. zwei Prüfziffern) umgestellt. Das originale Modul von
Algorithm::CheckDigits prüft fest auf sieben und ist damit für
aktuelle Nummern fehlerhaft.
Das Modul in overrides akzeptiert nun sieben- und achtstellige Ziffern
bei der Prüfung und erzeugt immer achtstellige
Nummern (bzw. zehnstelige mit Prüfziffern).