File Coverage

blib/lib/Net/DRI/Protocol/OpenSRS/XCP/Host.pm
Criterion Covered Total %
statement 12 38 31.5
branch 0 8 0.0
condition 0 8 0.0
subroutine 4 8 50.0
pod 0 4 0.0
total 16 66 24.2


line stmt bran cond sub pod time code
1             package Net::DRI::Protocol::OpenSRS::XCP::Host;
2             #===============================================================================
3             #
4             # FILE: Host.pm
5             #
6             # DESCRIPTION:
7             #
8             # FILES: ---
9             # BUGS: ---
10             # NOTES: ---
11             # AUTHOR: Dmitry Belyavsky (BelDmit),
12             # COMPANY: tcinet.ru
13             # VERSION: 1.0
14             # CREATED: 04/27/2012 04:10:40 PM MSK
15             # REVISION: ---
16             #===============================================================================
17              
18 1     1   1217 use strict;
  1         2  
  1         24  
19 1     1   3 use warnings;
  1         2  
  1         18  
20              
21 1     1   3 use Net::DRI::Exception;
  1         2  
  1         12  
22 1     1   3 use Net::DRI::Util;
  1         1  
  1         286  
23              
24             sub register_commands
25             {
26 0     0 0   my ($class,$version)=@_;
27 0           my %tmp=(
28             # info => [\&info, \&info_parse ],
29             # create => [ \&create, \&create_parse ],
30             # delete => [ \&delete, ],
31             # update => [\&update, undef],
32             #
33             registry_add => [\®istry_add, ],
34             registry_check => [\®istry_check, \®istry_check_parse],
35             );
36              
37 0           return { 'nameserver' => \%tmp };
38             }
39              
40             ####################################################################################################
41             ########### Query commands
42              
43             sub registry_check
44             {
45 0     0 0   my ($xcp, $hostname, $registry) = @_;
46 0           my $msg=$xcp->message();
47 0           my %r = (action => 'registry_check_nameserver', object => 'nameserver');
48              
49 0           $msg->command(\%r);
50 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('Missing or bad registry') unless ($registry && $registry =~ /^\./);
51 0           my $attr = {fqdn => $hostname, tld => $registry};
52 0           $msg->command_attributes($attr);
53 0           return;
54             }
55              
56             sub registry_check_parse
57             {
58 0     0 0   my ($xcp,$otype,$oaction,$oname,$rinfo)=@_;
59 0           my $mes=$xcp->message();
60 0 0         return if($mes->response_code() >= 400);
61              
62 0           $rinfo->{nameserver}->{$oname}->{action}='registry_check_nameserver';
63 0           my $ra=$mes->response_attributes();
64              
65 0 0         $rinfo->{nameserver}->{$oname}->{exists} = $ra->{is_success} ? 1 : 0;
66 0           return;
67             }
68              
69             ############ Transform commands
70              
71             sub registry_add
72             {
73 0     0 0   my ($xcp, $hostname, $rd) = @_;
74 0           my $msg=$xcp->message();
75 0           my %r = (action => 'registry_add_ns', object => 'nameserver');
76              
77 0           $msg->command(\%r);
78 0 0 0       Net::DRI::Exception::usererr_insufficient_parameters('Missing or bad registry') unless ($rd->{tld} && $rd->{tld} =~ /^\./);
79 0   0       my $attr = {fqdn => $hostname, tld => $rd->{tld}, all => $rd->{all} || 0};
80 0           $msg->command_attributes($attr);
81 0           return;
82             }
83              
84             1;