Codebase list libbusiness-tax-vat-validation-perl / e053032
Imported Upstream version 1.00 gregor herrmann 12 years ago
5 changed file(s) with 273 addition(s) and 212 deletion(s). Raw diff Collapse all Expand all
+7
-0
Changes less more
00 Revision history for Business::Tax::VAT::Validation
1
2 1.00 25/03/2012
3 - This module now uses the VIES SOAP interface (instead of the HTML one)
4
5 0.24 06/03/2012
6 - Fix traderName field required for EL and ES MS
7 Update POST request fields
18
29 0.23 29/02/2012
310 - Fix regexp in _is_res_ok with multiline regexp (Bart Heupers)
+2
-2
META.yml less more
00 --- #YAML:1.0
11 name: Business-Tax-VAT-Validation
2 version: 0.24
2 version: 1.00
33 abstract: A class for european VAT numbers validation.
44 author:
55 - Bernard Nauwelaerts <bpgn@cpan.org>
1616 directory:
1717 - t
1818 - inc
19 generated_by: ExtUtils::MakeMaker version 6.57_05
19 generated_by: ExtUtils::MakeMaker version 6.55_02
2020 meta-spec:
2121 url: http://module-build.sourceforge.net/META-spec-v1.4.html
2222 version: 1.4
+47
-47
examples/vat.cgi less more
00 #!/usr/bin/perl
1 ############################################################################
2 # IT Development software #
3 # European VAT number validator #
4 # CGI interface Version 1.00 #
5 # Copyright 2003 Nauwelaerts B bpn@it-development.be #
6 # Created 06/08/2003 Last Modified 25/03/2012 #
7 ############################################################################
8 # COPYRIGHT NOTICE #
9 # Copyright 2003 Bernard Nauwelaerts All Rights Reserved. #
10 # #
11 # THIS SOFTWARE IS RELEASED UNDER THE GNU Public Licence #
12 # See COPYING for details #
13 # #
14 # This software is provided as is, WITHOUT ANY WARRANTY, without even the #
15 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. #
16 # #
17 ############################################################################
18 # Revision history : #
19 # #
20 # 1.00 25/03/2012; For use with the SOAP version of the Validation module #
21 # 0.02 18/08/2008; Updated disclaimer URL #
22 # 0.01 06/08/2003; #
23 # #
24 ############################################################################
125
226 use strict;
27 use Business::Tax::VAT::Validation;
328 use CGI qw/:standard/;
4 use ITDev::Common;
5 use Business::Tax::VAT::Validation;
629
7 my $resultsfile='/isp/itdev/www/software/downloads.html';
8 my $title='A simple VAT checkup example';
9
10 my $res='';
11
30 print header,
31 start_html('VAT checkup example'),
32 h1('A simple VAT checkup example');
33 print "Uses the Business::Tax::VAT::Validation PERL module version ".$Business::Tax::VAT::Validation::VERSION;
34 my $hvatn=Business::Tax::VAT::Validation->new();
35
1236 if (param()) {
1337 my $vat=join("-",param('MS'),param('VAT'));
14 $res.= h2("Results").$vat.': ';
15 my $hvatn=Business::Tax::VAT::Validation->new();
38 print h2("Results"), $vat, ': ';
39
1640 if ($hvatn->check($vat)) {
17 $res.= 'Exists in database';
41 print 'This number exists in the VIES database. It belongs to '.$hvatn->informations('name')." ".$hvatn->informations('address');
1842 } else {
19 $res.= $hvatn->get_last_error;
43 print $hvatn->get_last_error_code.' '.$hvatn->get_last_error;
2044 }
2145 }
2246
2347
24 $res.= start_form.h2("Query")."VAT Number".p;
25 $res.= popup_menu(-name=>'MS', -values=>['AT','BE','DE','DK','EL','ES','FI','FR','GB','IE','IT','LU','NL','PT','SE']);
26 $res.= textfield('VAT').submit.end_form;
27 $res.= h2("Disclaimer"). "This interface is provided for demonstration purposes only, WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.".
28 p.
29 'See also this disclaimer: <a href="http://europa.eu.int/comm/taxation_customs/vies/en/viesdisc.htm">http://europa.eu.int/comm/taxation_customs/vies/en/viesdisc.htm</a>';
30
31 &parse_html($resultsfile, $title, $res, '', '');
48 print hr, start_form,
49 "VAT Number", p,
50 popup_menu(-name=>'MS',
51 -values=>[$hvatn->member_states]),
52 textfield('VAT'),p,
53 submit,
54 end_form,
55 hr,
56 h2("Disclaimer"), "This interface is provided for demonstration purposes only, WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.",
57 p,
58 'See also this disclaimer: <a href="http://ec.europa.eu/taxation_customs/vies/viesdisc.do?selectedLanguage=EN">http://ec.europa.eu/taxation_customs/vies/viesdisc.do?selectedLanguage=EN</a>';
59 end_html;
3260
3361 exit;
34
35 sub parse_html {
36 my($file) =$_[0]; # HTML 2B parsed
37 my($title) =$_[1]; # Box output type
38 my($result) =$_[2]; # Box output type
39 my($head) =$_[3]; # Box output type
40 my($jscript)=$_[4]; # Box output type
41 $title='Title' if !$title;
42 $result='No Result' if !$result;
43 $head='' if !$head;
44
45 if ($jscript){
46 $jscript='<script type="text/javascript">'."\n".$jscript.' </script>';
47 } else { $jscript='' }
48 print "Content-Type: text/html\n\n";
49 if (!-e $file) {print "$result"; exit;}
50 open (TEMP, $file) or print "$result $file";
51 my $template = join ('', <TEMP>);
52 close (TEMP);
53 $template =~ s#<!-- TITLE -->#$title#sg if $title;
54 $template =~ s#<!-- HEADER -->#$head#sg if $head;
55 $template =~ s#<!-- RESULTS -->#$result#sg if $result;
56 $template =~ s#<!-- JScript -->#$jscript#s if $jscript;
57 #$template =~ s#<!-- Menu1 -->#$menu1#sg;
58 #$template =~ s#<!--PageMarker-->#$PageMarker#sg;
59 print $template;
60 exit;
61 }⏎
+17
-13
examples/vat_cli.pl less more
11 ############################################################################
22 # IT Development software #
33 # European VAT number validator #
4 # command line interface Version 0.01 #
5 # Copyright 2003 Nauwelaerts B bpn#it-development%be #
6 # Created 06/08/2003 Last Modified 06/08/2003 #
4 # command line interface Version 1.00 #
5 # Copyright 2003 Nauwelaerts B bpn@it-development.be #
6 # Created 06/08/2003 Last Modified 25/03/2012 #
77 ############################################################################
88 # COPYRIGHT NOTICE #
99 # Copyright 2003 Bernard Nauwelaerts All Rights Reserved. #
1717 ############################################################################
1818 # Revision history : #
1919 # #
20 # 1.00 25/03/2012; For use with the SOAP version of the Validation module #
2021 # 0.01 06/08/2003; #
2122 # #
2223 ############################################################################
23 use Business::Tax::VAT::Validation;
24
25 my $hvatn=Business::Tax::VAT::Validation->new();
26
27 # Check number
28 if (my $n=$hvatn->check($ARGV[0])) {
29 print $n.": OK\n";
30 } else {
31 print $ARGV[0].': '.$hvatn->get_last_error."\n";
32 }⏎
24 my $vatNumber=$ARGV[0];
25
26 use Business::Tax::VAT::Validation;
27 my $val=Business::Tax::VAT::Validation->new();
28
29 if ($val->check($vatNumber)) {
30 print "VAT Number exists ! ";
31 print "It belongs to ".$val->informations('name')." ".$val->informations('address')."\n";
32 } else {
33 my $msg="Error ".$val->get_last_error_code." : ".$val->get_last_error;
34 $msg=~s/[\r\n]/ /g;
35 print $msg."\n"
36 }
+200
-150
lib/Business/Tax/VAT/Validation.pm less more
0 package Business::Tax::VAT::Validation;
0 package Business::Tax::VAT::Validation;
11 ############################################################################
22 # IT Development software #
3 # European VAT number validator Version 0.24 #
3 # European VAT number validator Version 1.00 #
44 # Copyright 2003 Nauwelaerts B bpgn@cpan.org #
5 # Created 06/08/2003 Last Modified 06/03/2012 #
5 # Created 06/08/2003 Last Modified 25/03/2012 #
66 ############################################################################
77 # COPYRIGHT NOTICE #
88 # Copyright 2003 Bernard Nauwelaerts All Rights Reserved. #
1111 # Please see COPYING for details #
1212 # #
1313 # DISCLAIMER #
14 # As usual with GNU software, this one is provided as is, #
14 # As usual with GNU software, this one is provided as is, #
1515 # WITHOUT ANY WARRANTY, without even the implied warranty of #
1616 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. #
1717 # #
1818 ############################################################################
1919 # Revision history (dd/mm/yyyy) : #
2020 # #
21 # 1.00 25/03/2012; This module now uses the VIES SOAP interface. #
2122 # 0.24 06/03/2012; Fix traderName field required for EL and ES MS #
2223 # Update POST request fields #
2324 # 0.23 29/02/2012; Fix regexp in _is_res_ok with multiline regexp #
24 # (Thanks to Bart Heupers) #
25 # (Thanks to Bart Heupers) #
2526 # 0.22 04/10/2011; Typo fix in POD error message #2 #
2627 # (Thanks to Martin H. Sluka) #
2728 # Minor POD fixes (BPGN) #
4748 # Updated regexps according to the actual VIES FAQ #
4849 # Some slight documentation improvements #
4950 # Improved tests: each regexp is tested accordind to FAQ #
50 # 0.13 16/01/2007; VIES interface changed "not found" layout #
51 # (Thanks to Tom Kirkpatrick for this update) #
52 # 0.12 10/11/2006; YAML Compliance #
53 # 0.11 10/11/2006; Minor bug allowing one forbidden character #
54 # corrected in Belgian regexp #
55 # (Thanks to Andy Wardley for this report) #
56 # + added regular_expressions property #
57 # for external testing purposes #
51 # 0.13 16/01/2007; VIES interface changed "not found" layout #
52 # (Thanks to Tom Kirkpatrick for this update) #
53 # 0.12 10/11/2006; YAML Compliance #
54 # 0.11 10/11/2006; Minor bug allowing one forbidden character #
55 # corrected in Belgian regexp #
56 # (Thanks to Andy Wardley for this report) #
57 # + added regular_expressions property #
58 # for external testing purposes #
5859 # 0.10 20/07/2006; Adding Test::Pod to test suite #
5960 # 0.09 20/06/2006; local_check method allows you to test VAT numbers #
6061 # without asking the EU database. Based on regexps. #
6263 # From 31/12/2007, only 10 digits will be valid #
6364 # 0.07 25/05/2006; Now we use "request" method not "simple request" #
6465 # in order to follow potential redirects #
65 # 0.06 25/05/2006; Changed $baseurl #
66 # (Thanks to Torsten Mueller for this update) #
67 # 0.05 19/01/2006; Adding support for proxy settings #
68 # (Thanks to Tom Kirkpatrick for this update) #
66 # 0.06 25/05/2006; Changed $baseurl #
67 # (Thanks to Torsten Mueller for this update) #
68 # 0.05 19/01/2006; Adding support for proxy settings #
69 # (Thanks to Tom Kirkpatrick for this update) #
6970 # 0.04 01/11/2004; Adding support for error "Member Service Unavailable" #
7071 # 0.03 01/11/2004; Adding 10 new members. #
7172 # (Thanks to Robert Alloway for this update) #
7778 use strict;
7879
7980 BEGIN {
80 $Business::Tax::VAT::Validation::VERSION = '0.24';
81 $Business::Tax::VAT::Validation::VERSION = '1.00';
8182 use HTTP::Request::Common qw(POST);
8283 use LWP::UserAgent;
8384 }
85
8486 =head1 NAME
8587
8688 Business::Tax::VAT::Validation - A class for european VAT numbers validation.
102104
103105 This class provides an easy api to check european VAT numbers' syntax, and if they has been registered by the competent authorities.
104106
105 It asks the EU database (VIES) for this, using its web interface methods.
107 It asks the EU database (VIES) for this, using its SOAP interface methods.
106108
107109
108110 =head1 CONSTRUCTOR
113115
114116 $hvatn=Business::Tax::VAT::Validation->new();
115117
118
116119 If your system is located behind a proxy :
117120
118121 $hvatn=Business::Tax::VAT::Validation->new(-proxy => ['http', 'http://example.com:8001/']);
122125 =cut
123126
124127 sub new {
125 my($class, %arg) = @_;
128 my ( $class, %arg ) = @_;
126129 my $self = {
127 #baseurl => 'http://europa.eu.int/comm/taxation_customs/vies/cgi-bin/viesquer', # Obsolete since v0.06
128 #baseurl => 'http://ec.europa.eu/taxation_customs/vies/cgi-bin/viesquer', # Obsolete since v0.14
129 baseurl => 'http://ec.europa.eu/taxation_customs/vies/viesquer.do',
130 error => '',
131 error_code => 0,
132 re => {
130 baseurl => $arg{baseurl} || 'http://ec.europa.eu/taxation_customs/vies/services/checkVatService',
131 error => '',
132 error_code => 0,
133 re => {
133134 ### t/01_localcheck.t tests if these regexps accepts all regular VAT numbers, according to VIES FAQ
134 AT => 'U[0-9]{8}',
135 BE => '0[0-9]{9}',
136 BG => '[0-9]{9,10}',
137 CY => '[0-9]{8}[A-Za-z]',
138 CZ => '[0-9]{8,10}',
139 DE => '[0-9]{9}',
140 DK => '[0-9]{2} ?[0-9]{2} ?[0-9]{2} ?[0-9]{2}',
141 EE => '[0-9]{9}',
142 EL => '[0-9]{9}',
143 ES => '([A-Za-z0-9][0-9]{7}[A-Za-z0-9])',
144 FI => '[0-9]{8}',
145 FR => '[A-Za-z0-9]{2} ?[0-9]{9}',
146 GB => '([0-9]{3} ?[0-9]{4} ?[0-9]{2}|[0-9]{3} ?[0-9]{4} ?[0-9]{2} ?[0-9]{3}|GD[0-9]{3}|HA[0-9]{3})',
147 HU => '[0-9]{8}',
148 IE => '[0-9][A-Za-z0-9\+\*][0-9]{5}[A-Za-z]',
149 IT => '[0-9]{11}',
150 LT => '([0-9]{9}|[0-9]{12})',
151 LU => '[0-9]{8}',
152 LV => '[0-9]{11}',
153 MT => '[0-9]{8}',
154 NL => '[0-9]{9}B[0-9]{2}',
155 PL => '[0-9]{10}',
156 PT => '[0-9]{9}',
157 RO => '[0-9]{2,10}',
158 SE => '[0-9]{12}',
159 SI => '[0-9]{8}',
160 SK => '[0-9]{10}',
135 AT => 'U[0-9]{8}',
136 BE => '0[0-9]{9}',
137 BG => '[0-9]{9,10}',
138 CY => '[0-9]{8}[A-Za-z]',
139 CZ => '[0-9]{8,10}',
140 DE => '[0-9]{9}',
141 DK => '[0-9]{2} ?[0-9]{2} ?[0-9]{2} ?[0-9]{2}',
142 EE => '[0-9]{9}',
143 EL => '[0-9]{9}',
144 ES => '([A-Za-z0-9][0-9]{7}[A-Za-z0-9])',
145 FI => '[0-9]{8}',
146 FR => '[A-Za-z0-9]{2} ?[0-9]{9}',
147 GB => '([0-9]{3} ?[0-9]{4} ?[0-9]{2}|[0-9]{3} ?[0-9]{4} ?[0-9]{2} ?[0-9]{3}|GD[0-9]{3}|HA[0-9]{3})',
148 HU => '[0-9]{8}',
149 IE => '[0-9][A-Za-z0-9\+\*][0-9]{5}[A-Za-z]',
150 IT => '[0-9]{11}',
151 LT => '([0-9]{9}|[0-9]{12})',
152 LU => '[0-9]{8}',
153 LV => '[0-9]{11}',
154 MT => '[0-9]{8}',
155 NL => '[0-9]{9}B[0-9]{2}',
156 PL => '[0-9]{10}',
157 PT => '[0-9]{9}',
158 RO => '[0-9]{2,10}',
159 SE => '[0-9]{12}',
160 SI => '[0-9]{8}',
161 SK => '[0-9]{10}',
161162 },
162 proxy => $arg{-proxy}
163 proxy => $arg{-proxy},
164 informations => {}
163165 };
164166 $self = bless $self, $class;
165 $self->{members}=join('|', keys %{$self->{re}});
167 $self->{members} = join( '|', keys %{ $self->{re} } );
166168 $self;
167169 }
168170
179181 =cut
180182
181183 sub member_states {
182 (keys %{$_[0]->{re}})
184 ( keys %{ $_[0]->{re} } );
183185 }
184186
185187 =item B<regular_expressions> - Returns a hash list containing one regular expression for each country
191193 returns
192194
193195 (
194 AT => 'U[0-9]{8}',
195 ...
196 SK => '[0-9]{10}',
196 AT => 'U[0-9]{8}',
197 ...
198 SK => '[0-9]{10}',
197199 );
198200
199201 =cut
200202
201203 sub regular_expressions {
202 (%{$_[0]->{re}})
204 ( %{ $_[0]->{re} } );
203205 }
204206
205207 =back
210212
211213 =over 4
212214
213 =item B<check> - Checks if a VAT number exists into the VIES database
214
215 $ok=$hvatn->check($number, [$memberStateCode, $requesterMemberStateCode, $requesterNumber, $traderName, $traderCompanyType, $traderStreet, $traderPostalCode, $traderCity]);
215 =item B<check> - Checks if a VAT number exists in the VIES database
216
217 $ok=$hvatn->check($vatNumber, [$countryCode]);
216218
217219 You may either provide the VAT number under its complete form (e.g. BE-123456789, BE123456789)
218 or either specify VAT and MSC (number and memberStateCode) individually.
220 or specify the VAT and MSC (vatNumber and countryCode) individually.
219221
220222 Valid MS values are :
221223
223225 FI, FR, GB, HU, IE, IT, LU, LT, LV, MT,
224226 NL, PL, PT, RO, SE, SI, SK
225227
226
227 Additional fields are availaible for all members :
228
229 requesterMemberStateCode
230 requesterNumber
231
232 Additional fields are availaible for these members :
233
234 EL (Greece)
235 ES (Spain)
236
237 These fields are :
238
239 traderName
240 traderCompanyType
241 traderStreet
242 traderPostalCode
243 traderCity
244
245228 =cut
246229
247230 sub check {
248 my($self, $number, $memberStateCode, $requesterMemberStateCode, $requesterNumber, $traderName, $traderCompanyType, $traderStreet, $traderPostalCode, $traderCity, @other)=@_; # @other is here for backward compatibility purposes
249 return $self->_set_error('You must provide a VAT number') unless $number;
250 $memberStateCode||='';
251 ($number, $memberStateCode)=$self->_format_vatn($number, $memberStateCode);
252 ($requesterNumber, $requesterMemberStateCode)=$self->_format_vatn($requesterNumber, $requesterMemberStateCode);
253 if ($number) {
231 my ($self, $vatNumber, $countryCode, @other) = @_; # @other is here for backward compatibility purposes
232 return $self->_set_error('You must provide a VAT number') unless $vatNumber;
233 $countryCode ||= '';
234 ( $vatNumber, $countryCode ) = $self->_format_vatn( $vatNumber, $countryCode );
235 if ($vatNumber) {
254236 my $ua = LWP::UserAgent->new;
255 if (ref $self->{proxy} eq 'ARRAY') {
256 $ua->proxy(@{$self->{proxy}});
237 if ( ref $self->{proxy} eq 'ARRAY' ) {
238 $ua->proxy( @{ $self->{proxy} } );
257239 } else {
258240 $ua->env_proxy;
259241 }
260 $ua->agent('Business::Tax::VAT::Validation/'.$Business::Tax::VAT::Validation::VERSION);
261 my $req = POST $self->{baseurl},
262 [
263 'selectedLanguage' => 'EN',
264 'memberStateCode' => $memberStateCode ,
265 'number' => $number ,
266 'traderName' => $traderName || '' ,
267 'traderCompanyType' => $traderCompanyType || '' ,
268 'traderStreet' => $traderStreet || '' ,
269 'traderPostalCode' => $traderPostalCode || '' ,
270 'traderCity' => $traderCity || '' ,
271 'requesterMemberStateCode' => $requesterMemberStateCode || '' ,
272 'requesterNumber' => $requesterNumber || '' ,
273
274
275 ];
276 return $memberStateCode.'-'.$number if $self->_is_res_ok($ua->request($req)->as_string);
242 $ua->agent( 'Business::Tax::VAT::Validation/'. $Business::Tax::VAT::Validation::VERSION );
243
244 my $request = HTTP::Request->new(POST => $self->{baseurl});
245 $request->header(SOAPAction => 'http://www.w3.org/2003/05/soap-envelope');
246 $request->content(_in_soap_envelope($vatNumber, $countryCode));
247 $request->content_type("Content-Type: application/soap+xml; charset=utf-8");
248
249 my $response = $ua->request($request);
250
251 return $countryCode . '-' . $vatNumber if $self->_is_res_ok( $response->code, $response->decoded_content );
277252 }
278253 0;
279254 }
280255
281
282256 =item B<local_check> - Checks if a VAT number format is valid
283257 This method is based on regexps only and DOES NOT ask the VIES database
284258
288262 =cut
289263
290264 sub local_check {
291 my($self,$vatn,$mscc,@other)=@_; # @other is here for backward compatibility purposes
265 my ( $self, $vatn, $mscc, @other ) = @_; # @other is here for backward compatibility purposes
292266 return $self->_set_error('You must provide a VAT number') unless $vatn;
293 $mscc||='';
294 ($vatn, $mscc)=$self->_format_vatn($vatn, $mscc);
267 $mscc ||= '';
268 ( $vatn, $mscc ) = $self->_format_vatn( $vatn, $mscc );
295269 if ($vatn) {
296 return 1
270 return 1;
271 }
272 else {
273 return 0;
274 }
275 }
276
277 =item B<informations> - Returns informations related to the last validated VAT number
278
279 %infos=$hvatn->informations();
280
281
282 =cut
283
284 sub informations {
285 my ( $self, $key, @other ) = @_;
286 if ($key) {
287 return $self->{informations}{$key}
297288 } else {
298 return 0
289 return ($self->{informations})
299290 }
300291 }
301292
311302 =over 4
312303
313304 =item *
305 -1 The provided VAT number is valid.
306
307 =item *
314308 0 Unknown MS code : Internal checkup failed (Specified Member State does not exist)
315309
316310 =item *
332326 19 The EU database is too busy.
333327
334328 =item *
329 20 Connexion to the VIES database failed.
330
331 =item *
332 21 The VIES interface failed to parse a stream. This error occurs unpredictabely, so you should retry your validation request.
333
334 =item *
335335 257 Invalid response, please contact the author of this module. : This normally only happens if this software doesn't recognize any valid pattern into the response document: this generally means that the database interface has been modified, and you'll make the author happy by submitting the returned response !!!
336
337 =item *
338 500 The VIES server encountered an internal server error.
339 Error 500 : soap:Server TIMEOUT
340 Error 500 : soap:Server MS_UNAVAILABLE
336341
337342 =back
338343
351356
352357 ### PRIVATE FUNCTIONS ==========================================================
353358 sub _format_vatn {
354 my($self,$vatn,$mscc)=@_;
355 my $null='';
356 $vatn=~s/\-/ /g; $vatn=~s/\./ /g; $vatn=~s/\s+/ /g;
357 if (!$mscc && $vatn=~s/^($self->{members}) ?/$null/e) {
358 $mscc=$1;
359 my ( $self, $vatn, $mscc ) = @_;
360 my $null = '';
361 $vatn =~ s/\-/ /g;
362 $vatn =~ s/\./ /g;
363 $vatn =~ s/\s+/ /g;
364 if ( !$mscc && $vatn =~ s/^($self->{members}) ?/$null/e ) {
365 $mscc = $1;
359366 }
360 return $self->_set_error(0, "Unknown MS code") if $mscc!~m/^($self->{members})$/;
361 my $re=$self->{re}{$mscc};
362 return $self->_set_error(1, "Invalid VAT number format") if $vatn!~m/^$re$/;
363 ($vatn, $mscc);
367 return $self->_set_error( 0, "Unknown MS code" )
368 if $mscc !~ m/^($self->{members})$/;
369 my $re = $self->{re}{$mscc};
370 return $self->_set_error( 1, "Invalid VAT number format" )
371 if $vatn !~ m/^$re$/;
372 ( $vatn, $mscc );
373 }
374
375 sub _in_soap_envelope {
376 my ($vatNumber, $countryCode)=@_;
377 '<?xml version="1.0" encoding="UTF-8"?>
378 <SOAP-ENV:Envelope
379 SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
380 xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/"
381 xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
382 xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/"
383 xmlns:xsd="http://www.w3.org/1999/XMLSchema">
384 <SOAP-ENV:Body>
385 <checkVat xmlns="urn:ec.europa.eu:taxud:vies:services:checkVat:types">
386 <countryCode>'.$countryCode.'</countryCode>
387 <vatNumber>'.$vatNumber.'</vatNumber>
388 </checkVat>
389 </SOAP-ENV:Body>
390 </SOAP-ENV:Envelope>'
364391 }
365392
366393 sub _is_res_ok {
367 my($self,$res)=@_;
368 if ($res=~/^(\d{3}) (.*)/) {
369 return $self->_set_error($1, $2)
394 my ( $self, $code, $res ) = @_;
395 $self->{informations}={};
396 $res=~s/[\r\n]/ /g;
397 if ($code == 200) {
398 if ($res=~m/<valid> *(.*?) *<\/valid>/) {
399 my $v = $1;
400 if ($v eq 'true' || $v eq '1') {
401 if ($res=~m/<name> *(.*?) *<\/name>/) {
402 $self->{informations}{name} = $1
403 }
404 if ($res=~m/<address> *(.*?) *<\/address>/) {
405 $self->{informations}{address} = $1
406 }
407 $self->_set_error( -1, 'Valid VAT Number');
408 return 1;
409 } else {
410 return $self->_set_error( 2, 'Invalid VAT Number ('.$v.')');
411 }
412 } else {
413 return $self->_set_error( 257, "Invalid response, please contact the author of this module. " . $res );
414 }
415 } else {
416 if ($res=~m/<faultcode> *(.*?) *<\/faultcode> *<faultstring> *(.*?) *<\/faultstring>/) {
417 my $faultcode = $1;
418 my $faultstring = $2;
419 if ($faultcode eq 'soap:Server' && $faultstring eq 'TIMEOUT') {
420 return $self->_set_error(17, "The VIES server timed out. Please re-submit your request later.")
421 } elsif ($faultcode eq 'soap:Server' && $faultstring eq 'MS_UNAVAILABLE') {
422 return $self->_set_error(18, "Member State service unavailable. Please re-submit your request later.")
423 } elsif ($faultstring=~m/^Couldn't parse stream/) {
424 return $self->_set_error( 21, "The VIES database failed to parse a stream. Please re-submit your request later." );
425 } else {
426 return $self->_set_error( $code, $1.' '.$2 )
427 }
428 } elsif ($res=~m/^Can't connect to/) {
429 return $self->_set_error( 20, "Connexion to the VIES database failed. " . $res );
430 } else {
431 return $self->_set_error( 257, "Invalid response [".$code."], please contact the author of this module. " . $res );
432 }
370433 }
371 if ($res =~ /\>\s*No\, invalid VAT number/m) {
372 return $self->_set_error(2, "This VAT number doesn't exists in EU database.")
373 } elsif ($res =~ /\>\s*Error\: (.*)$/im) {
374 return $self->_set_error(3, "This VAT number contains errors: ".$1)
375 } elsif ($res =~ /Request time-out\. Please re-submit your request later/m){
376 return $self->_set_error(17, "Time out connecting to the database")
377 } elsif ($res =~ /\>\s*Member State service unavailable/m) {
378 return $self->_set_error(18, "Member State service unavailable: Please re-submit your request later.")
379 } elsif ($res =~ /\>\s*(System busy: Too many requests)\. (Please re-submit your request later\.)/m) {
380 return $self->_set_error(19, "$1: $2")
381 }
382 return 1 if $res =~ />\s*Yes\, valid VAT number</m;
383 $self->_set_error(257, "Invalid response, please contact the author of this module. ".$res)
384434 }
385435
386436 sub _set_error {
387 my ($self, $code, $txt)=@_;
388 $self->{error_code}=$code;
389 $self->{error}=$txt;
390 undef
391 }
437 my ( $self, $code, $txt ) = @_;
438 $self->{error_code} = $code;
439 $self->{error} = $txt;
440 undef;
441 }
442
392443 =back
393444
394 =head1 WHY NOT SOAP ?
395
396 Just because this module's author wasn't given such time to do so. Furthermore, the SOAP module available at CPAN at time of writing is farly too complex to be used here, simple tasks having to be simply performed. However, if you already use SOAP in your application, it may be better to query the VIES database by this way. See the VIES documentation for further details on how to use it.
397
398445 =head1 SEE ALSO
399446
400447 LWP::UserAgent
401448
449 I<http://ec.europa.eu/taxation_customs/vies/faqvies.do> for the FAQs related to the VIES service.
450
402451
403452 =head1 FEEDBACK
404453
405 If you find this module useful, or have any comments, suggestions or improvements, please let me know.
454 If you find this module useful, or have any comments, suggestions or improvements, feel free to let me know.
406455
407456
408457 =head1 AUTHOR
423472 Martin H. Sluka, noris network AG, Germany.
424473
425474 =item *
426 Simon Williams, UK2 Limited, United Kingdom & Benoît Galy, Greenacres, France & Raluca Boboia, Evozon, Romania
475 Simon Williams, UK2 Limited, United Kingdom & Benoît Galy, Greenacres, France & Raluca Boboia, Evozon, Romania
427476
428477 =item *
429478 Dave O., POBox, U.S.A.
458507 without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
459508
460509 =cut
510
461511 1;