File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/PL/Domain.pm
Criterion Covered Total %
statement 18 98 18.3
branch 0 60 0.0
condition 0 39 0.0
subroutine 6 12 50.0
pod 0 6 0.0
total 24 215 11.1


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .PL Domain EPP extension commands
2             ##
3             ## Copyright (c) 2006,2008-2011,2013 Patrick Mevzek and Tonnerre Lombard .
4             ## 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::PL::Domain;
17              
18 1     1   1374 use strict;
  1         2  
  1         32  
19 1     1   3 use warnings;
  1         2  
  1         20  
20              
21 1     1   4 use Net::DRI::Exception;
  1         1  
  1         15  
22 1     1   3 use Net::DRI::Util;
  1         1  
  1         14  
23 1     1   4 use Net::DRI::Data::Hosts;
  1         1  
  1         9  
24 1     1   19 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         843  
25              
26             =pod
27              
28             =head1 NAME
29              
30             Net::DRI::Protocol::EPP::Extensions::PL::Domain - .PL EPP Domain extension commands for Net::DRI
31              
32             =head1 DESCRIPTION
33              
34             Please see the README file for details.
35              
36             =head1 SUPPORT
37              
38             For now, support questions should be sent to:
39              
40             Enetdri@dotandco.comE
41              
42             Please also see the SUPPORT file in the distribution.
43              
44             =head1 SEE ALSO
45              
46             Ehttp://www.dotandco.com/services/software/Net-DRI/E
47              
48             =head1 AUTHORS
49              
50             Patrick Mevzek, Enetdri@dotandco.comE
51             Tonnerre Lombard
52              
53             =head1 COPYRIGHT
54              
55             Copyright (c) 2006,2008-2011,2013 Patrick Mevzek and Tonnerre Lombard .
56             All rights reserved.
57              
58             This program is free software; you can redistribute it and/or modify
59             it under the terms of the GNU General Public License as published by
60             the Free Software Foundation; either version 2 of the License, or
61             (at your option) any later version.
62              
63             See the LICENSE file that comes with this distribution for more details.
64              
65             =cut
66              
67             ####################################################################################################
68              
69             sub register_commands
70             {
71 0     0 0   my ($class,$version)=@_;
72 0           my %tmp=(
73             create => [ \&create ],
74             update => [ \&update ],
75             info => [ undef, \&info_parse ],
76             );
77              
78 0           return { 'domain' => \%tmp };
79             }
80              
81             ####################################################################################################
82              
83             sub build_command_extension
84             {
85 0     0 0   my ($mes,$epp,$tag)=@_;
86 0           return $mes->command_extension_register($tag,sprintf('xmlns:extdom="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('pl_domain')));
87             }
88              
89             sub build_ns
90             {
91 0     0 0   my ($epp,$ns,$domain,$xmlns)=@_;
92 0 0         $xmlns='domain' unless defined($xmlns);
93 0           return map { [$xmlns . ':ns',$_] } $ns->get_names();
  0            
94             }
95              
96             sub create
97             {
98 0     0 0   my ($epp,$domain,$rd)=@_;
99 0           my $mes=$epp->message();
100              
101 0           my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'create',$domain);
102 0           my $def = $epp->default_parameters();
103              
104 0 0 0       if ($def && (ref($def) eq 'HASH') && exists($def->{domain_create}) && (ref($def->{domain_create}) eq 'HASH'))
      0        
      0        
105             {
106 0 0 0       $rd={} unless ($rd && (ref($rd) eq 'HASH') && keys(%$rd));
      0        
107 0           while(my ($k,$v)=each(%{$def->{domain_create}}))
  0            
108             {
109 0 0         next if exists($rd->{$k});
110 0           $rd->{$k}=$v
111             }
112             }
113              
114             ## Period, OPTIONAL
115 0 0         push @d,Net::DRI::Protocol::EPP::Util::build_period($rd->{duration}) if Net::DRI::Util::has_duration($rd);
116              
117             ## Nameservers, OPTIONAL
118 0 0         push @d,build_ns($epp,$rd->{ns},$domain) if Net::DRI::Util::has_ns($rd);
119              
120             ## Contacts, all OPTIONAL
121 0 0         if (Net::DRI::Util::has_contact($rd))
122             {
123 0           my $cs=$rd->{contact};
124 0           my @o=$cs->get('registrant');
125 0 0         push @d,['domain:registrant',$o[0]->srid()] if (@o);
126 0           push @d,Net::DRI::Protocol::EPP::Util::build_core_contacts($epp,$cs);
127             }
128              
129             ## AuthInfo
130 0 0         Net::DRI::Exception::usererr_insufficient_parameters("authInfo is mandatory") unless (Net::DRI::Util::has_auth($rd));
131 0           push @d,Net::DRI::Protocol::EPP::Util::domain_build_authinfo($epp,$rd->{auth});
132 0           $mes->command_body(\@d);
133              
134 0 0 0       return unless exists($rd->{reason}) || exists($rd->{book});
135              
136 0           my $eid=build_command_extension($mes,$epp,'extdom:create');
137              
138 0           my @e;
139 0 0 0       push @e,['extdom:reason',$rd->{reason}] if (exists($rd->{reason}) && $rd->{reason});
140 0 0 0       push @e,['extdom:book'] if (exists($rd->{book}) && $rd->{book});
141              
142 0           $mes->command_extension($eid,\@e);
143 0           return;
144             }
145              
146             sub update
147             {
148 0     0 0   my ($epp,$domain,$todo)=@_;
149 0           my $mes=$epp->message();
150              
151 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
152              
153 0           my @d=Net::DRI::Protocol::EPP::Util::domain_build_command($mes,'update',$domain);
154              
155 0           my $nsadd=$todo->add('ns');
156 0           my $nsdel=$todo->del('ns');
157 0           my $sadd=$todo->add('status');
158 0           my $sdel=$todo->del('status');
159 0           my $cadd=$todo->add('contact');
160 0           my $cdel=$todo->del('contact');
161 0           my (@add,@del);
162              
163 0 0 0       push @add,build_ns($epp,$nsadd,$domain) if $nsadd && !$nsadd->is_empty();
164 0 0         push @add,Net::DRI::Protocol::EPP::Util::build_core_contacts($epp,$cadd) if $cadd;
165 0 0         push @add,$sadd->build_xml('domain:status','core') if $sadd;
166 0 0 0       push @del,build_ns($epp,$nsdel,$domain,undef,1) if $nsdel && !$nsdel->is_empty();
167 0 0         push @del,Net::DRI::Protocol::EPP::Util::build_core_contacts($epp,$cdel) if $cdel;
168 0 0         push @del,$sdel->build_xml('domain:status','core') if $sdel;
169              
170 0 0         push @d,['domain:add',@add] if @add;
171 0 0         push @d,['domain:rem',@del] if @del;
172              
173 0           my $chg=$todo->set('registrant');
174 0           my @chg;
175 0 0         push @chg,['domain:registrant',$chg->srid()] if Net::DRI::Util::isa_contact($chg,'Net::DRI::Data::Contact::PL');
176 0           $chg=$todo->set('auth');
177 0 0 0       push @chg,Net::DRI::Protocol::EPP::Util::domain_build_authinfo($epp,$chg,1) if ($chg && (ref $chg eq 'HASH') && exists $chg->{pw});
      0        
178 0 0         push @d,['domain:chg',@chg] if @chg;
179 0           $mes->command_body(\@d);
180 0           return;
181             }
182              
183             sub info_parse
184             {
185 0     0 0   my ($po, $otype, $oaction, $oname, $rinfo) = @_;
186 0           my $mes = $po->message();
187 0 0         return unless $mes->is_success();
188 0           my $infdata = $mes->get_response('domain','infData');
189 0 0         return unless $infdata;
190 0           my $ns = Net::DRI::Data::Hosts->new();
191 0           my $c = $infdata->getFirstChild();
192              
193 0           while ($c)
194             {
195 0 0         next unless ($c->nodeType() == 1); ## only for element nodes
196 0   0       my $name = $c->localname() || $c->nodeName();
197 0 0         next unless $name;
198              
199 0 0         if ($name eq 'name')
    0          
200             {
201 0           $oname = lc($c->getFirstChild()->getData());
202             }
203             elsif ($name eq 'ns')
204             {
205 0           $ns->add($c->getFirstChild()->getData());
206             }
207 0           } continue { $c = $c->getNextSibling(); }
208              
209 0           $rinfo->{domain}->{$oname}->{ns} = $ns;
210 0           return;
211             }
212              
213             ####################################################################################################
214             1;