File Coverage

blib/lib/Net/DRI/Protocol/EPP/Extensions/VeriSign/Suggestion.pm
Criterion Covered Total %
statement 12 114 10.5
branch 0 64 0.0
condition 0 15 0.0
subroutine 4 10 40.0
pod 0 6 0.0
total 16 209 7.6


line stmt bran cond sub pod time code
1             ## Domain Registry Interface, VeriSign EPP Suggestion Extension
2             ##
3             ## Copyright (c) 2010,2012,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::VeriSign::Suggestion;
16              
17 1     1   942 use strict;
  1         2  
  1         27  
18 1     1   5 use warnings;
  1         2  
  1         20  
19              
20 1     1   4 use Net::DRI::Util;
  1         2  
  1         15  
21 1     1   5 use Net::DRI::Exception;
  1         1  
  1         1216  
22              
23             ####################################################################################################
24              
25             sub register_commands
26             {
27 0     0 0   my ($class,$version)=@_;
28              
29 0           return { 'domain' => { 'suggestion' => [ \&suggestion, \&parse ],
30             } };
31             }
32              
33             sub setup
34             {
35 0     0 0   my ($class,$po,$version)=@_;
36 0           $po->ns({ 'suggestion' => [ 'http://www.verisign-grs.com/epp/suggestion-1.1','suggestion-1.1.xsd' ] });
37 0           return;
38             }
39              
40             ####################################################################################################
41              
42             sub suggestion
43             {
44 0     0 0   my ($epp,$domain,$rd)=@_;
45              
46 0 0         Net::DRI::Exception::usererr_insufficient_parameters('suggestion domain/key must be a string of up to 32 characters') unless Net::DRI::Util::xml_is_string($domain,1,32);
47 0           my @d;
48 0           push @d,['suggestion:key',$domain];
49              
50 0 0         if (Net::DRI::Util::has_key($rd,'language'))
51             {
52 0 0         Net::DRI::Exception::usererr_invalid_parameters('language value must be of XML language type') unless Net::DRI::Util::xml_is_language($rd->{language});
53 0           push @d,['suggestion:language',$rd->{language}];
54             }
55              
56 0           my @f;
57 0 0         if (Net::DRI::Util::has_key($rd,'filter_id'))
58             {
59 0 0         Net::DRI::Exception::usererr_invalid_parameters('filter_id must be an integer') unless $rd->{filter_id}=~m/^\d+$/;
60 0           push @d,['suggestion:filterid',$rd->{filter_id}];
61             } else
62             {
63 0           my %f;
64 0           foreach my $k (qw/contentfilter customfilter usehyphens usenumbers/)
65             {
66 0 0 0       $f{$k}=$rd->{$k} if Net::DRI::Util::has_key($rd,$k) && Net::DRI::Util::xml_is_boolean($rd->{$k});
67             }
68 0 0         if (Net::DRI::Util::has_key($rd,'view'))
69             {
70 0 0         Net::DRI::Exception::usererr_invalid_parameters('view must be either table or grid') unless $rd->{view}=~m/^(?:table|grid)$/;
71 0           $f{view}=$rd->{view};
72             }
73 0 0         if (Net::DRI::Util::has_key($rd,'forsale'))
74             {
75 0 0         Net::DRI::Exception::usererr_invalid_parameters('forsale must be either off, low, medium or high') unless $rd->{forsale}=~m/^(?:off|low|medium|high)$/;
76 0           $f{forsale}=$rd->{forsale};
77             }
78 0 0         if (Net::DRI::Util::has_key($rd,'maxlength'))
79             {
80 0 0         Net::DRI::Exception::usererr_invalid_parameters('maxlength must be a number between 1 and 63') unless Net::DRI::Util::verify_int($rd->{maxlength},1,63);
81 0           $f{maxlength}=$rd->{maxlength};
82             }
83 0 0         if (Net::DRI::Util::has_key($rd,'maxresults'))
84             {
85 0 0         Net::DRI::Exception::usererr_invalid_parameters('maxresults must be a number between 1 and 100') unless Net::DRI::Util::verify_int($rd->{maxresults},1,100);
86 0           $f{maxresults}=$rd->{maxresults};
87             }
88              
89 0 0 0       if (Net::DRI::Util::has_key($rd,'action') && ref $rd->{action} eq 'HASH')
90             {
91 0           foreach my $action (sort { $a cmp $b } keys %{$rd->{action}})
  0            
  0            
92             {
93 0           my $weight=$rd->{action}->{$action};
94 0 0 0       Net::DRI::Exception::usererr_invalid_parameters(sprintf('weight for action "%s" myst be either off, low, medium or high',$action)) unless defined $weight && $weight=~/^(?:off|low|medium|high)$/;
95 0           push @f,['suggestion:action',{name => $action, weight => $weight }];
96             }
97             }
98 0 0         if (Net::DRI::Util::has_key($rd,'tld'))
99             {
100 0 0         foreach my $tld (ref $rd->{tld} eq 'ARRAY' ? @{$rd->{tld}} : ($rd->{tld}))
  0            
101             {
102 0 0 0       Net::DRI::Exception::usererr_invalid_parameters(sprintf('TLD must be 2 to 6 characters among a-zA-Z and not: ',defined $tld ? $tld : '')) unless defined $tld && $tld=~m/^[a-zA-Z]{2,6}$/;
    0          
103 0           push @f,['suggestion:tld',$tld];
104             }
105             }
106              
107 0 0 0       @f=(['suggestion:filter',\%f,@f]) if %f || @f;
108             }
109              
110 0 0         push @d,@f if @f;
111              
112 0           my $mes=$epp->message();
113 0           $mes->command(['info','suggestion:info',sprintf('xmlns:suggestion="%s" xsi:schemaLocation="%s %s"',$mes->nsattrs('suggestion'))]);
114 0           $mes->command_body(\@d);
115 0           return;
116             }
117              
118             sub parse
119             {
120 0     0 0   my ($po,$otype,$oaction,$oname,$rinfo)=@_;
121 0           my $mes=$po->message();
122 0 0         return unless $mes->is_success();
123              
124 0           my $infdata=$mes->get_response('suggestion','infData');
125 0 0         return unless defined $infdata;
126              
127 0           my $key;
128 0           my $ns=$mes->ns('suggestion');
129 0           foreach my $el (Net::DRI::Util::xml_list_children($infdata))
130             {
131 0           my ($n,$c)=@$el;
132 0 0         if ($n eq 'key')
    0          
    0          
    0          
133             {
134 0           $key=$c->textContent();
135 0           $rinfo->{domain}->{$key}->{action}='suggest';
136 0           $rinfo->{domain}->{$key}->{suggestions}={};
137             } elsif ($n eq 'language')
138             {
139 0           $rinfo->{domain}->{$key}->{suggestions}->{language}='ENG';
140             } elsif ($n eq 'token')
141             {
142 0           $rinfo->{domain}->{$key}->{suggestions}->{tokens}->{$c->getAttribute('name')}=[ map { $_->textContent() } (Net::DRI::Util::xml_traverse($c,$ns,'related')) ];
  0            
143             } elsif ($n eq 'answer')
144             {
145 0           my $ans=Net::DRI::Util::xml_traverse($c,$ns,'table');
146 0 0         if (defined $ans)
147             {
148 0           $rinfo->{domain}->{$key}->{suggestions}->{result_type}='table';
149 0           $rinfo->{domain}->{$key}->{suggestions}->{answer}=parse_table($ans,$ns);
150             }
151 0           $ans=Net::DRI::Util::xml_traverse($c,$ns,'grid');
152 0 0         if (defined $ans)
153             {
154 0           $rinfo->{domain}->{$key}->{suggestions}->{result_type}='grid';
155 0           $rinfo->{domain}->{$key}->{suggestions}->{answer}=parse_grid($ans,$ns);
156             }
157             }
158             }
159 0           return;
160             }
161              
162             sub parse_table
163             {
164 0     0 0   my ($node,$ns)=@_;
165 0           my %r;
166              
167 0           foreach my $row (Net::DRI::Util::xml_traverse($node,$ns,'row'))
168             {
169 0           my %d;
170 0           my $name=$row->getAttribute('name');
171 0           $d{score}=0+$row->getAttribute('score');
172 0           $d{status}=$row->getAttribute('status');
173 0           foreach my $key (qw/source morelikethis ppcvalue/)
174             {
175 0           my $v=$row->getAttribute($key);
176 0 0         next unless defined $v;
177 0           $d{$key}=$v;
178             }
179 0           $r{$name}=\%d;
180             }
181 0           return \%r;
182             }
183              
184              
185             sub parse_grid
186             {
187 0     0 0   my ($node,$ns)=@_;
188 0           my %r;
189              
190 0           foreach my $row (Net::DRI::Util::xml_traverse($node,$ns,'record'))
191             {
192 0           my %d;
193 0           my $name=$row->getAttribute('name');
194 0           foreach my $key (qw/source morelikethis ppcvalue/)
195             {
196 0           my $v=$row->getAttribute($key);
197 0 0         next unless defined $v;
198 0           $d{$key}=$v;
199             }
200 0           my %rr;
201 0           foreach my $cell (Net::DRI::Util::xml_traverse($row,$ns,'cell'))
202             {
203 0           my $tld=$cell->getAttribute('tld');
204 0           $rr{$tld}={ score => 0+$cell->getAttribute('score'), status => $cell->getAttribute('status'), %d };
205             }
206 0           $r{$name}=\%rr;
207             }
208 0           return \%r;
209             }
210             #########################################################################################################
211             1;
212              
213             __END__