File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/TCI/Domain.pm
Criterion Covered Total %
statement 15 89 16.8
branch 0 48 0.0
condition 0 18 0.0
subroutine 5 10 50.0
pod 0 5 0.0
total 20 170 11.7


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