File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/AFNIC/Contact.pm
Criterion Covered Total %
statement 12 182 6.5
branch 0 130 0.0
condition 0 39 0.0
subroutine 4 16 25.0
pod 0 12 0.0
total 16 379 4.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, AFNIC (.FR/.RE/.TF/.WF/.PM/.YT) Contact EPP extension commands
2             ##
3             ## Copyright (c) 2008,2009,2012,2013 Patrick Mevzek . All rights reserved.
4             ##
5             ## This file is part of Net::DRI
6             ##
7             ## Net::DRI is free software; you can redistribute it and/or modify
8             ## it under the terms of the GNU General Public License as published by
9             ## the Free Software Foundation; either version 2 of the License, or
10             ## (at your option) any later version.
11             ##
12             ## See the LICENSE file that comes with this distribution for more details.
13             ####################################################################################################
14              
15             package Net::DRI::Protocol::EPP::Extensions::AFNIC::Contact;
16              
17 1     1   1116 use strict;
  1         3  
  1         65  
18 1     1   8 use warnings;
  1         2  
  1         38  
19              
20 1     1   7 use Net::DRI::Util;
  1         1  
  1         29  
21 1     1   8 use Net::DRI::Exception;
  1         3  
  1         2391  
22              
23             =pod
24              
25             =head1 NAME
26              
27             Net::DRI::Protocol::EPP::Extensions::AFNIC::Contact - AFNIC (.FR/.RE/.TF/.WF/.PM/.YT) EPP Contact extensions for Net::DRI
28              
29             =head1 DESCRIPTION
30              
31             Please see the README file for details.
32              
33             =head1 SUPPORT
34              
35             For now, support questions should be sent to:
36              
37             Enetdri@dotandco.comE
38              
39             Please also see the SUPPORT file in the distribution.
40              
41             =head1 SEE ALSO
42              
43             Ehttp://www.dotandco.com/services/software/Net-DRI/E
44              
45             =head1 AUTHOR
46              
47             Patrick Mevzek, Enetdri@dotandco.comE
48              
49             =head1 COPYRIGHT
50              
51             Copyright (c) 2008,2009,2012,2013 Patrick Mevzek .
52             All rights reserved.
53              
54             This program is free software; you can redistribute it and/or modify
55             it under the terms of the GNU General Public License as published by
56             the Free Software Foundation; either version 2 of the License, or
57             (at your option) any later version.
58              
59             See the LICENSE file that comes with this distribution for more details.
60              
61             =cut
62              
63             ####################################################################################################
64              
65             sub register_commands
66             {
67 0     0 0   my ($class,$version)=@_;
68 0           my %tmp=(
69             create => [ \&create, \&create_parse ],
70             update => [ \&update, undef ],
71             info => [ undef, \&info_parse ],
72             );
73              
74 0           return { 'contact' => \%tmp };
75             }
76              
77             ####################################################################################################
78              
79             sub build_command_extension
80             {
81 0     0 0   my ($mes,$epp,$tag)=@_;
82 0           return $mes->command_extension_register($tag,sprintf('xmlns:frnic="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('frnic')));
83             }
84              
85             sub create
86             {
87 0     0 0   my ($epp,$contact)=@_;
88 0           my $mes=$epp->message();
89              
90             ## validate() has been called
91 0           my @n;
92 0           my $qual=$contact->qualification();
93 0 0         if ($contact->legal_form()) # PM
94             {
95 0           my @d;
96 0           push @d,build_q_idtstatus($qual);
97              
98 0 0         Net::DRI::Exception::usererr_insufficient_parameters('legal_form data mandatory') unless ($contact->legal_form());
99 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('legal_form_other data mandatory if legal_form=other') if (($contact->legal_form() eq 'other') && !$contact->legal_form_other());
100              
101 0 0         push @d,['frnic:legalStatus',{'s' => $contact->legal_form()},$contact->legal_form() eq 'other'? $contact->legal_form_other() : ''];
102 0           my @id;
103              
104 0 0 0       if ($contact->legal_id() && $contact->legal_id_type())
105             {
106 0 0         push @d,['frnic:siren',$contact->legal_id()] if $contact->legal_id_type() eq 'siren';
107 0 0         push @id,['frnic:DUNS',$contact->legal_id()] if $contact->legal_id_type() eq 'duns';
108 0 0         push @id,['frnic:local',$contact->legal_id()] if $contact->legal_id_type() eq 'local';
109             }
110 0 0         push @d,['frnic:VAT',$contact->vat()] if $contact->vat();
111 0 0         push @d,['frnic:trademark',$contact->trademark()] if $contact->trademark();
112 0           my $jo=$contact->jo();
113 0 0 0       if (defined($jo) && (ref($jo) eq 'HASH'))
114             {
115 0           my @j;
116 0 0         push @j,['frnic:waldec',$jo->{waldec}] if exists $jo->{waldec};
117 0 0 0       push @j,['frnic:waldec',$contact->legal_id()] if (defined $contact->legal_id() && defined $contact->legal_form_other() && $contact->legal_form_other() eq 'asso'); ## not sure API ok
      0        
118 0           push @j,['frnic:decl',$jo->{date_declaration}];
119 0           push @j,['frnic:publ',{announce=>$jo->{number},page=>$jo->{page}},$jo->{date_publication}];
120 0           push @d,['frnic:asso',@j];
121             }
122 0 0         push @d,@id if @id;
123 0           push @n,['frnic:legalEntityInfos',@d];
124             } else # PP
125             {
126 0           my @d;
127 0           push @d,build_q_idtstatus($qual);
128              
129 0           my $b=$contact->birth();
130 0 0 0       if (Net::DRI::Util::has_key($b,'date') && Net::DRI::Util::has_key($b,'place'))
131             {
132 0 0         push @d,['frnic:birthDate',ref $b->{date} ? $b->{date}->strftime('%Y-%m-%d') : $b->{date}];
133 0 0         if ($b->{place}=~m/^[A-Z]{2}$/i) ## country not France
134             {
135 0           push @d,['frnic:birthCc',$b->{place}];
136             } else
137             {
138 0           my @p=($b->{place}=~m/^\s*(\S.*\S)\s*,\s*(\S.+\S)\s*$/);
139 0           push @d,['frnic:birthCity',$p[1]];
140 0           push @d,['frnic:birthPc',$p[0]];
141 0           push @d,['frnic:birthCc','FR'];
142             }
143             }
144 0 0         if (@d)
145             {
146 0 0 0       push @n,['frnic:list','restrictedPublication'] if (defined $contact->disclose() && $contact->disclose() eq 'N');
147 0           push @n,['frnic:individualInfos',@d];
148             }
149 0           push @n,['frnic:firstName',$contact->firstname()];
150             }
151              
152 0           push @n,build_q_reachable($qual);
153              
154 0           my $eid=build_command_extension($mes,$epp,'frnic:ext');
155 0           $mes->command_extension($eid,['frnic:create',['frnic:contact',@n]]);
156 0           return;
157             }
158              
159             sub create_parse
160             {
161 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
162 0           my $mes=$po->message();
163 0 0         return unless $mes->is_success();
164              
165 0           my $credata=$mes->get_extension('frnic','ext');
166 0 0         return unless defined $credata;
167              
168 0           my $ns=$mes->ns('frnic');
169 0           $credata=Net::DRI::Util::xml_traverse($credata,$ns,'resData','creData');
170 0 0         return unless defined $credata;
171              
172 0           $oname=$rinfo->{contact}->{$oname}->{id}; ## take into account true ID (the one returned by the registry)
173 0           foreach my $el (Net::DRI::Util::xml_list_children($credata))
174             {
175 0           my ($name,$c)=@$el;
176 0 0         if ($name eq 'nhStatus')
    0          
177             {
178 0           $rinfo->{contact}->{$oname}->{new_handle}=Net::DRI::Util::xml_parse_boolean($c->getAttribute('new'));
179             } elsif ($name eq 'idStatus')
180             {
181 0           $rinfo->{contact}->{$oname}->{qualification}={ identification => parse_q_idtstatus($po,$c) };
182             }
183             }
184 0           return;
185             }
186              
187             sub build_q_idtstatus
188             {
189 0     0 0   my ($qual)=@_;
190 0           my @d;
191 0 0 0       if (Net::DRI::Util::has_key($qual,'identification') && Net::DRI::Util::has_key($qual->{identification},'status'))
192             {
193 0           push @d,['frnic:idStatus',$qual->{identification}->{status}];
194             }
195 0           return @d;
196             }
197              
198             sub build_q_reachable
199             {
200 0     0 0   my ($qual)=@_;
201 0           my @n;
202 0 0 0       if (Net::DRI::Util::has_key($qual,'reachable') && Net::DRI::Util::has_key($qual->{reachable},'value') && Net::DRI::Util::has_key($qual->{reachable},'media'))
      0        
203             {
204 0 0         push @n,['frnic:reachable',{media=>$qual->{reachable}->{media}},$qual->{reachable}->{value} ? 1 : 0];
205             }
206 0           return @n;
207             }
208              
209             sub update
210             {
211 0     0 0   my ($epp,$domain,$todo)=@_;
212 0           my $mes=$epp->message();
213              
214 0           my $dadd=$todo->add('disclose');
215 0           my $ddel=$todo->del('disclose');
216 0           my $qadd=$todo->add('qualification');
217 0           my $qdel=$todo->del('qualification');
218 0 0 0       return unless ($dadd || $ddel || $qadd || $qdel);
      0        
      0        
219              
220 0           my (@add,@del);
221 0 0         push @add,['frnic:list',$dadd] if $dadd;
222 0 0         push @del,['frnic:list',$ddel] if $ddel;
223              
224 0 0         if ($qadd)
225             {
226 0           push @add,build_q_idtstatus($qadd);
227 0           push @add,build_q_reachable($qadd);
228             }
229 0 0         if ($qdel)
230             {
231 0           push @del,build_q_idtstatus($qdel);
232 0           push @del,build_q_reachable($qdel);
233             }
234              
235 0           my @n;
236 0 0         push @n,['frnic:add',@add] if @add;
237 0 0         push @n,['frnic:rem',@del] if @del;
238              
239 0           my $eid=build_command_extension($mes,$epp,'frnic:ext');
240 0           $mes->command_extension($eid,['frnic:update',['frnic:contact',@n]]);
241 0           return;
242             }
243              
244             sub parse_q_idtstatus
245             {
246 0     0 0   my ($po,$c)=@_;
247 0           my %i;
248 0 0         $i{when}=$po->parse_iso8601($c->getAttribute('when')) if $c->hasAttribute('when');
249 0 0         $i{source}=$c->getAttribute('source') if $c->hasAttribute('source');
250 0           $i{value}=$c->textContent();
251 0           return \%i;
252             }
253              
254             sub parse_q_reachable
255             {
256 0     0 0   my ($po,$c)=@_;
257 0           my %r;
258 0 0         $r{when}=$po->parse_iso8601($c->getAttribute('when')) if $c->hasAttribute('when');
259 0 0         $r{media}=$c->getAttribute('media') if $c->hasAttribute('media');
260 0 0         $r{source}=$c->getAttribute('source') if $c->hasAttribute('source');
261 0           $r{value}=Net::DRI::Util::xml_parse_boolean($c->textContent());
262 0           return \%r;
263             }
264              
265             sub info_parse
266             {
267 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
268 0           my $mes=$po->message();
269 0 0         return unless $mes->is_success();
270              
271 0           my $infdata=$mes->get_extension('frnic','ext');
272 0 0         return unless defined $infdata;
273              
274 0           my $ns=$mes->ns('frnic');
275 0           $infdata=Net::DRI::Util::xml_traverse($infdata,$ns,'resData','infData','contact');
276 0 0         return unless defined $infdata;
277              
278 0           my $co=$rinfo->{contact}->{$oname}->{self};
279 0           my %q;
280 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
281             {
282 0           my ($name,$c)=@$el;
283 0 0         if ($name eq 'firstName')
    0          
    0          
    0          
    0          
    0          
284             {
285 0           $co->firstname($c->textContent());
286             } elsif ($name eq 'list')
287             {
288 0 0         $co->disclose($c->textContent() eq 'restrictedPublication'? 'N' : 'Y');
289             } elsif ($name eq 'individualInfos')
290             {
291 0           parse_individualinfos($po,$otype,$oaction,$oname,$rinfo,$c,$co,$mes,\%q);
292             } elsif ($name eq 'legalEntityInfos')
293             {
294 0           parse_legalentityinfos($po,$otype,$oaction,$oname,$rinfo,$c,$co,$mes,\%q);
295             } elsif ($name eq 'obsoleted')
296             {
297 0           my %o;
298 0           $o{value}=Net::DRI::Util::xml_parse_boolean($c->textContent());
299 0 0         $o{when}=$po->parse_iso8601($c->getAttribute('when')) if $c->hasAttribute('when');
300 0           $co->obsoleted(\%o);
301             } elsif ($name eq 'reachable')
302             {
303 0           $q{reachable}=parse_q_reachable($po,$c);
304             }
305             }
306 0 0         $co->qualification(\%q) if %q;
307              
308 0           return;
309             }
310              
311             sub parse_individualinfos
312             {
313 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo,$c,$co,$mes,$rq)=@_;
314              
315 0           my %birth;
316 0           foreach my $sel (Net::DRI::Util::xml_list_children($c))
317             {
318 0           my ($nn,$cc)=@$sel;
319 0 0         if ($nn eq 'idStatus')
    0          
    0          
    0          
    0          
320             {
321 0           $rq->{identification}=parse_q_idtstatus($po,$c);
322             } elsif ($nn eq 'birthDate')
323             {
324 0           $birth{date}=$cc->textContent();
325             } elsif ($nn eq 'birthCity')
326             {
327 0           $birth{place}=$cc->textContent();
328             } elsif ($nn eq 'birthPc')
329             {
330 0           $birth{place}=sprintf('%s, %s',$cc->textContent(),$birth{place});
331             } elsif ($nn eq 'birthCc')
332             {
333 0           my $v=$cc->textContent();
334 0 0         $birth{place}=$v unless ($v eq 'FR');
335             }
336             }
337 0           $co->birth(\%birth);
338              
339 0           return;
340             }
341              
342             sub parse_legalentityinfos
343             {
344 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo,$c,$co,$mes,$rq)=@_;
345              
346 0           foreach my $sel (Net::DRI::Util::xml_list_children($c))
347             {
348 0           my ($nn,$cc)=@$sel;
349 0 0         if ($nn eq 'idStatus')
    0          
    0          
    0          
    0          
350             {
351 0           $rq->{identification}=parse_q_idtstatus($po,$cc);
352             } elsif ($nn eq 'legalStatus')
353             {
354 0           $co->legal_form($cc->getAttribute('s'));
355 0           my $v=$cc->textContent();
356 0 0         $co->legal_form_other($v) if $v;
357             } elsif ($nn=~m/^(?:siren|DUNS|local)$/)
358             {
359 0           $co->legal_id($cc->textContent());
360 0           $co->legal_id_type(lc $nn);
361             } elsif ($nn eq 'trademark')
362             {
363 0           $co->trademark($cc->textContent());
364             } elsif ($nn eq 'asso')
365             {
366 0           my %jo;
367 0           my $ccc=$cc->getChildrenByTagNameNS($mes->ns('frnic'),'decl');
368 0 0         $jo{date_declaration}=$ccc->get_node(1)->textContent() if $ccc->size();
369 0           $ccc=$cc->getChildrenByTagNameNS($mes->ns('frnic'),'publ');
370 0 0         if ($ccc->size())
371             {
372 0           my $p=$ccc->get_node(1);
373 0           $jo{number}=$p->getAttribute('announce');
374 0           $jo{page}=$p->getAttribute('page');
375 0           $jo{date_publication}=$p->textContent();
376             }
377 0           $co->jo(\%jo);
378             }
379             }
380              
381 0           return;
382             }
383              
384             ####################################################################################################
385             1;