diff --git a/HISTORY.md b/HISTORY.md index 023db1a..84288af 100644 --- a/HISTORY.md +++ b/HISTORY.md @@ -1,3 +1,16 @@ +## [2.10.1](https://github.com/hexonet/perl-sdk/compare/v2.10.0...v2.10.1) (2021-01-25) + + +### Bug Fixes + +* **ci:** migrate from Travis CI to github actions ([292123f](https://github.com/hexonet/perl-sdk/commit/292123fcb51628041a95086786c13714099d0327)) +* **ci:** move POD Checks behind POD Generator ([8b99fbc](https://github.com/hexonet/perl-sdk/commit/8b99fbcd6d069d4b12080d2ba536d00f5d5bb02c)) + + +### Performance Improvements + +* **ci:** review perltidy script to a generic way ([4c3121b](https://github.com/hexonet/perl-sdk/commit/4c3121bff282225c339b82d89ecdf77491e3eab2)) + # [2.10.0](https://github.com/hexonet/perl-sdk/compare/v2.9.2...v2.10.0) (2020-07-16) diff --git a/WebService-Hexonet-Connector-latest.tar.gz b/WebService-Hexonet-Connector-latest.tar.gz index c987669..604bc74 100644 Binary files a/WebService-Hexonet-Connector-latest.tar.gz and b/WebService-Hexonet-Connector-latest.tar.gz differ diff --git a/cover_db/blib-lib-WebService-Hexonet-Connector-APIClient-pm.html b/cover_db/blib-lib-WebService-Hexonet-Connector-APIClient-pm.html index ab62205..c9d813c 100644 --- a/cover_db/blib-lib-WebService-Hexonet-Connector-APIClient-pm.html +++ b/cover_db/blib-lib-WebService-Hexonet-Connector-APIClient-pm.html @@ -26,29 +26,29 @@
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::APIClient; | ||||||
2 | |||||||
3 | 1 1 | 8 1 | use 5.030; | ||||
4 | 1 1 1 | 1 1 6 | use strict; | ||||
5 | 1 1 1 | 2 0 13 | use warnings; | ||||
6 | 1 1 1 | 184 5 4 | use utf8; | ||||
7 | 1 1 1 | 239 1 14 | use WebService::Hexonet::Connector::Logger; | ||||
8 | 1 1 1 | 286 1 15 | use WebService::Hexonet::Connector::Response; | ||||
9 | 1 1 1 | 3 1 11 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
10 | 1 1 1 | 280 2 15 | use WebService::Hexonet::Connector::SocketConfig; | ||||
11 | 1 1 1 | 242 18097 17 | use LWP::UserAgent; | ||||
12 | 1 1 1 | 4 0 29 | use Carp; | ||||
13 | 1 1 1 | 2 1 17 | use Readonly; | ||||
14 | 1 1 1 | 3 1 15 | use Data::Dumper; | ||||
15 | 1 1 1 | 1 1 15 | use Config; | ||||
16 | 1 1 1 | 2 1 4 | use POSIX; | ||||
2 | |||||||
3 | 1 1 | 9 2 | use 5.030; | ||||
4 | 1 1 1 | 2 1 13 | use strict; | ||||
5 | 1 1 1 | 2 1 16 | use warnings; | ||||
6 | 1 1 1 | 250 7 2 | use utf8; | ||||
7 | 1 1 1 | 269 1 14 | use WebService::Hexonet::Connector::Logger; | ||||
8 | 1 1 1 | 296 1 18 | use WebService::Hexonet::Connector::Response; | ||||
9 | 1 1 1 | 3 1 12 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
10 | 1 1 1 | 313 1 14 | use WebService::Hexonet::Connector::SocketConfig; | ||||
11 | 1 1 1 | 248 23492 21 | use LWP::UserAgent; | ||||
12 | 1 1 1 | 4 1 38 | use Carp; | ||||
13 | 1 1 1 | 2 1 20 | use Readonly; | ||||
14 | 1 1 1 | 2 2 19 | use Data::Dumper; | ||||
15 | 1 1 1 | 2 2 16 | use Config; | ||||
16 | 1 1 1 | 3 1 4 | use POSIX; | ||||
17 | |||||||
18 | Readonly my $SOCKETTIMEOUT => 300; # 300s or 5 min | ||||||
19 | Readonly my $IDX4 => 4; # Index 4 constant | ||||||
20 | Readonly our $ISPAPI_CONNECTION_URL => 'https://api.ispapi.net/api/call.cgi'; # Default Connection Setup URL | ||||||
21 | Readonly our $ISPAPI_CONNECTION_URL_PROXY => 'http://127.0.0.1/api/call.cgi'; # High Speed Connection Setup URL | ||||||
22 | |||||||
23 | 1 1 1 | 1014 11 4 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
22 | |||||||
23 | 1 1 1 | 1107 12 4 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
24 | |||||||
25 | my $rtm = WebService::Hexonet::Connector::ResponseTemplateManager->getInstance(); | ||||||
26 | |||||||
27 | |||||||
28 | sub new { | ||||||
29 | 2 | 1 | 7 | my $class = shift; | |||
30 | 2 | 9 | my $self = bless { | ||||
29 | 2 | 1 | 3 | my $class = shift; | |||
30 | 2 | 6 | my $self = bless { | ||||
31 | socketURL => $ISPAPI_CONNECTION_URL, | ||||||
32 | debugMode => 0, | ||||||
33 | socketConfig => WebService::Hexonet::Connector::SocketConfig->new(), | ||||||
35 | curlopts => {}, | ||||||
36 | logger => WebService::Hexonet::Connector::Logger->new() | ||||||
37 | }, $class; | ||||||
38 | 2 | 21 | $self->setURL($ISPAPI_CONNECTION_URL); | ||||
39 | 2 | 6 | $self->useLIVESystem(); | ||||
40 | 2 | 5 | $self->setDefaultLogger(); | ||||
41 | 2 | 4 | return $self; | ||||
38 | 2 | 12 | $self->setURL($ISPAPI_CONNECTION_URL); | ||||
39 | 2 | 2 | $self->useLIVESystem(); | ||||
40 | 2 | 3 | $self->setDefaultLogger(); | ||||
41 | 2 | 2 | return $self; | ||||
42 | } | ||||||
43 | |||||||
44 | |||||||
45 | sub setDefaultLogger { | ||||||
46 | 2 | 0 | 2 | my $self = shift; | |||
47 | 2 | 4 | $self->{logger} = WebService::Hexonet::Connector::Logger->new(); | ||||
47 | 2 | 3 | $self->{logger} = WebService::Hexonet::Connector::Logger->new(); | ||||
48 | 2 | 2 | return $self; | ||||
49 | } | ||||||
50 | |||||||
51 | |||||||
52 | sub setCustomLogger { | ||||||
57 | 0 | 0 | return $self; | ||||
58 | } | ||||||
59 | |||||||
60 | |||||||
61 | sub enableDebugMode { | ||||||
62 | 2 | 1 | 316 | my $self = shift; | |||
62 | 2 | 1 | 300 | my $self = shift; | |||
63 | 2 | 4 | $self->{debugMode} = 1; | ||||
64 | 2 | 4 | return $self; | ||||
64 | 2 | 5 | return $self; | ||||
65 | } | ||||||
66 | |||||||
67 | |||||||
68 | sub disableDebugMode { | ||||||
69 | 2 | 1 | 7 | my $self = shift; | |||
70 | 2 | 4 | $self->{debugMode} = 0; | ||||
71 | 2 | 4 | return $self; | ||||
69 | 2 | 1 | 4 | my $self = shift; | |||
70 | 2 | 3 | $self->{debugMode} = 0; | ||||
71 | 2 | 2 | return $self; | ||||
72 | } | ||||||
73 | |||||||
74 | |||||||
75 | sub getPOSTData { | ||||||
76 | 50 | 1 | 940 | my ( $self, $cmd, $secured ) = @_; | |||
76 | 50 | 1 | 838 | my ( $self, $cmd, $secured ) = @_; | |||
77 | 50 | 105 | my $post = $self->{socketConfig}->getPOSTData(); | ||||
78 | 50 | 119 | if ( defined($secured) && $secured == 1 ) { | ||||
79 | 18 | 50 | $post->{s_pw} = '***'; | ||||
78 | 50 | 113 | if ( defined($secured) && $secured == 1 ) { | ||||
79 | 18 | 24 | $post->{s_pw} = '***'; | ||||
80 | } | ||||||
81 | 50 | 50 | my $tmp = q{}; | ||||
82 | 50 | 72 | if ( ( ref $cmd ) eq 'HASH' ) { | ||||
83 | 49 49 | 47 109 | foreach my $key ( sort keys %{$cmd} ) { | ||||
84 | 91 | 103 | if ( defined $cmd->{$key} ) { | ||||
85 | 90 | 71 | my $val = $cmd->{$key}; | ||||
86 | 90 | 108 | $val =~ s/[\r\n]//msx; | ||||
87 | 90 | 130 | $tmp .= "${key}=${val}\n"; | ||||
81 | 50 | 58 | my $tmp = q{}; | ||||
82 | 50 | 74 | if ( ( ref $cmd ) eq 'HASH' ) { | ||||
83 | 49 49 | 53 116 | foreach my $key ( sort keys %{$cmd} ) { | ||||
84 | 91 | 115 | if ( defined $cmd->{$key} ) { | ||||
85 | 90 | 81 | my $val = $cmd->{$key}; | ||||
86 | 90 | 103 | $val =~ s/[\r\n]//msx; | ||||
87 | 90 | 128 | $tmp .= "${key}=${val}\n"; | ||||
88 | } | ||||||
89 | } | ||||||
90 | } else { | ||||||
91 | 1 | 2 | $tmp = $cmd; | ||||
91 | 1 | 1 | $tmp = $cmd; | ||||
92 | } | ||||||
93 | 50 | 88 | if ( defined($secured) && $secured == 1 ) { | ||||
94 | 18 | 31 | $tmp =~ s/PASSWORD\=[^\n]+/PASSWORD=***/gmsx; | ||||
93 | 50 | 99 | if ( defined($secured) && $secured == 1 ) { | ||||
94 | 18 | 43 | $tmp =~ s/PASSWORD\=[^\n]+/PASSWORD=***/gmsx; | ||||
95 | } | ||||||
96 | 50 | 111 | $tmp =~ s/\n$//msx; | ||||
97 | 50 | 80 | if ( utf8::is_utf8($tmp) ) { | ||||
96 | 50 | 116 | $tmp =~ s/\n$//msx; | ||||
97 | 50 | 88 | if ( utf8::is_utf8($tmp) ) { | ||||
98 | 2 | 3 | utf8::encode($tmp); | ||||
99 | } | ||||||
100 | 50 | 67 | $post->{'s_command'} = $tmp; | ||||
101 | 50 | 60 | return $post; | ||||
100 | 50 | 56 | $post->{'s_command'} = $tmp; | ||||
101 | 50 | 75 | return $post; | ||||
102 | } | ||||||
103 | |||||||
104 | |||||||
105 | sub getSession { | ||||||
106 | 2 | 1 | 6 | my $self = shift; | |||
106 | 2 | 1 | 4 | my $self = shift; | |||
107 | 2 | 5 | my $sessid = $self->{socketConfig}->getSession(); | ||||
108 | 2 | 6 | if ( length $sessid ) { | ||||
108 | 2 | 3 | if ( length $sessid ) { | ||||
109 | 1 | 2 | return $sessid; | ||||
110 | } | ||||||
111 | 1 | 2 | return; | ||||
111 | 1 | 1 | return; | ||||
112 | } | ||||||
113 | |||||||
114 | |||||||
115 | sub getURL { | ||||||
116 | 5 | 1 | 12 | my $self = shift; | |||
117 | 5 | 11 | return $self->{socketURL}; | ||||
116 | 5 | 1 | 10 | my $self = shift; | |||
117 | 5 | 10 | return $self->{socketURL}; | ||||
118 | } | ||||||
119 | |||||||
120 | |||||||
121 | sub getUserAgent { | ||||||
122 | 20 | 1 | 46 | my $self = shift; | |||
123 | 20 | 49 | if ( !( length $self->{ua} ) ) { | ||||
124 | 1 | 8 | my $arch = (POSIX::uname)[ $IDX4 ]; | ||||
125 | 1 | 5 | my $os = (POSIX::uname)[ 0 ]; | ||||
122 | 20 | 1 | 57 | my $self = shift; | |||
123 | 20 | 50 | if ( !( length $self->{ua} ) ) { | ||||
124 | 1 | 6 | my $arch = (POSIX::uname)[ $IDX4 ]; | ||||
125 | 1 | 6 | my $os = (POSIX::uname)[ 0 ]; | ||||
126 | 1 | 3 | my $rv = $self->getVersion(); | ||||
127 | 1 | 28 | $self->{ua} = "PERL-SDK ($os; $arch; rv:$rv) perl/$Config{version}"; | ||||
127 | 1 | 12 | $self->{ua} = "PERL-SDK ($os; $arch; rv:$rv) perl/$Config{version}"; | ||||
128 | } | ||||||
129 | 20 | 43 | return $self->{ua}; | ||||
129 | 20 | 46 | return $self->{ua}; | ||||
130 | } | ||||||
131 | |||||||
132 | |||||||
133 | sub setUserAgent { | ||||||
134 | 2 | 1 | 1115 | my ( $self, $str, $rv, $modules ) = @_; | |||
135 | 2 | 14 | my $arch = (POSIX::uname)[ $IDX4 ]; | ||||
136 | 2 | 13 | my $os = (POSIX::uname)[ 0 ]; | ||||
137 | 2 | 6 | my $rv2 = $self->getVersion(); | ||||
138 | 2 | 4 | my $mods = q{}; | ||||
139 | 2 | 10 | if ( defined $modules && length($modules) > 0 ) { | ||||
140 | 1 1 | 2 4 | $mods = q{ } . join q{ }, @{$modules}; | ||||
134 | 2 | 1 | 830 | my ( $self, $str, $rv, $modules ) = @_; | |||
135 | 2 | 7 | my $arch = (POSIX::uname)[ $IDX4 ]; | ||||
136 | 2 | 8 | my $os = (POSIX::uname)[ 0 ]; | ||||
137 | 2 | 3 | my $rv2 = $self->getVersion(); | ||||
138 | 2 | 2 | my $mods = q{}; | ||||
139 | 2 | 6 | if ( defined $modules && length($modules) > 0 ) { | ||||
140 | 1 1 | 1 2 | $mods = q{ } . join q{ }, @{$modules}; | ||||
141 | } | ||||||
142 | 2 | 16 | $self->{ua} = "$str ($os; $arch; rv:$rv)$mods perl-sdk/$rv2 perl/$Config{version}"; | ||||
143 | 2 | 10 | return $self; | ||||
142 | 2 | 10 | $self->{ua} = "$str ($os; $arch; rv:$rv)$mods perl-sdk/$rv2 perl/$Config{version}"; | ||||
143 | 2 | 6 | return $self; | ||||
144 | } | ||||||
145 | |||||||
146 | |||||||
147 | sub getProxy { | ||||||
148 | 19 | 1 | 33 | my ($self) = @_; | |||
149 | 19 | 33 | if ( exists $self->{curlopts}->{'PROXY'} ) { | ||||
150 | 1 | 4 | return $self->{curlopts}->{'PROXY'}; | ||||
149 | 19 | 42 | if ( exists $self->{curlopts}->{'PROXY'} ) { | ||||
150 | 1 | 1 | return $self->{curlopts}->{'PROXY'}; | ||||
151 | } | ||||||
152 | 18 | 21 | return; | ||||
152 | 18 | 26 | return; | ||||
153 | } | ||||||
154 | |||||||
155 | |||||||
156 | sub setProxy { | ||||||
157 | 2 | 1 | 5 | my ( $self, $proxy ) = @_; | |||
158 | 2 | 6 | if ( length($proxy) == 0 ) { | ||||
159 | 1 | 2 | delete $self->{curlopts}->{'PROXY'}; | ||||
157 | 2 | 1 | 2 | my ( $self, $proxy ) = @_; | |||
158 | 2 | 4 | if ( length($proxy) == 0 ) { | ||||
159 | 1 | 1 | delete $self->{curlopts}->{'PROXY'}; | ||||
160 | } else { | ||||||
161 | 1 | 3 | $self->{curlopts}->{'PROXY'} = $proxy; | ||||
161 | 1 | 2 | $self->{curlopts}->{'PROXY'} = $proxy; | ||||
162 | } | ||||||
163 | 2 | 3 | return $self; | ||||
163 | 2 | 2 | return $self; | ||||
164 | } | ||||||
165 | |||||||
166 | |||||||
167 | sub getReferer { | ||||||
168 | 19 | 1 | 38 | my ($self) = @_; | |||
169 | 19 | 41 | if ( exists $self->{curlopts}->{'REFERER'} ) { | ||||
170 | 1 | 4 | return $self->{curlopts}->{'REFERER'}; | ||||
168 | 19 | 1 | 34 | my ($self) = @_; | |||
169 | 19 | 45 | if ( exists $self->{curlopts}->{'REFERER'} ) { | ||||
170 | 1 | 2 | return $self->{curlopts}->{'REFERER'}; | ||||
171 | } | ||||||
172 | 18 | 24 | return; | ||||
172 | 18 | 41 | return; | ||||
173 | } | ||||||
174 | |||||||
175 | |||||||
176 | sub setReferer { | ||||||
177 | 2 | 1 | 389 | my ( $self, $referer ) = @_; | |||
178 | 2 | 5 | if ( length($referer) == 0 ) { | ||||
179 | 1 | 2 | delete $self->{curlopts}->{'REFERER'}; | ||||
177 | 2 | 1 | 333 | my ( $self, $referer ) = @_; | |||
178 | 2 | 4 | if ( length($referer) == 0 ) { | ||||
179 | 1 | 1 | delete $self->{curlopts}->{'REFERER'}; | ||||
180 | } else { | ||||||
181 | 1 | 3 | $self->{curlopts}->{'REFERER'} = $referer; | ||||
181 | 1 | 1 | $self->{curlopts}->{'REFERER'} = $referer; | ||||
182 | } | ||||||
183 | 2 | 4 | return $self; | ||||
183 | 2 | 2 | return $self; | ||||
184 | } | ||||||
185 | |||||||
186 | |||||||
187 | sub getVersion { | ||||||
188 | 4 | 1 | 16 | my $self = shift; | |||
189 | 4 | 10 | return $VERSION; | ||||
188 | 4 | 1 | 12 | my $self = shift; | |||
189 | 4 | 6 | return $VERSION; | ||||
190 | } | ||||||
191 | |||||||
192 | |||||||
193 | sub saveSession { | ||||||
194 | 1 | 1 | 6 | my ( $self, $session ) = @_; | |||
194 | 1 | 1 | 3 | my ( $self, $session ) = @_; | |||
195 | $session->{socketcfg} = { | ||||||
196 | entity => $self->{socketConfig}->getSystemEntity(), | ||||||
197 | session => $self->{socketConfig}->getSession() | ||||||
198 | 1 | 3 | }; | ||||
198 | 1 | 2 | }; | ||||
199 | 1 | 2 | return $self; | ||||
200 | } | ||||||
201 | |||||||
202 | |||||||
203 | sub reuseSession { | ||||||
207 | 1 | 1 | return $self; | ||||
208 | } | ||||||
209 | |||||||
210 | |||||||
211 | sub setURL { | ||||||
212 | 8 | 1 | 338 | my ( $self, $value ) = @_; | |||
213 | 8 | 34 | $self->{socketURL} = $value; | ||||
212 | 8 | 1 | 300 | my ( $self, $value ) = @_; | |||
213 | 8 | 24 | $self->{socketURL} = $value; | ||||
214 | 8 | 12 | return $self; | ||||
215 | } | ||||||
216 | |||||||
217 | |||||||
218 | sub setOTP { | ||||||
219 | 7 | 1 | 378 | my ( $self, $value ) = @_; | |||
220 | 7 | 25 | $self->{socketConfig}->setOTP($value); | ||||
221 | 7 | 11 | return $self; | ||||
219 | 7 | 1 | 416 | my ( $self, $value ) = @_; | |||
220 | 7 | 21 | $self->{socketConfig}->setOTP($value); | ||||
221 | 7 | 7 | return $self; | ||||
222 | } | ||||||
223 | |||||||
224 | |||||||
225 | sub setSession { | ||||||
226 | 12 | 1 | 2103 | my ( $self, $value ) = @_; | |||
227 | 12 | 37 | $self->{socketConfig}->setSession($value); | ||||
228 | 12 | 13 | return $self; | ||||
226 | 12 | 1 | 2053 | my ( $self, $value ) = @_; | |||
227 | 12 | 32 | $self->{socketConfig}->setSession($value); | ||||
228 | 12 | 14 | return $self; | ||||
229 | } | ||||||
230 | |||||||
231 | |||||||
232 | sub setRemoteIPAddress { | ||||||
233 | 3 | 1 | 375 | my ( $self, $value ) = @_; | |||
234 | 3 | 8 | $self->{socketConfig}->setRemoteAddress($value); | ||||
235 | 3 | 4 | return $self; | ||||
233 | 3 | 1 | 313 | my ( $self, $value ) = @_; | |||
234 | 3 | 6 | $self->{socketConfig}->setRemoteAddress($value); | ||||
235 | 3 | 2 | return $self; | ||||
236 | } | ||||||
237 | |||||||
238 | |||||||
239 | sub setCredentials { | ||||||
240 | 11 | 1 | 1120 | my ( $self, $uid, $pw ) = @_; | |||
241 | 11 | 38 | $self->{socketConfig}->setLogin($uid); | ||||
242 | 11 | 25 | $self->{socketConfig}->setPassword($pw); | ||||
243 | 11 | 59 | return $self; | ||||
240 | 11 | 1 | 1063 | my ( $self, $uid, $pw ) = @_; | |||
241 | 11 | 32 | $self->{socketConfig}->setLogin($uid); | ||||
242 | 11 | 22 | $self->{socketConfig}->setPassword($pw); | ||||
243 | 11 | 15 | return $self; | ||||
244 | } | ||||||
245 | |||||||
246 | |||||||
247 | sub setRoleCredentials { | ||||||
248 | 3 | 1 | 1093 | my ( $self, $uid, $role, $pw ) = @_; | |||
249 | 3 | 6 | my $myuid = "${uid}!${role}"; | ||||
250 | 3 | 8 | $myuid =~ s/^\!$//msx; | ||||
248 | 3 | 1 | 1117 | my ( $self, $uid, $role, $pw ) = @_; | |||
249 | 3 | 3 | my $myuid = "${uid}!${role}"; | ||||
250 | 3 | 6 | $myuid =~ s/^\!$//msx; | ||||
251 | 3 | 6 | return $self->setCredentials( $myuid, $pw ); | ||||
252 | } | ||||||
253 | |||||||
254 | |||||||
255 | sub login { | ||||||
256 | 3 | 1 | 9 | my $self = shift; | |||
257 | 3 | 6 | my $otp = shift; | ||||
258 | 3 | 17 | $self->setOTP( $otp || q{} ); | ||||
259 | 3 | 11 | my $rr = $self->request( { COMMAND => 'StartSession' } ); | ||||
260 | 3 | 12 | if ( $rr->isSuccess() ) { | ||||
256 | 3 | 1 | 10 | my $self = shift; | |||
257 | 3 | 5 | my $otp = shift; | ||||
258 | 3 | 16 | $self->setOTP( $otp || q{} ); | ||||
259 | 3 | 12 | my $rr = $self->request( { COMMAND => 'StartSession' } ); | ||||
260 | 3 | 13 | if ( $rr->isSuccess() ) { | ||||
261 | 1 | 2 | my $col = $rr->getColumn('SESSION'); | ||||
262 | 1 | 1 | my $sessid = q{}; | ||||
262 | 1 | 2 | my $sessid = q{}; | ||||
263 | 1 | 2 | if ( defined $col ) { | ||||
264 | 1 | 3 | my @d = $col->getData(); | ||||
265 | 1 | 1 | $sessid = $d[ 0 ]; | ||||
265 | 1 | 2 | $sessid = $d[ 0 ]; | ||||
266 | } | ||||||
267 | 1 | 3 | $self->setSession($sessid); | ||||
268 | } | ||||||
269 | 3 | 35 | return $rr; | ||||
269 | 3 | 36 | return $rr; | ||||
270 | } | ||||||
271 | |||||||
272 | |||||||
273 | sub loginExtended { | ||||||
274 | 1 | 1 | 2 | my $self = shift; | |||
274 | 1 | 1 | 4 | my $self = shift; | |||
275 | 1 | 2 | my $params = shift; | ||||
276 | 1 | 2 | my $otpc = shift; | ||||
277 | 1 | 13 | if ( !defined $otpc ) { | ||||
278 | 1 | 2 | $otpc = q{}; | ||||
277 | 1 | 15 | if ( !defined $otpc ) { | ||||
278 | 1 | 3 | $otpc = q{}; | ||||
279 | } | ||||||
280 | 1 | 3 | $self->setOTP($otpc); | ||||
281 | 1 | 2 | my $cmd = { COMMAND => 'StartSession' }; | ||||
282 | 1 1 | 2 3 | foreach my $key ( keys %{$params} ) { | ||||
283 | 1 | 3 | $cmd->{$key} = $params->{$key}; | ||||
280 | 1 | 4 | $self->setOTP($otpc); | ||||
281 | 1 | 4 | my $cmd = { COMMAND => 'StartSession' }; | ||||
282 | 1 1 | 2 5 | foreach my $key ( keys %{$params} ) { | ||||
283 | 1 | 4 | $cmd->{$key} = $params->{$key}; | ||||
284 | } | ||||||
285 | 1 | 3 | my $rr = $self->request($cmd); | ||||
286 | 1 | 4 | if ( $rr->isSuccess() ) { | ||||
287 | 1 | 3 | my $col = $rr->getColumn('SESSION'); | ||||
288 | 1 | 1 | my $sessid = q{}; | ||||
285 | 1 | 5 | my $rr = $self->request($cmd); | ||||
286 | 1 | 3 | if ( $rr->isSuccess() ) { | ||||
287 | 1 | 2 | my $col = $rr->getColumn('SESSION'); | ||||
288 | 1 | 2 | my $sessid = q{}; | ||||
289 | 1 | 2 | if ( defined $col ) { | ||||
290 | 1 | 3 | my @d = $col->getData(); | ||||
291 | 1 | 1 | $sessid = $d[ 0 ]; | ||||
290 | 1 | 4 | my @d = $col->getData(); | ||||
291 | 1 | 2 | $sessid = $d[ 0 ]; | ||||
292 | } | ||||||
293 | 1 | 4 | $self->setSession($sessid); | ||||
293 | 1 | 3 | $self->setSession($sessid); | ||||
294 | } | ||||||
295 | 1 | 7 | return $rr; | ||||
295 | 1 | 5 | return $rr; | ||||
296 | } | ||||||
297 | |||||||
298 | |||||||
299 | sub logout { | ||||||
300 | 2 | 1 | 3 | my $self = shift; | |||
301 | 2 | 10 | my $rr = $self->request( { COMMAND => 'EndSession' } ); | ||||
302 | 2 | 8 | if ( $rr->isSuccess() ) { | ||||
303 | 1 | 3 | $self->setSession(q{}); | ||||
301 | 2 | 9 | my $rr = $self->request( { COMMAND => 'EndSession' } ); | ||||
302 | 2 | 9 | if ( $rr->isSuccess() ) { | ||||
303 | 1 | 5 | $self->setSession(q{}); | ||||
304 | } | ||||||
305 | 2 | 17 | return $rr; | ||||
305 | 2 | 19 | return $rr; | ||||
306 | } | ||||||
307 | |||||||
308 | |||||||
309 | sub request { | ||||||
310 | 17 | 1 | 51 | my ( $self, $cmd ) = @_; | |||
310 | 17 | 1 | 36 | my ( $self, $cmd ) = @_; | |||
311 | # flatten nested api command bulk parameters | ||||||
312 | 17 | 50 | my $newcmd = $self->_flattenCommand($cmd); | ||||
312 | 17 | 47 | my $newcmd = $self->_flattenCommand($cmd); | ||||
313 | # auto convert umlaut names to punycode | ||||||
314 | 17 | 38 | $newcmd = $self->_autoIDNConvert($newcmd); | ||||
314 | 17 | 40 | $newcmd = $self->_autoIDNConvert($newcmd); | ||||
315 | |||||||
316 | # request command to API | ||||||
317 | 17 | 44 | my $cfg = { CONNECTION_URL => $self->{socketURL} }; | ||||
318 | 17 | 44 | my $post = $self->getPOSTData($newcmd); | ||||
319 | 17 | 29 | my $secured = $self->getPOSTData( $newcmd, 1 ); | ||||
320 | |||||||
321 | 17 | 110 | my $ua = LWP::UserAgent->new(); | ||||
322 | 17 | 4411 | $ua->agent( $self->getUserAgent() ); | ||||
323 | 17 | 539 | $ua->default_header( 'Expect', q{} ); | ||||
324 | 17 | 408 | $ua->timeout($SOCKETTIMEOUT); | ||||
325 | 17 | 234 | my $referer = $self->getReferer(); | ||||
326 | 17 | 32 | if ($referer) { | ||||
317 | 17 | 54 | my $cfg = { CONNECTION_URL => $self->{socketURL} }; | ||||
318 | 17 | 45 | my $post = $self->getPOSTData($newcmd); | ||||
319 | 17 | 31 | my $secured = $self->getPOSTData( $newcmd, 1 ); | ||||
320 | |||||||
321 | 17 | 91 | my $ua = LWP::UserAgent->new(); | ||||
322 | 17 | 4907 | $ua->agent( $self->getUserAgent() ); | ||||
323 | 17 | 597 | $ua->default_header( 'Expect', q{} ); | ||||
324 | 17 | 464 | $ua->timeout($SOCKETTIMEOUT); | ||||
325 | 17 | 228 | my $referer = $self->getReferer(); | ||||
326 | 17 | 28 | if ($referer) { | ||||
327 | 0 | 0 | $ua->default_header( 'Referer', $referer ); | ||||
328 | } | ||||||
329 | 17 | 63 | my $proxy = $self->getProxy(); | ||||
330 | 17 | 26 | if ($proxy) { | ||||
329 | 17 | 47 | my $proxy = $self->getProxy(); | ||||
330 | 17 | 27 | if ($proxy) { | ||||
331 | 0 | 0 | $ua->proxy( [ 'http', 'https' ], $proxy ); | ||||
332 | } | ||||||
333 | |||||||
334 | 17 | 65 | my $r = $ua->post( $cfg->{CONNECTION_URL}, $post ); | ||||
335 | 17 | 10929975 | if ( $r->is_success ) { | ||||
336 | 16 | 155 | $r = WebService::Hexonet::Connector::Response->new( $r->decoded_content, $newcmd, $cfg ); | ||||
337 | 16 | 53 | if ( $self->{debugMode} ) { | ||||
338 | 2 | 9 | $self->{logger}->log( $secured, $r ); | ||||
333 | |||||||
334 | 17 | 59 | my $r = $ua->post( $cfg->{CONNECTION_URL}, $post ); | ||||
335 | 17 | 13991152 | if ( $r->is_success ) { | ||||
336 | 16 | 242 | $r = WebService::Hexonet::Connector::Response->new( $r->decoded_content, $newcmd, $cfg ); | ||||
337 | 16 | 61 | if ( $self->{debugMode} ) { | ||||
338 | 2 | 11 | $self->{logger}->log( $secured, $r ); | ||||
339 | } | ||||||
340 | } else { | ||||||
341 | 1 | 11 | $r = WebService::Hexonet::Connector::Response->new( $rtm->getTemplate('httperror')->getPlain(), $newcmd, $cfg ); | ||||
342 | 1 | 4 | if ( $self->{debugMode} ) { | ||||
341 | 1 | 15 | $r = WebService::Hexonet::Connector::Response->new( $rtm->getTemplate('httperror')->getPlain(), $newcmd, $cfg ); | ||||
342 | 1 | 8 | if ( $self->{debugMode} ) { | ||||
343 | 0 | 0 | $self->{logger}->log( $secured, $r, $r->status_line ); | ||||
344 | } | ||||||
345 | } | ||||||
346 | 17 | 378 | return $r; | ||||
346 | 17 | 469 | return $r; | ||||
347 | } | ||||||
348 | |||||||
349 | |||||||
350 | sub requestNextResponsePage { | ||||||
351 | 6 | 1 | 17 | my ( $self, $rr ) = @_; | |||
352 | 6 | 12 | my $mycmd = $rr->getCommand(); | ||||
353 | 6 | 16 | if ( defined $mycmd->{LAST} ) { | ||||
351 | 6 | 1 | 15 | my ( $self, $rr ) = @_; | |||
352 | 6 | 17 | my $mycmd = $rr->getCommand(); | ||||
353 | 6 | 15 | if ( defined $mycmd->{LAST} ) { | ||||
354 | 0 | 0 | croak 'Parameter LAST in use! Please remove it to avoid issues in requestNextPage.'; | ||||
355 | } | ||||||
356 | 6 | 7 | my $first = 0; | ||||
357 | 6 | 13 | if ( defined $mycmd->{FIRST} ) { | ||||
358 | 5 | 9 | $first = $mycmd->{FIRST}; | ||||
356 | 6 | 8 | my $first = 0; | ||||
357 | 6 | 30 | if ( defined $mycmd->{FIRST} ) { | ||||
358 | 5 | 5 | $first = $mycmd->{FIRST}; | ||||
359 | } | ||||||
360 | 6 | 15 | my $total = $rr->getRecordsTotalCount(); | ||||
361 | 6 | 14 | my $limit = $rr->getRecordsLimitation(); | ||||
362 | 6 | 7 | $first += $limit; | ||||
363 | 6 | 16 | if ( $first < $total ) { | ||||
364 | 5 | 8 | $mycmd->{FIRST} = $first; | ||||
361 | 6 | 15 | my $limit = $rr->getRecordsLimitation(); | ||||
362 | 6 | 11 | $first += $limit; | ||||
363 | 6 | 12 | if ( $first < $total ) { | ||||
364 | 5 | 5 | $mycmd->{FIRST} = $first; | ||||
365 | 5 | 5 | $mycmd->{LIMIT} = $limit; | ||||
366 | 5 | 11 | return $self->request($mycmd); | ||||
366 | 5 | 9 | return $self->request($mycmd); | ||||
367 | } | ||||||
368 | 1 | 2 | return; | ||||
369 | } | ||||||
370 | |||||||
371 | |||||||
372 | sub requestAllResponsePages { | ||||||
373 | 1 | 1 | 8 | my ( $self, $cmd ) = @_; | |||
374 | 1 | 3 | my @responses = (); | ||||
373 | 1 | 1 | 5 | my ( $self, $cmd ) = @_; | |||
374 | 1 | 2 | my @responses = (); | ||||
375 | 1 | 1 | my $command = {}; | ||||
376 | 1 1 | 2 4 | foreach my $key ( keys %{$cmd} ) { | ||||
377 | 3 | 5 | $command->{$key} = $cmd->{$key}; | ||||
376 | 1 1 | 2 2 | foreach my $key ( keys %{$cmd} ) { | ||||
377 | 3 | 4 | $command->{$key} = $cmd->{$key}; | ||||
378 | } | ||||||
379 | 1 | 3 | $command->{FIRST} = 0; | ||||
380 | 1 | 4 | my $rr = $self->request($command); | ||||
381 | 1 | 2 | my $tmp = $rr; | ||||
382 | 1 | 1 | my $idx = 0; | ||||
383 | 1 | 3 | while ( defined $tmp ) { | ||||
384 | 4 | 7 | push @responses, $tmp; | ||||
379 | 1 | 1 | $command->{FIRST} = 0; | ||||
380 | 1 | 3 | my $rr = $self->request($command); | ||||
381 | 1 | 1 | my $tmp = $rr; | ||||
382 | 1 | 3 | my $idx = 0; | ||||
383 | 1 | 2 | while ( defined $tmp ) { | ||||
384 | 4 | 6 | push @responses, $tmp; | ||||
385 | 4 | 13 | $tmp = $self->requestNextResponsePage($tmp); | ||||
386 | } | ||||||
387 | 1 | 21 | return \@responses; | ||||
387 | 1 | 19 | return \@responses; | ||||
388 | } | ||||||
389 | |||||||
390 | |||||||
391 | sub setUserView { | ||||||
392 | 1 | 1 | 615 | my ( $self, $uid ) = @_; | |||
393 | 1 | 14 | $self->{socketConfig}->setUser($uid); | ||||
394 | 1 | 1 | return $self; | ||||
392 | 1 | 1 | 572 | my ( $self, $uid ) = @_; | |||
393 | 1 | 5 | $self->{socketConfig}->setUser($uid); | ||||
394 | 1 | 2 | return $self; | ||||
395 | } | ||||||
396 | |||||||
397 | |||||||
398 | sub resetUserView { | ||||||
399 | 1 | 1 | 2 | my $self = shift; | |||
399 | 1 | 1 | 1 | my $self = shift; | |||
400 | 1 | 6 | $self->{socketConfig}->setUser(q{}); | ||||
401 | 1 | 1 | return $self; | ||||
402 | } | ||||||
403 | |||||||
404 | |||||||
405 | sub useDefaultConnectionSetup { | ||||||
406 | 1 | 1 | 389 | my $self = shift; | |||
407 | 1 | 4 | return $self->setURL($ISPAPI_CONNECTION_URL); | ||||
406 | 1 | 1 | 372 | my $self = shift; | |||
407 | 1 | 2 | return $self->setURL($ISPAPI_CONNECTION_URL); | ||||
408 | } | ||||||
409 | |||||||
410 | |||||||
411 | sub useHighPerformanceConnectionSetup { | ||||||
412 | 1 | 1 | 385 | my $self = shift; | |||
413 | 1 | 3 | return $self->setURL($ISPAPI_CONNECTION_URL_PROXY); | ||||
412 | 1 | 1 | 386 | my $self = shift; | |||
413 | 1 | 2 | return $self->setURL($ISPAPI_CONNECTION_URL_PROXY); | ||||
414 | } | ||||||
415 | |||||||
416 | |||||||
417 | sub useOTESystem { | ||||||
418 | 1 | 0 | 363 | my $self = shift; | |||
419 | 1 | 4 | $self->{socketConfig}->setSystemEntity('1234'); | ||||
420 | 1 | 2 | return $self; | ||||
418 | 1 | 0 | 366 | my $self = shift; | |||
419 | 1 | 3 | $self->{socketConfig}->setSystemEntity('1234'); | ||||
420 | 1 | 1 | return $self; | ||||
421 | } | ||||||
422 | |||||||
423 | |||||||
424 | sub useLIVESystem { | ||||||
425 | 2 | 1 | 2 | my $self = shift; | |||
426 | 2 | 7 | $self->{socketConfig}->setSystemEntity('54cd'); | ||||
427 | 2 | 3 | return $self; | ||||
425 | 2 | 1 | 3 | my $self = shift; | |||
426 | 2 | 4 | $self->{socketConfig}->setSystemEntity('54cd'); | ||||
427 | 2 | 2 | return $self; | ||||
428 | } | ||||||
429 | |||||||
430 | |||||||
431 | sub _flattenCommand { | ||||||
432 | 17 | 35 | my ( $self, $cmd ) = @_; | ||||
433 | 17 17 | 27 47 | for my $key ( keys %{$cmd} ) { | ||||
434 | 34 | 44 | my $newkey = uc $key; | ||||
435 | 34 | 51 | if ( $newkey ne $key ) { | ||||
436 | 1 | 1 | $cmd->{$newkey} = delete $cmd->{$key}; | ||||
432 | 17 | 29 | my ( $self, $cmd ) = @_; | ||||
433 | 17 17 | 21 47 | for my $key ( keys %{$cmd} ) { | ||||
434 | 34 | 40 | my $newkey = uc $key; | ||||
435 | 34 | 52 | if ( $newkey ne $key ) { | ||||
436 | 1 | 2 | $cmd->{$newkey} = delete $cmd->{$key}; | ||||
437 | } | ||||||
438 | 34 | 65 | if ( ref( $cmd->{$newkey} ) eq 'ARRAY' ) { | ||||
439 | 3 3 | 6 5 | my @val = @{ $cmd->{$newkey} }; | ||||
440 | 3 | 4 | my $idx = 0; | ||||
441 | 3 | 6 | for my $str (@val) { | ||||
442 | 6 | 10 | $str =~ s/[\r\n]//gmsx; | ||||
443 | 6 | 13 | $cmd->{"${key}${idx}"} = $str; | ||||
444 | 6 | 7 | $idx++; | ||||
438 | 34 | 67 | if ( ref( $cmd->{$newkey} ) eq 'ARRAY' ) { | ||||
439 | 3 3 | 4 5 | my @val = @{ $cmd->{$newkey} }; | ||||
440 | 3 | 6 | my $idx = 0; | ||||
441 | 3 | 5 | for my $str (@val) { | ||||
442 | 6 | 6 | $str =~ s/[\r\n]//gmsx; | ||||
443 | 6 | 12 | $cmd->{"${key}${idx}"} = $str; | ||||
444 | 6 | 9 | $idx++; | ||||
445 | } | ||||||
446 | 3 | 5 | delete $cmd->{$newkey}; | ||||
447 | } | ||||||
448 | } | ||||||
449 | 17 | 27 | return $cmd; | ||||
449 | 17 | 31 | return $cmd; | ||||
450 | } | ||||||
451 | |||||||
452 | |||||||
453 | sub _autoIDNConvert { | ||||||
454 | 17 | 28 | my ( $self, $cmd ) = @_; | ||||
455 | 17 | 67 | if ( $cmd->{'COMMAND'} =~ /^CONVERTIDN$/imsx ) { | ||||
454 | 17 | 31 | my ( $self, $cmd ) = @_; | ||||
455 | 17 | 52 | if ( $cmd->{'COMMAND'} =~ /^CONVERTIDN$/imsx ) { | ||||
456 | 1 | 2 | return $cmd; | ||||
457 | } | ||||||
458 | 16 34 16 | 20 91 26 | my @keys = grep {/^(DOMAIN|NAMESERVER|DNSZONE)(\d*)$/imsx} keys %{$cmd}; | ||||
459 | 16 | 35 | if ( scalar @keys == 0 ) { | ||||
460 | 14 | 18 | return $cmd; | ||||
458 | 16 34 16 | 27 93 36 | my @keys = grep {/^(DOMAIN|NAMESERVER|DNSZONE)(\d*)$/imsx} keys %{$cmd}; | ||||
459 | 16 | 42 | if ( scalar @keys == 0 ) { | ||||
460 | 14 | 22 | return $cmd; | ||||
461 | } | ||||||
462 | 2 | 3 | my @toconvert = (); | ||||
462 | 2 | 5 | my @toconvert = (); | ||||
463 | 2 | 3 | my @idxs = (); | ||||
464 | 2 | 4 | foreach my $key (@keys) { | ||||
465 | 5 | 5 | my $val = $cmd->{$key}; | ||||
466 | 5 | 10 | if ( $val =~ /[^[:lower:]\d. -]/imsx ) { | ||||
464 | 2 | 5 | foreach my $key (@keys) { | ||||
465 | 5 | 6 | my $val = $cmd->{$key}; | ||||
466 | 5 | 13 | if ( $val =~ /[^[:lower:]\d. -]/imsx ) { | ||||
467 | 1 | 2 | push @toconvert, $val; | ||||
468 | 1 | 2 | push @idxs, $key; | ||||
468 | 1 | 1 | push @idxs, $key; | ||||
469 | } | ||||||
470 | } | ||||||
471 | 2 | 5 | if ( scalar @toconvert == 0 ) { | ||||
471 | 2 | 6 | if ( scalar @toconvert == 0 ) { | ||||
472 | 1 | 3 | return $cmd; | ||||
473 | } | ||||||
474 | 1 | 6 | my $r = $self->request( | ||||
474 | 1 | 5 | my $r = $self->request( | ||||
475 | { COMMAND => 'ConvertIDN', | ||||||
476 | DOMAIN => \@toconvert | ||||||
477 | } | ||||||
478 | ); | ||||||
479 | 1 | 3 | if ( $r->isSuccess() ) { | ||||
479 | 1 | 5 | if ( $r->isSuccess() ) { | ||||
480 | 1 | 2 | my $col = $r->getColumn('ACE'); | ||||
481 | 1 | 2 | if ($col) { | ||||
482 | 1 | 2 | my $data = $col->getData(); | ||||
483 | 1 | 1 | my $idx = 0; | ||||
484 | 1 1 | 1 2 | foreach my $pc ( @{$data} ) { | ||||
484 | 1 1 | 2 1 | foreach my $pc ( @{$data} ) { | ||||
485 | 1 | 3 | $cmd->{ $idxs[ $idx ] } = $pc; | ||||
486 | 1 | 2 | $idx++; | ||||
487 | } | ||||||
488 | } | ||||||
489 | } | ||||||
490 | 1 | 5 | return $cmd; | ||||
490 | 1 | 8 | return $cmd; | ||||
491 | } | ||||||
492 | |||||||
493 | 1; | ||||||
494 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::Column; | ||||||
2 | |||||||
3 | 1 1 | 5 2 | use 5.030; | ||||
4 | 1 1 1 | 1 1 6 | use strict; | ||||
5 | 1 1 1 | 1 1 16 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 1 5 2 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
2 | |||||||
3 | 1 1 | 8 1 | use 5.030; | ||||
4 | 1 1 1 | 2 1 9 | use strict; | ||||
5 | 1 1 1 | 3 1 23 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 3 6 3 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
8 | |||||||
9 | |||||||
10 | sub new { | ||||||
11 | 153 | 1 | 1513 | my ( $class, $key, @data ) = @_; | |||
12 | 153 | 123 | my $self = {}; | ||||
13 | 153 | 152 | $self->{key} = $key; | ||||
14 | 153 153 | 107 366 | @{ $self->{data} } = @data; | ||||
15 | 153 | 138 | $self->{length} = scalar @data; | ||||
16 | 153 | 240 | return bless $self, $class; | ||||
11 | 155 | 1 | 1512 | my ( $class, $key, @data ) = @_; | |||
12 | 155 | 144 | my $self = {}; | ||||
13 | 155 | 196 | $self->{key} = $key; | ||||
14 | 155 155 | 135 424 | @{ $self->{data} } = @data; | ||||
15 | 155 | 157 | $self->{length} = scalar @data; | ||||
16 | 155 | 274 | return bless $self, $class; | ||||
17 | } | ||||||
18 | |||||||
19 | |||||||
20 | sub getKey { | ||||||
21 | 1 | 1 | 331 | my $self = shift; | |||
22 | 1 | 6 | return $self->{key}; | ||||
21 | 1 | 1 | 362 | my $self = shift; | |||
22 | 1 | 5 | return $self->{key}; | ||||
23 | } | ||||||
24 | |||||||
25 | |||||||
26 | sub getData { | ||||||
27 | 3 | 1 | 4 | my $self = shift; | |||
28 | 3 | 5 | return $self->{data}; | ||||
28 | 3 | 4 | return $self->{data}; | ||||
29 | } | ||||||
30 | |||||||
31 | |||||||
32 | sub getDataByIndex { | ||||||
33 | 19735 | 1 | 12199 | my $self = shift; | |||
34 | 19735 | 12080 | my $idx = shift; | ||||
35 | 19735 | 15567 | return $self->{data}[ $idx ] | ||||
33 | 22080 | 1 | 14427 | my $self = shift; | |||
34 | 22080 | 13381 | my $idx = shift; | ||||
35 | 22080 | 16662 | return $self->{data}[ $idx ] | ||||
36 | if $self->hasDataIndex($idx); | ||||||
37 | 16245 | 12047 | return; | ||||
37 | 18196 | 14327 | return; | ||||
38 | } | ||||||
39 | |||||||
40 | |||||||
41 | sub hasDataIndex { | ||||||
42 | 19735 | 1 | 12060 | my $self = shift; | |||
43 | 19735 | 11753 | my $idx = shift; | ||||
44 | 19735 | 19186 | return $idx < $self->{length}; | ||||
42 | 22080 | 1 | 13575 | my $self = shift; | |||
43 | 22080 | 13759 | my $idx = shift; | ||||
44 | 22080 | 22631 | return $idx < $self->{length}; | ||||
45 | } | ||||||
46 | |||||||
47 | 1; | ||||||
48 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::Logger; | ||||||
2 | |||||||
3 | 1 1 | 8 2 | use 5.030; | ||||
4 | 1 1 1 | 1 1 7 | use strict; | ||||
5 | 1 1 1 | 1 3 15 | use warnings; | ||||
6 | 1 1 1 | 202 2919 32 | use Data::Dumper; | ||||
7 | |||||||
8 | 1 1 1 | 3 9 4 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
2 | |||||||
3 | 1 1 | 7 1 | use 5.030; | ||||
4 | 1 1 1 | 1 1 12 | use strict; | ||||
5 | 1 1 1 | 2 1 18 | use warnings; | ||||
6 | 1 1 1 | 205 3458 33 | use Data::Dumper; | ||||
7 | |||||||
8 | 1 1 1 | 4 9 3 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
9 | |||||||
10 | |||||||
11 | sub new { | ||||||
12 | 4 | 1 | 7 | my ($class) = @_; | |||
13 | 4 | 14 | return bless {}, $class; | ||||
12 | 4 | 1 | 4 | my ($class) = @_; | |||
13 | 4 | 9 | return bless {}, $class; | ||||
14 | } | ||||||
15 | |||||||
16 | |||||||
17 | sub log { | ||||||
18 | 2 | 1 | 4 | my ( $self, $post, $r, $error ) = @_; | |||
19 | 2 | 3 | if ( defined $error ) { | ||||
18 | 2 | 1 | 5 | my ( $self, $post, $r, $error ) = @_; | |||
19 | 2 | 5 | if ( defined $error ) { | ||||
20 | 0 0 | 0 0 | print {*STDERR} Dumper($post); | ||||
21 | 0 0 | 0 0 | print {*STDERR} 'HTTP communication failed: ' . $error; | ||||
22 | 0 0 | 0 0 | print {*STDERR} Dumper( $r->getCommandPlain() ); | ||||
23 | 0 0 | 0 0 | print {*STDERR} Dumper( $r->getPlain() ); | ||||
24 | } else { | ||||||
25 | 2 2 | 3 9 | print {*STDOUT} Dumper($post); | ||||
26 | 2 2 | 483 13 | print {*STDOUT} Dumper( $r->getCommandPlain() ); | ||||
27 | 2 2 | 82 12 | print {*STDOUT} Dumper( $r->getPlain() ); | ||||
25 | 2 2 | 5 11 | print {*STDOUT} Dumper($post); | ||||
26 | 2 2 | 539 10 | print {*STDOUT} Dumper( $r->getCommandPlain() ); | ||||
27 | 2 2 | 76 12 | print {*STDOUT} Dumper( $r->getPlain() ); | ||||
28 | } | ||||||
29 | 2 | 68 | return $self->{data}; | ||||
29 | 2 | 72 | return $self->{data}; | ||||
30 | } | ||||||
31 | |||||||
32 | 1; | ||||||
33 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::Record; | ||||||
2 | |||||||
3 | 1 1 | 6 1 | use 5.030; | ||||
4 | 1 1 1 | 2 1 6 | use strict; | ||||
5 | 1 1 1 | 2 1 19 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 1 5 3 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
2 | |||||||
3 | 1 1 | 9 1 | use 5.030; | ||||
4 | 1 1 1 | 2 1 12 | use strict; | ||||
5 | 1 1 1 | 2 1 22 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 3 9 4 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
8 | |||||||
9 | |||||||
10 | sub new { | ||||||
11 | 3287 | 1 | 2459 | my ( $class, $data ) = @_; | |||
12 | 3287 | 3513 | return bless { data => $data }, $class; | ||||
11 | 3677 | 1 | 3088 | my ( $class, $data ) = @_; | |||
12 | 3677 | 4029 | return bless { data => $data }, $class; | ||||
13 | } | ||||||
14 | |||||||
15 | |||||||
16 | sub getData { | ||||||
17 | 6 | 1 | 330 | my $self = shift; | |||
18 | 6 | 18 | return $self->{data}; | ||||
17 | 6 | 1 | 290 | my $self = shift; | |||
18 | 6 | 15 | return $self->{data}; | ||||
19 | } | ||||||
20 | |||||||
21 | |||||||
22 | sub getDataByKey { | ||||||
23 | 3 | 1 | 643 | my $self = shift; | |||
24 | 3 | 6 | my $key = shift; | ||||
25 | 3 | 9 | return $self->{data}->{$key} | ||||
23 | 3 | 1 | 512 | my $self = shift; | |||
24 | 3 | 4 | my $key = shift; | ||||
25 | 3 | 8 | return $self->{data}->{$key} | ||||
26 | if $self->hasData($key); | ||||||
27 | 1 | 3 | return; | ||||
27 | 1 | 2 | return; | ||||
28 | } | ||||||
29 | |||||||
30 | |||||||
31 | sub hasData { | ||||||
32 | 3 | 1 | 4 | my $self = shift; | |||
33 | 3 | 5 | my $key = shift; | ||||
34 | 3 | 16 | return defined $self->{data}->{$key}; | ||||
33 | 3 | 3 | my $key = shift; | ||||
34 | 3 | 13 | return defined $self->{data}->{$key}; | ||||
35 | } | ||||||
36 | |||||||
37 | 1; | ||||||
38 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::Response; | ||||||
2 | |||||||
3 | 1 1 | 9 1 | use 5.030; | ||||
4 | 1 1 1 | 1 1 8 | use strict; | ||||
2 | |||||||
3 | 1 1 | 7 1 | use 5.030; | ||||
4 | 1 1 1 | 2 1 9 | use strict; | ||||
5 | 1 1 1 | 1 1 19 | use warnings; | ||||
6 | 1 1 1 | 233 1 12 | use WebService::Hexonet::Connector::Column; | ||||
7 | 1 1 1 | 231 1 13 | use WebService::Hexonet::Connector::Record; | ||||
8 | 1 1 1 | 116 103 2 | use parent qw(WebService::Hexonet::Connector::ResponseTemplate); | ||||
9 | 1 1 1 | 18 1 4 | use POSIX qw(ceil floor); | ||||
10 | 1 1 1 | 465 5169 6 | use List::MoreUtils qw(first_index); | ||||
11 | 1 1 1 | 551 1 35 | use Readonly; | ||||
6 | 1 1 1 | 352 1 19 | use WebService::Hexonet::Connector::Column; | ||||
7 | 1 1 1 | 342 2 23 | use WebService::Hexonet::Connector::Record; | ||||
8 | 1 1 1 | 189 136 2 | use parent qw(WebService::Hexonet::Connector::ResponseTemplate); | ||||
9 | 1 1 1 | 20 1 3 | use POSIX qw(ceil floor); | ||||
10 | 1 1 1 | 296 5581 3 | use List::MoreUtils qw(first_index); | ||||
11 | 1 1 1 | 600 1 49 | use Readonly; | ||||
12 | Readonly my $INDEX_NOT_FOUND => -1; | ||||||
13 | |||||||
14 | 1 1 1 | 14 7 3 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
13 | |||||||
14 | 1 1 1 | 3 8 3 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
15 | |||||||
16 | |||||||
17 | sub new { | ||||||
18 | 49 | 1 | 11607 | my ( $class, $raw, $cmd, $ph ) = @_; | |||
19 | 49 | 147 | my $self = WebService::Hexonet::Connector::ResponseTemplate->new($raw); | ||||
18 | 49 | 1 | 23021 | my ( $class, $raw, $cmd, $ph ) = @_; | |||
19 | 49 | 172 | my $self = WebService::Hexonet::Connector::ResponseTemplate->new($raw); | ||||
20 | # care about getting placeholder variables replaced | ||||||
21 | 49 | 115 | if ( $self->{raw} =~ /[{][[:upper:]_]+[}]/gsmx ) { | ||||
22 | 4 | 7 | if ( !defined $ph ) { | ||||
23 | 3 | 4 | $ph = {}; | ||||
21 | 49 | 140 | if ( $self->{raw} =~ /[{][[:upper:]_]+[}]/gsmx ) { | ||||
22 | 4 | 6 | if ( !defined $ph ) { | ||||
23 | 3 | 3 | $ph = {}; | ||||
24 | } | ||||||
25 | 4 4 | 4 6 | foreach my $key ( keys %{$ph} ) { | ||||
26 | 1 | 1 | my $find = "[{]${key}[}]"; | ||||
27 | 1 | 2 | my $replace = $ph->{$key}; | ||||
28 | 1 | 14 | $self->{raw} =~ s/$find/$replace/gsmx; | ||||
27 | 1 | 1 | my $replace = $ph->{$key}; | ||||
28 | 1 | 31 | $self->{raw} =~ s/$find/$replace/gsmx; | ||||
29 | } | ||||||
30 | 4 | 8 | $self->{raw} =~ s/[{][[:upper:]_]+[}]//gsmx; | ||||
31 | 4 | 5 | $self = WebService::Hexonet::Connector::ResponseTemplate->new( $self->{raw} ); | ||||
30 | 4 | 9 | $self->{raw} =~ s/[{][[:upper:]_]+[}]//gsmx; | ||||
31 | 4 | 8 | $self = WebService::Hexonet::Connector::ResponseTemplate->new( $self->{raw} ); | ||||
32 | } | ||||||
33 | 49 | 57 | $self = bless $self, $class; | ||||
34 | 49 | 61 | $self->{command} = $cmd; | ||||
35 | 49 | 73 | if ( defined $self->{command}->{PASSWORD} ) { | ||||
33 | 49 | 72 | $self = bless $self, $class; | ||||
34 | 49 | 82 | $self->{command} = $cmd; | ||||
35 | 49 | 104 | if ( defined $self->{command}->{PASSWORD} ) { | ||||
36 | # make password no longer accessible | ||||||
37 | 1 | 1 | $self->{command}->{PASSWORD} = '***'; | ||||
37 | 1 | 2 | $self->{command}->{PASSWORD} = '***'; | ||||
38 | } | ||||||
39 | 49 | 54 | $self->{columnkeys} = []; | ||||
40 | 49 | 56 | $self->{columns} = []; | ||||
41 | 49 | 67 | $self->{records} = []; | ||||
42 | 49 | 60 | $self->{recordIndex} = 0; | ||||
43 | |||||||
44 | 49 | 87 | my $h = $self->getHash(); | ||||
45 | 49 | 68 | if ( defined $h->{PROPERTY} ) { | ||||
46 | 32 32 | 25 84 | my @keys = keys %{ $h->{PROPERTY} }; | ||||
47 | 32 | 35 | my $count = 0; | ||||
48 | 32 | 46 | foreach my $key (@keys) { | ||||
49 | 152 152 | 120 368 | my @d = @{ $h->{PROPERTY}->{$key} }; | ||||
50 | 152 | 243 | $self->addColumn( $key, @d ); | ||||
51 | 152 | 104 | my $len = scalar @d; | ||||
52 | 152 | 170 | if ( $len > $count ) { | ||||
53 | 55 | 100 | $count = $len; | ||||
39 | 49 | 76 | $self->{columnkeys} = []; | ||||
40 | 49 | 77 | $self->{columns} = []; | ||||
41 | 49 | 73 | $self->{records} = []; | ||||
42 | 49 | 67 | $self->{recordIndex} = 0; | ||||
43 | |||||||
44 | 49 | 95 | my $h = $self->getHash(); | ||||
45 | 49 | 92 | if ( defined $h->{PROPERTY} ) { | ||||
46 | 32 32 | 38 92 | my @keys = keys %{ $h->{PROPERTY} }; | ||||
47 | 32 | 48 | my $count = 0; | ||||
48 | 32 | 54 | foreach my $key (@keys) { | ||||
49 | 154 154 | 112 370 | my @d = @{ $h->{PROPERTY}->{$key} }; | ||||
50 | 154 | 238 | $self->addColumn( $key, @d ); | ||||
51 | 154 | 140 | my $len = scalar @d; | ||||
52 | 154 | 205 | if ( $len > $count ) { | ||||
53 | 53 | 140 | $count = $len; | ||||
54 | } | ||||||
55 | } | ||||||
56 | 32 | 29 | $count--; | ||||
57 | 32 | 45 | for my $i ( 0 .. $count ) { | ||||
58 | 3286 | 2121 | my %d = (); | ||||
59 | 3286 | 2157 | foreach my $colkey (@keys) { | ||||
60 | 19654 | 14961 | my $col = $self->getColumn($colkey); | ||||
61 | 19654 | 15707 | if ( defined $col ) { | ||||
62 | 19654 | 15852 | my $v = $col->getDataByIndex($i); | ||||
63 | 19654 | 17492 | if ( defined $v ) { | ||||
64 | 3409 | 3212 | $d{$colkey} = $v; | ||||
56 | 32 | 31 | $count--; | ||||
57 | 32 | 49 | for my $i ( 0 .. $count ) { | ||||
58 | 3676 | 2564 | my %d = (); | ||||
59 | 3676 | 2482 | foreach my $colkey (@keys) { | ||||
60 | 21999 | 16351 | my $col = $self->getColumn($colkey); | ||||
61 | 21999 | 19477 | if ( defined $col ) { | ||||
62 | 21999 | 18408 | my $v = $col->getDataByIndex($i); | ||||
63 | 21999 | 19933 | if ( defined $v ) { | ||||
64 | 3803 | 3558 | $d{$colkey} = $v; | ||||
65 | } | ||||||
66 | } | ||||||
67 | } | ||||||
68 | 3286 | 2552 | $self->addRecord( \%d ); | ||||
68 | 3676 | 2991 | $self->addRecord( \%d ); | ||||
69 | } | ||||||
70 | } | ||||||
71 | 49 | 379 | return $self; | ||||
71 | 49 | 411 | return $self; | ||||
72 | } | ||||||
73 | |||||||
74 | |||||||
75 | sub addColumn { | ||||||
76 | 152 | 1 | 315 | my ( $self, $key, @data ) = @_; | |||
77 | 152 152 | 105 252 | push @{ $self->{columns} }, WebService::Hexonet::Connector::Column->new( $key, @data ); | ||||
78 | 152 152 | 110 131 | push @{ $self->{columnkeys} }, $key; | ||||
79 | 152 | 178 | return $self; | ||||
76 | 154 | 1 | 428 | my ( $self, $key, @data ) = @_; | |||
77 | 154 154 | 139 305 | push @{ $self->{columns} }, WebService::Hexonet::Connector::Column->new( $key, @data ); | ||||
78 | 154 154 | 147 188 | push @{ $self->{columnkeys} }, $key; | ||||
79 | 154 | 255 | return $self; | ||||
80 | } | ||||||
81 | |||||||
82 | |||||||
83 | sub addRecord { | ||||||
84 | 3286 | 1 | 2369 | my ( $self, $h ) = @_; | |||
85 | 3286 3286 | 2087 3111 | push @{ $self->{records} }, WebService::Hexonet::Connector::Record->new($h); | ||||
86 | 3286 | 2639 | return $self; | ||||
84 | 3676 | 1 | 2747 | my ( $self, $h ) = @_; | |||
85 | 3676 3676 | 2332 3619 | push @{ $self->{records} }, WebService::Hexonet::Connector::Record->new($h); | ||||
86 | 3676 | 3135 | return $self; | ||||
87 | } | ||||||
88 | |||||||
89 | |||||||
90 | sub getColumn { | ||||||
91 | 19755 | 1 | 14913 | my ( $self, $key ) = @_; | |||
92 | 19755 | 16210 | if ( $self->_hasColumn($key) ) { | ||||
93 | 19738 69027 19738 | 45463 42517 16847 | my $idx = first_index { $_ eq $key } @{ $self->{columnkeys} }; | ||||
94 | 19738 | 19358 | return $self->{columns}[ $idx ]; | ||||
91 | 22100 | 1 | 16367 | my ( $self, $key ) = @_; | |||
92 | 22100 | 16809 | if ( $self->_hasColumn($key) ) { | ||||
93 | 22083 77201 22083 | 56083 47279 19153 | my $idx = first_index { $_ eq $key } @{ $self->{columnkeys} }; | ||||
94 | 22083 | 24085 | return $self->{columns}[ $idx ]; | ||||
95 | } | ||||||
96 | 17 | 49 | return; | ||||
96 | 17 | 51 | return; | ||||
97 | } | ||||||
98 | |||||||
99 | |||||||
100 | sub getColumnIndex { | ||||||
101 | 2 | 1 | 5 | my ( $self, $key, $idx ) = @_; | |||
104 | 1 | 1 | return; | ||||
105 | } | ||||||
106 | |||||||
107 | |||||||
108 | sub getColumnKeys { | ||||||
109 | 3 | 1 | 325 | my $self = shift; | |||
110 | 3 3 | 5 6 | return \@{ $self->{columnkeys} }; | ||||
109 | 3 | 1 | 330 | my $self = shift; | |||
110 | 3 3 | 3 6 | return \@{ $self->{columnkeys} }; | ||||
111 | } | ||||||
112 | |||||||
113 | |||||||
114 | sub getColumns { | ||||||
115 | 1 | 0 | 3 | my $self = shift; | |||
116 | 1 1 | 1 1 | return \@{ $self->{columns} }; | ||||
116 | 1 1 | 2 1 | return \@{ $self->{columns} }; | ||||
117 | } | ||||||
118 | |||||||
119 | |||||||
120 | sub getCommand { | ||||||
121 | 8 | 1 | 22 | my $self = shift; | |||
122 | 8 | 20 | return $self->{command}; | ||||
121 | 8 | 1 | 32 | my $self = shift; | |||
122 | 8 | 22 | return $self->{command}; | ||||
123 | } | ||||||
124 | |||||||
125 | |||||||
126 | sub getCommandPlain { | ||||||
127 | 4 | 1 | 12 | my $self = shift; | |||
127 | 4 | 1 | 11 | my $self = shift; | |||
128 | 4 | 7 | my $str = q{}; | ||||
129 | 4 4 | 4 16 | foreach my $key ( sort keys %{ $self->{command} } ) { | ||||
130 | 10 | 12 | my $val = $self->{command}->{$key}; | ||||
131 | 10 | 15 | $str .= "${key} = ${val}\n"; | ||||
129 | 4 4 | 5 16 | foreach my $key ( sort keys %{ $self->{command} } ) { | ||||
130 | 10 | 14 | my $val = $self->{command}->{$key}; | ||||
131 | 10 | 19 | $str .= "${key} = ${val}\n"; | ||||
132 | } | ||||||
133 | 4 | 10 | return $str; | ||||
134 | } | ||||||
135 | |||||||
136 | |||||||
137 | sub getCurrentPageNumber { | ||||||
138 | 19 | 1 | 17 | my $self = shift; | |||
139 | 19 | 24 | my $first = $self->getFirstRecordIndex(); | ||||
140 | 19 | 21 | my $limit = $self->getRecordsLimitation(); | ||||
141 | 19 | 33 | if ( defined $first && $limit > 0 ) { | ||||
142 | 14 | 38 | return floor( $first / $limit ) + 1; | ||||
138 | 19 | 1 | 20 | my $self = shift; | |||
139 | 19 | 16 | my $first = $self->getFirstRecordIndex(); | ||||
140 | 19 | 20 | my $limit = $self->getRecordsLimitation(); | ||||
141 | 19 | 34 | if ( defined $first && $limit > 0 ) { | ||||
142 | 14 | 32 | return floor( $first / $limit ) + 1; | ||||
143 | } | ||||||
144 | 5 | 5 | return $INDEX_NOT_FOUND; | ||||
144 | 5 | 7 | return $INDEX_NOT_FOUND; | ||||
145 | } | ||||||
146 | |||||||
147 | |||||||
148 | sub getCurrentRecord { | ||||||
149 | 2 | 1 | 5 | my $self = shift; | |||
150 | 2 | 4 | return $self->{records}[ $self->{recordIndex} ] | ||||
149 | 2 | 1 | 6 | my $self = shift; | |||
150 | 2 | 3 | return $self->{records}[ $self->{recordIndex} ] | ||||
151 | if $self->_hasCurrentRecord(); | ||||||
152 | 1 | 3 | return; | ||||
153 | } | ||||||
154 | |||||||
155 | |||||||
156 | sub getFirstRecordIndex { | ||||||
157 | 28 | 1 | 24 | my $self = shift; | |||
157 | 28 | 1 | 37 | my $self = shift; | |||
158 | 28 | 34 | my $col = $self->getColumn('FIRST'); | ||||
159 | 28 | 34 | if ( defined $col ) { | ||||
160 | 21 | 21 | my $f = $col->getDataByIndex(0); | ||||
161 | 21 | 24 | if ( defined $f ) { | ||||
159 | 28 | 35 | if ( defined $col ) { | ||||
160 | 21 | 27 | my $f = $col->getDataByIndex(0); | ||||
161 | 21 | 25 | if ( defined $f ) { | ||||
162 | 21 | 33 | return int $f; | ||||
163 | } | ||||||
164 | } | ||||||
165 | 7 7 | 5 7 | my $len = scalar @{ $self->{records} }; | ||||
165 | 7 7 | 6 7 | my $len = scalar @{ $self->{records} }; | ||||
166 | 7 | 10 | return 0 if ( $len > 0 ); | ||||
167 | 6 | 7 | return; | ||||
167 | 6 | 8 | return; | ||||
168 | } | ||||||
169 | |||||||
170 | |||||||
171 | sub getLastRecordIndex { | ||||||
172 | 9 | 1 | 15 | my $self = shift; | |||
173 | 9 | 16 | my $col = $self->getColumn('LAST'); | ||||
172 | 9 | 1 | 13 | my $self = shift; | |||
173 | 9 | 13 | my $col = $self->getColumn('LAST'); | ||||
174 | 9 | 14 | if ( defined $col ) { | ||||
175 | 7 | 14 | my $l = $col->getDataByIndex(0); | ||||
176 | 7 | 9 | if ( defined $l ) { | ||||
177 | 7 | 20 | return int $l; | ||||
175 | 7 | 10 | my $l = $col->getDataByIndex(0); | ||||
176 | 7 | 18 | if ( defined $l ) { | ||||
177 | 7 | 17 | return int $l; | ||||
178 | } | ||||||
179 | } | ||||||
180 | 2 | 3 | my $len = $self->getRecordsCount(); | ||||
181 | 2 | 3 | if ( $len > 0 ) { | ||||
181 | 2 | 4 | if ( $len > 0 ) { | ||||
182 | 1 | 3 | return ( $len - 1 ); | ||||
183 | } | ||||||
184 | 1 | 3 | return; | ||||
185 | } | ||||||
186 | |||||||
187 | |||||||
188 | sub getListHash { | ||||||
189 | 1 | 1 | 2 | my $self = shift; | |||
189 | 1 | 1 | 3 | my $self = shift; | |||
190 | 1 | 2 | my @lh = (); | ||||
191 | 1 1 | 1 2 | foreach my $rec ( @{ $self->getRecords() } ) { | ||||
192 | 2 | 3 | push @lh, $rec->getData(); | ||||
201 | 1 | 2 | return $r; | ||||
202 | } | ||||||
203 | |||||||
204 | |||||||
205 | sub getNextRecord { | ||||||
206 | 5 | 1 | 10 | my $self = shift; | |||
207 | 5 | 9 | return $self->{records}[ ++$self->{recordIndex} ] | ||||
206 | 5 | 1 | 7 | my $self = shift; | |||
207 | 5 | 6 | return $self->{records}[ ++$self->{recordIndex} ] | ||||
208 | if ( $self->_hasNextRecord() ); | ||||||
209 | 2 | 6 | return; | ||||
209 | 2 | 3 | return; | ||||
210 | } | ||||||
211 | |||||||
212 | |||||||
213 | sub getNextPageNumber { | ||||||
214 | 5 | 1 | 8 | my $self = shift; | |||
215 | 5 | 4 | my $cp = $self->getCurrentPageNumber(); | ||||
214 | 5 | 1 | 7 | my $self = shift; | |||
215 | 5 | 5 | my $cp = $self->getCurrentPageNumber(); | ||||
216 | 5 | 9 | if ( $cp < 0 ) { | ||||
217 | 1 | 2 | return $INDEX_NOT_FOUND; | ||||
217 | 1 | 1 | return $INDEX_NOT_FOUND; | ||||
218 | } | ||||||
219 | 4 | 3 | my $page = $cp + 1; | ||||
220 | 4 | 5 | my $pages = $self->getNumberOfPages(); | ||||
221 | 4 | 8 | return $page if ( $page <= $pages ); | ||||
219 | 4 | 4 | my $page = $cp + 1; | ||||
220 | 4 | 4 | my $pages = $self->getNumberOfPages(); | ||||
221 | 4 | 9 | return $page if ( $page <= $pages ); | ||||
222 | 0 | 0 | return $pages; | ||||
223 | } | ||||||
224 | |||||||
225 | |||||||
226 | sub getNumberOfPages { | ||||||
227 | 9 | 1 | 7 | my $self = shift; | |||
227 | 9 | 1 | 6 | my $self = shift; | |||
228 | 9 | 11 | my $t = $self->getRecordsTotalCount(); | ||||
229 | 9 | 9 | my $limit = $self->getRecordsLimitation(); | ||||
230 | 9 | 13 | if ( $t > 0 && $limit > 0 ) { | ||||
231 | 8 | 16 | return ceil( $t / $limit ); | ||||
230 | 9 | 18 | if ( $t > 0 && $limit > 0 ) { | ||||
231 | 8 | 17 | return ceil( $t / $limit ); | ||||
232 | } | ||||||
233 | 1 | 3 | return 0; | ||||
233 | 1 | 2 | return 0; | ||||
234 | } | ||||||
235 | |||||||
236 | |||||||
237 | sub getPagination { | ||||||
238 | 3 | 1 | 329 | my $self = shift; | |||
239 | 3 | 5 | my $r = { | ||||
238 | 3 | 1 | 281 | my $self = shift; | |||
239 | 3 | 4 | my $r = { | ||||
240 | COUNT => $self->getRecordsCount(), | ||||||
241 | CURRENTPAGE => $self->getCurrentPageNumber(), | ||||||
242 | FIRST => $self->getFirstRecordIndex(), | ||||||
250 | 3 | 9 | return $r; | ||||
251 | } | ||||||
252 | |||||||
253 | |||||||
254 | sub getPreviousPageNumber { | ||||||
255 | 5 | 1 | 7 | my $self = shift; | |||
256 | 5 | 8 | my $cp = $self->getCurrentPageNumber(); | ||||
257 | 5 | 9 | if ( $cp < 0 ) { | ||||
258 | 1 | 2 | return $INDEX_NOT_FOUND; | ||||
255 | 5 | 1 | 6 | my $self = shift; | |||
256 | 5 | 5 | my $cp = $self->getCurrentPageNumber(); | ||||
257 | 5 | 7 | if ( $cp < 0 ) { | ||||
258 | 1 | 1 | return $INDEX_NOT_FOUND; | ||||
259 | } | ||||||
260 | 4 | 4 | my $np = $cp - 1; | ||||
261 | 4 | 3 | return $np if ( $np > 0 ); | ||||
262 | 4 | 3 | return $INDEX_NOT_FOUND; | ||||
260 | 4 | 5 | my $np = $cp - 1; | ||||
261 | 4 | 5 | return $np if ( $np > 0 ); | ||||
262 | 4 | 4 | return $INDEX_NOT_FOUND; | ||||
263 | } | ||||||
264 | |||||||
265 | |||||||
266 | sub getPreviousRecord { | ||||||
267 | 4 | 1 | 9 | my $self = shift; | |||
268 | 4 | 9 | return $self->{records}[ --$self->{recordIndex} ] | ||||
267 | 4 | 1 | 5 | my $self = shift; | |||
268 | 4 | 5 | return $self->{records}[ --$self->{recordIndex} ] | ||||
269 | if ( $self->_hasPreviousRecord() ); | ||||||
270 | 3 | 11 | return; | ||||
270 | 3 | 7 | return; | ||||
271 | } | ||||||
272 | |||||||
273 | |||||||
274 | sub getRecord { | ||||||
275 | 2 | 1 | 5 | my ( $self, $idx ) = @_; | |||
276 | 2 | 12 | if ( $idx >= 0 && $self->getRecordsCount() > $idx ) { | ||||
277 | 2 | 12 | return $self->{records}[ $idx ]; | ||||
275 | 2 | 1 | 4 | my ( $self, $idx ) = @_; | |||
276 | 2 | 8 | if ( $idx >= 0 && $self->getRecordsCount() > $idx ) { | ||||
277 | 2 | 8 | return $self->{records}[ $idx ]; | ||||
278 | } | ||||||
279 | 0 | 0 | return; | ||||
280 | } | ||||||
281 | |||||||
282 | |||||||
283 | sub getRecords { | ||||||
284 | 1 | 1 | 1 | my $self = shift; | |||
285 | 1 1 | 1 1 | return \@{ $self->{records} }; | ||||
285 | 1 1 | 1 2 | return \@{ $self->{records} }; | ||||
286 | } | ||||||
287 | |||||||
288 | |||||||
289 | sub getRecordsCount { | ||||||
290 | 18 | 1 | 22 | my $self = shift; | |||
291 | 18 18 | 15 24 | my $len = scalar @{ $self->{records} }; | ||||
290 | 18 | 1 | 21 | my $self = shift; | |||
291 | 18 18 | 16 22 | my $len = scalar @{ $self->{records} }; | ||||
292 | 18 | 33 | return $len; | ||||
293 | } | ||||||
294 | |||||||
295 | |||||||
296 | sub getRecordsTotalCount { | ||||||
297 | 18 | 1 | 21 | my $self = shift; | |||
298 | 18 | 22 | my $col = $self->getColumn('TOTAL'); | ||||
299 | 18 | 23 | if ( defined $col ) { | ||||
300 | 17 | 20 | my $t = $col->getDataByIndex(0); | ||||
301 | 17 | 18 | if ( defined $t ) { | ||||
302 | 17 | 41 | return int $t; | ||||
297 | 18 | 1 | 23 | my $self = shift; | |||
298 | 18 | 20 | my $col = $self->getColumn('TOTAL'); | ||||
299 | 18 | 22 | if ( defined $col ) { | ||||
300 | 17 | 19 | my $t = $col->getDataByIndex(0); | ||||
301 | 17 | 25 | if ( defined $t ) { | ||||
302 | 17 | 30 | return int $t; | ||||
303 | } | ||||||
304 | } | ||||||
305 | 1 | 2 | return $self->getRecordsCount(); | ||||
305 | 1 | 1 | return $self->getRecordsCount(); | ||||
306 | } | ||||||
307 | |||||||
308 | |||||||
309 | sub getRecordsLimitation { | ||||||
310 | 41 | 1 | 34 | my $self = shift; | |||
311 | 41 | 50 | my $col = $self->getColumn('LIMIT'); | ||||
312 | 41 | 45 | if ( defined $col ) { | ||||
313 | 35 | 43 | my $l = $col->getDataByIndex(0); | ||||
310 | 41 | 1 | 41 | my $self = shift; | |||
311 | 41 | 44 | my $col = $self->getColumn('LIMIT'); | ||||
312 | 41 | 53 | if ( defined $col ) { | ||||
313 | 35 | 41 | my $l = $col->getDataByIndex(0); | ||||
314 | 35 | 43 | if ( defined $l ) { | ||||
315 | 35 | 42 | return int $l; | ||||
315 | 35 | 59 | return int $l; | ||||
316 | } | ||||||
317 | } | ||||||
318 | 6 | 7 | return $self->getRecordsCount(); | ||||
318 | 6 | 8 | return $self->getRecordsCount(); | ||||
319 | } | ||||||
320 | |||||||
321 | |||||||
322 | sub hasNextPage { | ||||||
323 | 2 | 1 | 6 | my $self = shift; | |||
324 | 2 | 2 | my $cp = $self->getCurrentPageNumber(); | ||||
325 | 2 | 6 | if ( $cp < 0 ) { | ||||
324 | 2 | 3 | my $cp = $self->getCurrentPageNumber(); | ||||
325 | 2 | 5 | if ( $cp < 0 ) { | ||||
326 | 1 | 2 | return 0; | ||||
327 | } | ||||||
328 | 1 | 1 | my $np = $cp + 1; | ||||
329 | 1 | 1 | if ( $np <= $self->getNumberOfPages() ) { | ||||
330 | 1 | 4 | return 1; | ||||
329 | 1 | 3 | if ( $np <= $self->getNumberOfPages() ) { | ||||
330 | 1 | 3 | return 1; | ||||
331 | } | ||||||
332 | 0 | 0 | return 0; | ||||
333 | } | ||||||
334 | |||||||
335 | |||||||
336 | sub hasPreviousPage { | ||||||
337 | 2 | 1 | 7 | my $self = shift; | |||
338 | 2 | 4 | my $cp = $self->getCurrentPageNumber(); | ||||
339 | 2 | 5 | if ( $cp < 0 ) { | ||||
340 | 1 | 2 | return 0; | ||||
338 | 2 | 3 | my $cp = $self->getCurrentPageNumber(); | ||||
339 | 2 | 6 | if ( $cp < 0 ) { | ||||
340 | 1 | 3 | return 0; | ||||
341 | } | ||||||
342 | 1 | 2 | my $pp = $cp - 1; | ||||
343 | 1 | 1 | if ( $pp > 0 ) { | ||||
343 | 1 | 2 | if ( $pp > 0 ) { | ||||
344 | 0 | 0 | return 1; | ||||
345 | } | ||||||
346 | 1 | 3 | return 0; | ||||
348 | |||||||
349 | |||||||
350 | sub rewindRecordList { | ||||||
351 | 1 | 1 | 2 | my $self = shift; | |||
352 | 1 | 1 | $self->{recordIndex} = 0; | ||||
353 | 1 | 4 | return $self; | ||||
353 | 1 | 2 | return $self; | ||||
354 | } | ||||||
355 | |||||||
356 | |||||||
357 | sub _hasColumn { | ||||||
358 | 19755 | 14464 | my ( $self, $key ) = @_; | ||||
359 | 19755 69035 19755 | 17275 43499 16322 | my $idx = first_index { $_ eq $key } @{ $self->{columnkeys} }; | ||||
360 | 19755 | 19428 | return ( $idx > $INDEX_NOT_FOUND ); | ||||
358 | 22100 | 17302 | my ( $self, $key ) = @_; | ||||
359 | 22100 77209 22100 | 21341 47475 19582 | my $idx = first_index { $_ eq $key } @{ $self->{columnkeys} }; | ||||
360 | 22100 | 25151 | return ( $idx > $INDEX_NOT_FOUND ); | ||||
361 | } | ||||||
362 | |||||||
363 | |||||||
364 | sub _hasCurrentRecord { | ||||||
365 | 8 | 10 | my $self = shift; | ||||
366 | 8 8 | 5 11 | my $len = scalar @{ $self->{records} }; | ||||
367 | 8 | 48 | return ( $len > 0 && $self->{recordIndex} >= 0 && $self->{recordIndex} < $len ); | ||||
365 | 8 | 8 | my $self = shift; | ||||
366 | 8 8 | 5 6 | my $len = scalar @{ $self->{records} }; | ||||
367 | 8 | 40 | return ( $len > 0 && $self->{recordIndex} >= 0 && $self->{recordIndex} < $len ); | ||||
368 | } | ||||||
369 | |||||||
370 | |||||||
371 | sub _hasNextRecord { | ||||||
372 | 5 | 6 | my $self = shift; | ||||
373 | 5 | 7 | my $next = $self->{recordIndex} + 1; | ||||
374 | 5 5 | 5 6 | my $len = scalar @{ $self->{records} }; | ||||
375 | 5 | 8 | return ( $self->_hasCurrentRecord() && $next < $len ); | ||||
372 | 5 | 4 | my $self = shift; | ||||
373 | 5 | 6 | my $next = $self->{recordIndex} + 1; | ||||
374 | 5 5 | 2 5 | my $len = scalar @{ $self->{records} }; | ||||
375 | 5 | 5 | return ( $self->_hasCurrentRecord() && $next < $len ); | ||||
376 | } | ||||||
377 | |||||||
378 | |||||||
379 | sub _hasPreviousRecord { | ||||||
380 | 4 | 4 | my $self = shift; | ||||
381 | 4 | 16 | return ( $self->{recordIndex} > 0 && $self->_hasCurrentRecord() ); | ||||
381 | 4 | 8 | return ( $self->{recordIndex} > 0 && $self->_hasCurrentRecord() ); | ||||
382 | } | ||||||
383 | |||||||
384 | 1; | ||||||
385 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::ResponseParser; | ||||||
2 | |||||||
3 | 1 1 | 6 1 | use 5.030; | ||||
4 | 1 1 1 | 2 1 6 | use strict; | ||||
5 | 1 1 1 | 1 1 17 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 2 5 2 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
2 | |||||||
3 | 1 1 | 7 2 | use 5.030; | ||||
4 | 1 1 1 | 2 1 9 | use strict; | ||||
5 | 1 1 1 | 2 1 19 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 2 6 3 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
8 | |||||||
9 | |||||||
10 | sub parse { | ||||||
11 | 111 | 1 | 113 | my $response = shift; | |||
12 | 111 | 120 | my %hash = (); | ||||
13 | 111 | 323 | $response =~ s/\r\n/\n/gmsx; | ||||
14 | 111 | 610 | foreach ( split /\n/msx, $response ) { | ||||
15 | 4116 | 5152 | if (/^([^\=]*[^\t\= ])[\t ]*=[\t ]*(.+)/msx) { | ||||
16 | 3859 | 2990 | my $attr = $1; | ||||
17 | 3859 | 2830 | my $value = $2; | ||||
18 | 3859 | 6968 | $value =~ s/[\t ]*$//msx; | ||||
19 | 3859 | 3837 | if ( $attr =~ /^property\[([^\]]*)\]/imsx ) { | ||||
20 | 3528 | 2954 | if ( !defined $hash{PROPERTY} ) { | ||||
21 | 49 | 75 | $hash{PROPERTY} = {}; | ||||
11 | 111 | 1 | 114 | my $response = shift; | |||
12 | 111 | 113 | my %hash = (); | ||||
13 | 111 | 304 | $response =~ s/\r\n/\n/gmsx; | ||||
14 | 111 | 1069 | foreach ( split /\n/msx, $response ) { | ||||
15 | 4506 | 6478 | if (/^([^\=]*[^\t\= ])[\t ]*=[\t ]*(.+)/msx) { | ||||
16 | 4253 | 3958 | my $attr = $1; | ||||
17 | 4253 | 3573 | my $value = $2; | ||||
18 | 4253 | 8567 | $value =~ s/[\t ]*$//msx; | ||||
19 | 4253 | 4929 | if ( $attr =~ /^property\[([^\]]*)\]/imsx ) { | ||||
20 | 3922 | 3713 | if ( !defined $hash{PROPERTY} ) { | ||||
21 | 49 | 82 | $hash{PROPERTY} = {}; | ||||
22 | } | ||||||
23 | 3528 | 2706 | my $prop = uc $1; | ||||
24 | 3528 | 2464 | $prop =~ s/\s//ogmsx; | ||||
25 | 3528 | 2864 | if ( defined $hash{PROPERTY}{$prop} ) { | ||||
26 | 3274 3274 | 2058 3236 | push @{ $hash{PROPERTY}{$prop} }, $value; | ||||
23 | 3922 | 3338 | my $prop = uc $1; | ||||
24 | 3922 | 3148 | $prop =~ s/\s//ogmsx; | ||||
25 | 3922 | 3548 | if ( defined $hash{PROPERTY}{$prop} ) { | ||||
26 | 3666 3666 | 2460 4164 | push @{ $hash{PROPERTY}{$prop} }, $value; | ||||
27 | } else { | ||||||
28 | 254 | 364 | $hash{PROPERTY}{$prop} = [ $value ]; | ||||
28 | 256 | 403 | $hash{PROPERTY}{$prop} = [ $value ]; | ||||
29 | } | ||||||
30 | } else { | ||||||
31 | 331 | 439 | $hash{ uc $attr } = $value; | ||||
31 | 331 | 504 | $hash{ uc $attr } = $value; | ||||
32 | } | ||||||
33 | } | ||||||
34 | } | ||||||
35 | 111 | 297 | return \%hash; | ||||
35 | 111 | 332 | return \%hash; | ||||
36 | } | ||||||
37 | |||||||
38 | |||||||
39 | sub serialize { | ||||||
40 | 6 | 1 | 27 | my $h = shift; | |||
40 | 6 | 1 | 21 | my $h = shift; | |||
41 | 6 | 7 | my $plain = '[RESPONSE]'; | ||||
42 | 6 | 10 | if ( defined $h->{PROPERTY} ) { | ||||
42 | 6 | 7 | if ( defined $h->{PROPERTY} ) { | ||||
43 | 3 | 3 | my $props = $h->{PROPERTY}; | ||||
44 | 3 3 | 5 13 | foreach my $key ( sort keys %{$props} ) { | ||||
45 | 5 | 3 | my $i = 0; | ||||
46 | 5 5 | 5 6 | foreach my $val ( @{ $props->{$key} } ) { | ||||
47 | 11 | 14 | $plain .= "\r\nPROPERTY[${key}][${i}]=${val}"; | ||||
48 | 11 | 11 | $i++; | ||||
44 | 3 3 | 3 12 | foreach my $key ( sort keys %{$props} ) { | ||||
45 | 5 | 4 | my $i = 0; | ||||
46 | 5 5 | 4 6 | foreach my $val ( @{ $props->{$key} } ) { | ||||
47 | 11 | 10 | $plain .= "\r\nPROPERTY[${key}][${i}]=${val}"; | ||||
48 | 11 | 14 | $i++; | ||||
49 | } | ||||||
50 | } | ||||||
51 | } | ||||||
52 | 6 | 10 | if ( defined $h->{CODE} ) { | ||||
52 | 6 | 5 | if ( defined $h->{CODE} ) { | ||||
53 | 5 | 6 | $plain .= "\r\nCODE=" . $h->{CODE}; | ||||
54 | } | ||||||
55 | 6 | 9 | if ( defined $h->{DESCRIPTION} ) { | ||||
56 | 5 | 5 | $plain .= "\r\nDESCRIPTION=" . $h->{DESCRIPTION}; | ||||
55 | 6 | 7 | if ( defined $h->{DESCRIPTION} ) { | ||||
56 | 5 | 6 | $plain .= "\r\nDESCRIPTION=" . $h->{DESCRIPTION}; | ||||
57 | } | ||||||
58 | 6 | 8 | if ( defined $h->{QUEUETIME} ) { | ||||
58 | 6 | 9 | if ( defined $h->{QUEUETIME} ) { | ||||
59 | 1 | 2 | $plain .= "\r\nQUEUETIME=" . $h->{QUEUETIME}; | ||||
60 | } | ||||||
61 | 6 | 7 | if ( defined $h->{RUNTIME} ) { | ||||
62 | 1 | 1 | $plain .= "\r\nRUNTIME=" . $h->{RUNTIME}; | ||||
61 | 6 | 6 | if ( defined $h->{RUNTIME} ) { | ||||
62 | 1 | 2 | $plain .= "\r\nRUNTIME=" . $h->{RUNTIME}; | ||||
63 | } | ||||||
64 | 6 | 7 | $plain .= "\r\nEOF\r\n"; | ||||
65 | 6 | 8 | return $plain; | ||||
64 | 6 | 6 | $plain .= "\r\nEOF\r\n"; | ||||
65 | 6 | 7 | return $plain; | ||||
66 | } | ||||||
67 | |||||||
68 | 1; | ||||||
69 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::ResponseTemplate; | ||||||
2 | |||||||
3 | 1 1 | 274 2 | use 5.030; | ||||
4 | 1 1 1 | 2 1 8 | use strict; | ||||
5 | 1 1 1 | 2 1 15 | use warnings; | ||||
6 | 1 1 1 | 234 1 15 | use WebService::Hexonet::Connector::ResponseParser; | ||||
7 | 1 1 1 | 248 1 18 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
8 | |||||||
9 | 1 1 1 | 2 5 2 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
2 | |||||||
3 | 1 1 | 329 2 | use 5.030; | ||||
4 | 1 1 1 | 2 0 11 | use strict; | ||||
5 | 1 1 1 | 2 1 18 | use warnings; | ||||
6 | 1 1 1 | 328 1 20 | use WebService::Hexonet::Connector::ResponseParser; | ||||
7 | 1 1 1 | 336 2 15 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
8 | |||||||
9 | 1 1 1 | 3 6 4 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
10 | |||||||
11 | my $rtm = WebService::Hexonet::Connector::ResponseTemplateManager->getInstance(); | ||||||
12 | |||||||
13 | |||||||
14 | sub new { | ||||||
15 | 109 | 1 | 3479 | my ( $class, $raw ) = @_; | |||
16 | 109 | 118 | my $self = {}; | ||||
17 | 109 | 306 | if ( !defined $raw || length $raw == 0 ) { | ||||
18 | 11 | 14 | $raw = "[RESPONSE]\r\nCODE=423\r\nDESCRIPTION=Empty API response. Probably unreachable API end point {CONNECTION_URL}\r\nEOF\r\n"; | ||||
15 | 109 | 1 | 3696 | my ( $class, $raw ) = @_; | |||
16 | 109 | 145 | my $self = {}; | ||||
17 | 109 | 302 | if ( !defined $raw || length $raw == 0 ) { | ||||
18 | 11 | 12 | $raw = "[RESPONSE]\r\nCODE=423\r\nDESCRIPTION=Empty API response. Probably unreachable API end point {CONNECTION_URL}\r\nEOF\r\n"; | ||||
19 | } | ||||||
20 | 109 | 149 | $self->{raw} = $raw; | ||||
21 | 109 | 182 | $self->{hash} = WebService::Hexonet::Connector::ResponseParser::parse($raw); | ||||
22 | 109 | 266 | if ( !defined $self->{hash}->{'DESCRIPTION'} || !defined $self->{hash}->{'CODE'} ) { | ||||
23 | 1 | 3 | $self->{raw} = $rtm->getTemplate('invalid')->getPlain(); | ||||
20 | 109 | 179 | $self->{raw} = $raw; | ||||
21 | 109 | 181 | $self->{hash} = WebService::Hexonet::Connector::ResponseParser::parse($raw); | ||||
22 | 109 | 269 | if ( !defined $self->{hash}->{'DESCRIPTION'} || !defined $self->{hash}->{'CODE'} ) { | ||||
23 | 1 | 2 | $self->{raw} = $rtm->getTemplate('invalid')->getPlain(); | ||||
24 | 1 | 2 | $self->{hash} = WebService::Hexonet::Connector::ResponseParser::parse( $self->{raw} ); | ||||
25 | } | ||||||
26 | 109 | 263 | return bless $self, $class; | ||||
26 | 109 | 248 | return bless $self, $class; | ||||
27 | } | ||||||
28 | |||||||
29 | |||||||
30 | sub getCode { | ||||||
31 | 3 | 1 | 8 | my $self = shift; | |||
32 | 3 | 10 | return ( $self->{hash}->{CODE} + 0 ); | ||||
32 | 3 | 7 | return ( $self->{hash}->{CODE} + 0 ); | ||||
33 | } | ||||||
34 | |||||||
35 | |||||||
36 | sub getDescription { | ||||||
37 | 7 | 1 | 14 | my $self = shift; | |||
38 | 7 | 27 | return $self->{hash}->{DESCRIPTION}; | ||||
38 | 7 | 23 | return $self->{hash}->{DESCRIPTION}; | ||||
39 | } | ||||||
40 | |||||||
41 | |||||||
42 | sub getPlain { | ||||||
43 | 32 | 1 | 74 | my $self = shift; | |||
44 | 32 | 97 | return $self->{raw}; | ||||
43 | 32 | 1 | 75 | my $self = shift; | |||
44 | 32 | 85 | return $self->{raw}; | ||||
45 | } | ||||||
46 | |||||||
47 | |||||||
48 | sub getQueuetime { | ||||||
49 | 2 | 1 | 5 | my $self = shift; | |||
53 | 1 | 3 | return 0.00; | ||||
54 | } | ||||||
55 | |||||||
56 | |||||||
57 | sub getHash { | ||||||
58 | 61 | 1 | 68 | my $self = shift; | |||
59 | 61 | 92 | return $self->{hash}; | ||||
58 | 61 | 1 | 75 | my $self = shift; | |||
59 | 61 | 104 | return $self->{hash}; | ||||
60 | } | ||||||
61 | |||||||
62 | |||||||
63 | sub getRuntime { | ||||||
64 | 2 | 1 | 7 | my $self = shift; | |||
65 | 2 | 4 | if ( defined $self->{hash}->{RUNTIME} ) { | ||||
64 | 2 | 1 | 5 | my $self = shift; | |||
65 | 2 | 5 | if ( defined $self->{hash}->{RUNTIME} ) { | ||||
66 | 1 | 5 | return ( $self->{hash}->{RUNTIME} + 0.00 ); | ||||
67 | } | ||||||
68 | 1 | 3 | return 0.00; | ||||
68 | 1 | 2 | return 0.00; | ||||
69 | } | ||||||
70 | |||||||
71 | |||||||
72 | sub isError { | ||||||
73 | 2 | 1 | 1628 | my $self = shift; | |||
73 | 2 | 1 | 2081 | my $self = shift; | |||
74 | 2 | 7 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
75 | 2 | 9 | return ( $first eq '5' ); | ||||
76 | } | ||||||
77 | |||||||
78 | |||||||
79 | sub isSuccess { | ||||||
80 | 18 | 1 | 6099 | my $self = shift; | |||
81 | 18 | 51 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
82 | 18 | 77 | return ( $first eq '2' ); | ||||
80 | 18 | 1 | 8958 | my $self = shift; | |||
81 | 18 | 57 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
82 | 18 | 78 | return ( $first eq '2' ); | ||||
83 | } | ||||||
84 | |||||||
85 | |||||||
86 | sub isTmpError { | ||||||
87 | 1 | 1 | 620 | my $self = shift; | |||
88 | 1 | 5 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
89 | 1 | 6 | return ( $first eq '4' ); | ||||
87 | 1 | 1 | 948 | my $self = shift; | |||
88 | 1 | 4 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
89 | 1 | 5 | return ( $first eq '4' ); | ||||
90 | } | ||||||
91 | |||||||
92 | |||||||
93 | sub isPending { | ||||||
94 | 2 | 1 | 7 | my $self = shift; | |||
95 | 2 | 4 | if ( defined $self->{hash}->{PENDING} ) { | ||||
96 | 1 | 3 | return int( $self->{hash}->{PENDING} ); | ||||
95 | 2 | 3 | if ( defined $self->{hash}->{PENDING} ) { | ||||
96 | 1 | 4 | return int( $self->{hash}->{PENDING} ); | ||||
97 | } | ||||||
98 | 1 | 3 | return 0; | ||||
99 | } |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::ResponseTemplateManager; | ||||||
2 | |||||||
3 | 1 1 | 7 1 | use 5.030; | ||||
4 | 1 1 1 | 4 1 9 | use strict; | ||||
5 | 1 1 1 | 1 1 14 | use warnings; | ||||
6 | 1 1 1 | 2 1 12 | use WebService::Hexonet::Connector::ResponseTemplate; | ||||
7 | 1 1 1 | 1 1 9 | use WebService::Hexonet::Connector::ResponseParser; | ||||
8 | |||||||
9 | 1 1 1 | 1 7 3 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
2 | |||||||
3 | 1 1 | 8 2 | use 5.030; | ||||
4 | 1 1 1 | 2 1 8 | use strict; | ||||
5 | 1 1 1 | 2 1 19 | use warnings; | ||||
6 | 1 1 1 | 2 1 13 | use WebService::Hexonet::Connector::ResponseTemplate; | ||||
7 | 1 1 1 | 2 1 10 | use WebService::Hexonet::Connector::ResponseParser; | ||||
8 | |||||||
9 | 1 1 1 | 2 6 2 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
10 | |||||||
11 | my $instance = undef; | ||||||
12 | |||||||
13 | |||||||
14 | sub getInstance { | ||||||
15 | 3 | 1 | 7 | if ( !defined $instance ) { | |||
16 | 1 | 1 | my $self = { templates => {} }; | ||||
17 | 1 | 2 | $instance = bless $self, shift; | ||||
18 | 1 | 1 | $instance->addTemplate( '404', $instance->generateTemplate( '421', 'Page not found' ) ); | ||||
15 | 3 | 1 | 6 | if ( !defined $instance ) { | |||
16 | 1 | 2 | my $self = { templates => {} }; | ||||
17 | 1 | 1 | $instance = bless $self, shift; | ||||
18 | 1 | 2 | $instance->addTemplate( '404', $instance->generateTemplate( '421', 'Page not found' ) ); | ||||
19 | 1 | 1 | $instance->addTemplate( '500', $instance->generateTemplate( '500', 'Internal server error' ) ); | ||||
20 | 1 | 1 | $instance->addTemplate( 'empty', $instance->generateTemplate( '423', 'Empty API response. Probably unreachable API end point {CONNECTION_URL}' ) ); | ||||
21 | 1 | 1 | $instance->addTemplate( 'error', $instance->generateTemplate( '421', 'Command failed due to server error. Client should try again' ) ); | ||||
22 | 1 | 2 | $instance->addTemplate( 'expired', $instance->generateTemplate( '530', 'SESSION NOT FOUND' ) ); | ||||
23 | 1 | 1 | $instance->addTemplate( 'httperror', $instance->generateTemplate( '421', 'Command failed due to HTTP communication error' ) ); | ||||
22 | 1 | 1 | $instance->addTemplate( 'expired', $instance->generateTemplate( '530', 'SESSION NOT FOUND' ) ); | ||||
23 | 1 | 2 | $instance->addTemplate( 'httperror', $instance->generateTemplate( '421', 'Command failed due to HTTP communication error' ) ); | ||||
24 | 1 | 1 | $instance->addTemplate( 'invalid', $instance->generateTemplate( '423', 'Invalid API response. Contact Support' ) ); | ||||
25 | 1 | 2 | $instance->addTemplate( 'unauthorized', $instance->generateTemplate( '530', 'Unauthorized' ) ); | ||||
26 | } | ||||||
27 | 3 | 4 | return $instance; | ||||
27 | 3 | 5 | return $instance; | ||||
28 | } | ||||||
29 | |||||||
30 | |||||||
31 | sub generateTemplate { | ||||||
32 | 10 | 1 | 319 | my ( $self, $code, $description ) = @_; | |||
33 | 10 | 18 | return "[RESPONSE]\r\nCODE=${code}\r\nDESCRIPTION=${description}\r\nEOF\r\n"; | ||||
32 | 10 | 1 | 468 | my ( $self, $code, $description ) = @_; | |||
33 | 10 | 14 | return "[RESPONSE]\r\nCODE=${code}\r\nDESCRIPTION=${description}\r\nEOF\r\n"; | ||||
34 | } | ||||||
35 | |||||||
36 | |||||||
37 | sub addTemplate { | ||||||
38 | 10 | 1 | 11 | my ( $self, $id, $plain ) = @_; | |||
38 | 10 | 1 | 9 | my ( $self, $id, $plain ) = @_; | |||
39 | 10 | 12 | $self->{templates}->{$id} = $plain; | ||||
40 | 10 | 8 | return $instance; | ||||
40 | 10 | 9 | return $instance; | ||||
41 | } | ||||||
42 | |||||||
43 | |||||||
44 | sub getTemplate { | ||||||
45 | 35 | 1 | 8993 | my ( $self, $id ) = @_; | |||
46 | 35 | 40 | my $plain; | ||||
47 | 35 | 54 | if ( $self->hasTemplate($id) ) { | ||||
48 | 34 | 44 | $plain = $self->{templates}->{$id}; | ||||
45 | 35 | 1 | 8360 | my ( $self, $id ) = @_; | |||
46 | 35 | 35 | my $plain; | ||||
47 | 35 | 47 | if ( $self->hasTemplate($id) ) { | ||||
48 | 34 | 37 | $plain = $self->{templates}->{$id}; | ||||
49 | } else { | ||||||
50 | 1 | 3 | $plain = $self->generateTemplate( '500', 'Response Template not found' ); | ||||
50 | 1 | 2 | $plain = $self->generateTemplate( '500', 'Response Template not found' ); | ||||
51 | } | ||||||
52 | 35 | 108 | return WebService::Hexonet::Connector::ResponseTemplate->new($plain); | ||||
52 | 35 | 71 | return WebService::Hexonet::Connector::ResponseTemplate->new($plain); | ||||
53 | } | ||||||
54 | |||||||
55 | |||||||
56 | sub getTemplates { | ||||||
57 | 1 | 1 | 2 | my $self = shift; | |||
58 | 1 | 2 | my $tmp = {}; | ||||
57 | 1 | 1 | 1 | my $self = shift; | |||
58 | 1 | 1 | my $tmp = {}; | ||||
59 | 1 | 2 | my $tpls = $self->{templates}; | ||||
60 | 1 1 | 2 4 | foreach my $key ( keys %{$tpls} ) { | ||||
61 | 10 | 13 | $tmp->{$key} = WebService::Hexonet::Connector::ResponseTemplate->new( $tpls->{$key} ); | ||||
60 | 1 1 | 1 3 | foreach my $key ( keys %{$tpls} ) { | ||||
61 | 10 | 12 | $tmp->{$key} = WebService::Hexonet::Connector::ResponseTemplate->new( $tpls->{$key} ); | ||||
62 | } | ||||||
63 | 1 | 1 | return $tmp; | ||||
63 | 1 | 2 | return $tmp; | ||||
64 | } | ||||||
65 | |||||||
66 | |||||||
67 | sub hasTemplate { | ||||||
68 | 35 | 1 | 51 | my ( $self, $id ) = @_; | |||
69 | 35 | 82 | return defined $self->{templates}->{$id}; | ||||
68 | 35 | 1 | 36 | my ( $self, $id ) = @_; | |||
69 | 35 | 64 | return defined $self->{templates}->{$id}; | ||||
70 | } | ||||||
71 | |||||||
72 | |||||||
73 | sub isTemplateMatchHash { | ||||||
74 | 2 | 1 | 5 | my ( $self, $tpl2, $id ) = @_; | |||
75 | 2 | 3 | my $tpl = $self->getTemplate($id); | ||||
76 | 2 | 3 | my $h = $tpl->getHash(); | ||||
76 | 2 | 4 | my $h = $tpl->getHash(); | ||||
77 | 2 | 10 | return ( $h->{CODE} eq $tpl2->{CODE} ) && ( $h->{DESCRIPTION} eq $tpl2->{DESCRIPTION} ); | ||||
78 | } | ||||||
79 | |||||||
80 | |||||||
81 | sub isTemplateMatchPlain { | ||||||
line | stmt | bran | cond | sub | pod | time | code |
1 | package WebService::Hexonet::Connector::SocketConfig; | ||||||
2 | |||||||
3 | 1 1 | 8 1 | use 5.030; | ||||
4 | 1 1 1 | 1 2 7 | use strict; | ||||
5 | 1 1 1 | 2 1 16 | use warnings; | ||||
4 | 1 1 1 | 2 1 10 | use strict; | ||||
5 | 1 1 1 | 2 1 19 | use warnings; | ||||
6 | 1 1 1 | 2 1 2 | use utf8; | ||||
7 | |||||||
8 | 1 1 1 | 10 9 3 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
7 | |||||||
8 | 1 1 1 | 12 5 3 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
9 | |||||||
10 | |||||||
11 | sub new { | ||||||
12 | 3 | 1 | 363 | my $class = shift; | |||
13 | 3 | 31 | return bless { | ||||
12 | 3 | 1 | 337 | my $class = shift; | |||
13 | 3 | 19 | return bless { | ||||
14 | entity => q{}, | ||||||
15 | login => q{}, | ||||||
16 | otp => q{}, | ||||||
21 | }, $class; | ||||||
22 | } | ||||||
23 | |||||||
24 | |||||||
25 | sub getPOSTData { | ||||||
26 | 51 | 1 | 62 | my $self = shift; | |||
26 | 51 | 1 | 59 | my $self = shift; | |||
27 | 51 | 57 | my $data = {}; | ||||
28 | 51 | 121 | if ( length $self->{entity} ) { | ||||
29 | 50 | 79 | $data->{'s_entity'} = $self->{entity}; | ||||
28 | 51 | 119 | if ( length $self->{entity} ) { | ||||
29 | 50 | 76 | $data->{'s_entity'} = $self->{entity}; | ||||
30 | } | ||||||
31 | 51 | 82 | if ( length $self->{login} ) { | ||||
32 | 33 | 65 | $data->{'s_login'} = $self->{login}; | ||||
31 | 51 | 88 | if ( length $self->{login} ) { | ||||
32 | 33 | 105 | $data->{'s_login'} = $self->{login}; | ||||
33 | } | ||||||
34 | 51 | 98 | if ( length $self->{otp} ) { | ||||
35 | 1 | 3 | $data->{'s_otp'} = $self->{otp}; | ||||
34 | 51 | 86 | if ( length $self->{otp} ) { | ||||
35 | 1 | 2 | $data->{'s_otp'} = $self->{otp}; | ||||
36 | } | ||||||
37 | 51 | 73 | if ( length $self->{pw} ) { | ||||
38 | 33 | 45 | $data->{'s_pw'} = $self->{pw}; | ||||
38 | 33 | 44 | $data->{'s_pw'} = $self->{pw}; | ||||
39 | } | ||||||
40 | 51 | 69 | if ( length $self->{remoteaddr} ) { | ||||
41 | 35 | 46 | $data->{'s_remoteaddr'} = $self->{remoteaddr}; | ||||
40 | 51 | 79 | if ( length $self->{remoteaddr} ) { | ||||
41 | 35 | 51 | $data->{'s_remoteaddr'} = $self->{remoteaddr}; | ||||
42 | } | ||||||
43 | 51 | 65 | if ( length $self->{session} ) { | ||||
43 | 51 | 83 | if ( length $self->{session} ) { | ||||
44 | 7 | 10 | $data->{'s_session'} = $self->{session}; | ||||
45 | } | ||||||
46 | 51 | 65 | if ( length $self->{user} ) { | ||||
47 | 2 | 3 | $data->{'s_user'} = $self->{user}; | ||||
46 | 51 | 81 | if ( length $self->{user} ) { | ||||
47 | 2 | 2 | $data->{'s_user'} = $self->{user}; | ||||
48 | } | ||||||
49 | 51 | 59 | return $data; | ||||
50 | } | ||||||
51 | |||||||
52 | |||||||
53 | sub getSession { | ||||||
54 | 3 | 1 | 5 | my $self = shift; | |||
55 | 3 | 7 | return $self->{session}; | ||||
54 | 3 | 1 | 3 | my $self = shift; | |||
55 | 3 | 5 | return $self->{session}; | ||||
56 | } | ||||||
57 | |||||||
58 | |||||||
59 | sub getSystemEntity { | ||||||
60 | 1 | 1 | 2 | my $self = shift; | |||
61 | 1 | 4 | return $self->{entity}; | ||||
61 | 1 | 2 | return $self->{entity}; | ||||
62 | } | ||||||
63 | |||||||
64 | |||||||
65 | sub setLogin { | ||||||
66 | 11 | 1 | 21 | my ( $self, $value ) = @_; | |||
67 | 11 | 16 | $self->{session} = q{}; # Empty string | ||||
68 | 11 | 19 | $self->{login} = $value; | ||||
69 | 11 | 16 | return $self; | ||||
66 | 11 | 1 | 17 | my ( $self, $value ) = @_; | |||
67 | 11 | 15 | $self->{session} = q{}; # Empty string | ||||
68 | 11 | 14 | $self->{login} = $value; | ||||
69 | 11 | 13 | return $self; | ||||
70 | } | ||||||
71 | |||||||
72 | |||||||
73 | sub setOTP { | ||||||
74 | 7 | 1 | 13 | my ( $self, $value ) = @_; | |||
75 | 7 | 10 | $self->{session} = q{}; # Empty string | ||||
76 | 7 | 11 | $self->{otp} = $value; | ||||
77 | 7 | 8 | return $self; | ||||
74 | 7 | 1 | 16 | my ( $self, $value ) = @_; | |||
75 | 7 | 11 | $self->{session} = q{}; # Empty string | ||||
76 | 7 | 10 | $self->{otp} = $value; | ||||
77 | 7 | 10 | return $self; | ||||
78 | } | ||||||
79 | |||||||
80 | |||||||
81 | sub setPassword { | ||||||
82 | 11 | 1 | 19 | my ( $self, $value ) = @_; | |||
83 | 11 | 17 | $self->{session} = q{}; # Empty string | ||||
84 | 11 | 16 | $self->{pw} = $value; | ||||
85 | 11 | 19 | return $self; | ||||
82 | 11 | 1 | 18 | my ( $self, $value ) = @_; | |||
83 | 11 | 11 | $self->{session} = q{}; # Empty string | ||||
84 | 11 | 13 | $self->{pw} = $value; | ||||
85 | 11 | 12 | return $self; | ||||
86 | } | ||||||
87 | |||||||
88 | |||||||
89 | sub setRemoteAddress { | ||||||
90 | 3 | 1 | 6 | my ( $self, $value ) = @_; | |||
91 | 3 | 5 | $self->{remoteaddr} = $value; | ||||
90 | 3 | 1 | 4 | my ( $self, $value ) = @_; | |||
91 | 3 | 4 | $self->{remoteaddr} = $value; | ||||
92 | 3 | 3 | return $self; | ||||
93 | } | ||||||
94 | |||||||
95 | |||||||
96 | sub setSession { | ||||||
97 | 12 | 1 | 17 | my ( $self, $value ) = @_; | |||
98 | 12 | 18 | $self->{session} = $value; | ||||
99 | 12 | 17 | $self->{login} = q{}; # Empty string | ||||
97 | 12 | 1 | 20 | my ( $self, $value ) = @_; | |||
98 | 12 | 16 | $self->{session} = $value; | ||||
99 | 12 | 15 | $self->{login} = q{}; # Empty string | ||||
100 | 12 | 18 | $self->{pw} = q{}; # Empty string | ||||
101 | 12 | 18 | $self->{otp} = q{}; # Empty string | ||||
102 | 12 | 13 | return $self; | ||||
101 | 12 | 14 | $self->{otp} = q{}; # Empty string | ||||
102 | 12 | 14 | return $self; | ||||
103 | } | ||||||
104 | |||||||
105 | |||||||
106 | sub setSystemEntity { | ||||||
107 | 4 | 1 | 8 | my ( $self, $value ) = @_; | |||
108 | 4 | 6 | $self->{entity} = $value; | ||||
109 | 4 | 3 | return $self; | ||||
107 | 4 | 1 | 5 | my ( $self, $value ) = @_; | |||
108 | 4 | 5 | $self->{entity} = $value; | ||||
109 | 4 | 4 | return $self; | ||||
110 | } | ||||||
111 | |||||||
112 | |||||||
113 | sub setUser { | ||||||
114 | 2 | 1 | 4 | my ( $self, $value ) = @_; | |||
115 | 2 | 6 | $self->{user} = $value; | ||||
116 | 2 | 4 | return $self; | ||||
114 | 2 | 1 | 3 | my ( $self, $value ) = @_; | |||
115 | 2 | 5 | $self->{user} = $value; | ||||
116 | 2 | 3 | return $self; | ||||
117 | } | ||||||
118 | |||||||
119 | 1; | ||||||
120 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector; | ||||||
2 | |||||||
3 | 1 1 | 318862 3 | use 5.030; | ||||
4 | 1 1 1 | 1 2 9 | use strict; | ||||
5 | 1 1 1 | 2 1 27 | use warnings; | ||||
6 | 1 1 1 | 280 2 17 | use WebService::Hexonet::Connector::APIClient; | ||||
7 | 1 1 1 | 3 1 9 | use WebService::Hexonet::Connector::Column; | ||||
8 | 1 1 1 | 2 1 10 | use WebService::Hexonet::Connector::Record; | ||||
9 | 1 1 1 | 2 1 10 | use WebService::Hexonet::Connector::Response; | ||||
10 | 1 1 1 | 1 1 7 | use WebService::Hexonet::Connector::ResponseParser; | ||||
11 | 1 1 1 | 2 1 5 | use WebService::Hexonet::Connector::ResponseTemplate; | ||||
12 | 1 1 1 | 2 1 6 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
13 | 1 1 1 | 1 1 13 | use WebService::Hexonet::Connector::SocketConfig; | ||||
14 | |||||||
15 | 1 1 1 | 1 7 3 | use version 0.9917; our $VERSION = version->declare('v2.10.0'); | ||||
2 | |||||||
3 | 1 1 | 395730 4 | use 5.030; | ||||
4 | 1 1 1 | 3 1 9 | use strict; | ||||
5 | 1 1 1 | 3 1 30 | use warnings; | ||||
6 | 1 1 1 | 366 2 18 | use WebService::Hexonet::Connector::APIClient; | ||||
7 | 1 1 1 | 4 1 8 | use WebService::Hexonet::Connector::Column; | ||||
8 | 1 1 1 | 2 1 9 | use WebService::Hexonet::Connector::Record; | ||||
9 | 1 1 1 | 2 1 8 | use WebService::Hexonet::Connector::Response; | ||||
10 | 1 1 1 | 2 1 8 | use WebService::Hexonet::Connector::ResponseParser; | ||||
11 | 1 1 1 | 2 1 7 | use WebService::Hexonet::Connector::ResponseTemplate; | ||||
12 | 1 1 1 | 2 2 6 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
13 | 1 1 1 | 2 1 12 | use WebService::Hexonet::Connector::SocketConfig; | ||||
14 | |||||||
15 | 1 1 1 | 1 8 2 | use version 0.9917; our $VERSION = version->declare('v2.10.1'); | ||||
16 | |||||||
17 | 1; | ||||||
18 |
Database: | /home/travis/build/hexonet/perl-sdk/cover_db | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Report Date: | 2020-07-16 09:00:10 | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Perl Version: | v5.30.1 | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Database: | /__w/perl-sdk/perl-sdk/cover_db | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Report Date: | 2021-01-25 14:15:53 | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Perl Version: | v5.32.0 | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
OS: | linux | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Thresholds: | @@ -31,12 +31,12 @@
file | stmt | bran | cond | sub | pod | time | total |
---|---|---|---|---|---|---|---|
blib/lib/WebService/Hexonet/Connector.pm | 100.0 | n/a | n/a | 100.0 | n/a | 2.7 | 100.0 |
blib/lib/WebService/Hexonet/Connector/APIClient.pm | 97.3 | 82.8 | 50.0 | 98.0 | 91.4 | 92.6 | 93.4 |
blib/lib/WebService/Hexonet/Connector/Column.pm | 100.0 | 100.0 | n/a | 100.0 | 100.0 | 0.8 | 100.0 |
blib/lib/WebService/Hexonet/Connector.pm | 100.0 | n/a | n/a | 100.0 | n/a | 2.6 | 100.0 |
blib/lib/WebService/Hexonet/Connector/APIClient.pm | 97.3 | 82.8 | 50.0 | 98.0 | 91.4 | 93.0 | 93.4 |
blib/lib/WebService/Hexonet/Connector/Column.pm | 100.0 | 100.0 | n/a | 100.0 | 100.0 | 0.7 | 100.0 |
blib/lib/WebService/Hexonet/Connector/Logger.pm | 75.7 | 50.0 | n/a | 100.0 | 100.0 | 0.0 | 79.5 |
blib/lib/WebService/Hexonet/Connector/Record.pm | 100.0 | 100.0 | n/a | 100.0 | 100.0 | 0.0 | 100.0 |
blib/lib/WebService/Hexonet/Connector/Response.pm | 98.2 | 84.8 | 61.1 | 100.0 | 96.4 | 3.1 | 94.3 |
blib/lib/WebService/Hexonet/Connector/Response.pm | 98.2 | 84.8 | 61.1 | 100.0 | 96.4 | 2.9 | 94.3 |
blib/lib/WebService/Hexonet/Connector/ResponseParser.pm | 100.0 | 100.0 | n/a | 100.0 | 100.0 | 0.3 | 100.0 |
blib/lib/WebService/Hexonet/Connector/ResponseTemplate.pm | 100.0 | 100.0 | 83.3 | 100.0 | 100.0 | 0.1 | 99.0 |
blib/lib/WebService/Hexonet/Connector/ResponseTemplateManager.pm | 100.0 | 100.0 | 33.3 | 100.0 | 100.0 | 0.0 | 97.6 |