File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/NAME/EmailFwd.pm
Criterion Covered Total %
statement 21 145 14.4
branch 0 52 0.0
condition 0 14 0.0
subroutine 7 18 38.8
pod 0 11 0.0
total 28 240 11.6


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, EPP Email forwarding extension commands
2             ## (based on .NAME Technical Accreditation Guide v3.03)
3             ##
4             ## Copyright (c) 2007,2008,2013 Tonnerre Lombard . 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::NAME::EmailFwd;
17              
18 1     1   1155 use strict;
  1         1  
  1         29  
19 1     1   5 use warnings;
  1         2  
  1         18  
20              
21 1     1   5 use Net::DRI::Util;
  1         1  
  1         14  
22 1     1   3 use Net::DRI::Exception;
  1         2  
  1         14  
23 1     1   4 use Net::DRI::Data::Contact;
  1         2  
  1         10  
24 1     1   26 use Net::DRI::Data::ContactSet;
  1         1  
  1         14  
25 1     1   4 use DateTime::Format::ISO8601;
  1         1  
  1         1461  
26              
27             =pod
28              
29             =head1 NAME
30              
31             Net::DRI::Protocol::EPP::Extensions::NAME::EmailFwd - EPP EmailFwd extension commands for Net::DRI
32              
33             =head1 DESCRIPTION
34              
35             Please see the README file for details.
36              
37             =head1 SUPPORT
38              
39             For now, support questions should be sent to:
40              
41             Enetdri@dotandco.comE
42              
43             Please also see the SUPPORT file in the distribution.
44              
45             =head1 SEE ALSO
46              
47             Ehttp://www.dotandco.com/services/software/Net-DRI/E or
48             Ehttp://oss.bsdprojects.net/projects/netdri/E
49              
50             =head1 AUTHOR
51              
52             Tonnerre Lombard, Etonnerre.lombard@sygroup.chE
53              
54             =head1 COPYRIGHT
55              
56             Copyright (c) 2007,2008,2013 Tonnerre Lombard .
57             All rights reserved.
58              
59             This program is free software; you can redistribute it and/or modify
60             it under the terms of the GNU General Public License as published by
61             the Free Software Foundation; either version 2 of the License, or
62             (at your option) any later version.
63              
64             See the LICENSE file that comes with this distribution for more details.
65              
66             =cut
67              
68             ####################################################################################################
69              
70             sub register_commands
71             {
72 0     0 0   my ($class,$version)=@_;
73 0           my %tmp1=( create => [ \&create ],
74             check => [ \&check, \&check_parse ],
75             info => [ \&info, \&info_parse ],
76             delete => [ \&delete ],
77             update => [ \&update ],
78             renew => [ \&renew ]
79             );
80              
81 0           $tmp1{check_multi}=$tmp1{check};
82            
83 0           return { 'emailfwd' => \%tmp1 };
84             }
85              
86             sub ns
87             {
88 0     0 0   my ($mes)=@_;
89 0           my $ns=$mes->ns('emailFwd');
90 0 0         return defined($ns)? $ns : 'http://www.nic.name/epp/emailFwd-1.0';
91             }
92              
93             sub build_command
94             {
95 0     0 0   my ($epp,$msg,$command,$info)=@_;
96 0           my $contacts = $info->{contact};
97 0           my $authid = $info->{auth};
98 0           my @ret;
99             my @auth;
100              
101 0           delete $info->{contact};
102 0           delete $info->{auth};
103              
104 0 0         Net::DRI::Exception->die(1,'protocol/EPP',2,'emailFwd name needed') unless (defined($info->{name}));
105              
106 0           my @ns=$msg->nsattrs('emailFwd');
107 0 0         @ns=qw(http://www.nic.name/epp/emailFwd-1.0 http://www.nic.name/epp/emailFwd-1.0 emailFwd-1.0.xsd) unless @ns;
108 0           $msg->command([$command,'emailFwd:'.$command,sprintf('xmlns:emailFwd="%s" xsi:schemaLocation="%s %s"',@ns)]);
109              
110             # @ret = map { ['emailFwd:' . $_, $info->{$_}] } keys(%{$info});
111 0 0         push(@ret, ['emailFwd:name', $info->{name}]) if (defined($info->{name}));
112 0 0         push(@ret, ['emailFwd:fwdTo', $info->{fwdTo}]) if (defined($info->{fwdTo}));
113 0 0         push(@ret, ['emailFwd:curExpDate', $info->{curExpDate}])
114             if (defined($info->{curExpDate}));
115 0 0         push(@ret, ['emailFwd:period', { unit => 'y' },
116             $info->{period}->in_units('years')]) if (defined($info->{period}));
117 0 0         push(@ret, ['emailFwd:registrant', $info->{registrant}]) if (defined($info->{registrant}));
118 0           foreach my $type (sort { $a cmp $b } keys %$contacts)
  0            
119             {
120 0           push(@ret, ['emailFwd:contact', {type => $type}, $contacts->{$type}]);
121             }
122              
123 0           foreach my $auth (sort { $a cmp $b } keys %$authid)
  0            
124             {
125 0           push(@auth, ['emailFwd:' . $auth, $authid->{$auth}]);
126             }
127 0 0         push(@ret, ['emailFwd:authInfo', @auth]) if (@auth);
128              
129 0           return @ret;
130             }
131              
132             ####################################################################################################
133             ########### Query commands
134              
135             sub check
136             {
137 0     0 0   my $epp=shift;
138 0           my $info=shift;
139 0           my $mes=$epp->message();
140 0           my @d=build_command($epp,$mes,'check', { name => $info });
141 0           $mes->command_body(\@d);
142 0           return;
143             }
144              
145             sub check_parse
146             {
147 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
148 0           my $mes=$po->message();
149 0 0         return unless $mes->is_success();
150              
151 0           my $ns=ns('emailFwd');
152 0           my $chkdata=$mes->get_response($ns,'chkData');
153 0 0         return unless $chkdata;
154 0           foreach my $cd ($chkdata->getElementsByTagNameNS($ns,'cd'))
155             {
156 0           my $c = $cd->getFirstChild();
157 0           my $fwd;
158              
159 0           while($c)
160             {
161 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
162 0   0       my $n=$c->localname() || $c->nodeName();
163 0 0         if ($n eq 'name')
164             {
165 0           $fwd = $c->getFirstChild()->getData();
166 0           $rinfo->{emailFwd}->{$fwd}->{exist} = 1 -
167             Net::DRI::Util::xml_parse_boolean($c->getAttribute('avail'));
168 0           $rinfo->{emailFwd}->{$fwd}->{action} = 'check';
169             }
170 0           } continue { $c = $c->getNextSibling(); }
171             }
172 0           return;
173             }
174              
175             sub info
176             {
177 0     0 0   my ($epp,$mail)=@_;
178 0           my $mes = $epp->message();
179 0           my @d = build_command($epp,$mes,'info',{ name => $mail });
180 0           $mes->command_body(\@d);
181 0           return;
182             }
183              
184             sub info_parse
185             {
186 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
187 0           my $mes=$po->message();
188 0 0         return unless $mes->is_success();
189              
190 0           my $infdata=$mes->get_response(ns($mes),'infData');
191 0 0         return unless $infdata;
192              
193 0           my $nm;
194 0           my $cs = Net::DRI::Data::ContactSet->new();
195 0           my $info = {};
196 0           my $ginfo = {};
197              
198 0           my $c=$infdata->getFirstChild();
199 0           while ($c)
200             {
201 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
202 0   0       my $name=$c->localname() || $c->nodeName();
203 0 0         next unless $name;
204              
205 0 0         if ($name eq 'name')
    0          
    0          
    0          
    0          
    0          
206             {
207 0           $info->{name} = $nm = $c->getFirstChild()->getData();
208             }
209             elsif ($name eq 'fwdTo')
210 0           {
211 0           $info->{$name} = $c->getFirstChild()->getData();
212             }
213             elsif (grep { $_ eq $name } qw/clID crID upID/)
214 0           {
215 0           $ginfo->{$name} = $c->getFirstChild()->getData();
216             }
217             elsif (grep { $_ eq $name } qw/crDate upDate trDate exDate/)
218 0           {
219 0           $ginfo->{$name} = DateTime::Format::ISO8601()->new()->
220             parse_datetime($c->getFirstChild()->getData());
221             }
222             elsif (grep { $_ eq $name } qw/registrant contact/)
223             {
224 0   0       my $type = $c->getAttribute('type') || 'registrant';
225 0           $cs->add(Net::DRI::Data::Contact()->new()->
226             srid($c->getFirstChild()->getData()), $type);
227             }
228             elsif ($name eq 'authInfo')
229             {
230 0           my $pw = ($c->getElementsByTagNameNS($mes->ns('emailFwd'),'pw'))[0];
231 0 0 0       $ginfo->{auth} = { pw => (defined($pw) && $pw->hasChildNodes() ?
232             $pw->getFirstChild->getData() : undef) };
233             }
234 0           } continue { $c=$c->getNextSibling(); }
235              
236 0           $info->{contact} = $cs;
237              
238 0           $ginfo->{exist} = defined($nm);
239 0           $ginfo->{action} = 'info';
240 0           $ginfo->{self} = $info;
241 0           $rinfo->{emailFwd}->{$nm} = $ginfo;
242 0           return;
243             }
244              
245             ############ Transform commands
246              
247             sub create
248             {
249 0     0 0   my ($epp,$mail,$info)=@_;
250 0           my $mes = $epp->message();
251 0           my @d;
252 0           $info->{name} = $mail;
253 0           @d = build_command($epp,$mes,'create',$info);
254 0           $mes->command_body(\@d);
255 0           return;
256             }
257              
258             sub delete ## no critic (Subroutines::ProhibitBuiltinHomonyms)
259             {
260 0     0 0   my ($epp,$mail)=@_;
261 0           my $mes=$epp->message();
262 0           my @d=build_command($epp,$mes,'delete',{ name => $mail });
263 0           $mes->command_body(\@d);
264 0           return;
265             }
266              
267             sub update
268             {
269 0     0 0   my ($epp,$hosts,$todo)=@_;
270 0           my $mes=$epp->message();
271              
272 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
273              
274 0 0 0       if ((grep { ! /^(?:ns)$/ } $todo->types()) || (grep { ! /^(?:set)$/ } $todo->types('ns') ))
  0            
  0            
275             {
276 0           Net::DRI::Exception->die(0,'protocol/EPP',11,'Only ns set available for nsgroup');
277             }
278              
279 0           my $ns=$todo->set('ns');
280 0           my @d=build_command($epp,$mes,'update',$hosts);
281 0           push @d,add_nsname($ns);
282 0           $mes->command_body(\@d);
283 0           return;
284             }
285              
286             sub renew
287             {
288 0     0 0   my ($epp,$mail,$period,$curexp)=@_;
289 0           my $mes = $epp->message();
290              
291 0           Net::DRI::Util::check_isa($curexp,'DateTime');
292 0           Net::DRI::Util::check_isa($period,'DateTime::Duration');
293              
294 0           my $info = {
295             name => $mail,
296             curExpDate => $curexp->ymd,
297             period => $period
298             };
299              
300 0           my @d = build_command($epp,$mes,'renew',$info);
301 0           $mes->command_body(\@d);
302 0           return;
303             }
304              
305             ####################################################################################################
306             1;