File Coverage

blib/lib/Data/Random/NL.pm
Criterion Covered Total %
statement 64 65 98.4
branch 11 14 78.5
condition 3 3 100.0
subroutine 11 11 100.0
pod 4 4 100.0
total 93 97 95.8


line stmt bran cond sub pod time code
1             package Data::Random::NL;
2 1     1   73697 use warnings;
  1         11  
  1         30  
3 1     1   6 use strict;
  1         2  
  1         35  
4              
5             # ABSTRACT: Tools for generating random Dutch numbers
6             our $VERSION = '1.5';
7              
8 1     1   5 use Exporter qw(import);
  1         1  
  1         49  
9 1     1   7 use Carp qw(croak);
  1         8  
  1         728  
10              
11             our @EXPORT_OK = (
12             qw(
13             generate_bsn
14             generate_rsin
15             generate_kvk
16             generate_vestigingsnummer
17             ),
18             );
19              
20             our %EXPORT_TAGS = (
21             all => \@EXPORT_OK,
22             );
23              
24             sub generate_bsn {
25 2     2 1 1593 my $begin = shift;
26 2         7 my @bsn = _generate_number_set(9, $begin);
27              
28             # A BSN cannot start with a 00
29 2   100     11 while ($bsn[0] == 0 && $bsn[1] == 0) {
30 1         6 $bsn[1] = int(rand(10));
31             }
32              
33 2         4 @bsn = reverse(@bsn);
34              
35 2         3 my $sum = 0;
36 2         5 foreach my $i (reverse(1..8)) {
37 16         24 $sum += (($i + 1) * $bsn[$i]);
38             }
39              
40 2         4 my $last_number = $sum % 11;
41             # if the last number is 10, we have an invalid number
42 2 50       6 return generate_bsn($begin) if $last_number > 9;
43              
44 2         14 @bsn = reverse(@bsn);
45              
46 2         4 $bsn[-1] = $last_number;
47 2         12 return join("", @bsn);
48             }
49              
50             sub generate_kvk {
51 3     3 1 1950 my $begin = shift;
52 3         8 my @kvk = _generate_number_set(9, 0, $begin);
53 3         6 $kvk[0] = 0; # we always start with a 0
54              
55 3         7 @kvk = _get_last_number(@kvk);
56 3 100       9 if (@kvk) {
57 2         4 shift @kvk;
58 2         13 return join("", @kvk);
59             }
60 1         5 return generate_kvk($begin);
61             }
62              
63             sub generate_rsin {
64 2     2 1 1487 my $begin = shift;
65 2         6 my @rsin = _generate_number_set(9, $begin);
66              
67 2         9 @rsin = _get_last_number(@rsin);
68 2 50       15 return join("", @rsin) if @rsin;
69 0         0 return generate_rsin($begin);
70             }
71              
72             sub _get_last_number {
73 5     5   10 my @set = @_;
74              
75 5         8 @set = reverse(@set);
76              
77 5         7 my $sum = 0;
78 5         10 foreach my $i (reverse(1..8)) {
79 40         57 $sum += (($i + 1) * $set[$i]);
80             }
81              
82 5         10 my $left = $sum % 11;
83 5         9 my $last_number = abs($left - 11);
84              
85             # if the last number is 10, we have an invalid number
86 5 100       10 return if $last_number > 9;
87              
88 4         8 $set[0] = $last_number;
89 4         9 return reverse(@set);
90             }
91              
92             sub _generate_number_set {
93 9     9   19 my ($max, @begin) = @_;
94 9         15 my @number;
95 9         17 foreach (@begin) {
96 12         18 eval { _starts_with(\@number, $_) };
  12         23  
97 12 50       28 croak "$@" if $@;
98             }
99              
100 9         22 while(@number < $max) {
101 79         184 push(@number, int(rand(10)));
102             }
103 9         36 return @number;
104             }
105              
106             sub generate_vestigingsnummer {
107 2     2 1 1918 my $begin = shift;
108 2         6 return join("", _generate_number_set(12, $begin));
109             }
110              
111             sub _starts_with {
112 15     15   2713 my ($ref, $begin) = @_;
113              
114 15 100       38 if (defined $begin) {
115 11 100       45 if ($begin !~ /^[0-9]$/) {
116 2         15 die("You did not provide a number", $/);
117             }
118 9         17 push(@$ref, $begin);
119 9         19 return 1;
120             }
121             }
122              
123             1;
124              
125             __END__