File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/CAT/DefensiveRegistration.pm
Criterion Covered Total %
statement 15 217 6.9
branch 0 148 0.0
condition 0 75 0.0
subroutine 5 23 21.7
pod 0 18 0.0
total 20 481 4.1


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .CAT Defensive Registration EPP extension commands
2             ##
3             ## Copyright (c) 2006-2010,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::Extensions::CAT::DefensiveRegistration;
16              
17 1     1   734 use strict;
  1         3  
  1         38  
18 1     1   6 use warnings;
  1         3  
  1         29  
19              
20 1     1   4 use Net::DRI::Util;
  1         2  
  1         17  
21 1     1   4 use Net::DRI::Exception;
  1         1  
  1         12  
22 1     1   4 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         2395  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::EPP::Extensions::CAT::DefensiveRegistration - .CAT EPP Defensive Registration extension commands for Net::DRI
29              
30             =head1 DESCRIPTION
31              
32             Please see the README file for details.
33              
34             =head1 SUPPORT
35              
36             For now, support questions should be sent to:
37              
38             Enetdri@dotandco.comE
39              
40             Please also see the SUPPORT file in the distribution.
41              
42             =head1 SEE ALSO
43              
44             Ehttp://www.dotandco.com/services/software/Net-DRI/E
45              
46             =head1 AUTHOR
47              
48             Patrick Mevzek, Enetdri@dotandco.comE
49              
50             =head1 COPYRIGHT
51              
52             Copyright (c) 2006-2010,2013-2015 Patrick Mevzek .
53             All rights reserved.
54              
55             This program is free software; you can redistribute it and/or modify
56             it under the terms of the GNU General Public License as published by
57             the Free Software Foundation; either version 2 of the License, or
58             (at your option) any later version.
59              
60             See the LICENSE file that comes with this distribution for more details.
61              
62             =cut
63              
64             ####################################################################################################
65              
66             sub register_commands
67             {
68 0     0 0   my ($class,$version)=@_;
69 0           my %tmp1=( create => [ \&create ],
70             check => [ \&check, \&check_parse ],
71             info => [ \&info, \&info_parse ],
72             delete => [ \&delete ],
73             update => [ \&update ],
74             renew => [ \&renew ],
75             );
76              
77 0           $tmp1{check_multi}=$tmp1{check};
78            
79 0           return { 'defreg' => \%tmp1 };
80             }
81              
82             sub ns
83             {
84 0     0 0   my $mes=shift;
85 0 0         return wantarray()? @{$mes->ns()->{'puntcat_defreg'}} : $mes->ns('puntcat_defreg');
  0            
86             }
87              
88             sub build_command
89             {
90 0     0 0   my ($epp,$command,$id)=@_;
91 0           my $mes=$epp->message();
92              
93 0           my @id;
94 0 0         foreach my $n ( grep { defined } (ref($id) eq 'ARRAY')? @$id : ($id))
  0            
95             {
96 0 0 0       Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid defensive registration id '.$n) unless ($n && !ref($n) && Net::DRI::Util::xml_is_token($n,3,16));
      0        
97 0           push @id,$n;
98             }
99              
100 0 0         Net::DRI::Exception->die(1,'protocol/EPP',2,'Defensive registration id needed') unless @id;
101              
102 0           my @ns=ns($mes);
103 0           $mes->command([$command,'defreg:'.$command,sprintf('xmlns:defreg="%s" xsi:schemaLocation="%s %s"',$ns[0],$ns[0],$ns[1])]);
104 0           return map { ['defreg:id',$_] } @id;
  0            
105             }
106              
107             sub build_pattern
108             {
109 0     0 0   my ($d)=@_;
110 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('pattern is mandatory') unless (defined($d) && $d);
111 0 0         Net::DRI::Exception::usererr_invalid_parameters('pattern must be a XML token between 1 and 63 chars long') unless Net::DRI::Util::xml_is_token($d,1,63);
112 0           return ['defreg:pattern',$d];
113             }
114              
115             sub build_contact
116             {
117 0     0 0   my ($d,$type)=@_;
118 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters($type.' contact is mandatory') unless (defined($d) && $d);
119 0 0         $d=$d->srid() if Net::DRI::Util::isa_contact($d,'Net::DRI::Data::Contact::CAT');
120 0 0         Net::DRI::Exception->die(1,'protocol/EPP',10,"Invalid $type contact id: $d") unless Net::DRI::Util::xml_is_token($d,3,16);
121 0 0         return ($type eq 'registrant')? ['defreg:registrant',$d] : ['defreg:contact',$d,{type => $type}];
122             }
123              
124             sub build_contact_noregistrant
125             {
126 0     0 0   my $cs=shift;
127 0           my @d;
128 0           foreach my $t (sort($cs->types()))
129             {
130 0 0         next if ($t eq 'registrant');
131 0           my @o=$cs->get($t);
132 0           push @d,map { ['defreg:contact',$_->srid(),{'type'=>$t}] } @o;
  0            
133             }
134 0           return @d;
135             }
136              
137             sub build_authinfo
138             {
139 0     0 0   my ($d)=@_;
140 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('auth info is mandatory') unless (defined($d) && (ref($d) eq 'HASH') && exists($d->{pw}) && $d->{pw});
      0        
      0        
141 0 0         Net::DRI::Exception::usererr_invalid_parameters('auth pw must be a XML normalized string') unless Net::DRI::Util::xml_is_normalizedstring($d->{pw});
142 0 0         return ['defreg:authInfo',['defreg:pw',$d->{pw},exists($d->{roid})? { 'roid' => $d->{roid} } : undef]];
143             }
144              
145             sub build_maintainer
146             {
147 0     0 0   my ($d)=@_;
148 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('maintainer is mandatory') unless (defined($d) && $d);
149 0 0         Net::DRI::Exception::usererr_invalid_parameters('maintainer must be an XML token up to 128 chars long') unless Net::DRI::Util::xml_is_token($d,undef,128);
150 0           return ['defreg:maintainer',$d];
151             }
152              
153             sub build_trademark
154             {
155 0     0 0   my ($d)=@_;
156 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('trademark is mandatory') unless (defined $d && ref $d eq 'HASH' && keys %$d);
      0        
157 0           my %t=%$d;
158 0           my @n;
159 0 0         if (exists($t{name}))
160             {
161 0 0         Net::DRI::Exception::usererr_invalid_parameters('trademark name must be an XML token at least one char long') unless Net::DRI::Util::xml_is_token($t{name},1);
162 0           push @n,['defreg:name',$t{name}];
163             }
164 0 0         if (exists($t{issue_date}))
165             {
166 0 0         Net::DRI::Exception::usererr_invalid_parameters('trademark issueDate must be a valid DateTime object') unless Net::DRI::Util::check_isa($t{issue_date},'DateTime');
167 0           push @n,['defreg:issueDate',$t{issue_date}->strftime('%Y-%m-%d')];
168             }
169 0 0         if (exists($t{country}))
170             {
171 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('trademark country must be a valid country code') unless ($t{country} && exists($Net::DRI::Util::CCA2{uc($t{country})}));
172 0           push @n,['defreg:country',$t{country}];
173             }
174 0 0         if (exists($t{number}))
175             {
176 0 0         Net::DRI::Exception::usererr_invalid_parameters('trademark number must be an XML token at least one chat long') unless Net::DRI::Util::xml_is_token($t{number},1);
177 0           push @n,['defreg:number',$t{number}];
178             }
179 0           return ['defreg:trademark',@n];
180             }
181              
182             sub build_period
183             {
184 0     0 0   my $p=Net::DRI::Protocol::EPP::Util::build_period(shift);
185 0           $p->[0]='defreg:period';
186 0           return $p;
187             }
188              
189             ####################################################################################################
190             ########### Query commands
191              
192             sub check
193             {
194 0     0 0   my ($epp,@id)=@_;
195 0           my @d=build_command($epp,'check',\@id);
196 0           $epp->message->command_body(\@d);
197 0           return;
198             }
199              
200             sub check_parse
201             {
202 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
203 0           my $mes=$po->message();
204 0 0         return unless $mes->is_success();
205              
206 0           my $ns=ns($mes);
207 0           my $chkdata=$mes->get_response($ns,'chkData');
208 0 0         return unless defined $chkdata;
209              
210 0           foreach my $cd ($chkdata->getChildrenByTagNameNS($ns,'cd'))
211             {
212 0           my $id;
213 0           foreach my $el (Net::DRI::Util::xml_list_children($cd))
214             {
215 0           my ($n,$c)=@$el;
216 0 0         if ($n eq 'id')
    0          
217             {
218 0           $id=$c->textContent();
219 0           $rinfo->{defreg}->{$id}->{action}='check';
220 0           $rinfo->{defreg}->{$id}->{exist}=1-Net::DRI::Util::xml_parse_boolean($c->getAttribute('avail'));
221             } elsif ($n eq 'reason')
222             {
223 0           $rinfo->{defreg}->{$id}->{exist_reason}=$c->textContent();
224             }
225             }
226             }
227 0           return;
228             }
229              
230             sub info
231             {
232 0     0 0   my ($epp,$id,$rd)=@_;
233 0           my @d=build_command($epp,'info',$id);
234 0 0         push @d,build_authinfo($rd->{auth}) if Net::DRI::Util::has_auth($rd);
235 0           $epp->message->command_body(\@d);
236 0           return;
237             }
238              
239             sub info_parse
240             {
241 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
242 0           my $mes=$po->message();
243 0 0         return unless $mes->is_success();
244              
245 0           my $ns=ns($mes);
246 0           my $infdata=$mes->get_response($ns,'infData');
247 0 0         return unless defined $infdata;
248              
249 0           my (@s,%t);
250 0           my $cs=$po->create_local_object('contactset');
251 0           my %ccache;
252 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
253             {
254 0           my ($name,$c)=@$el;
255 0 0         if ($name eq 'id')
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
256             {
257 0           $oname=$c->textContent();
258 0           $rinfo->{defreg}->{$oname}->{id}=$oname;
259             } elsif ($name eq 'roid')
260             {
261 0           $rinfo->{defreg}->{$oname}->{roid}=$c->textContent();
262             } elsif ($name eq 'pattern')
263             {
264 0           $rinfo->{defreg}->{$oname}->{pattern}=$c->textContent();
265             } elsif ($name eq 'status')
266             {
267 0           push @s,Net::DRI::Protocol::EPP::Util::parse_node_status($c);
268             } elsif ($name eq 'registrant')
269             {
270 0           my $id=$c->textContent();
271 0 0         $ccache{$id}=$po->create_local_object('contact')->srid($id) unless exists $ccache{$id};
272 0           $cs->set($ccache{$id},'registrant');
273             } elsif ($name eq 'contact')
274             {
275 0           my $id=$c->textContent();
276 0 0         $ccache{$id}=$po->create_local_object('contact')->srid($id) unless exists $ccache{$id};
277 0           $cs->add($ccache{$id},$c->getAttribute('type'));
278             } elsif ($name=~m/^(clID|crID|upID)$/)
279             {
280 0           $rinfo->{defreg}->{$oname}->{$1}=$c->textContent();
281             } elsif ($name=~m/^(crDate|upDate|exDate)$/)
282             {
283 0           $rinfo->{defreg}->{$oname}->{$1}=$po->parse_iso8601($c->textContent());
284             } elsif ($name eq 'authInfo')
285             {
286 0           $rinfo->{defreg}->{$oname}->{auth}={ pw => Net::DRI::Util::xml_child_content($c,$ns,'pw') };
287             } elsif ($name eq 'maintainer')
288             {
289 0           $rinfo->{defreg}->{$oname}->{maintainer}=$c->textContent();
290             } elsif ($name eq 'trademark')
291             {
292 0           foreach my $sel (Net::DRI::Util::xml_list_children($c))
293             {
294 0           my ($name2,$cc)=@$sel;
295 0 0         if ($name2 eq 'name')
    0          
    0          
    0          
296             {
297 0           $t{name}=$cc->textContent();
298             } elsif ($name2 eq 'issueDate')
299             {
300 0           $t{issue_date}=$po->parse_iso8601($cc->textContent());
301             } elsif ($name2 eq 'country')
302             {
303 0           $t{country}=$cc->textContent();
304             } elsif ($name2 eq 'number')
305             {
306 0           $t{number}=$cc->textContent();
307             }
308             }
309             }
310             }
311              
312 0           $rinfo->{defreg}->{$oname}->{action}='info';
313 0           $rinfo->{defreg}->{$oname}->{exist}=1;
314 0           $rinfo->{defreg}->{$oname}->{contact}=$cs;
315 0           $rinfo->{defreg}->{$oname}->{status}=$po->create_local_object('status')->add(@s);
316 0           $rinfo->{defreg}->{$oname}->{trademark}=\%t;
317 0           return;
318             }
319              
320             ####################################################################################################
321             ############ Transform commands
322              
323             sub create
324             {
325 0     0 0   my ($epp,$id,$ri)=@_;
326 0           my @d=build_command($epp,'create',$id);
327              
328 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('A ref hash with all info must be provided alongside the id') unless (defined $ri && ref $ri eq 'HASH' && keys %$ri);
      0        
329              
330             ## Period, OPTIONAL
331 0 0         if (exists($ri->{duration}))
332             {
333 0           my $period=$ri->{duration};
334 0           Net::DRI::Util::check_isa($period,'DateTime::Duration');
335 0           push @d,build_period($period);
336             }
337              
338 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('pattern must be an XML token between 1 and 63 chars long') unless (exists($ri->{pattern}) && $ri->{pattern} && Net::DRI::Util::xml_is_token($ri->{pattern},1,63));
      0        
339 0           push @d,['defreg:pattern',$ri->{pattern}];
340 0 0         Net::DRI::Exception::usererr_invalid_parameters('a valid contactset object must be given in contact attribute') unless Net::DRI::Util::has_contact($ri);
341 0           my $cs=$ri->{contact};
342 0           push @d,build_contact($cs->get('registrant'),'registrant');
343 0           push @d,build_contact($cs->get('billing'),'billing');
344 0           push @d,build_contact($cs->get('admin'),'admin');
345 0           push @d,build_authinfo($ri->{auth});
346 0 0         push @d,build_maintainer($ri->{maintainer}) if (exists($ri->{maintainer})); ## optional
347 0           my $tmp=build_trademark($ri->{trademark});
348 0 0         Net::DRI::Exception::usererr_insufficient_parameters('trademark must be a ref hash with 4 keys: name, issue_date, country, number') unless (@$tmp==5);
349 0           push @d,$tmp;
350 0           $epp->message->command_body(\@d);
351 0           return;
352             }
353              
354             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
355             {
356 0     0 0   my ($epp,$id)=@_;
357 0           my @d=build_command($epp,'delete',$id);
358 0           $epp->message->command_body(\@d);
359 0           return;
360             }
361              
362             sub renew
363             {
364 0     0 0   my ($epp,$id,$rd)=@_;
365 0 0 0       my $period=(defined($rd) && (ref($rd) eq 'HASH') && exists($rd->{duration}))? $rd->{duration} : undef;
366 0 0 0       my $curexp=(defined($rd) && (ref($rd) eq 'HASH') && exists($rd->{current_expiration}))? $rd->{current_expiration} : undef;
367 0 0         Net::DRI::Exception::usererr_insufficient_parameters('current expiration year') unless defined($curexp);
368 0 0 0       $curexp=$curexp->set_time_zone('UTC')->strftime('%Y-%m-%d') if (ref $curexp && Net::DRI::Util::is_class($curexp,'DateTime'));
369 0 0         Net::DRI::Exception::usererr_invalid_parameters('current expiration year must be YYYY-MM-DD') unless $curexp=~m/^\d{4}-\d{2}-\d{2}$/;
370              
371 0           my @d=build_command($epp,'renew',$id);
372 0           push @d,['defreg:curExpDate',$curexp];
373 0 0         if (defined($period))
374             {
375 0           Net::DRI::Util::check_isa($period,'DateTime::Duration');
376 0           push @d,build_period($period);
377             }
378              
379 0           $epp->message->command_body(\@d);
380 0           return;
381             }
382              
383             sub update
384             {
385 0     0 0   my ($epp,$id,$todo)=@_;
386 0           my $mes=$epp->message();
387              
388 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
389              
390 0 0 0       if ((grep { ! /^(?:add|del)$/ } $todo->types('status')) ||
  0   0        
  0   0        
      0        
      0        
391 0           (grep { ! /^(?:add|del)$/ } $todo->types('contact')) ||
392 0           (grep { ! /^set$/ } $todo->types('registrant')) ||
393 0           (grep { ! /^set$/ } $todo->types('auth')) ||
394 0           (grep { ! /^set$/ } $todo->types('maintainer')) ||
395             (grep { ! /^set$/ } $todo->types('trademark'))
396             )
397             {
398 0           Net::DRI::Exception->die(0,'protocol/EPP',11,'Only status/contact add/del or registrant/authinfo/maintainer/trademark set available for defreg');
399             }
400              
401 0           my @d=build_command($epp,'update',$id);
402              
403 0           my $sadd=$todo->add('status');
404 0           my $sdel=$todo->del('status');
405 0           my $cadd=$todo->add('contact');
406 0           my $cdel=$todo->del('contact');
407 0           my (@add,@del);
408              
409 0 0         push @add,build_contact_noregistrant($cadd) if $cadd;
410 0 0         push @add,$sadd->build_xml('defreg:status') if $sadd;
411 0 0         push @del,build_contact_noregistrant($cdel) if $cdel;
412 0 0         push @del,$sdel->build_xml('defreg:status') if $sdel;
413              
414 0 0         push @d,['defreg:add',@add] if @add;
415 0 0         push @d,['defreg:rem',@del] if @del;
416              
417 0           my (@chg,$chg);
418              
419 0           $chg=$todo->set('registrant');
420 0 0         push @chg,['defreg:registrant',$chg->srid()] if Net::DRI::Util::isa_contact($chg,'Net::DRI::Data::Contact::CAT');
421 0           $chg=$todo->set('auth');
422 0 0 0       push @chg,build_authinfo($chg) if ($chg && ref($chg));
423 0           $chg=$todo->set('maintainer');
424 0 0         push @chg,build_maintainer($chg) if $chg;
425 0           $chg=$todo->set('trademark');
426 0 0 0       push @chg,build_trademark($chg) if ($chg && ref($chg));
427              
428 0 0         push @d,['defreg:chg',@chg] if @chg;
429 0           $mes->command_body(\@d);
430 0           return;
431             }
432              
433             ####################################################################################################
434             1;