File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/AusRegistry/KeyValue.pm
Criterion Covered Total %
statement 12 67 17.9
branch 0 22 0.0
condition n/a
subroutine 4 11 36.3
pod 0 7 0.0
total 16 107 14.9


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, EPP AusRegistry Key Value Extension
2             ##
3             ## Copyright (c) 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::EPP::Extensions::AusRegistry::KeyValue;
16              
17 1     1   795 use strict;
  1         1  
  1         29  
18 1     1   3 use warnings;
  1         2  
  1         20  
19              
20 1     1   4 use Net::DRI::Util;
  1         2  
  1         12  
21 1     1   3 use Net::DRI::Exception;
  1         2  
  1         573  
22              
23             ####################################################################################################
24              
25             sub register_commands
26             {
27 0     0 0   my ($class,$version)=@_;
28 0           my %tmp=(
29             info => [ undef , \&info_parse ],
30             create => [ \&create_build, undef ],
31             update => [ \&update_build, undef ],
32             );
33              
34 0           return { 'domain' => \%tmp };
35             }
36              
37             sub setup
38             {
39 0     0 0   my ($class,$po,$version)=@_;
40 0           $po->ns({ 'kv' => [ 'urn:X-ar:params:xml:ns:kv-1.0','kv-1.0.xsd' ],
41             });
42 0           return;
43             }
44              
45 0     0 0   sub capabilities_add { return ('domain_update','keyvalue',['set']); }
46              
47             ####################################################################################################
48              
49             ##
50             ##
51             ##
52             ## value1
53             ## value2
54             ##
55             ##
56             ##
57              
58             sub info_parse
59             {
60 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
61 0           my $mes=$po->message();
62 0 0         return unless $mes->is_success();
63              
64 0           my $data=$mes->get_extension('kv','infData');
65 0 0         return unless defined $data;
66              
67 0           my %kvs;
68 0           foreach my $el (Net::DRI::Util::xml_list_children($data))
69             {
70 0           my ($name,$node)=@$el;
71 0 0         if ($name eq 'kvlist')
72             {
73 0           my $kvname=$node->getAttribute('name');
74 0           my %kv;
75 0           foreach my $kvel (Net::DRI::Util::xml_list_children($node))
76             {
77 0           my ($kvelname,$kvelnode)=@$kvel;
78 0 0         if ($kvelname eq 'item')
79             {
80 0           $kv{$kvelnode->getAttribute('key')}=$kvelnode->textContent();
81             }
82             }
83 0           $kvs{$kvname}=\%kv;
84             }
85             }
86              
87 0           $rinfo->{domain}->{$oname}->{keyvalue}=\%kvs;
88 0           return;
89             }
90              
91             sub build_kvlists
92             {
93 0     0 0   my ($rd)=@_;
94 0 0         Net::DRI::Exception::usererr_invalid_parameters(qq{keyvalue parameter must be ref hash, not: }.$rd) unless ref $rd eq 'HASH';
95 0           my @kvs;
96 0           foreach my $kvlistname (sort { $a cmp $b } keys %$rd)
  0            
97             {
98 0 0         Net::DRI::Exception::usererr_invalid_parameters(qq{kvlist name "$kvlistname" must be an XML token}) unless Net::DRI::Util::xml_is_token($kvlistname);
99 0 0         Net::DRI::Exception::usererr_invalid_parameters(qq{value for kvlistname "$kvlistname" must be ref hash, not: }.$rd->{$kvlistname}) unless ref $rd->{$kvlistname} eq 'HASH';
100 0           my @kv;
101 0           foreach my $key (sort { $a cmp $b } keys %{$rd->{$kvlistname}})
  0            
  0            
102             {
103 0 0         Net::DRI::Exception::usererr_invalid_parameters(qq{item name "$key" (in kvlist name "$kvlistname") must be an XML token}) unless Net::DRI::Util::xml_is_token($key);
104 0           my $v=$rd->{$kvlistname}->{$key};
105 0 0         Net::DRI::Exception::usererr_invalid_parameters(qq{value "$v" for item name "$key" (in kvlist name "$kvlistname") must be an XML string}) unless Net::DRI::Util::xml_is_string($v);
106 0           push @kv,['kv:item',{key => $key},$v];
107             }
108 0           push @kvs,['kv:kvlist',{name => $kvlistname},@kv];
109             }
110 0           return @kvs;
111             }
112              
113             ##
114             ##
115             ##
116             ## value1
117             ## value2
118             ##
119             ##
120             ##
121              
122             sub create_build
123             {
124 0     0 0   my ($epp,$domain,$rd)=@_;
125 0           my $mes=$epp->message();
126              
127 0 0         return unless Net::DRI::Util::has_key($rd,'keyvalue');
128              
129 0           my $eid=$mes->command_extension_register('kv','create');
130 0           $mes->command_extension($eid,[build_kvlists($rd->{keyvalue})]);
131              
132 0           return;
133             }
134              
135             ##
136             ##
137             ##
138             ## value1
139             ## value2
140             ##
141             ##
142             ##
143              
144             sub update_build
145             {
146 0     0 0   my ($epp,$domain,$todo)=@_;
147 0           my $mes=$epp->message();
148              
149 0           my $toset=$todo->set('keyvalue');
150 0 0         return unless defined $toset;
151              
152 0           my $eid=$mes->command_extension_register('kv','update');
153 0           $mes->command_extension($eid,[build_kvlists($toset)]);
154              
155 0           return;
156             }
157              
158             ####################################################################################################
159             1;
160              
161             __END__