File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/FCCN/Domain.pm
Criterion Covered Total %
statement 15 117 12.8
branch 0 52 0.0
condition 0 18 0.0
subroutine 5 17 29.4
pod 0 12 0.0
total 20 216 9.2


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .PT Domain EPP extension commands
2             ##
3             ## Copyright (c) 2008,2013-2014 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::FCCN::Domain;
16              
17 1     1   1656 use strict;
  1         1  
  1         30  
18 1     1   13 use warnings;
  1         5  
  1         23  
19              
20 1     1   4 use Net::DRI::Exception;
  1         2  
  1         17  
21 1     1   4 use Net::DRI::Util;
  1         3  
  1         15  
22 1     1   4 use DateTime::Duration;
  1         2  
  1         1357  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::EPP::Extensions::FCCN::Domain - FCCN (.PT) 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-2014 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             create => [ \&create, \&create_parse ],
71             info => [ \&info, \&info_parse ],
72             update => [ \&update ],
73             renew => [ \&renew ],
74             renounce => [ \&renounce ],
75             delete => [ \&delete ],
76             transfer_request => [ \&transfer_request ],
77             );
78              
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:ptdomain="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('ptdomain')));
88             }
89              
90             sub create
91             {
92 0     0 0   my ($epp,$domain,$rd)=@_;
93 0           my $mes=$epp->message();
94              
95 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('Registrant contact required for .PT domain name creation') unless (Net::DRI::Util::has_contact($rd) && $rd->{contact}->has_type('registrant'));
96 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('Tech contact required for .PT domain name creation') unless (Net::DRI::Util::has_contact($rd) && $rd->{contact}->has_type('tech'));
97              
98 0           foreach my $d (qw/legitimacy registration_basis auto_renew/)
99             {
100 0 0         Net::DRI::Exception::usererr_insufficient_parameters($d.' attribute is mandatory for .PT domain name creation') unless Net::DRI::Util::has_key($rd,$d);
101             }
102 0           foreach my $d (qw/auto_renew/)
103             {
104 0 0 0       Net::DRI::Exception::usererr_invalid_parameters($d.' must be either 0 or 1 for .PT domain name creation') unless ($rd->{$d}==0 || $rd->{$d}==1);
105             }
106              
107 0           my @n;
108 0           push @n,['ptdomain:legitimacy',{type => $rd->{legitimacy}}];
109 0           push @n,['ptdomain:registration_basis',{type => $rd->{registration_basis}}];
110 0           push @n,['ptdomain:autoRenew',$rd->{auto_renew}];
111 0           my $eid=build_command_extension($mes,$epp,'ptdomain:create');
112 0           $mes->command_extension($eid,\@n);
113 0           return;
114             }
115              
116             sub create_parse
117             {
118 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
119 0           my $mes=$po->message();
120 0 0         return unless $mes->is_success();
121              
122 0           my $credata=$mes->get_extension('ptdomain','creData');
123 0 0         return unless $credata;
124              
125 0           my $c=$credata->getFirstChild();
126 0           while($c)
127             {
128 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
129 0   0       my $n=$c->localname() || $c->nodeName();
130 0 0         if ($n eq 'roid')
131             {
132 0           $rinfo->{domain}->{$oname}->{roid}=$c->getFirstChild()->getData();
133             }
134 0           } continue { $c=$c->getNextSibling(); }
135 0           return;
136             }
137              
138             sub add_roid
139             {
140 0     0 0   my ($roid)=@_;
141 0           return ['ptdomain:roid',$roid];
142             }
143              
144             sub info
145             {
146 0     0 0   my ($epp,$domain,$rd)=@_;
147 0           my $mes=$epp->message();
148              
149 0 0         Net::DRI::Exception::usererr_insufficient_parameters('roid attribute required for .PT domain name info') unless (Net::DRI::Util::has_key($rd,'roid'));
150              
151 0           my $eid=build_command_extension($mes,$epp,'ptdomain:info');
152 0           my @n=add_roid($rd->{roid});
153 0           $mes->command_extension($eid,\@n);
154 0           return;
155             }
156              
157             sub info_parse
158             {
159 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
160 0           my $mes=$po->message();
161 0 0         return unless $mes->is_success();
162              
163 0           my $infdata=$mes->get_extension('ptdomain','infData');
164 0 0         return unless $infdata;
165              
166 0           my $c=$infdata->getFirstChild();
167 0           while($c)
168             {
169 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
170 0   0       my $name=$c->localname() || $c->nodeName();
171 0 0         next unless $name;
172              
173 0 0         if ($name=~m/^(?:legitimacy|registration_basis)$/)
    0          
    0          
174             {
175 0           $rinfo->{domain}->{$oname}->{$name}=$c->getAttribute('type');
176             } elsif ($name=~m/^(?:autoRenew|notRenew|nextPossibleRegistration|addPeriod|waitingRemoval)$/)
177             {
178 0           $rinfo->{domain}->{$oname}->{Net::DRI::Util::remcam($name)}=Net::DRI::Util::xml_parse_boolean($c->getFirstChild()->getData());
179             } elsif ($name eq 'renew')
180             {
181 0           $rinfo->{domain}->{$oname}->{renew_period}=DateTime::Duration->new(years => $c->getAttribute('period'));
182             }
183 0           } continue { $c=$c->getNextSibling(); }
184 0           return;
185             }
186              
187             sub update
188             {
189 0     0 0   my ($epp,$domain,$toc,$rd)=@_;
190 0           my $mes=$epp->message();
191              
192 0 0         Net::DRI::Exception::usererr_insufficient_parameters('roid attribute required for .PT domain name update') unless (Net::DRI::Util::has_key($rd,'roid'));
193              
194 0           my $eid=build_command_extension($mes,$epp,'ptdomain:update');
195 0           my @n=add_roid($rd->{roid});
196 0           $mes->command_extension($eid,\@n);
197 0           return;
198             }
199              
200             sub renew
201             {
202 0     0 0   my ($epp,$domain,$rd)=@_;
203 0           my $mes=$epp->message();
204              
205 0 0         Net::DRI::Exception::usererr_insufficient_parameters('roid attribute required for .PT domain name renew') unless (Net::DRI::Util::has_key($rd,'roid'));
206              
207 0           my $c=Net::DRI::Util::has_key($rd,'duration');
208 0           foreach my $d (qw/auto_renew not_renew/)
209             {
210 0 0         next unless Net::DRI::Util::has_key($rd,$d);
211 0 0 0       Net::DRI::Exception::usererr_invalid_parameters($d.' must be either 0 or 1 for .PT domain name creation') unless ($rd->{$d}==0 || $rd->{$d}==1);
212 0           $c+=$rd->{$d};
213             }
214 0 0         Net::DRI::Exception::usererr_invalid_parameters('only one of duration, auto_renew and not_renew attributes can be set for .PT domain name renew') if $c > 1;
215              
216 0           my $eid=build_command_extension($mes,$epp,'ptdomain:renew');
217 0           my @n=add_roid($rd->{roid});
218 0 0         push @n,['ptdomain:autoRenew',$rd->{auto_renew}] if Net::DRI::Util::has_key($rd,'auto_renew');
219 0 0         push @n,['ptdomain:notRenew',$rd->{not_renew}] if Net::DRI::Util::has_key($rd,'not_renew');
220 0           $mes->command_extension($eid,\@n);
221 0           return;
222             }
223              
224             sub renounce
225             {
226 0     0 0   my ($epp,$domain,$rd)=@_;
227 0           my $mes=$epp->message();
228              
229 0 0         Net::DRI::Exception::usererr_insufficient_parameters('roid attribute required for .PT domain name renounce') unless (Net::DRI::Util::has_key($rd,'roid'));
230              
231 0           my $eid=build_command_extension($mes,$epp,'ptdomain:renounce');
232 0           my @n=(['ptdomain:name',$domain]);
233 0           push @n,add_roid($rd->{roid});
234 0           push @n,['ptdomain:clTRID',$mes->cltrid()];
235 0           $mes->command_extension($eid,\@n);
236 0           return;
237             }
238              
239             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
240             {
241 0     0 0   my ($epp,$domain,$rd)=@_;
242 0           my $mes=$epp->message();
243              
244 0 0         Net::DRI::Exception::usererr_insufficient_parameters('roid attribute required for .PT domain name delete') unless (Net::DRI::Util::has_key($rd,'roid'));
245              
246 0           my $eid=build_command_extension($mes,$epp,'ptdomain:delete');
247 0           my @n=add_roid($rd->{roid});
248 0           $mes->command_extension($eid,\@n);
249 0           return;
250             }
251              
252             sub transfer_request
253             {
254 0     0 0   my ($epp,$domain,$rd)=@_;
255 0           my $mes=$epp->message();
256              
257 0 0         Net::DRI::Exception::usererr_insufficient_parameters('you have to specify authinfo for .PT domain transfer (mapped to transferKey)') unless Net::DRI::Util::has_auth($rd);
258              
259 0           my $eid=build_command_extension($mes,$epp,'ptdomain:transfer');
260 0           $mes->command_extension($eid,['ptdomain:transferKey',$rd->{"auth"}->{"pw"}]);
261 0           return;
262             }
263              
264             ####################################################################################################
265             1;