File Coverage

blib/lib/Net/DRI/Protocol/EPP/Core/Contact.pm
Criterion Covered Total %
statement 18 218 8.2
branch 0 104 0.0
condition 0 21 0.0
subroutine 6 24 25.0
pod 0 18 0.0
total 24 385 6.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, EPP Contact commands (RFC5733)
2             ##
3             ## Copyright (c) 2005-2010,2012-2013,2015 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::Core::Contact;
16              
17 1     1   668 use utf8;
  1         1  
  1         4  
18 1     1   22 use strict;
  1         1  
  1         14  
19 1     1   2 use warnings;
  1         1  
  1         17  
20              
21 1     1   3 use Net::DRI::Util;
  1         0  
  1         14  
22 1     1   3 use Net::DRI::Exception;
  1         1  
  1         16  
23 1     1   3 use Net::DRI::Protocol::EPP::Util;
  1         0  
  1         2069  
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::Protocol::EPP::Core::Contact - EPP Contact commands (RFC5733) for Net::DRI
30              
31             =head1 DESCRIPTION
32              
33             Please see the README file for details.
34              
35             =head1 SUPPORT
36              
37             For now, support questions should be sent to:
38              
39             Enetdri@dotandco.comE
40              
41             Please also see the SUPPORT file in the distribution.
42              
43             =head1 SEE ALSO
44              
45             Ehttp://www.dotandco.com/services/software/Net-DRI/E
46              
47             =head1 AUTHOR
48              
49             Patrick Mevzek, Enetdri@dotandco.comE
50              
51             =head1 COPYRIGHT
52              
53             Copyright (c) 2005-2010,2012-2013,2015 Patrick Mevzek .
54             All rights reserved.
55              
56             This program is free software; you can redistribute it and/or modify
57             it under the terms of the GNU General Public License as published by
58             the Free Software Foundation; either version 2 of the License, or
59             (at your option) any later version.
60              
61             See the LICENSE file that comes with this distribution for more details.
62              
63             =cut
64              
65             ####################################################################################################
66              
67             sub register_commands
68             {
69 0     0 0   my ($class,$version)=@_;
70 0           my %tmp=(
71             check => [ \&check, \&check_parse ],
72             info => [ \&info, \&info_parse ],
73             transfer_query => [ \&transfer_query, \&transfer_parse ],
74             create => [ \&create, \&create_parse ],
75             delete => [ \&delete ],
76             transfer_request => [ \&transfer_request, \&transfer_parse ],
77             transfer_cancel => [ \&transfer_cancel,\&transfer_parse ],
78             transfer_answer => [ \&transfer_answer,\&transfer_parse ],
79             update => [ \&update ],
80             review_complete => [ undef, \&pandata_parse ],
81             );
82              
83 0           $tmp{check_multi}=$tmp{check};
84 0           return { 'contact' => \%tmp };
85             }
86              
87             sub build_command
88             {
89 0     0 0   my ($msg,$command,$contact)=@_;
90 0 0         my @contact=(ref($contact) eq 'ARRAY')? @$contact : ($contact);
91 0 0         my @c=map { Net::DRI::Util::isa_contact($_)? $_->srid() : $_ } @contact;
  0            
92              
93 0 0         Net::DRI::Exception->die(1,'protocol/EPP',2,'Contact id needed') unless @c;
94 0           foreach my $n (@c)
95             {
96 0 0 0       Net::DRI::Exception->die(1,'protocol/EPP',2,'Contact id needed') unless defined($n) && $n;
97 0 0         Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid contact id: '.$n) unless Net::DRI::Util::xml_is_token($n,3,16);
98             }
99              
100 0 0         my $tcommand=(ref($command))? $command->[0] : $command;
101 0           $msg->command([$command,'contact:'.$tcommand,sprintf('xmlns:contact="%s" xsi:schemaLocation="%s %s"',$msg->nsattrs('contact'))]);
102              
103 0           my @d=map { ['contact:id',$_] } @c;
  0            
104              
105 0 0 0       if (($tcommand=~m/^(?:info|transfer)$/) && ref($contact[0]) && Net::DRI::Util::isa_contact($contact[0]))
      0        
106             {
107 0           push @d,build_authinfo($contact[0]);
108             }
109              
110 0           return @d;
111             }
112              
113             ####################################################################################################
114             ########### Query commands
115              
116             sub check
117             {
118 0     0 0   my ($epp,$c)=@_;
119 0           my $mes=$epp->message();
120 0           my @d=build_command($mes,'check',$c);
121 0           $mes->command_body(\@d);
122 0           return;
123             }
124              
125             sub check_parse
126             {
127 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
128 0           my $mes=$po->message();
129 0 0         return unless $mes->is_success();
130              
131 0           my $chkdata=$mes->get_response('contact','chkData');
132 0 0         return unless defined $chkdata;
133 0           foreach my $cd ($chkdata->getChildrenByTagNameNS($mes->ns('contact'),'cd'))
134             {
135 0           my $contact;
136 0           foreach my $el (Net::DRI::Util::xml_list_children($cd))
137             {
138 0           my ($n,$c)=@$el;
139 0 0         if ($n eq 'id')
140             {
141 0           $contact=$c->textContent();
142 0           $rinfo->{contact}->{$contact}->{action}='check';
143 0           $rinfo->{contact}->{$contact}->{exist}=1-Net::DRI::Util::xml_parse_boolean($c->getAttribute('avail'));
144             }
145 0 0         if ($n eq 'reason')
146             {
147 0           $rinfo->{contact}->{$contact}->{exist_reason}=$c->textContent();
148             }
149             }
150             }
151 0           return;
152             }
153              
154             sub info
155             {
156 0     0 0   my ($epp,$c)=@_;
157 0           my $mes=$epp->message();
158 0           my @d=build_command($mes,'info',$c);
159 0           $mes->command_body(\@d);
160 0           return;
161             }
162              
163             sub info_parse
164             {
165 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
166 0           my $mes=$po->message();
167 0 0         return unless $mes->is_success();
168              
169 0           my $infdata=$mes->get_response('contact','infData');
170 0 0         return unless defined $infdata;
171              
172 0           my %cd=map { $_ => [] } qw/name org city sp pc cc/;
  0            
173 0           $cd{street}=[[],[]];
174 0           my $contact=$po->create_local_object('contact');
175 0           my @s;
176              
177 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
178             {
179 0           my ($name,$c)=@$el;
180 0 0         if ($name eq 'id')
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
181             {
182 0           $oname=$c->textContent();
183 0           $rinfo->{contact}->{$oname}->{action}='info';
184 0           $rinfo->{contact}->{$oname}->{exist}=1;
185 0           $rinfo->{contact}->{$oname}->{id}=$oname;
186 0           $contact->srid($oname);
187             } elsif ($name eq 'roid')
188             {
189 0           $contact->roid($c->textContent());
190 0           $rinfo->{contact}->{$oname}->{roid}=$contact->roid();
191             } elsif ($name eq 'status')
192             {
193 0           push @s,Net::DRI::Protocol::EPP::Util::parse_node_status($c);
194             } elsif ($name=~m/^(clID|crID|upID)$/)
195             {
196 0           $rinfo->{contact}->{$oname}->{$1}=$c->textContent();
197             } elsif ($name=~m/^(crDate|upDate|trDate)$/)
198             {
199 0           $rinfo->{contact}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
200             } elsif ($name eq 'email')
201             {
202 0           $contact->email($c->textContent());
203             } elsif ($name eq 'voice')
204             {
205 0           $contact->voice(Net::DRI::Protocol::EPP::Util::parse_tel($c));
206             } elsif ($name eq 'fax')
207             {
208 0           $contact->fax(Net::DRI::Protocol::EPP::Util::parse_tel($c));
209             } elsif ($name eq 'postalInfo')
210             {
211 0           Net::DRI::Protocol::EPP::Util::parse_postalinfo($po,$c,\%cd);
212             } elsif ($name eq 'authInfo') ## we only try to parse the authInfo version defined in the RFC, other cases are to be handled by extensions
213             {
214 0           $contact->auth({pw => Net::DRI::Util::xml_child_content($c,$mes->ns('contact'),'pw')});
215             } elsif ($name eq 'disclose')
216             {
217 0           $contact->disclose(Net::DRI::Protocol::EPP::Util::parse_disclose($c));
218             }
219             }
220              
221 0           $contact->name(@{$cd{name}});
  0            
222 0           $contact->org(@{$cd{org}});
  0            
223 0           $contact->street(@{$cd{street}});
  0            
224 0           $contact->city(@{$cd{city}});
  0            
225 0           $contact->sp(@{$cd{sp}});
  0            
226 0           $contact->pc(@{$cd{pc}});
  0            
227 0           $contact->cc(@{$cd{cc}});
  0            
228              
229 0           $rinfo->{contact}->{$oname}->{status}=$po->create_local_object('status')->add(@s);
230 0           $rinfo->{contact}->{$oname}->{self}=$contact;
231 0           return;
232             }
233              
234             sub transfer_query
235             {
236 0     0 0   my ($epp,$c)=@_;
237 0           my $mes=$epp->message();
238 0           my @d=build_command($mes,['transfer',{'op'=>'query'}],$c);
239 0           $mes->command_body(\@d);
240 0           return;
241             }
242              
243             sub transfer_parse
244             {
245 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
246 0           my $mes=$po->message();
247 0 0         return unless $mes->is_success();
248              
249 0           my $trndata=$mes->get_response('contact','trnData');
250 0 0         return unless defined $trndata;
251              
252 0           foreach my $el (Net::DRI::Util::xml_list_children($trndata))
253             {
254 0           my ($name,$c)=@$el;
255 0 0         if ($name eq 'id')
    0          
    0          
256             {
257 0           $oname=$c->textContent();
258 0           $rinfo->{contact}->{$oname}->{id}=$oname;
259 0           $rinfo->{contact}->{$oname}->{action}='transfer';
260 0           $rinfo->{contact}->{$oname}->{exist}=1;
261             } elsif ($name=~m/^(trStatus|reID|acID)$/)
262             {
263 0           $rinfo->{contact}->{$oname}->{$1}=$c->textContent();
264             } elsif ($name=~m/^(reDate|acDate)$/)
265             {
266 0           $rinfo->{contact}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
267             }
268             }
269 0           return;
270             }
271              
272             ############ Transform commands
273              
274             sub build_authinfo
275             {
276 0     0 0   my $contact=shift;
277 0           my $az=$contact->auth();
278 0 0 0       return () unless ($az && ref($az) && exists($az->{pw}));
      0        
279 0           return ['contact:authInfo',['contact:pw',$az->{pw}]];
280             }
281              
282             sub build_cdata
283             {
284 0     0 0   my ($contact,$v)=@_;
285              
286 0           my @d=Net::DRI::Protocol::EPP::Util::build_postalinfo($contact,$v);
287              
288 0 0         push @d,Net::DRI::Protocol::EPP::Util::build_tel('contact:voice',$contact->voice()) if defined($contact->voice());
289 0 0         push @d,Net::DRI::Protocol::EPP::Util::build_tel('contact:fax',$contact->fax()) if defined($contact->fax());
290 0 0         push @d,['contact:email',$contact->email()] if defined($contact->email());
291 0           push @d,build_authinfo($contact);
292 0           push @d,Net::DRI::Protocol::EPP::Util::build_disclose($contact->disclose());
293              
294 0           return @d;
295             }
296              
297             sub create
298             {
299 0     0 0   my ($epp,$contact)=@_;
300 0           my $mes=$epp->message();
301 0           my @d=build_command($mes,'create',$contact);
302              
303 0 0         Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid contact '.$contact) unless Net::DRI::Util::isa_contact($contact);
304 0           $contact->validate(); ## will trigger an Exception if needed
305 0           push @d,build_cdata($contact,$epp->{contacti18n});
306 0           $mes->command_body(\@d);
307 0           return;
308             }
309              
310             sub create_parse
311             {
312 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
313 0           my $mes=$po->message();
314 0 0         return unless $mes->is_success();
315              
316 0           my $credata=$mes->get_response('contact','creData');
317 0 0         return unless defined $credata;
318              
319 0           foreach my $el (Net::DRI::Util::xml_list_children($credata))
320             {
321 0           my ($name,$c)=@$el;
322 0 0         if ($name eq 'id')
    0          
323             {
324 0           my $new=$c->textContent();
325 0 0 0       $rinfo->{contact}->{$oname}->{id}=$new if (defined $oname && ($oname ne $new)); ## registry may give another id than the one we requested or not take ours into account at all !
326 0           $oname=$new;
327 0           $rinfo->{contact}->{$oname}->{id}=$oname;
328 0           $rinfo->{contact}->{$oname}->{action}='create';
329 0           $rinfo->{contact}->{$oname}->{exist}=1;
330             } elsif ($name=~m/^(crDate)$/)
331             {
332 0           $rinfo->{contact}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
333             }
334             }
335 0           return;
336             }
337              
338             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
339             {
340 0     0 0   my ($epp,$contact)=@_;
341 0           my $mes=$epp->message();
342 0           my @d=build_command($mes,'delete',$contact);
343 0           $mes->command_body(\@d);
344 0           return;
345             }
346              
347             sub transfer_request
348             {
349 0     0 0   my ($epp,$c)=@_;
350 0           my $mes=$epp->message();
351 0           my @d=build_command($mes,['transfer',{'op'=>'request'}],$c);
352 0           $mes->command_body(\@d);
353 0           return;
354             }
355              
356             sub transfer_cancel
357             {
358 0     0 0   my ($epp,$c)=@_;
359 0           my $mes=$epp->message();
360 0           my @d=build_command($mes,['transfer',{'op'=>'cancel'}],$c);
361 0           $mes->command_body(\@d);
362 0           return;
363             }
364              
365             sub transfer_answer
366             {
367 0     0 0   my ($epp,$c,$ep)=@_;
368 0           my $mes=$epp->message();
369 0 0 0       my @d=build_command($mes,['transfer',{'op'=>((Net::DRI::Util::has_key($ep,'approve') && $ep->{approve})? 'approve' : 'reject' )}],$c);
370 0           $mes->command_body(\@d);
371 0           return;
372             }
373              
374             sub update
375             {
376 0     0 0   my ($epp,$contact,$todo)=@_;
377 0           my $mes=$epp->message();
378              
379 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a non empty Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
380              
381 0           my $sadd=$todo->add('status');
382 0           my $sdel=$todo->del('status');
383              
384 0           my @d=build_command($mes,'update',$contact);
385 0 0         push @d,['contact:add',$sadd->build_xml('contact:status')] if Net::DRI::Util::isa_statuslist($sadd);
386 0 0         push @d,['contact:rem',$sdel->build_xml('contact:status')] if Net::DRI::Util::isa_statuslist($sdel);
387              
388 0           my $newc=$todo->set('info');
389 0 0         if (defined $newc)
390             {
391 0 0         Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid contact '.$newc) unless Net::DRI::Util::isa_contact($newc);
392 0           $newc->validate(1); ## will trigger an Exception if needed
393 0           my @c=build_cdata($newc,$epp->{contacti18n});
394 0 0         push @d,['contact:chg',@c] if @c;
395             }
396 0           $mes->command_body(\@d);
397 0           return;
398             }
399              
400             ####################################################################################################
401             ## RFC4933 ยง3.3 Offline Review of Requested Actions
402              
403             sub pandata_parse
404             {
405 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
406 0           my $mes=$po->message();
407 0 0         return unless $mes->is_success();
408              
409 0           my $pandata=$mes->get_response('contact','panData');
410 0 0         return unless defined $pandata;
411              
412 0           foreach my $el (Net::DRI::Util::xml_list_children($pandata))
413             {
414 0           my ($name,$c)=@$el;
415 0 0         if ($name eq 'id')
    0          
    0          
416             {
417 0           $oname=$c->textContent();
418 0           $rinfo->{contact}->{$oname}->{action}='review';
419 0           $rinfo->{contact}->{$oname}->{result}=Net::DRI::Util::xml_parse_boolean($c->getAttribute('paResult'));
420             } elsif ($name eq 'paTRID')
421             {
422 0           my $ns=$mes->ns('_main');
423 0           my $tmp=Net::DRI::Util::xml_child_content($c,$ns,'clTRID');
424 0 0         $rinfo->{contact}->{$oname}->{trid}=$tmp if defined $tmp;
425 0           $rinfo->{contact}->{$oname}->{svtrid}=Net::DRI::Util::xml_child_content($c,$ns,'svTRID');
426             } elsif ($name eq 'paDate')
427             {
428 0           $rinfo->{contact}->{$oname}->{date}=$po->parse_iso8601($c->textContent());
429             }
430             }
431 0           return;
432             }
433              
434             ####################################################################################################
435             1;