File Coverage

blib/lib/Person/ID/CZ/RC/Generator.pm
Criterion Covered Total %
statement 80 80 100.0
branch 32 32 100.0
condition 3 3 100.0
subroutine 14 14 100.0
pod 2 2 100.0
total 131 131 100.0


line stmt bran cond sub pod time code
1             package Person::ID::CZ::RC::Generator;
2              
3             # Pragmas.
4 4     4   38536 use strict;
  4         7  
  4         87  
5 4     4   19 use warnings;
  4         8  
  4         100  
6              
7             # Modules.
8 4     4   2748 use Class::Utils qw(set_params);
  4         95543  
  4         111  
9 4     4   5298 use DateTime;
  4         538669  
  4         162  
10 4     4   39 use English qw(-no_match_vars);
  4         9  
  4         35  
11 4     4   2011 use Error::Pure qw(err);
  4         8  
  4         180  
12 4     4   19 use List::MoreUtils qw(none);
  4         7  
  4         49  
13 4     4   4837 use Random::Day;
  4         227520  
  4         158  
14 4     4   38 use Readonly;
  4         10  
  4         3082  
15              
16             # Constants.
17             Readonly::Scalar our $EMPTY_STR => q{};
18             Readonly::Scalar our $YEAR_FROM => 1855;
19             Readonly::Scalar our $YEAR_TO => 2054;
20              
21             # Version.
22             our $VERSION = 0.05;
23              
24             # Constructor.
25             sub new {
26 16     16 1 12874 my ($class, @params) = @_;
27              
28             # Create object.
29 16         38 my $self = bless {}, $class;
30              
31             # Alternate flag.
32 16         39 $self->{'alternate'} = undef;
33              
34             # Day.
35 16         29 $self->{'day'} = undef;
36              
37             # Month.
38 16         24 $self->{'month'} = undef;
39              
40             # RC number separator.
41 16         33 $self->{'rc_sep'} = $EMPTY_STR;
42              
43             # Serial.
44 16         25 $self->{'serial'} = undef;
45              
46             # Sex.
47 16         23 $self->{'sex'} = undef;
48              
49             # Year.
50 16         24 $self->{'year'} = undef;
51              
52             # Process parameters.
53 16         51 set_params($self, @params);
54              
55             # Check RC separator.
56 14 100   15   211 if (none { $self->{'rc_sep'} eq $_ } ('', '/')) {
  15         54  
57 1         4 err "Parameter 'rc_sep' has bad value.";
58             }
59              
60             # Check serial part of RC.
61 13 100       52 if (defined $self->{'serial'}) {
62 5 100       37 if ($self->{'serial'} !~ m/^\d+$/ms) {
    100          
    100          
63 1         3 err "Parameter 'serial' isn't number.";
64             } elsif ($self->{'serial'} < 1) {
65 1         4 err "Parameter 'serial' is lesser than 1.";
66             } elsif ($self->{'serial'} > 999) {
67 1         3 err "Parameter 'serial' is greater than 999.";
68             }
69             }
70              
71             # Check sex.
72 10 100 100     49 if (defined $self->{'sex'}
73 5     5   21 && none { $self->{'sex'} eq $_ } qw(male female)) {
74              
75 1         5 err "Parameter 'sex' has bad value.";
76             }
77              
78             # Check year.
79 9 100       26 if (defined $self->{'year'}) {
80 3 100       14 if ($self->{'year'} < $YEAR_FROM) {
    100          
81 1         6 err "Parameter 'year' is lesser than $YEAR_FROM.";
82             } elsif ($self->{'year'} > $YEAR_TO) {
83 1         5 err "Parameter 'year' is greater than $YEAR_TO.";
84             }
85             }
86              
87             # Object.
88 7         21 return $self;
89             }
90              
91             # Get rc.
92             sub rc {
93 17     17 1 1691 my $self = shift;
94              
95             # Construct date.
96             my $date = Random::Day->new(
97             'day' => $self->{'day'},
98             'dt_from' => DateTime->new(
99             'day' => 1,
100             'month' => 1,
101             'year' => $YEAR_FROM,
102             ),
103             'dt_to' => DateTime->new(
104             'day' => 31,
105             'month' => 12,
106             'year' => $YEAR_TO,
107             ),
108             'month' => $self->{'month'},
109 17         68 'year' => $self->{'year'},
110             )->get;
111              
112             # Sex.
113 17         90245 my $sex = $self->{'sex'};
114 17 100       47 if (! defined $sex) {
115 10 100       33 $sex = int(rand(2)) ? 'male' : 'female';
116             }
117              
118             # Get month part.
119 17         46 my $month = $date->month;
120 17 100       137 if ($sex eq 'female') {
121 14         24 $month += 50;
122             }
123              
124             # Alternate number.
125 17 100       50 if ($self->{'alternate'}) {
126 7         10 $month += 20;
127             }
128              
129             # Construct date part.
130 17         43 my $date_part = (sprintf '%02d%02d%02d', (substr $date->year, 2), $month, $date->day);
131              
132             # Add serial.
133 17         213 my $serial = $self->{'serial'};
134 17 100       66 if (! defined $serial) {
135 16         30 $serial = int(rand(1000)) + 1;
136             }
137 17         41 my $serial_part = sprintf '%03d', $serial;
138              
139             # Add checksum.
140 17 100       44 if ($date->year > 1954) {
141 9         56 $serial_part = $self->_checksum($date_part, $serial_part);
142             }
143              
144             # Construct rc.
145 17         70 my $rc = $date_part.$self->{'rc_sep'}.$serial_part;
146              
147             # Return $rc.
148 17         92 return $rc;
149             }
150              
151             # Compute checksum.
152             sub _checksum {
153 9     9   17 my ($self, $date_part, $serial_part) = @_;
154 9         16 my $num = $date_part.$serial_part;
155 9         17 my $num_11 = $num % 11;
156 9         11 my $checksum;
157 9 100       23 if ($num_11 == 10) {
158 1         3 $checksum = 0;
159             } else {
160 8         13 $checksum = $num_11;
161             }
162 9         22 return $serial_part.$checksum;
163             }
164              
165             1;
166              
167             __END__