File Coverage

blib/lib/Business/ES/NIF.pm
Criterion Covered Total %
statement 6 33 18.1
branch 0 10 0.0
condition 0 7 0.0
subroutine 2 6 33.3
pod 4 4 100.0
total 12 60 20.0


line stmt bran cond sub pod time code
1             package Business::ES::NIF;
2              
3             =head1 NAME
4            
5             Business::ES::NIF - Check is valid Spanish NIF
6              
7             =cut
8              
9             our $VERSION = '0.07';
10              
11 1     1   16479 use strict;
  1         3  
  1         36  
12 1     1   4 use warnings FATAL => 'all';
  1         1  
  1         1167  
13              
14             =head1 SYNOPSIS
15              
16             use Business::ES::NIF;
17              
18             my $NIF = Business::ES::NIF->new( nif => '01234567L' , vies => 0);
19              
20             $NIF->set('B01234567');
21             $NIF->set('B01234567',1); <= Check with Business::Tax::VAT::Validation
22              
23             Dump:
24              
25             $VAR1 = bless( {
26             'status' => 1,
27             'nif' => '01234567L',
28             'vies' => 0,
29             'extra' => 'NIF',
30             'type' => 'NIF',
31             }, 'NIF' );
32              
33             $VAR1 = bless( {
34             'status' => 0,
35             'nif' => 'B01234567',
36             'vies' => 1,
37             'vies_check' => 0,
38             'extra' => 'Sociedad Limitada - S.L',
39             'type' => 'CIF',
40             'vies_error' => 'Invalid VAT Number (false)'
41             }, 'NIF' );
42              
43             =head1 DESCRIPTION
44              
45             Validate a Spanish NIF / CIF / NIE
46              
47             Referencias: http://es.wikipedia.org/wiki/Numero_de_identificacion_fiscal
48              
49             Se puede activar la comprobacion sobre el VIES ( Business::Tax::VAT::Validation )
50              
51             =head1 EXPORT
52              
53             =head1 SUBROUTINES/METHODS
54              
55             =cut
56              
57             my $Types = {
58             NIF => {
59             re => '^[0-9]{8}[A-Za-z]',
60             val => sub {
61             my $dni = shift;
62             my $ret = shift || 0;
63              
64             $dni =~ /^([0-9]{8})([A-Za-z])$/x;
65             my ($NIF,$DC) = ($1,$2);
66             my $L = substr( 'TRWAGMYFPDXBNJZSQVHLCKE', $NIF % 23, 1);
67              
68             return $NIF.$L if $ret;
69              
70             return 1 if $L eq $DC;
71             return 0;
72             },
73             extra => sub { return 'NIF'; }
74             },
75             CIFe => {
76             re => '^[SQPK][0-9]{7}[A-J]$',
77             val => sub {
78             my $cif = shift;
79              
80             $cif =~ /^([SQPK])([0-9]{7})([A-J])$/x;
81             my ($sociedad, $inscripcion, $control) = ($1,$2,$3);
82              
83             my @n = split //, $inscripcion;
84             my $pares = $n[1] + $n[3] + $n[5];
85             my $nones;
86             for (0, 2, 4, 6) {
87             my $d = $n[$_] * 2;
88             $nones += $d < 10 ? $d : $d - 9;
89             }
90             my $c = (10 - substr($pares + $nones, -1)) % 10;
91             my $l = substr('JABCDEFGHI', $c, 1);
92              
93             for ($sociedad) {
94             if (/[KPQS]/i) {
95             return 0 if $l ne uc($control);
96             }else {
97             return 0 if $c != $control and $l ne uc($control);
98             }
99             }
100              
101             return 1;
102             },
103             extra => sub {
104             my $cif = shift;
105              
106             my $Tipos = {
107             'S' => 'Organos de administracion del estado',
108             'Q' => 'Organismos autónomos, estatales o no, y asimilados, y congregaciones e instituciones religiosas',
109             'P' => 'Corporaciones locales.',
110             'K' => 'Formato antiguo orden EHA/451/2008',
111             };
112              
113             $cif =~ /^([SQPK])[0-9]{7}[A-J]$/x;
114              
115             return $Tipos->{$1};
116             }
117             },
118             CIF => {
119             re => '^[ABCDEFGHJPQRUVNW][0-9]{8}$',
120             val => sub {
121             my $cif = shift;
122              
123             $cif =~ /^([ABCDEFGHJPQRUVNW])([0-9]{7})([0-9])$/x;
124             my ($sociedad, $inscripcion, $control) = ($1,$2,$3);
125              
126             my @n = split //, $inscripcion;
127             my $pares = $n[1] + $n[3] + $n[5];
128             my $nones;
129             for (0, 2, 4, 6) {
130             my $d = $n[$_] * 2;
131             $nones += $d < 10 ? $d : $d - 9;
132             }
133             my $c = (10 - substr($pares + $nones, -1)) % 10;
134             my $l = substr('JABCDEFGHI', $c, 1);
135              
136             for ($sociedad) {
137             if (/[KPQS]/i) {
138             return 0 if $l ne uc($control);
139             }elsif (/[ABEH]/i) {
140             return 0 if $c != $control;
141             }else {
142             return 0 if $c != $control and $l ne uc($control);
143             }
144             }
145              
146             return 1;
147             },
148             extra => sub {
149             my $cif = shift;
150              
151             my $Tipos = {
152             'A' => 'Sociedad Anonima - S.A',
153             'B' => 'Sociedad Limitada - S.L',
154             'C' => 'Sociedad Colectiva - S.C',
155             'D' => 'Sociedades comanditarias',
156             'E' => 'Comunidad de bienes y herencias',
157             'F' => 'Sociedades cooperativas',
158             'G' => 'Asociaciones',
159             'H' => 'Comunidaddes de propietarios',
160             'J' => 'Sociedades civiles',
161             'P' => 'Corporaciones locales',
162             'Q' => 'Organismos publicos',
163             'N' => 'Entidades extranjeras',
164             'R' => 'Congregaciones e instituciones religiosas',
165             'U' => 'Uniones temporales de epresas',
166             'V' => 'Otros tipos de sociedades',
167             'W' => 'Establecimientos permanentes de entidades no residentes en España',
168             };
169             $cif =~ /^([ABCDEFGHJPQRUVNW])[0-9]{7}[0-9]$/x;
170              
171             return $Tipos->{$1};
172             }
173             },
174             NIE => {
175             re => '^[XY][0-9]{7}[A-Z]$',
176             val => sub {
177             my $dni = shift;
178             $dni =~ /^([XY])([0-9]{7})([A-Z])$/x;
179              
180             my ($NIE,$NIF,$DC) = ($1,$2,$3);
181              
182             for ($NIE) {
183             $NIF = '0'.$NIF if /X/;
184             $NIF = '1'.$NIF if /Y/;
185             $NIF = '2'.$NIF if /Z/;
186             }
187              
188             my $L = substr( 'TRWAGMYFPDXBNJZSQVHLCKE', $NIF % 23, 1);
189              
190             return 1 if $L eq $DC;
191             return 0;
192             },
193             extra => sub { return 'NIE'; }
194             }
195             };
196              
197             =head2 new
198             new method
199             =cut
200             sub new {
201 0     0 1   my ($class, %args) = @_;
202              
203 0   0       my $self = {
204             nif => '',
205             vies => $args{vies} || 0,
206             };
207              
208 0           $self = bless $self, $class;
209              
210 0           $self->set($args{nif});
211              
212 0           return $self;
213             }
214              
215             =head2 set
216             Set NIF
217             $vies = 1 || 0
218             =cut
219              
220             sub set {
221 0     0 1   my $self = shift;
222 0           my $nif = shift;
223 0   0       my $vies = shift || 0;
224              
225 0           $self->{vies} = $vies;
226              
227 0           $nif =~ s/[-\.\s]//g;
228 0           $self->{nif} = uc $nif;
229              
230 0 0         delete $self->{nif_check} if $self->{nif_check};
231              
232 0           $self->check();
233             }
234              
235             =head2 check
236              
237             =cut
238             sub check {
239 0     0 1   my $self = shift;
240              
241 0           for (keys %{ $Types }) {
  0            
242 0 0         if ( $self->{nif} =~ /$Types->{$_}->{re}/ ) {
243 0           $self->{type} = $_;
244              
245 0           $self->{status} = $Types->{$_}->{val}->($self->{nif});
246 0           $self->{extra} = $Types->{$_}->{extra}->($self->{nif});
247              
248 0 0 0       $self->{nif_check} = $Types->{NIF}->{val}->($self->{nif},1)
249             if $self->{status} == 0 && $self->{type} eq 'NIF';
250              
251 0 0         $self->vies() if $self->{vies};
252             }
253             }
254              
255             }
256              
257             =head2 vies
258              
259             =cut
260             sub vies {
261 0     0 1   my $self = shift;
262              
263 0           require Business::Tax::VAT::Validation;
264              
265 0           my $vat = Business::Tax::VAT::Validation->new();
266              
267 0           $self->{vies_check} = $vat->check('ES'.$self->{nif});
268 0 0         $self->{vies_error} = $vat->get_last_error unless $self->{vies_check};
269             }
270              
271             =head1 AUTHOR
272              
273             Harun Delgado, C<< >> L
274              
275             =head1 BUGS
276              
277             Please report any bugs or feature requests to C, or through
278             the web interface at L. I will be notified, and then you'll
279             automatically be notified of progress on your bug as I make changes.
280              
281              
282             =head1 SUPPORT
283              
284             You can find documentation for this module with the perldoc command.
285              
286             perldoc Business::ES::NIF
287              
288             You can also look for information at:
289              
290             =over 4
291              
292             =item * RT: CPAN's request tracker (report bugs here)
293              
294             L
295              
296             =item * AnnoCPAN: Annotated CPAN documentation
297              
298             L
299              
300             =item * CPAN Ratings
301              
302             L
303              
304             =item * Search CPAN
305              
306             L
307              
308             =back
309              
310              
311             =head1 ACKNOWLEDGEMENTS
312              
313              
314             =head1 LICENSE AND COPYRIGHT
315              
316             This program is free software; you can redistribute it and/or modify it
317             under the terms of the the Artistic License (2.0). You may obtain a
318             copy of the full license at:
319              
320             L
321              
322             Any use, modification, and distribution of the Standard or Modified
323             Versions is governed by this Artistic License. By using, modifying or
324             distributing the Package, you accept this license. Do not use, modify,
325             or distribute the Package, if you do not accept this license.
326              
327             If your Modified Version has been derived from a Modified Version made
328             by someone other than you, you are nevertheless required to ensure that
329             your Modified Version complies with the requirements of this license.
330              
331             This license does not grant you the right to use any trademark, service
332             mark, tradename, or logo of the Copyright Holder.
333              
334             This license includes the non-exclusive, worldwide, free-of-charge
335             patent license to make, have made, use, offer to sell, sell, import and
336             otherwise transfer the Package with respect to any patent claims
337             licensable by the Copyright Holder that are necessarily infringed by the
338             Package. If you institute patent litigation (including a cross-claim or
339             counterclaim) against any party alleging that the Package constitutes
340             direct or contributory patent infringement, then this Artistic License
341             to you shall terminate on the date that such litigation is filed.
342              
343             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
344             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
345             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
346             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
347             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
348             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
349             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
350             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
351              
352              
353             =cut
354              
355             1;