File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/TCI/Registrar.pm
Criterion Covered Total %
statement 15 110 13.6
branch 0 52 0.0
condition 0 16 0.0
subroutine 5 9 55.5
pod 0 4 0.0
total 20 191 10.4


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, .RU/.SU/.XN--P1AI EPP REgistrar 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::Registrar;
17              
18 1     1   985 use strict;
  1         3  
  1         34  
19 1     1   5 use warnings;
  1         2  
  1         20  
20              
21 1     1   7 use Net::DRI::Util;
  1         2  
  1         15  
22 1     1   4 use Net::DRI::Exception;
  1         1  
  1         16  
23 1     1   4 use DateTime::Format::ISO8601;
  1         1  
  1         848  
24              
25             ####################################################################################################
26              
27             sub register_commands
28             {
29 0     0 0   my ($class,$version)=@_;
30 0           my %tmp=(
31             update => [ \&update, ],
32             info => [ \&info, \&info_parse ],
33             );
34              
35 0           return { 'registrar' => \%tmp };
36             }
37              
38             ####################################################################################################
39              
40             sub update
41             {
42 0     0 0   my ($epp,$registrar,$todo)=@_;
43 0           my $mes=$epp->message();
44              
45 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);
46              
47 0           my $ip_add=$todo->add('ip');
48 0           my $ip_del=$todo->del('ip');
49              
50 0           my $email_add=$todo->add('email');
51 0           my $email_del=$todo->del('email');
52              
53 0           my @d;
54 0           push @d, ['registrar:id', $registrar];
55 0           my (@add,@del);
56 0 0         if ($email_add)
57             {
58 0           foreach my $key (sort { $a cmp $b } keys %$email_add)
  0            
59             {
60 0           my @emails = @{$email_add->{$key}};
  0            
61              
62 0           foreach my $email (@emails)
63             {
64 0           push @add, ['registrar:email', $email, {'type' => $key}];
65             }
66             }
67             }
68 0 0         if ($ip_add)
69             {
70 0           foreach my $ip (@$ip_add)
71             {
72 0           push @add, ['registrar:addr', $ip, {'ip' => 'v4'}];
73             }
74             }
75              
76 0 0         if ($email_del)
77             {
78 0           foreach my $key (sort { $a cmp $b } keys %$email_del)
  0            
79             {
80 0           my @emails = @{$email_add->{$key}};
  0            
81              
82 0           foreach my $email (@emails)
83             {
84 0           push @del, ['registrar:email', $email, {'type' => $key}];
85             }
86             }
87             }
88              
89 0 0         if ($ip_del)
90             {
91 0           foreach my $ip (@$ip_del)
92             {
93 0           push @del, ['registrar:addr', $ip, {'ip' => 'v4'}];
94             }
95             }
96              
97             $mes->command(
98 0           ['update','registrar:update',sprintf('xmlns:registrar="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('registrar')),]
99             );
100 0 0         push @d,['registrar:add',@add] if @add;
101 0 0         push @d,['registrar:rem',@del] if @del;
102              
103 0           my @chg;
104 0           my $chg = $todo->set('voice');
105 0           for my $str (@$chg)
106             {
107 0           push @chg,['registrar:voice',$str];
108             }
109            
110 0           $chg = $todo->set('fax');
111 0           for my $str (@$chg)
112             {
113 0           push @chg,['registrar:fax',$str];
114             }
115              
116 0           $chg=$todo->set('www');
117 0 0         push @chg,['registrar:www',$chg] if $chg;
118            
119 0           $chg = $todo->set('whois');
120 0 0         push @chg,['registrar:whois',$chg] if $chg;
121              
122 0 0         push @d,['registrar:chg',@chg] if @chg;
123              
124 0           $mes->command_body(\@d);
125 0           return;
126             }
127              
128             sub info
129             {
130 0     0 0   my ($epp,$registrar,$rd)=@_;
131              
132 0           my $mes=$epp->message();
133              
134 0           $mes->command(
135             ['info','registrar:info',sprintf('xmlns:registrar="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('registrar')),]
136             );
137 0           $mes->command_body(['registrar:id', $registrar]);
138 0           return;
139             }
140              
141             sub info_parse
142             {
143 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
144 0           my $mes=$po->message();
145 0 0         return unless $mes->is_success();
146              
147 0           my $infdata=$mes->get_response("registrar", "infData");
148 0 0         return unless defined $infdata;
149              
150 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
151             {
152 0           my ($name,$c)=@$el;
153              
154 0 0         if($name eq 'id')
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
155             {
156 0           $rinfo->{registrar}->{info}->{id} = $c->textContent();
157             }
158             elsif($name eq 'status')
159             {
160 0   0       $rinfo->{registrar}->{info}->{status} ||= [];
161 0           push @{$rinfo->{registrar}->{info}->{status}}, $c->textContent();
  0            
162             }
163             elsif($name eq 'intPostalInfo')
164             {
165 0   0       $rinfo->{registrar}->{info}->{intPostalInfo} ||= [];
166 0           push @{$rinfo->{registrar}->{info}->{intPostalInfo}}, $c->textContent();
  0            
167             }
168             elsif($name eq 'locPostalInfo')
169             {
170 0   0       $rinfo->{registrar}->{info}->{locPostalInfo} ||= [];
171 0           push @{$rinfo->{registrar}->{info}->{locPostalInfo}}, $c->textContent();
  0            
172             }
173             elsif($name eq 'legalInfo')
174             {
175 0   0       $rinfo->{registrar}->{info}->{legalInfo} ||= [];
176 0           push @{$rinfo->{registrar}->{info}->{legalInfo}}, $c->textContent();
  0            
177             }
178             elsif($name eq 'taxpayerNumbers')
179             {
180 0           $rinfo->{registrar}->{info}->{taxpayerNumbers} = $c->textContent();
181             }
182             elsif($name eq 'voice')
183             {
184 0   0       $rinfo->{registrar}->{info}->{voice} ||= [];
185 0           push @{$rinfo->{registrar}->{info}->{voice}}, $c->textContent();
  0            
186             }
187             elsif($name eq 'fax')
188             {
189 0   0       $rinfo->{registrar}->{info}->{fax} ||= [];
190 0           push @{$rinfo->{registrar}->{info}->{fax}}, $c->textContent();
  0            
191             }
192             elsif($name eq 'email')
193             {
194 0           my $email_type = $c->getAttribute( "type" );
195 0   0       $rinfo->{registrar}->{info}->{email}{$email_type} ||= [];
196 0           push @{$rinfo->{registrar}->{info}->{email}{$email_type}}, $c->textContent();
  0            
197             }
198             elsif($name eq 'www')
199             {
200 0           $rinfo->{registrar}->{info}->{www} = $c->textContent();
201             }
202             elsif($name eq 'whois')
203             {
204 0           $rinfo->{registrar}->{info}->{whois} = $c->textContent();
205             }
206             elsif($name eq 'addr')
207             {
208 0   0       $rinfo->{registrar}->{info}->{addr} ||= [];
209 0           push @{$rinfo->{registrar}->{info}->{addr}}, $c->textContent();
  0            
210             }
211             elsif($name eq 'crDate')
212             {
213 0           $rinfo->{registrar}->{info}->{crDate} = DateTime::Format::ISO8601->new()->parse_datetime($c->textContent());
214             }
215             elsif($name eq 'upDate')
216             {
217 0           $rinfo->{registrar}->{info}->{upDate} = DateTime::Format::ISO8601->new()->parse_datetime($c->textContent());
218             }
219             }
220 0           return;
221             }
222              
223             ####################################################################################################
224             1;
225              
226             =pod
227              
228             =head1 NAME
229              
230             Net::DRI::Protocol::EPP::Extensions::TCI::Registrar - TCI EPP Registrar Extension for Net::DRI
231              
232             =head1 DESCRIPTION
233              
234             Please see the README file for details.
235              
236             =head1 SUPPORT
237              
238             For now, support questions should be sent to:
239              
240             Enetdri@dotandco.comE
241              
242             Please also see the SUPPORT file in the distribution.
243              
244             =head1 SEE ALSO
245              
246             Ehttp://www.dotandco.com/services/software/Net-DRI/E
247              
248             =head1 AUTHOR
249              
250             Dmitry Belyavsky, Ebeldmit@gmail.comE
251             Patrick Mevzek, Enetdri@dotandco.comE
252              
253             =head1 COPYRIGHT
254              
255             Copyright (c) 2010-2011 Dmitry Belyavsky
256             Copyright (c) 2011-2014 Patrick Mevzek .
257             All rights reserved.
258              
259             This program is free software; you can redistribute it and/or modify
260             it under the terms of the GNU General Public License as published by
261             the Free Software Foundation; either version 2 of the License, or
262             (at your option) any later version.
263              
264             See the LICENSE file that comes with this distribution for more details.
265              
266             =cut