File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/LU/Domain.pm
Criterion Covered Total %
statement 15 203 7.3
branch 0 86 0.0
condition 0 36 0.0
subroutine 5 30 16.6
pod 0 25 0.0
total 20 380 5.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .LU Domain EPP extension commands
2             ##
3             ## Copyright (c) 2007,2008,2010,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::LU::Domain;
16              
17 1     1   698 use strict;
  1         1  
  1         24  
18 1     1   3 use warnings;
  1         1  
  1         19  
19              
20 1     1   4 use Net::DRI::Exception;
  1         1  
  1         13  
21 1     1   3 use Net::DRI::Util;
  1         0  
  1         18  
22              
23 1     1   3 use DateTime::Format::ISO8601;
  1         1  
  1         1979  
24              
25             =pod
26              
27             =head1 NAME
28              
29             Net::DRI::Protocol::EPP::Extensions::LU::Domain - .LU EPP Domain extension commands 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) 2007,2008,2010,2013 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             info => [ undef, \&info_parse ],
72             create => [ \&create, undef ],
73             update => [ \&update, undef ],
74             delete => [ \&delete, undef ],
75             restore => [ \&restore, undef ],
76             transfer_request => [ \&transfer_request, \&transfer_parse ],
77             transfer_query => [ undef , \&transfer_parse ],
78             trade_request => [ \&trade_request , \&trade_parse ],
79             trade_query => [ \&trade_query , \&trade_parse ],
80             trade_cancel => [ \&trade_cancel , undef ],
81             transfer_trade_request => [ \&transfer_trade_request, \&transfer_trade_parse ],
82             transfer_trade_query => [ \&transfer_trade_query , \&transfer_trade_parse ],
83             transfer_trade_cancel => [ \&transfer_trade_cancel , undef ],
84             transfer_restore_request => [ \&transfer_restore_request, \&transfer_restore_parse ],
85             transfer_restore_query => [ \&transfer_restore_query , \&transfer_restore_parse ],
86             transfer_restore_cancel => [ \&transfer_restore_cancel , undef ],
87             );
88              
89 0           return { 'domain' => \%tmp };
90             }
91              
92             sub build_command_extension
93             {
94 0     0 0   my ($mes,$epp,$tag)=@_;
95 0           return $mes->command_extension_register($tag,sprintf('xmlns:dnslu="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('dnslu')));
96             }
97              
98             ####################################################################################################
99              
100             sub info_parse
101             {
102 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
103 0           my $mes=$po->message();
104 0 0         return unless $mes->is_success();
105              
106 0           my $infdata=$mes->get_extension('dnslu','ext');
107 0 0         return unless $infdata;
108 0           my $ns=$mes->ns('dnslu');
109 0           $infdata=$infdata->getChildrenByTagNameNS($ns,'resData');
110 0 0         return unless $infdata->size();
111 0           $infdata=$infdata->shift()->getChildrenByTagNameNS($ns,'infData');
112 0 0         return unless $infdata->size();
113 0           $infdata=$infdata->shift()->getChildrenByTagNameNS($ns,'domain');
114 0 0         return unless $infdata->size();
115              
116 0           my $pd=DateTime::Format::ISO8601->new();
117 0           my $c=$infdata->shift()->getFirstChild();
118 0           while($c)
119             {
120 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
121 0   0       my $name=$c->localname() || $c->nodeName();
122 0 0         next unless $name;
123              
124 0 0         if ($name eq 'idn')
    0          
    0          
    0          
125             {
126             ## currently not used
127             } elsif ($name eq 'status')
128             {
129 0           $rinfo->{domain}->{$oname}->{status}->add($c->getFirstChild()->getData());
130             } elsif ($name eq 'crReqID')
131             {
132 0           $rinfo->{domain}->{$oname}->{$name}=$c->getFirstChild()->getData();
133             } elsif ($name=~m/^(crReqDate|delReqDate|delDate)$/)
134             {
135 0           $rinfo->{domain}->{$oname}->{$name}=$pd->parse_datetime($c->getFirstChild()->getData());
136             }
137              
138 0           } continue { $c=$c->getNextSibling(); }
139 0           return;
140             }
141              
142             sub verify_contacts
143             {
144 0     0 0   my $rd=shift;
145 0 0         Net::DRI::Exception::usererr_invalid_parameters('.LU needs contact for domain_create/domain_transfer/domain_trade') unless Net::DRI::Util::has_contact($rd);
146 0           my @t=$rd->{contact}->types();
147 0 0 0       Net::DRI::Exception::usererr_invalid_parameters('.LU needs registrant, admin and tech contacts only') unless ($t[0] eq 'admin' && $t[1] eq 'registrant' && $t[2] eq 'tech');
      0        
148 0           foreach my $t (qw/registrant admin tech/)
149             {
150 0           my @t=$rd->{contact}->get($t);
151 0 0         Net::DRI::Exception::usererr_invalid_parameters('.LU needs only one contact of type '.$t) unless @t==1;
152             }
153 0           return;
154             }
155              
156             sub create
157             {
158 0     0 0   my ($epp,$domain,$rd)=@_;
159 0           my $mes=$epp->message();
160              
161 0           verify_contacts($rd);
162              
163             ## idn is not handled
164              
165 0 0         return unless Net::DRI::Util::has_key($rd,'status');
166 0 0         my @n=map { ['dnslu:status',{ s => $_ }] } (Net::DRI::Util::isa_statuslist($rd->{status})? $rd->{status}->list_status() : @{$rd->{status}});
  0            
  0            
167              
168 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
169 0           $mes->command_extension($eid,['dnslu:create',['dnslu:domain',@n]]);
170 0           return;
171             }
172              
173             sub update
174             {
175 0     0 0   my ($epp,$domain,$todo)=@_;
176 0           my $mes=$epp->message();
177              
178 0           my @n;
179 0           my $sadd=$todo->add('status');
180 0           my $sdel=$todo->del('status');
181 0           my (@add,@del);
182 0 0         push @add,$sadd->build_xml('dnslu:status','dnslu') if $sadd;
183 0 0         push @del,$sdel->build_xml('dnslu:status','dnslu') if $sdel;
184 0 0         push @n,['dnslu:add',@add] if @add;
185 0 0         push @n,['dnslu:rem',@del] if @del;
186 0 0         return unless @n;
187              
188 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
189 0           $mes->command_extension($eid,['dnslu:update',['dnslu:domain',@n]]);
190 0           return;
191             }
192              
193             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
194             {
195 0     0 0   my ($epp,$domain,$rd)=@_;
196 0           my $mes=$epp->message();
197              
198 0 0 0       return unless (defined($rd) && ref($rd) && exists($rd->{delDate}) && ($rd->{delDate}=~m/^(?:immediate|cancel)$/ || Net::DRI::Util::is_class($rd->{delDate},'DateTime')));
      0        
      0        
      0        
199              
200 0           my @n;
201 0 0         if ($rd->{delDate}=~m/^(?:immediate|cancel)$/)
202             {
203 0           @n=['dnslu:op',$rd->{delDate}];
204             } else
205             {
206 0           @n=['dnslu:op','setDate'];
207 0           push @n,['dnslu:delDate',$rd->{delDate}->set_time_zone('UTC')->strftime('%Y-%m-%dT%TZ')];
208             }
209              
210 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
211 0           $mes->command_extension($eid,['dnslu:delete',['dnslu:domain',@n]]);
212 0           return;
213             }
214              
215             sub build_command
216             {
217 0     0 0   my ($domain)=@_;
218              
219 0 0 0       Net::DRI::Exception->die(1,'protocol/EPP',2,'Domain name needed') unless (defined($domain) && $domain && !ref($domain));
      0        
220 0 0         Net::DRI::Exception->die(1,'protocol/EPP',10,'Invalid domain name: '.$domain) unless Net::DRI::Util::is_hostname($domain);
221 0 0         Net::DRI::Exception->die(1,'protocol/EPP',10,'Domain name not in .LU: '.$domain) unless $domain=~m/\.LU$/i;
222              
223 0           return ['dnslu:name',$domain];
224             }
225              
226             sub restore
227             {
228 0     0 0   my ($epp,$domain,$rd)=@_;
229 0           my $mes=$epp->message();
230              
231 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
232 0           $mes->command_extension($eid,['dnslu:command',['dnslu:restore',['dnslu:domain',build_command($domain)]]]);
233 0           return;
234             }
235              
236             sub build_transfer_trade_restore
237             {
238 0     0 0   my ($rd)=@_;
239 0           my @n;
240              
241 0           verify_contacts($rd);
242            
243 0 0         push @n,['dnslu:ns',map { ['dnslu:hostObj',$_] } $rd->{ns}->get_names() ] if Net::DRI::Util::has_ns($rd);
  0            
244 0           my $cs=$rd->{contact};
245 0           push @n,['dnslu:registrant',$cs->get('registrant')->srid()];
246 0           push @n,['dnslu:contact',{type => 'admin'},$cs->get('admin')->srid()];
247 0           push @n,['dnslu:contact',{type => 'tech'},$cs->get('tech')->srid()];
248 0 0         push @n,map { ['dnslu:status',{ s => $_ }] } (Net::DRI::Util::isa_statuslist($rd->{status})? $rd->{status}->list_status() : @{$rd->{status}}) if Net::DRI::Util::has_key($rd,'status');
  0 0          
  0            
249             ## IDN not used
250 0 0 0       push @n,['dnslu:trDate',$rd->{trDate}->set_time_zone('UTC')->strftime('%Y-%m-%d')] if (exists($rd->{trDate}) && defined($rd->{trDate}) && Net::DRI::Util::check_isa($rd->{trDate},'DateTime'));
      0        
251 0           return @n;
252             }
253              
254             sub transfer_request
255             {
256 0     0 0   my ($epp,$domain,$rd)=@_;
257 0           my $mes=$epp->message();
258              
259 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
260 0           $mes->command_extension($eid,['dnslu:transfer',['dnslu:domain',build_transfer_trade_restore($rd)]]);
261 0           return;
262             }
263              
264             sub transfer_parse ## for request & query
265             {
266 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
267 0           my $mes=$po->message();
268 0 0         return unless $mes->is_success();
269              
270 0           parse_transfer_trade_restore($po,$otype,$oaction,$oname,$rinfo,'trnData');
271 0           return;
272             }
273              
274             sub parse_transfer_trade_restore
275             {
276 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo,$s)=@_;
277 0           my $mes=$po->message();
278              
279 0           my $infdata=$mes->get_extension('dnslu','ext');
280 0 0         return unless $infdata;
281 0           my $ns=$mes->ns('dnslu');
282 0           $infdata=$infdata->getChildrenByTagNameNS($ns,'resData');
283 0 0         return unless $infdata->size();
284 0           $infdata=$infdata->shift()->getChildrenByTagNameNS($ns,$s);
285 0 0         return unless $infdata->size();
286 0           $infdata=$infdata->shift()->getChildrenByTagNameNS($ns,'domain');
287 0 0         return unless $infdata->size();
288              
289 0           my $pd=DateTime::Format::ISO8601->new();
290 0           my $c=$infdata->shift->getFirstChild();
291 0           while($c)
292             {
293 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
294 0   0       my $name=$c->localname() || $c->nodeName();
295 0 0         next unless $name;
296              
297 0 0         if ($name eq 'idn')
    0          
    0          
298             {
299             ## currently not used
300             } elsif ($name=~m/^(trStatus|reID)$/)
301             {
302 0           $rinfo->{domain}->{$oname}->{$name}=$c->getFirstChild()->getData();
303             } elsif ($name=~m/^(reDate|acDate|trDate)$/)
304             {
305 0           $rinfo->{domain}->{$oname}->{$name}=$pd->parse_datetime($c->getFirstChild()->getData());
306             }
307 0           } continue { $c=$c->getNextSibling(); }
308 0           return;
309             }
310              
311             sub trade_request
312             {
313 0     0 0   my ($epp,$domain,$rd)=@_;
314 0           my $mes=$epp->message();
315              
316 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
317 0           $mes->command_extension($eid,['dnslu:command',['dnslu:trade',{op=>'request'},['dnslu:domain',build_command($domain),build_transfer_trade_restore($rd)]]]);
318 0           return;
319             }
320              
321             sub trade_parse
322             {
323 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
324 0           my $mes=$po->message();
325 0 0         return unless $mes->is_success();
326              
327 0           parse_transfer_trade_restore($po,$otype,$oaction,$oname,$rinfo,'traData');
328 0           return;
329             }
330              
331             sub trade_query
332             {
333 0     0 0   my ($epp,$domain,$rd)=@_;
334 0           my $mes=$epp->message();
335              
336 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
337 0           $mes->command_extension($eid,['dnslu:command',['dnslu:trade',{op=>'query'},['dnslu:domain',build_command($domain)]]]);
338 0           return;
339             }
340              
341             sub trade_cancel
342             {
343 0     0 0   my ($epp,$domain,$rd)=@_;
344 0           my $mes=$epp->message();
345              
346 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
347 0           $mes->command_extension($eid,['dnslu:command',['dnslu:trade',{op=>'cancel'},['dnslu:domain',build_command($domain)]]]);
348 0           return;
349             }
350              
351             sub transfer_trade_request
352             {
353 0     0 0   my ($epp,$domain,$rd)=@_;
354 0           my $mes=$epp->message();
355              
356 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
357 0           $mes->command_extension($eid,['dnslu:command',['dnslu:transferTrade',{op=>'request'},['dnslu:domain',build_command($domain),build_transfer_trade_restore($rd)]]]);
358 0           return;
359             }
360              
361             sub transfer_trade_parse
362             {
363 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
364 0           my $mes=$po->message();
365 0 0         return unless $mes->is_success();
366              
367 0           parse_transfer_trade_restore($po,$otype,$oaction,$oname,$rinfo,'trnTraData');
368 0           return;
369             }
370              
371             sub transfer_trade_query
372             {
373 0     0 0   my ($epp,$domain,$rd)=@_;
374 0           my $mes=$epp->message();
375              
376 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
377 0           $mes->command_extension($eid,['dnslu:command',['dnslu:transferTrade',{op=>'query'},['dnslu:domain',build_command($domain)]]]);
378 0           return;
379             }
380              
381             sub transfer_trade_cancel
382             {
383 0     0 0   my ($epp,$domain,$rd)=@_;
384 0           my $mes=$epp->message();
385              
386 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
387 0           $mes->command_extension($eid,['dnslu:command',['dnslu:transferTrade',{op=>'cancel'},['dnslu:domain',build_command($domain)]]]);
388 0           return;
389             }
390              
391             sub transfer_restore_request
392             {
393 0     0 0   my ($epp,$domain,$rd)=@_;
394 0           my $mes=$epp->message();
395              
396 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
397 0           $mes->command_extension($eid,['dnslu:command',['dnslu:transferRestore',{op=>'request'},['dnslu:domain',build_command($domain),build_transfer_trade_restore($rd)]]]);
398 0           return;
399             }
400              
401             sub transfer_restore_parse
402             {
403 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
404 0           my $mes=$po->message();
405 0 0         return unless $mes->is_success();
406              
407 0           parse_transfer_trade_restore($po,$otype,$oaction,$oname,$rinfo,'trnResData');
408 0           return;
409             }
410              
411             sub transfer_restore_query
412             {
413 0     0 0   my ($epp,$domain,$rd)=@_;
414 0           my $mes=$epp->message();
415              
416 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
417 0           $mes->command_extension($eid,['dnslu:command',['dnslu:transferRestore',{op=>'query'},['dnslu:domain',build_command($domain)]]]);
418 0           return;
419             }
420              
421             sub transfer_restore_cancel
422             {
423 0     0 0   my ($epp,$domain,$rd)=@_;
424 0           my $mes=$epp->message();
425              
426 0           my $eid=build_command_extension($mes,$epp,'dnslu:ext');
427 0           $mes->command_extension($eid,['dnslu:command',['dnslu:transferRestore',{op=>'cancel'},['dnslu:domain',build_command($domain)]]]);
428 0           return;
429             }
430              
431             ####################################################################################################
432             1;