File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/ResellerObject.pm
Criterion Covered Total %
statement 18 200 9.0
branch 0 112 0.0
condition 0 27 0.0
subroutine 6 19 31.5
pod 0 12 0.0
total 24 370 6.4


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Reseller Extension Mapping for EPP
2             ##
3             ## Copyright (c) 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::Extensions::ResellerObject;
16              
17 1     1   801 use strict;
  1         2  
  1         30  
18 1     1   4 use warnings;
  1         1  
  1         22  
19 1     1   4 use feature 'state';
  1         1  
  1         74  
20              
21 1     1   4 use Net::DRI::Util;
  1         1  
  1         18  
22 1     1   4 use Net::DRI::Exception;
  1         2  
  1         14  
23 1     1   3 use Net::DRI::Protocol::EPP::Util;
  1         2  
  1         2230  
24              
25             ####################################################################################################
26              
27             sub register_commands
28             {
29 0     0 0   my ($class,$version)=@_;
30              
31 0           state $rops = { 'reseller' => { check => [ \&check_build, \&check_parse ],
32             info => [ \&info_build, \&info_parse ],
33             create => [ \&create_build, \&create_parse ],
34             delete => [ \&delete_build, undef ],
35             update => [ \&update_build, undef ],
36             }
37             };
38              
39 0           return $rops;
40             }
41              
42             sub setup
43             {
44 0     0 0   my ($class,$po,$version)=@_;
45 0           $po->ns({ 'reseller' => [ 'urn:ietf:params:xml:ns:reseller-1.0','reseller-1.0.xsd' ] });
46 0           return;
47             }
48              
49             sub capabilities_add
50             {
51 0     0 0   state $c = [ [ 'reseller_update', 'contact', [qw/add del set/] ],
52             [ 'reseller_update', 'status', ['set'] ],
53             [ 'reseller_update', 'parent_id', ['set'] ],
54             [ 'reseller_update', 'url', ['set'] ],
55             ];
56 0           return $c;
57             }
58              
59 0     0 0   sub implements { return 'https://tools.ietf.org/html/draft-zhou-eppext-reseller-mapping-00'; }
60              
61             ####################################################################################################
62              
63             sub _add_id
64             {
65 0     0     my ($mes,$command,$reseller)=@_;
66 0           my @r;
67              
68 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('Missing reseller id') unless defined $reseller && (!ref $reseller || ref $reseller eq 'ARRAY');
      0        
69 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('Only one reseller id allowed for command '.$command) if $command ne 'check' && ref $reseller;
70 0 0         foreach my $id (ref $reseller ? @$reseller : ($reseller))
71             {
72 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid syntax for reseller id: '.$id) unless Net::DRI::Util::xml_is_token($id,3,16);
73 0           push @r,['reseller:id',$id];
74             }
75              
76 0           $mes->command([$command,'reseller:'.$command,sprintf('xmlns:reseller="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('reseller'))]);
77              
78 0           return @r;
79             }
80              
81             sub check_build
82             {
83 0     0 0   my ($epp,$reseller,$rd)=@_;
84 0           my $mes=$epp->message();
85              
86 0           my @d=_add_id($mes,'check',$reseller);
87 0           $mes->command_body(\@d);
88 0           return;
89             }
90              
91             sub check_parse
92             {
93 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
94 0           my $mes=$po->message();
95 0 0         return unless $mes->is_success();
96              
97 0           my $chkdata=$mes->get_response('reseller','chkData');
98 0 0         return unless defined $chkdata;
99              
100 0           foreach my $cd ($chkdata->getChildrenByTagNameNS($mes->ns('reseller'),'cd'))
101             {
102 0           my $id;
103 0           foreach my $el (Net::DRI::Util::xml_list_children($cd))
104             {
105 0           my ($n,$c)=@$el;
106 0 0         if ($n eq 'id')
    0          
107             {
108 0           $id=$c->textContent();
109 0           $rinfo->{reseller}->{$id}->{action}='check';
110 0           $rinfo->{reseller}->{$id}->{exist}=1-Net::DRI::Util::xml_parse_boolean($c->getAttribute('avail'));
111             } elsif ($n eq 'reason')
112             {
113 0 0         $rinfo->{reseller}->{$id}->{exist_reason}=$c->hasAttribute('lang') ? { lang => $c->getAttribute('lang'), reason => $c->textContent() } : $c->textContent();
114             }
115             }
116             }
117 0           return;
118             }
119              
120             sub info_build
121             {
122 0     0 0   my ($epp,$reseller,$rd)=@_;
123 0           my $mes=$epp->message();
124              
125 0           my @d=_add_id($mes,'info',$reseller);
126 0           $mes->command_body(\@d);
127 0           return;
128             }
129              
130             sub info_parse
131             {
132 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
133 0           my $mes=$po->message();
134 0 0         return unless $mes->is_success();
135              
136 0           my $data=$mes->get_response('reseller','infData');
137 0 0         return unless defined $data;
138              
139 0           my %r=(action => 'info', exist => 1);
140 0           my $cs=$po->create_local_object('contactset');
141 0           my %ccache;
142 0           my %cd=map { $_ => [] } qw/name org city sp pc cc/;
  0            
143 0           $cd{street}=[[],[]];
144 0           my $contact=$po->create_local_object('contact');
145              
146 0           foreach my $el (Net::DRI::Util::xml_list_children($data))
147             {
148 0           my ($name,$node)=@$el;
149 0 0 0       if ($name=~m/^(?:id|roid|state|parentId|url)$/)
    0          
    0          
    0          
    0          
    0          
    0          
    0          
150             {
151 0           my $key=Net::DRI::Util::remcam($name);
152 0 0         $key='status' if $key eq 'state';
153 0           $r{$key}=$node->textContent();
154             } elsif ($name=~m/^(email)$/) ## TODO: url should be there too
155             {
156 0           $contact->$name($node->textContent());
157             } elsif ($name eq 'postalInfo')
158             {
159 0           Net::DRI::Protocol::EPP::Util::parse_postalinfo($po,$node,\%cd);
160             } elsif ($name eq 'voice' || $name eq 'fax')
161             {
162 0           $contact->$name(Net::DRI::Protocol::EPP::Util::parse_tel($node));
163             } elsif ($name eq 'contact')
164             {
165 0           my $id=$node->textContent();
166 0 0         $ccache{$id}=$po->create_local_object('contact')->srid($id) unless exists $ccache{$id};
167 0           $cs->add($ccache{$id},$node->getAttribute('type'));
168             } elsif ($name=~m/^(clID|crID|upID)$/)
169             {
170 0           $r{$1}=$node->textContent();
171             } elsif ($name=~m/^(crDate|upDate)$/)
172             {
173 0           $r{$1}=$po->parse_iso8601($node->textContent());
174             } elsif ($name eq 'disclose')
175             {
176 0           $contact->disclose(Net::DRI::Protocol::EPP::Util::parse_disclose($node));
177             }
178             }
179              
180 0           $contact->name(@{$cd{name}});
  0            
181 0           $contact->org(@{$cd{org}});
  0            
182 0           $contact->street(@{$cd{street}});
  0            
183 0           $contact->city(@{$cd{city}});
  0            
184 0           $contact->sp(@{$cd{sp}});
  0            
185 0           $contact->pc(@{$cd{pc}});
  0            
186 0           $contact->cc(@{$cd{cc}});
  0            
187 0           $cs->set($contact,'main');
188 0           $r{contact}=$cs;
189 0           $rinfo->{$otype}->{$r{id}}=\%r;
190              
191 0           return;
192             }
193              
194             sub create_build
195             {
196 0     0 0   my ($epp,$reseller,$rd)=@_;
197 0           my $mes=$epp->message();
198              
199 0           my @d=_add_id($mes,'create',$reseller);
200              
201 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Missing mandatory reseller state') unless Net::DRI::Util::has_key($rd,'status');
202 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid reseller state: '.$rd->{status}) unless $rd->{status}=~m/^(?:ok|readonly|terminated)$/;
203 0           push @d,['reseller:state',$rd->{status}];
204              
205 0 0         if (Net::DRI::Util::has_key($rd,'parent_id'))
206             {
207 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid syntax for reseller parent_id: '.$rd->{parent_id}) unless Net::DRI::Util::xml_is_token($rd->{parent_id},3,16);
208 0           push @d,['reseller:parentId',$rd->{parent_id}];
209             }
210              
211 0           my $cs=$rd->{contact};
212 0 0         Net::DRI::Exception::usererr_invalid_parameters('Missing mandatory contact structure') unless Net::DRI::Util::has_contact($rd);
213 0 0         Net::DRI::Exception::usererr_invalid_parameters('Missing mandatory contact "main"') unless $cs->has_type('main');
214 0           my $co=$cs->get('main');
215             ## Fake data to pass validate
216 0           $co->auth('FAKE');
217 0           $co->srid('FAKE');
218 0           $co->validate();
219 0           push @d,Net::DRI::Protocol::EPP::Util::build_postalinfo($co,$epp->{contacti18n},'reseller');
220 0 0         push @d,Net::DRI::Protocol::EPP::Util::build_tel('reseller:voice',$co->voice()) if defined $co->voice();
221 0 0         push @d,Net::DRI::Protocol::EPP::Util::build_tel('reseller:fax',$co->fax()) if defined $co->fax();
222 0           push @d,['reseller:email',$co->email()];
223              
224 0 0         Net::DRI::Exception::usererr_insufficient_parameters('Missing mandatory reseller url') unless Net::DRI::Util::has_key($rd,'url');
225 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('Invalid reseller url: '.$rd->{url}) unless Net::DRI::Util::xml_is_token($rd->{url},1,undef) && $rd->{url}=~m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; ## regexp taken from URI Perl module
226 0           push @d,['reseller:url',$rd->{url}];
227              
228 0 0         if (Net::DRI::Util::has_contact($rd))
229             {
230 0           push @d,Net::DRI::Protocol::EPP::Util::build_core_contacts($epp,$rd->{contact},'reseller');
231             }
232              
233 0           my $d=$co->disclose();
234 0 0         if (defined $d)
235             {
236 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid reseller disclose item: '.$d) unless ref $d eq 'HASH';
237 0           my @dd=Net::DRI::Protocol::EPP::Util::build_disclose($d,'reseller',qw/url contact/);
238 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid reseller disclose item: '.$d) unless @dd;
239 0           push @d,@dd;
240             }
241              
242 0           $mes->command_body(\@d);
243 0           return;
244             }
245              
246             sub create_parse
247             {
248 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
249 0           my $mes=$po->message();
250 0 0         return unless $mes->is_success();
251              
252 0           my $credata=$mes->get_response('reseller','creData');
253 0 0         return unless defined $credata;
254              
255 0           my %r=(action => 'create', exist => 1);
256 0           foreach my $el (Net::DRI::Util::xml_list_children($credata))
257             {
258 0           my ($name,$node)=@$el;
259 0 0         if ($name eq 'id')
    0          
260             {
261 0           $r{id}=$node->textContent();
262             } elsif ($name eq 'crDate')
263             {
264 0           $r{crDate}=$po->parse_iso8601($node->textContent());
265             }
266             }
267              
268 0           $rinfo->{reseller}->{$r{id}}=\%r;
269 0           return;
270             }
271              
272             sub delete_build
273             {
274 0     0 0   my ($epp,$reseller,$rd)=@_;
275 0           my $mes=$epp->message();
276              
277 0           my @d=_add_id($mes,'delete',$reseller);
278 0           $mes->command_body(\@d);
279 0           return;
280             }
281              
282             sub update_build
283             {
284 0     0 0   my ($epp,$reseller,$todo,$rp)=@_;
285              
286 0           my (@add,@del,@set);
287 0           my $cs;
288              
289 0           $cs=$todo->add('contact');
290 0 0         if (Net::DRI::Util::isa_contactset($cs))
291             {
292 0           push @add,Net::DRI::Protocol::EPP::Util::build_core_contacts($epp,$cs,'reseller');
293             }
294              
295 0           $cs=$todo->del('contact');
296 0 0         if (Net::DRI::Util::isa_contactset($cs))
297             {
298 0           push @del,Net::DRI::Protocol::EPP::Util::build_core_contacts($epp,$cs,'reseller');
299             }
300              
301 0           my $e;
302              
303 0           $e=$todo->set('status');
304 0 0         push @set,['reseller:state',$e] if defined $e;
305              
306 0           $e=$todo->set('parent_id');
307 0 0         push @set,['reseller:parentId',$e] if defined $e;
308              
309 0           my $co;
310 0           $cs=$todo->set('contact');
311 0 0         if (Net::DRI::Util::isa_contactset($cs))
312             {
313 0           $co=$cs->get('main');
314 0 0 0       if (defined $co && Net::DRI::Util::isa_contact($co))
315             {
316             ## Fake data to pass validate
317 0           $co->auth('FAKE');
318 0           $co->srid('FAKE');
319 0           $co->validate(1);
320 0           push @set,Net::DRI::Protocol::EPP::Util::build_postalinfo($co,$epp->{contacti18n},'reseller');
321 0 0         push @set,Net::DRI::Protocol::EPP::Util::build_tel('reseller:voice',$co->voice()) if defined $co->voice();
322 0 0         push @set,Net::DRI::Protocol::EPP::Util::build_tel('reseller:fax',$co->fax()) if defined $co->fax();
323 0 0         push @set,['reseller:email',$co->email()] if defined $co->email();
324             } else
325             {
326 0           $co=undef;
327             }
328             }
329              
330 0           $e=$todo->set('url');
331 0 0         push @set,['reseller:url',$e] if defined $e;
332              
333 0           my $d;
334 0 0 0       if (defined $co && defined($d=$co->disclose()))
335             {
336 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid reseller disclose item: '.$d) unless ref $d eq 'HASH';
337 0           my @dd=Net::DRI::Protocol::EPP::Util::build_disclose($d,'reseller',qw/url contact/);
338 0 0         Net::DRI::Exception::usererr_invalid_parameters('Invalid reseller disclose item: '.$d) unless @dd;
339 0           push @set,@dd;
340             }
341              
342 0 0 0       return unless @add || @del || @set;
      0        
343              
344 0           my $mes=$epp->message();
345 0           my @d=_add_id($mes,'update',$reseller);
346 0 0         push @d,['reseller:add',@add] if @add;
347 0 0         push @d,['reseller:rem',@del] if @del;
348 0 0         push @d,['reseller:chg',@set] if @set;
349              
350 0           $mes->command_body(\@d);
351 0           return;
352             }
353              
354             ####################################################################################################
355             1;
356              
357             __END__