File Coverage

blib/lib/Business/ID/NIK.pm
Criterion Covered Total %
statement 58 58 100.0
branch 17 26 65.3
condition 2 4 50.0
subroutine 7 7 100.0
pod 1 1 100.0
total 85 96 88.5


line stmt bran cond sub pod time code
1             package Business::ID::NIK;
2              
3 1     1   740 use 5.010001;
  1         9  
4 1     1   5 use warnings;
  1         2  
  1         39  
5 1     1   6 use strict;
  1         2  
  1         21  
6              
7 1     1   968 use DateTime;
  1         544045  
  1         48  
8 1     1   638 use Locale::ID::Locality qw(list_idn_localities);
  1         116590  
  1         85  
9 1     1   610 use Locale::ID::Province qw(list_idn_provinces);
  1         57581  
  1         794  
10              
11             require Exporter;
12             our @ISA = qw(Exporter);
13             our @EXPORT_OK = qw(parse_nik);
14              
15             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
16             our $DATE = '2021-08-31'; # DATE
17             our $DIST = 'Business-ID-NIK'; # DIST
18             our $VERSION = '0.094'; # VERSION
19              
20             our %SPEC;
21              
22             $SPEC{parse_nik} = {
23             v => 1.1,
24             summary => 'Parse Indonesian citizenship registration number (NIK)',
25             args => {
26             nik => {
27             summary => 'Input NIK to be validated',
28             schema => 'str*',
29             pos => 0,
30             req => 1,
31             },
32             check_province => {
33             summary => 'Whether to check for known province codes',
34             schema => [bool => default => 1],
35             },
36             check_locality => {
37             summary => 'Whether to check for known locality (city) codes',
38             schema => [bool => default => 1],
39             },
40             },
41             examples => [
42             {args=>{nik=>"32 7300 010101 0001"}},
43             {args=>{nik=>"32 7300 710101 0001"}},
44             ],
45             };
46             sub parse_nik {
47 3     3 1 10912 my %args = @_;
48              
49 3         6 state $provinces;
50 3 100       9 if (!$provinces) {
51 1         7 my $res = list_idn_provinces(detail => 1);
52 1 50       4373 return [500, "Can't get list of provinces: $res->[0] - $res->[1]"]
53             if $res->[0] != 200;
54 1         3 $provinces = { map {$_->{bps_code} => $_} @{$res->[2]} };
  33         85  
  1         4  
55             }
56              
57 3 50       14 my $nik = $args{nik} or return [400, "Please specify nik"];
58 3         17 my $res = {};
59              
60 3         24 $nik =~ s/\D+//g;
61 3 50       13 return [400, "Not 16 digit"] unless length($nik) == 16;
62              
63 3         12 $res->{prov_code} = substr($nik, 0, 2);
64 3 50 50     19 if ($args{check_province} // 1) {
65 3         6 my $p = $provinces->{ $res->{prov_code} };
66 3 50       9 $p or return [400, "Unknown province code"];
67 3         7 $res->{prov_eng_name} = $p->{eng_name};
68 3         5 $res->{prov_ind_name} = $p->{ind_name};
69             }
70              
71 3         8 $res->{loc_code} = substr($nik, 0, 4);
72 3 50 50     13 if ($args{check_locality} // 1) {
73             my $lres = list_idn_localities(
74 3         11 detail => 1, bps_code => $res->{loc_code});
75 3 50       44367 return [500, "Can't check locality: $lres->[0] - $lres->[1]"]
76             unless $lres->[0] == 200;
77 3         5 my $l = $lres->[2][0];
78 3 50       8 $l or return [400, "Unknown locality code"];
79             #$res->{loc_eng_name} = $p->{eng_name};
80 3         9 $res->{loc_ind_name} = $l->{ind_name};
81 3         11 $res->{loc_type} = $l->{type};
82             }
83              
84 3         21 my ($d, $m, $y) = $nik =~ /^\d{6}(..)(..)(..)/;
85 3 100       11 if ($d > 40) {
86 1         4 $res->{gender} = 'F';
87 1         2 $d -= 40;
88             } else {
89 2         5 $res->{gender} = 'M';
90             }
91 3         24 my $today = DateTime->today;
92 3         2061 $y += int($today->year / 100) * 100;
93 3 100       34 $y -= 100 if $y > $today->year;
94 3         19 eval { $res->{dob} = DateTime->new(day=>$d, month=>$m, year=>$y)->ymd };
  3         11  
95 3 100       1862 if ($@) {
96 1         2770 return [400, "Invalid date of birth: $d-$m-$y"];
97             }
98              
99 2         10 $res->{serial} = substr($nik, 12);
100 2 50       9 return [400, "Serial starts from 1, not 0"] if $res->{serial} < 1;
101              
102 2         14 [200, "OK", $res];
103             }
104              
105             1;
106             # ABSTRACT: Parse Indonesian citizenship registration number (NIK)
107              
108             __END__
109              
110             =pod
111              
112             =encoding UTF-8
113              
114             =head1 NAME
115              
116             Business::ID::NIK - Parse Indonesian citizenship registration number (NIK)
117              
118             =head1 VERSION
119              
120             This document describes version 0.094 of Business::ID::NIK (from Perl distribution Business-ID-NIK), released on 2021-08-31.
121              
122             =head1 SYNOPSIS
123              
124             use Business::ID::NIK qw(parse_nik);
125              
126             my $res = parse_nik(nik => "3273010119800002");
127              
128             =head1 DESCRIPTION
129              
130             This module can be used to validate Indonesian citizenship registration number,
131             Nomor Induk Kependudukan (NIK), or more popularly known as Nomor Kartu Tanda
132             Penduduk (Nomor KTP), because NIK is displayed on the KTP (citizen identity
133             card).
134              
135             NIK is composed of 16 digits as follow:
136              
137             pp.DDSS.ddmmyy.ssss
138              
139             pp.DDSS is a 6-digit area code where the NIK was registered (it used to be but
140             nowadays not always [citation needed] composed as: pp 2-digit province code, DD
141             2-digit city/district [kota/kabupaten] code, SS 2-digit subdistrict [kecamatan]
142             code), ddmmyy is date of birth of the citizen (dd will be added by 40 for
143             female), ssss is 4-digit serial starting from 1.
144              
145             =head1 FUNCTIONS
146              
147              
148             =head2 parse_nik
149              
150             Usage:
151              
152             parse_nik(%args) -> [$status_code, $reason, $payload, \%result_meta]
153              
154             Parse Indonesian citizenship registration number (NIK).
155              
156             Examples:
157              
158             =over
159              
160             =item * Example #1:
161              
162             parse_nik(nik => "32 7300 010101 0001");
163              
164             Result:
165              
166             [
167             200,
168             "OK",
169             {
170             dob => "2001-01-01",
171             gender => "M",
172             loc_code => 3273,
173             loc_ind_name => "BANDUNG",
174             loc_type => 1,
175             prov_code => 32,
176             prov_eng_name => "West Java",
177             prov_ind_name => "Jawa Barat",
178             serial => "0001",
179             },
180             {},
181             ]
182              
183             =item * Example #2:
184              
185             parse_nik(nik => "32 7300 710101 0001");
186              
187             Result:
188              
189             [
190             200,
191             "OK",
192             {
193             dob => "2001-01-31",
194             gender => "F",
195             loc_code => 3273,
196             loc_ind_name => "BANDUNG",
197             loc_type => 1,
198             prov_code => 32,
199             prov_eng_name => "West Java",
200             prov_ind_name => "Jawa Barat",
201             serial => "0001",
202             },
203             {},
204             ]
205              
206             =back
207              
208             This function is not exported by default, but exportable.
209              
210             Arguments ('*' denotes required arguments):
211              
212             =over 4
213              
214             =item * B<check_locality> => I<bool> (default: 1)
215              
216             Whether to check for known locality (city) codes.
217              
218             =item * B<check_province> => I<bool> (default: 1)
219              
220             Whether to check for known province codes.
221              
222             =item * B<nik>* => I<str>
223              
224             Input NIK to be validated.
225              
226              
227             =back
228              
229             Returns an enveloped result (an array).
230              
231             First element ($status_code) is an integer containing HTTP-like status code
232             (200 means OK, 4xx caller error, 5xx function error). Second element
233             ($reason) is a string containing error message, or something like "OK" if status is
234             200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
235             element (%result_meta) is called result metadata and is optional, a hash
236             that contains extra information, much like how HTTP response headers provide additional metadata.
237              
238             Return value: (any)
239              
240             =head1 HOMEPAGE
241              
242             Please visit the project's homepage at L<https://metacpan.org/release/Business-ID-NIK>.
243              
244             =head1 SOURCE
245              
246             Source repository is at L<https://github.com/perlancar/perl-Business-ID-NIK>.
247              
248             =head1 SEE ALSO
249              
250             L<Business::ID::NKK> to parse family card number (nomor kartu keluarga, nomor
251             KK, NKK)
252              
253             =head1 AUTHOR
254              
255             perlancar <perlancar@cpan.org>
256              
257             =head1 CONTRIBUTORS
258              
259             =for stopwords Steven Haryanto (on PC)
260              
261             =over 4
262              
263             =item *
264              
265             Steven Haryanto (on PC) <stevenharyanto@gmail.com>
266              
267             =item *
268              
269             Steven Haryanto <steven@masterweb.net>
270              
271             =back
272              
273             =head1 CONTRIBUTING
274              
275              
276             To contribute, you can send patches by email/via RT, or send pull requests on
277             GitHub.
278              
279             Most of the time, you don't need to build the distribution yourself. You can
280             simply modify the code, then test via:
281              
282             % prove -l
283              
284             If you want to build the distribution (e.g. to try to install it locally on your
285             system), you can install L<Dist::Zilla>,
286             L<Dist::Zilla::PluginBundle::Author::PERLANCAR>, and sometimes one or two other
287             Dist::Zilla plugin and/or Pod::Weaver::Plugin. Any additional steps required
288             beyond that are considered a bug and can be reported to me.
289              
290             =head1 COPYRIGHT AND LICENSE
291              
292             This software is copyright (c) 2021, 2018, 2015, 2014, 2013 by perlancar <perlancar@cpan.org>.
293              
294             This is free software; you can redistribute it and/or modify it under
295             the same terms as the Perl 5 programming language system itself.
296              
297             =head1 BUGS
298              
299             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Business-ID-NIK>
300              
301             When submitting a bug or request, please include a test-file or a
302             patch to an existing test-file that illustrates the bug or desired
303             feature.
304              
305             =cut