File Coverage

blib/lib/Person/ID/CZ/RC.pm
Criterion Covered Total %
statement 97 108 89.8
branch 20 24 83.3
condition 5 6 83.3
subroutine 18 19 94.7
pod 11 11 100.0
total 151 168 89.8


line stmt bran cond sub pod time code
1             package Person::ID::CZ::RC;
2              
3             # Pragmas.
4 12     12   41516 use strict;
  12         19  
  12         370  
5 12     12   55 use warnings;
  12         23  
  12         304  
6              
7             # Modules.
8 12     12   8559 use Class::Utils qw(set_params);
  12         307363  
  12         269  
9 12     12   16099 use DateTime;
  12         1712801  
  12         534  
10 12     12   123 use English qw(-no_match_vars);
  12         24  
  12         107  
11 12     12   6029 use Error::Pure qw(err);
  12         26  
  12         13864  
12              
13             # Version.
14             our $VERSION = 0.04;
15              
16             # Constructor.
17             sub new {
18 33     33 1 15464 my ($class, @params) = @_;
19              
20             # Create object.
21 33         80 my $self = bless {}, $class;
22              
23             # RC number.
24 33         121 $self->{'rc'} = undef;
25              
26             # Process parameters.
27 33         173 set_params($self, @params);
28              
29             # Check RC.
30 31 100       376 if (! defined $self->{'rc'}) {
31 1         4 err "Parameter 'rc' is required.";
32             }
33              
34             # Parse.
35 30         99 $self->_parse;
36              
37             # Object.
38 30         94 return $self;
39             }
40              
41             # Get alternate flag.
42             sub alternate {
43 3     3 1 20 my $self = shift;
44 3         54 return $self->{'alternate'};
45             }
46              
47             # Get checksum.
48             sub checksum {
49 3     3 1 21 my $self = shift;
50 3         9 return $self->{'checksum'};
51             }
52              
53             # Get day.
54             sub day {
55 3     3 1 21 my $self = shift;
56 3         6 return $self->{'day'};
57             }
58              
59             # Get error.
60             sub error {
61 5     5 1 34 my $self = shift;
62 5         16 return $self->{'error'};
63             }
64              
65             # Check validity.
66             sub is_valid {
67 3     3 1 21 my $self = shift;
68 3         7 return $self->{'validity'};
69             }
70              
71             # Get month.
72             sub month {
73 3     3 1 22 my $self = shift;
74 3         7 return $self->{'month'};
75             }
76              
77             # Get rc.
78             sub rc {
79 3     3 1 18 my $self = shift;
80 3         8 return $self->{'rc'};
81             }
82              
83             # Get serial.
84             sub serial {
85 3     3 1 26 my $self = shift;
86 3         11 return $self->{'serial'};
87             }
88              
89             # Get sex.
90             sub sex {
91 0     0 1 0 my $self = shift;
92 0         0 return $self->{'sex'};
93             }
94              
95             # Get year.
96             sub year {
97 3     3 1 22 my $self = shift;
98 3         10 return $self->{'year'};
99             }
100              
101             # Check validity.
102             sub _check_validity {
103 19     19   30 my $self = shift;
104 19         43 my $number = $self->{'rc'};
105 19         56 $number =~ s/\///ms;
106 19         43 $number = substr $number, 0, 9;
107 19         51 my $checksum = $number % 11;
108 19 100       65 if ($checksum == 10) {
109 9         20 $checksum = 0;
110             }
111 19 100       58 if ($self->{'checksum'} == $checksum) {
112 18         39 $self->{'validity'} = 1;
113             } else {
114 1         2 $self->{'error'} = "Checksum isn't valid.";
115 1         2 $self->{'validity'} = 0;
116             }
117 19         39 return;
118             }
119              
120             # Parse.
121             sub _parse {
122 30     30   48 my $self = shift;
123 30 100 100     334 if ($self->{'rc'} =~ m/^(\d\d)(\d\d)(\d\d)\/(\d\d\d)(\d)$/ms
    100 66        
124             || $self->{'rc'} =~ m/^(\d\d)(\d\d)(\d\d)(\d\d\d)(\d)$/ms) {
125              
126 19         89 $self->{'year'} = int(1900 + $1);
127 19 50       126 if ($2 > 70) {
    50          
    100          
128 0         0 $self->{'alternate'} = 1;
129 0         0 $self->{'month'} = int($2 - 70);
130 0         0 $self->{'sex'} = 'female';
131             } elsif ($2 > 50) {
132 0         0 $self->{'month'} = int($2 - 50);
133 0         0 $self->{'sex'} = 'female';
134 0         0 $self->{'alternate'} = 0;
135             } elsif ($2 > 20) {
136 8         31 $self->{'month'} = int($2 - 20);
137 8         22 $self->{'alternate'} = 1;
138 8         23 $self->{'sex'} = 'male';
139             } else {
140 11         32 $self->{'alternate'} = 0;
141 11         33 $self->{'month'} = int($2);
142 11         34 $self->{'sex'} = 'male';
143             }
144 19         57 $self->{'day'} = int($3);
145 19         69 $self->{'serial'} = $4;
146 19         70 $self->{'checksum'} = $5;
147              
148             # Check validity.
149 19         68 $self->_check_validity;
150              
151             # To 31. 12.1953.
152             } elsif ($self->{'rc'} =~ m/^(\d\d)(\d\d)(\d\d)\/(\d\d\d)$/ms
153             || $self->{'rc'} =~ m/^(\d\d)(\d\d)(\d\d)(\d\d\d)$/ms) {
154              
155 1         5 $self->{'year'} = int(1900 + $1);
156 1 50       7 if ($2 > 50) {
157 0         0 $self->{'month'} = int($2 - 50);
158 0         0 $self->{'sex'} = 'female';
159             } else {
160 1         3 $self->{'month'} = int($2);
161 1         4 $self->{'sex'} = 'male';
162             }
163 1         3 $self->{'day'} = int($3);
164 1         3 $self->{'serial'} = $4;
165 1         3 $self->{'checksum'} = '-';
166 1 50       6 if ($self->{'year'} <= 1953) {
167 0         0 $self->{'validity'} = 1;
168             } else {
169 1         4 $self->{'error'} = "Format of rc identification ".
170             "hasn't checksum.";
171 1         3 $self->{'validity'} = 0;
172             }
173 1         3 $self->{'alternate'} = 0;
174              
175             # Not valid.
176             } else {
177 10         149 $self->{'alternate'} = '-';
178 10         26 $self->{'checksum'} = '-';
179 10         26 $self->{'year'} = '-';
180 10         44 $self->{'month'} = '-';
181 10         26 $self->{'day'} = '-';
182 10         26 $self->{'serial'} = '-';
183 10         28 $self->{'sex'} = '-';
184 10         27 $self->{'error'} = "Format of rc identification isn't valid.";
185 10         19 $self->{'validity'} = 0;
186             }
187              
188             # Check date.
189 30 100       91 if ($self->{'validity'}) {
190 18         23 eval {
191             DateTime->new(
192             'year' => $self->{'year'},
193             'month' => $self->{'month'},
194 18         191 'day' => $self->{'day'},
195             );
196             };
197 18 100       5361 if ($EVAL_ERROR) {
198 1         3 $self->{'error'} = "Date isn't valid.";
199 1         3 $self->{'validity'} = 0;
200             }
201             }
202              
203 30         55 return;
204             }
205              
206             1;
207              
208             __END__