File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/UnitedTLD/Charge.pm
Criterion Covered Total %
statement 18 111 16.2
branch 0 70 0.0
condition 0 3 0.0
subroutine 6 20 30.0
pod 0 12 0.0
total 24 216 11.1


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, Charge Extension Mapping for EPP
2             ##
3             ## Copyright (c) 2015 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::UnitedTLD::Charge;
16              
17 1     1   678 use strict;
  1         2  
  1         22  
18 1     1   3 use warnings;
  1         1  
  1         19  
19 1     1   3 use feature 'state';
  1         1  
  1         43  
20              
21 1     1   3 use Net::DRI::Util;
  1         1  
  1         13  
22 1     1   3 use Net::DRI::Exception;
  1         9  
  1         20  
23 1     1   3 use Net::DRI::Protocol::EPP::Util;
  1         1  
  1         1183  
24              
25             ####################################################################################################
26              
27             sub register_commands
28             {
29 0     0 0   my ($class,$version)=@_;
30              
31 0           state $rops = { 'domain' => { check => [ undef, \&check_parse ],
32             check_multi => [ undef, \&check_parse ],
33             create => [ \&add_agreement, \&create_parse ],
34             info => [ undef, \&info_parse ],
35             renew => [ \&add_agreement, \&renew_parse ],
36             transfer_request => [ \&add_agreement, \&transfer_parse ],
37             update => [ \&update_build, \&update_parse ],
38             }
39             };
40              
41 0           return $rops;
42             }
43              
44             sub setup
45             {
46 0     0 0   my ($class,$po,$version)=@_;
47 0           state $ns = { 'charge' => [ 'http://www.unitedtld.com/epp/charge-1.0','charge-1.0.xsd' ] };
48 0           $po->ns($ns);
49 0           return;
50             }
51              
52 0     0 0   sub implements { return 'http://rightside.co/fileadmin/downloads/policies/Rightside_Price_Categories.pdf'; }
53              
54             ####################################################################################################
55              
56             sub _parse_set
57             {
58 0     0     my ($node)=@_;
59              
60 0           my %s;
61 0           foreach my $el (Net::DRI::Util::xml_list_children($node))
62             {
63 0           my ($name,$node)=@$el;
64 0 0         if ($name eq 'category')
    0          
    0          
65             {
66 0           my $v=$node->textContent();
67 0 0         $s{category}=$node->hasAttribute('name') ? { name => $node->getAttribute('name'), value => $v } : $v;
68             } elsif ($name eq 'type')
69             {
70 0           my $v=$node->textContent();
71 0 0         $s{type}=$node->hasAttribute('name') ? { name => $node->getAttribute('name'), value => $v } : $v;
72             } elsif ($name eq 'amount')
73             {
74 0           my $key=$node->getAttribute('command');
75 0 0         $key.='.'.$node->getAttribute('name') if $node->hasAttribute('name');
76 0           $s{$key}=0+$node->textContent();
77             }
78             }
79 0           return \%s;
80             }
81              
82             sub check_parse
83             {
84 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
85 0           my $mes=$po->message();
86 0 0         return unless $mes->is_success();
87              
88 0           my $data=$mes->get_extension('charge','chkData');
89 0 0         return unless defined $data;
90              
91 0           foreach my $cd (grep { $_->[0] eq 'cd' } Net::DRI::Util::xml_list_children($data))
  0            
92             {
93 0           my ($domain,@p);
94 0           foreach my $el (Net::DRI::Util::xml_list_children($cd->[1]))
95             {
96 0           my ($name,$node)=@$el;
97 0 0         if ($name eq 'name')
    0          
98             {
99 0           $domain=$node->textContent();
100             } elsif ($name eq 'set')
101             {
102 0           push @p,_parse_set($node);
103             }
104             }
105 0 0         $rinfo->{$otype}->{$domain}->{price}=@p > 1 ? \@p : $p[0];
106             }
107              
108 0           return;
109             }
110              
111             sub add_agreement
112             {
113 0     0 0   my ($epp,$domain,$rp)=@_;
114 0           my $mes=$epp->message();
115              
116 0 0         return unless Net::DRI::Util::has_key($rp,'price');
117              
118 0           my @d;
119 0 0         foreach my $charge (ref $rp->{price} eq 'ARRAY' ? @{$rp->{price}} : ($rp->{price}))
  0            
120             {
121 0           push @d,['charge:set',add_set($charge)];
122             }
123              
124 0           my $eid=$mes->command_extension_register('charge','agreement');
125 0           $mes->command_extension($eid,\@d);
126 0           return;
127             }
128              
129             sub add_set
130             {
131 0     0 0   my ($charge)=@_;
132 0 0         Net::DRI::Exception::usererr_invalid_parameters('price element must be ref hash') unless ref $charge eq 'HASH';
133              
134 0           my @d;
135              
136 0 0         Net::DRI::Exception::usererr_insufficient_parameters('missing category element in price structure') unless Net::DRI::Util::has_key($charge,'category');
137 0 0         if (ref $charge->{category} eq 'HASH')
138             {
139 0 0         Net::DRI::Exception::usererr_insufficient_parameters('category missing value') unless Net::DRI::Util::has_key($charge->{category},'value');
140 0 0         Net::DRI::Exception::usererr_invalid_parameters('category value must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{category}->{value});
141 0 0         Net::DRI::Exception::usererr_insufficient_parameters('category missing name') unless Net::DRI::Util::has_key($charge->{category},'name');
142 0 0         Net::DRI::Exception::usererr_invalid_parameters('category name must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{category}->{name});
143 0           push @d,['charge:category',{ name => $charge->{category}->{name} },$charge->{category}->{value}];
144             } else
145             {
146 0 0         Net::DRI::Exception::usererr_invalid_parameters('category must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{category});
147 0           push @d,['charge:category',$charge->{category}];
148             }
149              
150 0 0         Net::DRI::Exception::usererr_insufficient_parameters('missing type element in price structure') unless Net::DRI::Util::has_key($charge,'type');
151 0 0         if ($charge->{type} eq 'HASH')
152             {
153 0 0         Net::DRI::Exception::usererr_insufficient_parameters('type missing value') unless Net::DRI::Util::has_key($charge->{type},'value');
154 0 0         Net::DRI::Exception::usererr_invalid_parameters('type value must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{type}->{value});
155 0 0         Net::DRI::Exception::usererr_insufficient_parameters('type missing name') unless Net::DRI::Util::has_key($charge->{type},'name');
156 0 0         Net::DRI::Exception::usererr_invalid_parameters('type name must be an XML token') unless Net::DRI::Util::xml_is_token($charge->{type}->{name});
157 0           push @d,['charge:type',{ name => $charge->{type}->{name} },$charge->{type}->{value}];
158             } else
159             {
160 0 0         Net::DRI::Exception::usererr_invalid_parameters('type value must be "price", "fee" or "custom"') unless $charge->{type}=~m/^(?:price|fee|custom)$/;
161 0 0         Net::DRI::Exception::usererr_invalid_parameters('type name must be set if type value is "custom"') if $charge->{type} eq 'custom';
162 0           push @d,['charge:type',$charge->{type}];
163             }
164              
165 0           foreach my $key (sort { $a cmp $b } grep { ! /^(?:category|type)$/ } keys %$charge)
  0            
  0            
166             {
167 0           my ($command,$name)=split(/\./,$key);
168 0 0         push @d,['charge:amount',{ command => $command, defined $name ? (name => $name) : ()},0+$charge->{$key}];
169             }
170              
171 0           return @d;
172             }
173              
174             sub _parse
175             {
176 0     0     my ($po,$otype,$oaction,$oname,$rinfo,$topname)=@_;
177 0           my $mes=$po->message();
178 0 0         return unless $mes->is_success();
179              
180 0           my $data=$mes->get_extension('charge',$topname);
181 0 0         return unless defined $data;
182              
183 0           my @p=map { _parse_set($_) } Net::DRI::Util::xml_list_children($data,'set');
  0            
184 0 0         $rinfo->{$otype}->{$oname}->{price}=@p > 1 ? \@p : $p[0];
185 0           return;
186             }
187              
188 0     0 0   sub create_parse { return _parse(@_,'creData'); } ## no critic (Subroutines::RequireArgUnpacking)
189 0     0 0   sub info_parse { return _parse(@_,'infData'); } ## no critic (Subroutines::RequireArgUnpacking)
190 0     0 0   sub renew_parse { return _parse(@_,'renData'); } ## no critic (Subroutines::RequireArgUnpacking)
191 0     0 0   sub transfer_parse { return _parse(@_,'trnData'); } ## no critic (Subroutines::RequireArgUnpacking)
192 0     0 0   sub update_parse { return _parse(@_,'upData'); } ## no critic (Subroutines::RequireArgUnpacking)
193              
194             sub update_build
195             {
196 0     0 0   my ($epp,$domain,$todo,$rp)=@_;
197              
198 0           my $rgp=$todo->set('rgp');
199 0 0 0       return unless Net::DRI::Util::has_key($rgp,'op') && $rgp->{op} eq 'request';
200 0 0         Net::DRI::Exception::usererr_insufficient_parameters('price structure is mandatory for a domain:update RGP request') unless Net::DRI::Util::has_key($rp,'price');
201 0           return add_agreement($epp,$domain,$rp);
202             }
203              
204              
205             ####################################################################################################
206             1;
207              
208             __END__