File Coverage

blib/lib/Net/DRI/Protocol/RRP/Core/Host.pm
Criterion Covered Total %
statement 43 101 42.5
branch 6 42 14.2
condition 2 35 5.7
subroutine 11 16 68.7
pod 0 10 0.0
total 62 204 30.3


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, RRP Host commands
2             ##
3             ## Copyright (c) 2005,2006,2008,2013 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::RRP::Core::Host;
16              
17 2     2   1258 use strict;
  2         3  
  2         48  
18 2     2   7 use warnings;
  2         2  
  2         40  
19              
20 2     2   7 use Net::DRI::Protocol::RRP;
  2         3  
  2         11  
21 2     2   42 use Net::DRI::Data::Hosts;
  2         3  
  2         10  
22 2     2   32 use Net::DRI::Util;
  2         2  
  2         2373  
23              
24             =pod
25              
26             =head1 NAME
27              
28             Net::DRI::Protocol::RRP::Core::Host - RRP Host 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) 2005,2006,2008,2013 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 1     1 0 3 my ($class,$version)=@_;
69 1         6 my %tmp=( create => [ \&add ],
70             check => [ \&check, \&check_parse ],
71             info => [ \&status, \&status_parse ],
72             delete => [ \&del ],
73             update => [ \&mod ],
74             );
75              
76 1         5 return { 'host' => \%tmp };
77             }
78              
79             sub build_msg
80             {
81 3     3 0 4 my ($msg,$command,$hostname)=@_;
82 3 50 33     11 ($hostname)=$hostname->get_names(1) if (defined($hostname) && ref($hostname));
83 3 50 33     12 Net::DRI::Exception->die(1,'protocol/RRP',3,"Host name needed") unless defined($hostname) && $hostname;
84 3 50       29 Net::DRI::Exception->die(1,'protocol/RRP',10,"Invalid host name") unless ($hostname=~m/^([a-z0-9]([a-z0-9\-]{0,61}[a-z0-9])?\.)*[a-z0-9]([a-z0-9\-]{0,61}[a-z0-9])?\.[a-z0-9]([a-z0-9\-]{0,61}[a-z0-9])?$/i); ## from RRP grammar
85 3 50       11 $msg->command($command) if defined($command);
86 3         19 $msg->entities('EntityName','NameServer');
87 3         37 $msg->entities('NameServer',uc $hostname);
88 3         3 return;
89             }
90              
91             sub add
92             {
93 0     0 0 0 my ($rrp,$ns)=@_;
94 0         0 my $mes=$rrp->message();
95 0         0 build_msg($mes,'add',$ns);
96 0         0 add_ip($mes,$ns,$rrp->version());
97 0         0 return;
98             }
99              
100             sub _basic_command
101             {
102 3     3   3 my ($command,$rrp,$ns)=@_;
103 3         7 my $mes=$rrp->message();
104 3         13 build_msg($mes,$command,$ns);
105 3         8 return;
106             }
107              
108 2     2 0 3 sub check { my (@args)=@_; return _basic_command('check',@args); }
  2         8  
109 0     0 0 0 sub status { my (@args)=@_; return _basic_command('status',@args); }
  0         0  
110 1     1 0 2 sub del { my (@args)=@_; return _basic_command('del',@args); }
  1         2  
111              
112             sub check_parse
113             {
114 2     2 0 3 my ($po,$otype,$oaction,$oname,$rinfo)=@_;
115 2         4 my $mes=$po->message();
116 2 50       19 return unless $mes->is_success();
117              
118 2         18 $rinfo->{host}->{$oname}->{action}='check';
119 2 50       4 if ($mes->errcode() == 213) ## nameserver exists
    0          
120             {
121 2         12 my @ip=$mes->entities('ipaddress');
122 2         7 $rinfo->{host}->{$oname}->{self}=Net::DRI::Data::Hosts->new($oname,\@ip);
123 2         3 $rinfo->{host}->{$oname}->{exist}=1;
124             } elsif ($mes->errcode() == 212) ## nameserver available
125             {
126 0         0 $rinfo->{host}->{$oname}->{exist}=0;
127             }
128 2         7 return;
129             }
130              
131             sub status_parse
132             {
133 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
134 0           my $mes=$po->message();
135 0 0         return unless $mes->is_success(); ## if operation succeeds, information should be there
136              
137 0           $rinfo->{host}->{$oname}->{exist}=1;
138 0           $rinfo->{host}->{$oname}->{action}='info';
139 0           while(my ($k,$v)=each(%Net::DRI::Protocol::RRP::DATES))
140             {
141 0           my $d=$mes->entities($k);
142 0 0         next unless $d;
143 0           $rinfo->{host}->{$oname}->{$v}=$po->{dt_parse}->parse_datetime($d);
144             }
145              
146 0           while(my ($k,$v)=each(%Net::DRI::Protocol::RRP::IDS))
147             {
148 0           my $d=$mes->entities($k);
149 0 0         next unless $d;
150 0           $rinfo->{host}->{$oname}->{$v}=$d;
151             }
152              
153 0           my @ip=$mes->entities('ipaddress');
154 0           $rinfo->{host}->{$oname}->{self}=Net::DRI::Data::Hosts->new($oname,\@ip);
155 0           return;
156             }
157              
158             sub mod
159             {
160 0     0 0   my ($rrp,$hostname,$todo)=@_;
161 0           my $mes=$rrp->message();
162              
163 0 0         Net::DRI::Exception::usererr_invalid_parameters($todo.' must be a Net::DRI::Data::Changes object') unless Net::DRI::Util::isa_changes($todo);
164 0 0 0       if ((grep { ! /^(?:ip|name)$/ } $todo->types()) ||
  0   0        
165 0           (grep { ! /^(?:add|del)$/ } $todo->types('ip')) ||
166 0           (grep { ! /^(?:set)$/ } $todo->types('name'))
167             )
168             {
169 0           Net::DRI::Exception->die(0,'protocol/RRP',11,'Only IP add/del or name set available for host');
170             }
171              
172 0           my $nsadd=$todo->add('ip');
173 0           my $nsdel=$todo->del('ip');
174 0           my $newname=$todo->set('name');
175            
176 0 0 0       unless (defined($hostname) && $hostname)
177             {
178 0 0 0       $hostname=$nsadd->get_names(1) if (defined($nsadd) && ref($nsadd) && $nsadd->can('get_names'));
      0        
179 0 0 0       $hostname=$nsdel->get_names(1) if (defined($nsdel) && ref($nsdel) && $nsdel->can('get_names'));
      0        
180             }
181 0           build_msg($mes,'mod',$hostname);
182              
183 0           my $version=$rrp->version();
184 0           add_ip($mes,$nsadd,$version);
185 0           add_ip($mes,$nsdel,$version,'=');
186 0 0 0       $mes->entities('NewNameServer',ref($newname)? $newname->get_names(1) : $newname) if (defined($newname) && $newname);
    0          
187 0           return;
188             }
189              
190             sub add_ip
191             {
192 0     0 0   my ($mes,$ns,$version,$extra)=@_;
193 0   0       $extra||='';
194 0 0 0       return unless (defined($ns) && ref($ns));
195 0           my ($name,$r4,$r6)=$ns->get_details(1);
196 0           my $c=1;
197 0 0         foreach my $ip (@$r4) { last if $c++>13; $mes->entities('IPAddress',$_.$extra); };
  0            
  0            
198 0           $c=1;
199 0 0         if ($version eq '2.0') { foreach my $ip (@$r6) { last if $c++>13; $mes->entities('IPAddress',$_.$extra); } }
  0 0          
  0            
  0            
200 0           return;
201             }
202              
203             #########################################################################################
204             1;