File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/BR/Domain.pm
Criterion Covered Total %
statement 12 178 6.7
branch 0 110 0.0
condition 0 32 0.0
subroutine 4 19 21.0
pod 0 15 0.0
total 16 354 4.5


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .BR Domain EPP extension commands
2             ## draft-neves-epp-brdomain-03.txt
3             ##
4             ## Copyright (c) 2008,2013 Patrick Mevzek . All rights reserved.
5             ##
6             ## This file is part of Net::DRI
7             ##
8             ## Net::DRI is free software; you can redistribute it and/or modify
9             ## it under the terms of the GNU General Public License as published by
10             ## the Free Software Foundation; either version 2 of the License, or
11             ## (at your option) any later version.
12             ##
13             ## See the LICENSE file that comes with this distribution for more details.
14             ####################################################################################################
15              
16             package Net::DRI::Protocol::EPP::Extensions::BR::Domain;
17              
18 1     1   691 use strict;
  1         1  
  1         24  
19 1     1   3 use warnings;
  1         1  
  1         18  
20              
21 1     1   3 use Net::DRI::Exception;
  1         1  
  1         13  
22 1     1   3 use Net::DRI::Util;
  1         2  
  1         1552  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::EPP::Extensions::BR::Domain - .BR EPP Domain 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) 2008,2013 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 %tmp=(
70             check => [ \&check, \&check_parse ],
71             info => [ \&info, \&info_parse ],
72             create => [ \&create, \&create_parse ],
73             renew => [ undef, \&renew_parse ],
74             update => [ \&update, \&update_parse ],
75             review_complete => [ undef, \&pandata_parse ], ## needs to have same name for key as in Core/Domain to make sure this will be called after Core parsing !
76             );
77              
78 0           $tmp{check_multi}=$tmp{check};
79 0           return { 'domain' => \%tmp };
80             }
81              
82             ####################################################################################################
83              
84             sub build_command_extension
85             {
86 0     0 0   my ($mes,$epp,$tag)=@_;
87 0           return $mes->command_extension_register($tag,sprintf('xmlns:brdomain="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('brdomain')));
88             }
89              
90             sub check
91             {
92 0     0 0   my ($epp,$domain,$rd)=@_;
93 0           my $mes=$epp->message();
94              
95 0 0         return unless Net::DRI::Util::has_key($rd,'orgid');
96 0 0         Net::DRI::Exception::usererr_invalid_parameters('orgid must be an xml token string with 1 to 30 characters') unless Net::DRI::Util::xml_is_token($rd->{orgid},1,30);
97              
98 0           my $eid=build_command_extension($mes,$epp,'brdomain:check');
99 0           my @n=('brdomain:organization',$rd->{orgid});
100 0           $mes->command_extension($eid,\@n);
101 0           return;
102             }
103              
104             sub check_parse
105             {
106 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
107 0           my $mes=$po->message();
108 0 0         return unless $mes->is_success();
109              
110 0           my $chkdata=$mes->get_extension('brdomain','chkData');
111 0 0         return unless $chkdata;
112              
113 0           foreach my $cd ($chkdata->getChildrenByTagNameNS($mes->ns('brdomain'),'cd'))
114             {
115 0           my $hc=$cd->getAttribute('hasConcurrent');
116 0           my $irp=$cd->getAttribute('inReleaseProcess');
117 0           my $c=$cd->getFirstChild();
118 0           my $domain;
119             my @tn;
120 0           while($c)
121             {
122 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
123 0   0       my $n=$c->localname() || $c->nodeName();
124 0 0         if ($n eq 'name')
    0          
    0          
    0          
125             {
126 0           $domain=lc($c->getFirstChild()->getData());
127 0 0         $rinfo->{domain}->{$domain}->{has_concurrent}=Net::DRI::Util::xml_parse_boolean($hc) if defined($hc);
128 0 0         $rinfo->{domain}->{$domain}->{in_release_process}=Net::DRI::Util::xml_parse_boolean($irp) if defined($irp);
129             } elsif ($n eq 'equivalentName')
130             {
131 0           $rinfo->{domain}->{$domain}->{equivalent_name}=$c->getFirstChild()->getData();
132             } elsif ($n eq 'organization')
133             {
134 0           $rinfo->{domain}->{$domain}->{orgid}=$c->getFirstChild()->getData();
135             } elsif ($n eq 'ticketNumber')
136             {
137 0           push @tn,$c->getFirstChild()->getData();
138             }
139 0           } continue { $c=$c->getNextSibling(); }
140 0           $rinfo->{domain}->{$domain}->{ticket}=\@tn;
141             }
142 0           return;
143             }
144              
145             sub info
146             {
147 0     0 0   my ($epp,$domain,$rd)=@_;
148 0           my $mes=$epp->message();
149              
150 0 0         return unless Net::DRI::Util::has_key($rd,'ticket');
151 0 0         Net::DRI::Exception::usererr_invalid_parameters('ticket parameter must be an integer') unless Net::DRI::Util::isint($rd->{ticket});
152              
153 0           my $eid=build_command_extension($mes,$epp,'brdomain:info');
154 0           my @n=('brdomain:ticketNumber',$rd->{ticket});
155 0           $mes->command_extension($eid,\@n);
156 0           return;
157             }
158              
159             sub info_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 $infdata=$mes->get_extension('brdomain','infData');
166 0 0         return unless $infdata;
167 0           parse_extra_data($po,$oname,$rinfo,$mes,$infdata);
168 0           return;
169             }
170              
171             sub parse_extra_data
172             {
173 0     0 0   my ($po,$oname,$rinfo,$mes,$c)=@_;
174 0           my $ns=$mes->ns('brdomain');
175 0           $c=$c->getFirstChild();
176 0           my @tnc;
177 0           while($c)
178             {
179 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
180 0   0       my $n=$c->localname() || $c->nodeName();
181 0 0         if ($n eq 'ticketNumber')
    0          
    0          
    0          
    0          
    0          
    0          
182             {
183 0           $rinfo->{domain}->{$oname}->{ticket}=$c->getFirstChild()->getData();
184             } elsif ($n eq 'organization')
185             {
186 0           $rinfo->{domain}->{$oname}->{orgid}=$c->getFirstChild()->getData();
187             } elsif ($n eq 'releaseProcessFlags')
188             {
189 0           my %f;
190 0           foreach my $f (1..3)
191             {
192 0 0         next unless $c->hasAttribute('flag'.$f);
193 0           $f{'flag'.$f}=Net::DRI::Util::xml_parse_boolean($c->getAttribute('flag'.$f));
194             }
195 0           $rinfo->{domain}->{$oname}->{release_process}=\%f;
196             } elsif ($n eq 'pending')
197             {
198 0           my $cc=$c->getFirstChild();
199 0           my %p;
200 0           my $pd=DateTime::Format::ISO8601->new();
201 0           while($cc)
202             {
203 0 0         next unless ($cc->nodeType() == 1);
204 0   0       my $nn=$cc->localName() || $c->nodeName();
205 0 0         if ($nn eq 'doc')
    0          
    0          
206             {
207 0           my $d=$cc->getChildrenByTagNameNS($ns,'description')->shift();
208 0           push @{$p{doc}}, { status => $cc->getAttribute('status'),
  0            
209             type => $cc->getChildrenByTagNameNS($ns,'docType')->shift()->getFirstChild()->getData(),
210             limit => $pd->parse_datetime($cc->getChildrenByTagNameNS($ns,'limit')->shift()->getFirstChild()->getData()),
211             description => $d->getFirstChild()->getData(),
212             lang => $d->getAttribute('lang'),
213             };
214             } elsif ($nn eq 'dns')
215             {
216 0           push @{$p{dns}},{ status => $cc->getAttribute('status'),
  0            
217             hostname => $cc->getChildrenByTagNameNS($ns,'hostName')->shift()->getFirstChild()->getData(),
218             limit => $pd->parse_datetime($cc->getChildrenByTagNameNS($ns,'limit')->shift()->getFirstChild()->getData()),
219             };
220             } elsif ($nn eq 'releaseProc')
221             {
222 0           $p{release}={ status => $cc->getAttribute('status'),
223             limit => $pd->parse_datetime($cc->getChildrenByTagNameNS($ns,'limit')->shift()->getFirstChild()->getData()),
224             };
225             }
226 0           } continue { $cc=$cc->getNextSibling(); }
227 0           $rinfo->{domain}->{$oname}->{pending}=\%p;
228             } elsif ($n eq 'ticketNumberConc')
229             {
230 0           push @tnc,$c->getFirstChild()->getData();
231             } elsif ($n eq 'publicationStatus')
232             {
233 0           $rinfo->{domain}->{$oname}->{publication}=parse_publication($ns,$c);
234             } elsif ($n eq 'autoRenew')
235             {
236 0           $rinfo->{domain}->{$oname}->{auto_renew}=Net::DRI::Util::xml_parse_boolean($c->getAttribute('active'));
237             }
238 0           } continue { $c=$c->getNextSibling(); }
239              
240 0           $rinfo->{domain}->{$oname}->{ticket_concurrent}=\@tnc;
241 0           return;
242             }
243              
244             sub parse_publication
245             {
246 0     0 0   my ($ns,$c)=@_;
247 0           my %s;
248 0           $s{flag}=$c->getAttribute('publicationFlag');
249 0           foreach my $r ($c->getChildrenByTagNameNS($ns,'onHoldReason'))
250             {
251 0           push @{$s{onhold_reason}},$r->getFirstChild()->getData();
  0            
252             }
253 0           return \%s;
254             }
255              
256             sub build_release
257             {
258 0     0 0   my $rh=shift;
259 0 0 0       my %f=map { $_ => (defined($rh->{$_}) && $rh->{$_})? 1 : 0 } grep { exists($rh->{$_}) } qw/flag1 flag2 flag3/;
  0            
  0            
260 0 0         return keys(%f)? ['brdomain:releaseProcessFlags',\%f] : ();
261             }
262              
263             sub create
264             {
265 0     0 0   my ($epp,$domain,$rd)=@_;
266 0           my $mes=$epp->message();
267              
268 0 0         Net::DRI::Exception::usererr_insufficient_parameters('orgid is mandatory for domain_create') unless Net::DRI::Util::has_key($rd,'orgid');
269 0 0         Net::DRI::Exception::usererr_invalid_parameters('orgid must be an xml token string with 1 to 30 characters') unless Net::DRI::Util::xml_is_token($rd->{orgid},1,30);
270              
271 0           my @n=(['brdomain:organization',$rd->{orgid}]);
272 0 0 0       push @n,build_release($rd->{release}) if (Net::DRI::Util::has_key($rd,'release') && (ref($rd->{release}) eq 'HASH'));
273 0 0         push @n,['brdomain:autoRenew',{active => $rd->{auto_renew}? 1 : 0 }] if (Net::DRI::Util::has_key($rd,'auto_renew'));
    0          
274              
275 0           my $eid=build_command_extension($mes,$epp,'brdomain:create');
276 0           $mes->command_extension($eid,\@n);
277 0           return;
278             }
279              
280             sub create_parse
281             {
282 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
283 0           my $mes=$po->message();
284 0 0         return unless $mes->is_success();
285              
286 0           my $credata=$mes->get_extension('brdomain','creData');
287 0 0         return unless $credata;
288 0           parse_extra_data($po,$oname,$rinfo,$mes,$credata);
289 0           return;
290             }
291              
292             sub renew_parse
293             {
294 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
295 0           my $mes=$po->message();
296 0 0         return unless $mes->is_success();
297              
298 0           my $rendata=$mes->get_extension('brdomain','renData');
299 0 0         return unless $rendata;
300 0           my $ns=$mes->ns('brdomain');
301 0           my $pub=$rendata->getChildrenByTagNameNS($ns,'publicationStatus');
302 0 0         return unless $pub->size();
303              
304 0           $rinfo->{domain}->{$oname}->{publication}=parse_publication($ns,$pub->shift());
305 0           return;
306             }
307              
308             sub update
309             {
310 0     0 0   my ($epp,$domain,$todo)=@_;
311 0           my $mes=$epp->message();
312              
313 0           my $ticket=$todo->set('ticket');
314 0           my $release=$todo->set('release');
315 0           my $autorenew=$todo->set('auto_renew');
316              
317 0 0 0       return unless (defined($ticket) || defined($release) || defined($autorenew));
      0        
318              
319 0           my @n;
320 0 0 0       push @n,['brdomain:ticketNumber',$ticket] if (defined($ticket) && Net::DRI::Util::isint($ticket));
321 0           my @c;
322 0 0 0       push @c,build_release($release) if (defined($release) && (ref($release) eq 'HASH'));
323 0 0         push @c,['brdomain:autoRenew',{active => $autorenew? 1 : 0}] if defined($autorenew);
    0          
324 0 0         push @n,['brdomain:chg',@c] if @c;
325              
326 0 0         return unless @n;
327 0           my $eid=build_command_extension($mes,$epp,'brdomain:update');
328 0           $mes->command_extension($eid,\@n);
329 0           return;
330             }
331              
332             sub update_parse
333             {
334 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
335 0           my $mes=$po->message();
336 0 0         return unless $mes->is_success();
337              
338 0           my $upddata=$mes->get_extension('brdomain','updData');
339 0 0         return unless $upddata;
340 0           parse_extra_data($po,$oname,$rinfo,$mes,$upddata);
341 0           return;
342             }
343              
344             sub pandata_parse
345             {
346 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
347 0           my $mes=$po->message();
348 0 0         return unless $mes->is_success();
349              
350 0           my $pandata=$mes->get_extension('brdomain','panData');
351 0 0         return unless $pandata;
352              
353 0           my $c=$pandata->firstChild();
354 0           while ($c)
355             {
356 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
357 0   0       my $n=$c->localname() || $c->nodeName();
358 0 0         next unless $n;
359 0 0         if ($n eq 'ticketNumber')
    0          
360             {
361 0           $rinfo->{$otype}->{$oname}->{ticket}=$c->getFirstChild()->getData();
362             } elsif ($n eq 'reason')
363             {
364 0           $rinfo->{$otype}->{$oname}->{reason}=$c->getFirstChild()->getData();
365 0   0       $rinfo->{$otype}->{$oname}->{reason_lang}=$c->getAttribute('lang') || 'en';
366             }
367 0           } continue { $c=$c->getNextSibling(); }
368 0           return;
369             }
370              
371             ####################################################################################################
372             1;