diff --git a/HISTORY.md b/HISTORY.md index 11dc949..c976e2f 100644 --- a/HISTORY.md +++ b/HISTORY.md @@ -1,3 +1,10 @@ +## [2.2.3](https://github.com/hexonet/perl-sdk/compare/v2.2.2...v2.2.3) (2019-09-19) + + +### Bug Fixes + +* **release process:** migrate configuration ([26efd60](https://github.com/hexonet/perl-sdk/commit/26efd60)) + ## [2.2.2](https://github.com/hexonet/perl-sdk/compare/v2.2.1...v2.2.2) (2019-08-16) diff --git a/WebService-Hexonet-Connector-latest.tar.gz b/WebService-Hexonet-Connector-latest.tar.gz index 69515b9..471cb65 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 2d72db5..9c7cad2 100644 --- a/cover_db/blib-lib-WebService-Hexonet-Connector-APIClient-pm.html +++ b/cover_db/blib-lib-WebService-Hexonet-Connector-APIClient-pm.html @@ -26,285 +26,285 @@
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::APIClient; | ||||||
2 | |||||||
3 | 1 1 | 8 4 | use 5.026_000; | ||||
4 | 1 1 1 | 2 2 8 | use strict; | ||||
5 | 1 1 1 | 3 1 19 | use warnings; | ||||
6 | 1 1 1 | 256 9 5 | use utf8; | ||||
7 | 1 1 1 | 288 2 18 | use WebService::Hexonet::Connector::SocketConfig; | ||||
8 | 1 1 1 | 349 3 30 | use WebService::Hexonet::Connector::Response; | ||||
9 | 1 1 1 | 397 2 19 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
10 | 1 1 1 | 370 24427 28 | use LWP::UserAgent; | ||||
11 | 1 1 1 | 7 2 46 | use Carp; | ||||
12 | 1 1 1 | 4 2 39 | use Readonly; | ||||
13 | 1 1 1 | 371 3795 54 | use Data::Dumper; | ||||
14 | 1 1 1 | 6 2 23 | use Config; | ||||
15 | 1 1 1 | 4 2 7 | use POSIX; | ||||
2 | |||||||
3 | 1 1 | 9 2 | use 5.026_000; | ||||
4 | 1 1 1 | 2 2 12 | use strict; | ||||
5 | 1 1 1 | 2 2 17 | use warnings; | ||||
6 | 1 1 1 | 237 9 5 | use utf8; | ||||
7 | 1 1 1 | 316 2 19 | use WebService::Hexonet::Connector::SocketConfig; | ||||
8 | 1 1 1 | 325 2 21 | use WebService::Hexonet::Connector::Response; | ||||
9 | 1 1 1 | 318 2 21 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
10 | 1 1 1 | 293 23081 23 | use LWP::UserAgent; | ||||
11 | 1 1 1 | 5 2 35 | use Carp; | ||||
12 | 1 1 1 | 4 2 23 | use Readonly; | ||||
13 | 1 1 1 | 307 3968 41 | use Data::Dumper; | ||||
14 | 1 1 1 | 5 2 23 | use Config; | ||||
15 | 1 1 1 | 3 2 6 | use POSIX; | ||||
16 | |||||||
17 | Readonly my $SOCKETTIMEOUT => 300; # 300s or 5 min | ||||||
18 | |||||||
19 | 1 1 1 | 1256 19 7 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
18 | |||||||
19 | 1 1 1 | 1262 13 6 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
20 | |||||||
21 | my $rtm = WebService::Hexonet::Connector::ResponseTemplateManager->getInstance(); | ||||||
22 | |||||||
23 | |||||||
24 | sub new { | ||||||
25 | 2 | 1 | 12 | my $class = shift; | |||
26 | 2 | 14 | my $self = bless { | ||||
25 | 2 | 1 | 9 | my $class = shift; | |||
26 | 2 | 11 | my $self = bless { | ||||
27 | socketURL => 'https://api.ispapi.net/api/call.cgi', | ||||||
28 | debugMode => 0, | ||||||
29 | socketConfig => WebService::Hexonet::Connector::SocketConfig->new(), | ||||||
30 | ua => q{} | ||||||
31 | }, $class; | ||||||
32 | 2 | 11 | $self->setURL('https://api.ispapi.net/api/call.cgi'); | ||||
33 | 2 | 10 | $self->useLIVESystem(); | ||||
34 | 2 | 4 | return $self; | ||||
32 | 2 | 10 | $self->setURL('https://api.ispapi.net/api/call.cgi'); | ||||
33 | 2 | 11 | $self->useLIVESystem(); | ||||
34 | 2 | 5 | return $self; | ||||
35 | } | ||||||
36 | |||||||
37 | |||||||
38 | sub enableDebugMode { | ||||||
39 | 2 | 1 | 578 | my $self = shift; | |||
40 | 2 | 8 | $self->{debugMode} = 1; | ||||
41 | 2 | 6 | return $self; | ||||
39 | 2 | 1 | 611 | my $self = shift; | |||
40 | 2 | 6 | $self->{debugMode} = 1; | ||||
41 | 2 | 5 | return $self; | ||||
42 | } | ||||||
43 | |||||||
44 | |||||||
45 | sub disableDebugMode { | ||||||
46 | 2 | 1 | 11 | my $self = shift; | |||
47 | 2 | 8 | $self->{debugMode} = 0; | ||||
47 | 2 | 7 | $self->{debugMode} = 0; | ||||
48 | 2 | 5 | return $self; | ||||
49 | } | ||||||
50 | |||||||
51 | |||||||
52 | sub getPOSTData { | ||||||
53 | 43 | 1 | 1404 | my ( $self, $cmd ) = @_; | |||
54 | 43 | 158 | my $post = $self->{socketConfig}->getPOSTData(); | ||||
55 | 43 | 89 | my $tmp = q{}; | ||||
56 | 43 | 251 | if ( ( ref $cmd ) eq 'HASH' ) { | ||||
57 | 42 42 | 72 158 | foreach my $key ( sort keys %{$cmd} ) { | ||||
58 | 66 | 149 | if ( defined $cmd->{$key} ) { | ||||
59 | 65 | 107 | my $val = $cmd->{$key}; | ||||
60 | 65 | 148 | $val =~ s/[\r\n]//gmsx; | ||||
61 | 65 | 165 | $tmp .= "${key}=${val}\n"; | ||||
53 | 43 | 1 | 1352 | my ( $self, $cmd ) = @_; | |||
54 | 43 | 144 | my $post = $self->{socketConfig}->getPOSTData(); | ||||
55 | 43 | 83 | my $tmp = q{}; | ||||
56 | 43 | 127 | if ( ( ref $cmd ) eq 'HASH' ) { | ||||
57 | 42 42 | 72 141 | foreach my $key ( sort keys %{$cmd} ) { | ||||
58 | 66 | 129 | if ( defined $cmd->{$key} ) { | ||||
59 | 65 | 101 | my $val = $cmd->{$key}; | ||||
60 | 65 | 160 | $val =~ s/[\r\n]//gmsx; | ||||
61 | 65 | 147 | $tmp .= "${key}=${val}\n"; | ||||
62 | } | ||||||
63 | } | ||||||
64 | } | ||||||
65 | 43 | 176 | $tmp =~ s/\n$//msx; | ||||
66 | 43 | 133 | if ( utf8::is_utf8($tmp) ) { | ||||
65 | 43 | 183 | $tmp =~ s/\n$//msx; | ||||
66 | 43 | 115 | if ( utf8::is_utf8($tmp) ) { | ||||
67 | 0 | 0 | utf8::encode($tmp); | ||||
68 | } | ||||||
69 | 43 | 92 | $post->{'s_command'} = $tmp; | ||||
70 | 43 | 100 | return $post; | ||||
70 | 43 | 90 | return $post; | ||||
71 | } | ||||||
72 | |||||||
73 | |||||||
74 | sub getSession { | ||||||
75 | 2 | 1 | 12 | my $self = shift; | |||
76 | 2 | 8 | my $sessid = $self->{socketConfig}->getSession(); | ||||
77 | 2 | 9 | if ( length $sessid ) { | ||||
78 | 1 | 3 | return $sessid; | ||||
75 | 2 | 1 | 11 | my $self = shift; | |||
76 | 2 | 10 | my $sessid = $self->{socketConfig}->getSession(); | ||||
77 | 2 | 7 | if ( length $sessid ) { | ||||
78 | 1 | 4 | return $sessid; | ||||
79 | } | ||||||
80 | 1 | 3 | return; | ||||
81 | } | ||||||
82 | |||||||
83 | |||||||
84 | sub getURL { | ||||||
85 | 3 | 1 | 14 | my $self = shift; | |||
86 | 3 | 10 | return $self->{socketURL}; | ||||
85 | 3 | 1 | 11 | my $self = shift; | |||
86 | 3 | 12 | return $self->{socketURL}; | ||||
87 | } | ||||||
88 | |||||||
89 | |||||||
90 | sub getUserAgent { | ||||||
91 | 16 | 1 | 62 | my $self = shift; | |||
92 | 16 | 57 | if ( !( length $self->{ua} ) ) { | ||||
93 | 1 | 8 | my $arch = (POSIX::uname)[ 4 ]; | ||||
94 | 1 | 4 | my $os = (POSIX::uname)[ 0 ]; | ||||
95 | 1 | 4 | my $rv = $self->getVersion(); | ||||
91 | 16 | 1 | 57 | my $self = shift; | |||
92 | 16 | 52 | if ( !( length $self->{ua} ) ) { | ||||
93 | 1 | 7 | my $arch = (POSIX::uname)[ 4 ]; | ||||
94 | 1 | 5 | my $os = (POSIX::uname)[ 0 ]; | ||||
95 | 1 | 3 | my $rv = $self->getVersion(); | ||||
96 | 1 | 36 | $self->{ua} = "PERL-SDK ($os; $arch; rv:$rv) perl/$Config{version}"; | ||||
97 | } | ||||||
98 | 16 | 55 | return $self->{ua}; | ||||
98 | 16 | 54 | return $self->{ua}; | ||||
99 | } | ||||||
100 | |||||||
101 | |||||||
102 | sub setUserAgent { | ||||||
103 | 1 | 1 | 499 | my ( $self, $str, $rv ) = @_; | |||
104 | 1 | 8 | my $arch = (POSIX::uname)[ 4 ]; | ||||
105 | 1 | 6 | my $os = (POSIX::uname)[ 0 ]; | ||||
106 | 1 | 5 | my $rv2 = $self->getVersion(); | ||||
103 | 1 | 1 | 516 | my ( $self, $str, $rv ) = @_; | |||
104 | 1 | 7 | my $arch = (POSIX::uname)[ 4 ]; | ||||
105 | 1 | 7 | my $os = (POSIX::uname)[ 0 ]; | ||||
106 | 1 | 6 | my $rv2 = $self->getVersion(); | ||||
107 | 1 | 10 | $self->{ua} = "$str ($os; $arch; rv:$rv) perl-sdk/$rv2 perl/$Config{version}"; | ||||
108 | 1 | 7 | return $self; | ||||
108 | 1 | 13 | return $self; | ||||
109 | } | ||||||
110 | |||||||
111 | |||||||
112 | sub getVersion { | ||||||
113 | 3 | 1 | 23 | my $self = shift; | |||
114 | 3 | 10 | return $VERSION; | ||||
113 | 3 | 1 | 21 | my $self = shift; | |||
114 | 3 | 9 | return $VERSION; | ||||
115 | } | ||||||
116 | |||||||
117 | |||||||
118 | sub saveSession { | ||||||
119 | 1 | 1 | 7 | my ( $self, $session ) = @_; | |||
120 | $session->{socketcfg} = { | ||||||
121 | entity => $self->{socketConfig}->getSystemEntity(), | ||||||
122 | session => $self->{socketConfig}->getSession() | ||||||
123 | 1 | 11 | }; | ||||
123 | 1 | 6 | }; | ||||
124 | 1 | 3 | return $self; | ||||
125 | } | ||||||
126 | |||||||
127 | |||||||
128 | sub reuseSession { | ||||||
129 | 1 | 1 | 5 | my ( $self, $session ) = @_; | |||
130 | 1 | 5 | $self->{socketConfig}->setSystemEntity( $session->{socketcfg}->{entity} ); | ||||
130 | 1 | 9 | $self->{socketConfig}->setSystemEntity( $session->{socketcfg}->{entity} ); | ||||
131 | 1 | 3 | $self->setSession( $session->{socketcfg}->{session} ); | ||||
132 | 1 | 1 | return $self; | ||||
132 | 1 | 2 | return $self; | ||||
133 | } | ||||||
134 | |||||||
135 | |||||||
136 | sub setURL { | ||||||
137 | 6 | 1 | 964 | my ( $self, $value ) = @_; | |||
138 | 6 | 22 | $self->{socketURL} = $value; | ||||
137 | 6 | 1 | 901 | my ( $self, $value ) = @_; | |||
138 | 6 | 23 | $self->{socketURL} = $value; | ||||
139 | 6 | 17 | return $self; | ||||
140 | } | ||||||
141 | |||||||
142 | |||||||
143 | sub setOTP { | ||||||
144 | 8 | 1 | 627 | my ( $self, $value ) = @_; | |||
145 | 8 | 40 | $self->{socketConfig}->setOTP($value); | ||||
146 | 8 | 18 | return $self; | ||||
144 | 8 | 1 | 600 | my ( $self, $value ) = @_; | |||
145 | 8 | 32 | $self->{socketConfig}->setOTP($value); | ||||
146 | 8 | 14 | return $self; | ||||
147 | } | ||||||
148 | |||||||
149 | |||||||
150 | sub setSession { | ||||||
151 | 13 | 1 | 3297 | my ( $self, $value ) = @_; | |||
152 | 13 | 64 | $self->{socketConfig}->setSession($value); | ||||
153 | 13 | 28 | return $self; | ||||
151 | 13 | 1 | 3337 | my ( $self, $value ) = @_; | |||
152 | 13 | 59 | $self->{socketConfig}->setSession($value); | ||||
153 | 13 | 27 | return $self; | ||||
154 | } | ||||||
155 | |||||||
156 | |||||||
157 | sub setRemoteIPAddress { | ||||||
158 | 3 | 1 | 572 | my ( $self, $value ) = @_; | |||
159 | 3 | 19 | $self->{socketConfig}->setRemoteAddress($value); | ||||
160 | 3 | 7 | return $self; | ||||
158 | 3 | 1 | 610 | my ( $self, $value ) = @_; | |||
159 | 3 | 17 | $self->{socketConfig}->setRemoteAddress($value); | ||||
160 | 3 | 6 | return $self; | ||||
161 | } | ||||||
162 | |||||||
163 | |||||||
164 | sub setCredentials { | ||||||
165 | 10 | 1 | 1262 | my ( $self, $uid, $pw ) = @_; | |||
166 | 10 | 64 | $self->{socketConfig}->setLogin($uid); | ||||
167 | 10 | 45 | $self->{socketConfig}->setPassword($pw); | ||||
168 | 10 | 35 | return $self; | ||||
165 | 10 | 1 | 1218 | my ( $self, $uid, $pw ) = @_; | |||
166 | 10 | 58 | $self->{socketConfig}->setLogin($uid); | ||||
167 | 10 | 47 | $self->{socketConfig}->setPassword($pw); | ||||
168 | 10 | 25 | return $self; | ||||
169 | } | ||||||
170 | |||||||
171 | |||||||
172 | sub setRoleCredentials { | ||||||
173 | 4 | 1 | 1729 | my ( $self, $uid, $role, $pw ) = @_; | |||
174 | 4 | 14 | my $myuid = "${uid}!${role}"; | ||||
175 | 4 | 15 | $myuid =~ s/^\!$//msx; | ||||
176 | 4 | 18 | return $self->setCredentials( $myuid, $pw ); | ||||
173 | 4 | 1 | 1765 | my ( $self, $uid, $role, $pw ) = @_; | |||
174 | 4 | 13 | my $myuid = "${uid}!${role}"; | ||||
175 | 4 | 16 | $myuid =~ s/^\!$//msx; | ||||
176 | 4 | 16 | return $self->setCredentials( $myuid, $pw ); | ||||
177 | } | ||||||
178 | |||||||
179 | |||||||
180 | sub login { | ||||||
181 | 4 | 1 | 17 | my $self = shift; | |||
182 | 4 | 11 | my $otp = shift; | ||||
183 | 4 | 36 | $self->setOTP( $otp || q{} ); | ||||
184 | 4 | 23 | my $rr = $self->request( { COMMAND => 'StartSession' } ); | ||||
185 | 4 | 29 | if ( $rr->isSuccess() ) { | ||||
181 | 4 | 1 | 15 | my $self = shift; | |||
182 | 4 | 9 | my $otp = shift; | ||||
183 | 4 | 29 | $self->setOTP( $otp || q{} ); | ||||
184 | 4 | 20 | my $rr = $self->request( { COMMAND => 'StartSession' } ); | ||||
185 | 4 | 20 | if ( $rr->isSuccess() ) { | ||||
186 | 2 | 6 | my $col = $rr->getColumn('SESSION'); | ||||
187 | 2 | 4 | my $sessid = q{}; | ||||
188 | 2 | 7 | if ( defined $col ) { | ||||
189 | 2 | 8 | my @d = $col->getData(); | ||||
190 | 2 | 5 | $sessid = $d[ 0 ]; | ||||
189 | 2 | 7 | my @d = $col->getData(); | ||||
190 | 2 | 6 | $sessid = $d[ 0 ]; | ||||
191 | } | ||||||
192 | 2 | 9 | $self->setSession($sessid); | ||||
193 | } | ||||||
194 | 4 | 54 | return $rr; | ||||
195 | } | ||||||
196 | |||||||
197 | |||||||
198 | sub loginExtended { | ||||||
199 | 1 | 1 | 4 | my $self = shift; | |||
199 | 1 | 1 | 3 | my $self = shift; | |||
200 | 1 | 2 | my $params = shift; | ||||
201 | 1 | 3 | my $otpc = shift; | ||||
202 | 1 | 4 | if ( !defined $otpc ) { | ||||
201 | 1 | 4 | my $otpc = shift; | ||||
202 | 1 | 5 | if ( !defined $otpc ) { | ||||
203 | 1 | 3 | $otpc = q{}; | ||||
204 | } | ||||||
205 | 1 | 4 | $self->setOTP($otpc); | ||||
206 | 1 | 2 | my $cmd = { COMMAND => 'StartSession' }; | ||||
207 | 1 1 | 2 4 | foreach my $key ( keys %{$params} ) { | ||||
205 | 1 | 5 | $self->setOTP($otpc); | ||||
206 | 1 | 4 | my $cmd = { COMMAND => 'StartSession' }; | ||||
207 | 1 1 | 2 3 | foreach my $key ( keys %{$params} ) { | ||||
208 | 1 | 3 | $cmd->{$key} = $params->{$key}; | ||||
209 | } | ||||||
210 | 1 | 4 | my $rr = $self->request($cmd); | ||||
211 | 1 | 5 | if ( $rr->isSuccess() ) { | ||||
212 | 1 | 2 | my $col = $rr->getColumn('SESSION'); | ||||
213 | 1 | 3 | my $sessid = q{}; | ||||
210 | 1 | 5 | my $rr = $self->request($cmd); | ||||
211 | 1 | 15 | if ( $rr->isSuccess() ) { | ||||
212 | 1 | 4 | my $col = $rr->getColumn('SESSION'); | ||||
213 | 1 | 4 | my $sessid = q{}; | ||||
214 | 1 | 3 | if ( defined $col ) { | ||||
215 | 1 | 4 | my @d = $col->getData(); | ||||
215 | 1 | 3 | my @d = $col->getData(); | ||||
216 | 1 | 3 | $sessid = $d[ 0 ]; | ||||
217 | } | ||||||
218 | 1 | 6 | $self->setSession($sessid); | ||||
219 | } | ||||||
220 | 1 | 8 | return $rr; | ||||
220 | 1 | 7 | return $rr; | ||||
221 | } | ||||||
222 | |||||||
223 | |||||||
224 | sub logout { | ||||||
225 | 2 | 1 | 7 | my $self = shift; | |||
225 | 2 | 1 | 12 | my $self = shift; | |||
226 | 2 | 11 | my $rr = $self->request( { COMMAND => 'EndSession' } ); | ||||
227 | 2 | 11 | if ( $rr->isSuccess() ) { | ||||
227 | 2 | 10 | if ( $rr->isSuccess() ) { | ||||
228 | 1 | 6 | $self->setSession(q{}); | ||||
229 | } | ||||||
230 | 2 | 18 | return $rr; | ||||
230 | 2 | 434 | return $rr; | ||||
231 | } | ||||||
232 | |||||||
233 | |||||||
234 | sub request { | ||||||
235 | 14 | 1 | 57 | my ( $self, $cmd ) = @_; | |||
236 | 14 | 78 | my $data = $self->getPOSTData($cmd); | ||||
237 | |||||||
238 | 14 | 125 | my $ua = LWP::UserAgent->new(); | ||||
239 | 14 | 5941 | $ua->agent( $self->getUserAgent() ); | ||||
240 | 14 | 851 | $ua->default_header( 'Expect', q{} ); | ||||
241 | 14 | 663 | $ua->timeout($SOCKETTIMEOUT); | ||||
242 | |||||||
243 | 14 | 317 | my $post = $self->getPOSTData($cmd); | ||||
244 | 14 | 66 | my $r = $ua->post( $self->{socketURL}, $post ); | ||||
245 | 14 | 7473158 | if ( $r->is_success ) { | ||||
246 | 13 | 168 | $r = $r->decoded_content; | ||||
247 | 13 | 9057 | if ( $self->{debugMode} ) { | ||||
248 | 2 2 | 4 26 | print {*STDOUT} Dumper($cmd); | ||||
249 | 2 2 | 563 10 | print {*STDOUT} Dumper($post); | ||||
250 | 2 2 | 155 32 | print {*STDOUT} Dumper($r); | ||||
235 | 14 | 1 | 92 | my ( $self, $cmd ) = @_; | |||
236 | 14 | 64 | my $data = $self->getPOSTData($cmd); | ||||
237 | |||||||
238 | 14 | 149 | my $ua = LWP::UserAgent->new(); | ||||
239 | 14 | 5595 | $ua->agent( $self->getUserAgent() ); | ||||
240 | 14 | 831 | $ua->default_header( 'Expect', q{} ); | ||||
241 | 14 | 681 | $ua->timeout($SOCKETTIMEOUT); | ||||
242 | |||||||
243 | 14 | 315 | my $post = $self->getPOSTData($cmd); | ||||
244 | 14 | 58 | my $r = $ua->post( $self->{socketURL}, $post ); | ||||
245 | 14 | 7506674 | if ( $r->is_success ) { | ||||
246 | 13 | 161 | $r = $r->decoded_content; | ||||
247 | 13 | 8929 | if ( $self->{debugMode} ) { | ||||
248 | 2 2 | 4 20 | print {*STDOUT} Dumper($cmd); | ||||
249 | 2 2 | 528 12 | print {*STDOUT} Dumper($post); | ||||
250 | 2 2 | 132 33 | print {*STDOUT} Dumper($r); | ||||
251 | } | ||||||
252 | } else { | ||||||
253 | 1 | 11 | my $err = $r->status_line; | ||||
254 | 1 | 15 | $r = $rtm->getTemplate('httperror')->getPlain(); | ||||
255 | 1 | 13 | if ( $self->{debugMode} ) { | ||||
253 | 1 | 13 | my $err = $r->status_line; | ||||
254 | 1 | 17 | $r = $rtm->getTemplate('httperror')->getPlain(); | ||||
255 | 1 | 12 | if ( $self->{debugMode} ) { | ||||
256 | 0 0 | 0 0 | print {*STDERR} Dumper($cmd); | ||||
257 | 0 0 | 0 0 | print {*STDERR} Dumper($post); | ||||
258 | 0 0 | 0 0 | print {*STDERR} Dumper($r); | ||||
259 | } | ||||||
260 | } | ||||||
261 | 14 | 258 | return WebService::Hexonet::Connector::Response->new( $r, $cmd ); | ||||
261 | 14 | 225 | return WebService::Hexonet::Connector::Response->new( $r, $cmd ); | ||||
262 | } | ||||||
263 | |||||||
264 | |||||||
265 | sub requestNextResponsePage { | ||||||
266 | 5 | 1 | 22 | my ( $self, $rr ) = @_; | |||
267 | 5 | 20 | my $mycmd = $self->_toUpperCaseKeys( $rr->getCommand() ); | ||||
268 | 5 | 18 | if ( defined $mycmd->{LAST} ) { | ||||
266 | 5 | 1 | 20 | my ( $self, $rr ) = @_; | |||
267 | 5 | 15 | my $mycmd = $self->_toUpperCaseKeys( $rr->getCommand() ); | ||||
268 | 5 | 15 | if ( defined $mycmd->{LAST} ) { | ||||
269 | 0 | 0 | croak 'Parameter LAST in use! Please remove it to avoid issues in requestNextPage.'; | ||||
270 | } | ||||||
271 | 5 | 12 | my $first = 0; | ||||
272 | 5 | 19 | if ( defined $mycmd->{FIRST} ) { | ||||
273 | 4 | 8 | $first = $mycmd->{FIRST}; | ||||
271 | 5 | 8 | my $first = 0; | ||||
272 | 5 | 13 | if ( defined $mycmd->{FIRST} ) { | ||||
273 | 4 | 9 | $first = $mycmd->{FIRST}; | ||||
274 | } | ||||||
275 | 5 | 20 | my $total = $rr->getRecordsTotalCount(); | ||||
276 | 5 | 19 | my $limit = $rr->getRecordsLimitation(); | ||||
277 | 5 | 14 | $first += $limit; | ||||
278 | 5 | 16 | if ( $first < $total ) { | ||||
276 | 5 | 16 | my $limit = $rr->getRecordsLimitation(); | ||||
277 | 5 | 9 | $first += $limit; | ||||
278 | 5 | 17 | if ( $first < $total ) { | ||||
279 | 4 | 10 | $mycmd->{FIRST} = $first; | ||||
280 | 4 | 9 | $mycmd->{LIMIT} = $limit; | ||||
281 | 4 | 14 | return $self->request($mycmd); | ||||
280 | 4 | 6 | $mycmd->{LIMIT} = $limit; | ||||
281 | 4 | 13 | return $self->request($mycmd); | ||||
282 | } | ||||||
283 | 1 | 3 | return; | ||||
283 | 1 | 4 | return; | ||||
284 | } | ||||||
285 | |||||||
286 | |||||||
287 | sub requestAllResponsePages { | ||||||
288 | 1 | 1 | 15 | my ( $self, $cmd ) = @_; | |||
288 | 1 | 1 | 12 | my ( $self, $cmd ) = @_; | |||
289 | 1 | 3 | my @responses = (); | ||||
290 | 1 | 3 | my $command = {}; | ||||
291 | 1 1 | 3 5 | foreach my $key ( keys %{$cmd} ) { | ||||
291 | 1 1 | 3 4 | foreach my $key ( keys %{$cmd} ) { | ||||
292 | 3 | 9 | $command->{$key} = $cmd->{$key}; | ||||
293 | } | ||||||
294 | 1 | 4 | $command->{FIRST} = 0; | ||||
295 | 1 | 5 | my $rr = $self->request($command); | ||||
296 | 1 | 3 | my $tmp = $rr; | ||||
297 | 1 | 2 | my $idx = 0; | ||||
298 | 1 | 5 | while ( defined $tmp ) { | ||||
299 | 3 | 10 | push @responses, $tmp; | ||||
300 | 3 | 13 | $tmp = $self->requestNextResponsePage($tmp); | ||||
294 | 1 | 3 | $command->{FIRST} = 0; | ||||
295 | 1 | 4 | my $rr = $self->request($command); | ||||
296 | 1 | 2 | my $tmp = $rr; | ||||
297 | 1 | 3 | my $idx = 0; | ||||
298 | 1 | 4 | while ( defined $tmp ) { | ||||
299 | 3 | 8 | push @responses, $tmp; | ||||
300 | 3 | 16 | $tmp = $self->requestNextResponsePage($tmp); | ||||
301 | } | ||||||
302 | 1 | 27 | return \@responses; | ||||
302 | 1 | 28 | return \@responses; | ||||
303 | } | ||||||
304 | |||||||
305 | |||||||
306 | sub setUserView { | ||||||
307 | 1 | 1 | 911 | my ( $self, $uid ) = @_; | |||
308 | 1 | 8 | $self->{socketConfig}->setUser($uid); | ||||
307 | 1 | 1 | 985 | my ( $self, $uid ) = @_; | |||
308 | 1 | 9 | $self->{socketConfig}->setUser($uid); | ||||
309 | 1 | 3 | return $self; | ||||
310 | } | ||||||
311 | |||||||
312 | |||||||
313 | sub resetUserView { | ||||||
314 | 1 | 1 | 4 | my $self = shift; | |||
315 | 1 | 8 | $self->{socketConfig}->setUser(q{}); | ||||
316 | 1 | 3 | return $self; | ||||
314 | 1 | 1 | 3 | my $self = shift; | |||
315 | 1 | 7 | $self->{socketConfig}->setUser(q{}); | ||||
316 | 1 | 2 | return $self; | ||||
317 | } | ||||||
318 | |||||||
319 | |||||||
320 | sub useOTESystem { | ||||||
321 | 1 | 1 | 562 | my $self = shift; | |||
322 | 1 | 7 | $self->{socketConfig}->setSystemEntity('1234'); | ||||
321 | 1 | 1 | 576 | my $self = shift; | |||
322 | 1 | 6 | $self->{socketConfig}->setSystemEntity('1234'); | ||||
323 | 1 | 2 | return $self; | ||||
324 | } | ||||||
325 | |||||||
326 | |||||||
327 | sub useLIVESystem { | ||||||
328 | 2 | 1 | 4 | my $self = shift; | |||
329 | 2 | 30 | $self->{socketConfig}->setSystemEntity('54cd'); | ||||
330 | 2 | 5 | return $self; | ||||
328 | 2 | 1 | 5 | my $self = shift; | |||
329 | 2 | 9 | $self->{socketConfig}->setSystemEntity('54cd'); | ||||
330 | 2 | 3 | return $self; | ||||
331 | } | ||||||
332 | |||||||
333 | |||||||
334 | sub _toUpperCaseKeys { | ||||||
335 | 5 | 14 | my ( $self, $cmd ) = @_; | ||||
336 | 5 5 | 12 19 | for my $key ( keys %{$cmd} ) { | ||||
337 | 14 | 27 | my $newkey = uc $key; | ||||
338 | 14 | 37 | if ( $newkey ne $key ) { | ||||
339 | 1 | 4 | $cmd->{$newkey} = delete $cmd->{$key}; | ||||
335 | 5 | 11 | my ( $self, $cmd ) = @_; | ||||
336 | 5 5 | 10 18 | for my $key ( keys %{$cmd} ) { | ||||
337 | 14 | 24 | my $newkey = uc $key; | ||||
338 | 14 | 33 | if ( $newkey ne $key ) { | ||||
339 | 1 | 2 | $cmd->{$newkey} = delete $cmd->{$key}; | ||||
340 | } | ||||||
341 | } | ||||||
342 | 5 | 16 | return $cmd; | ||||
342 | 5 | 11 | return $cmd; | ||||
343 | } | ||||||
344 | |||||||
345 | 1; | ||||||
346 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::Column; | ||||||
2 | |||||||
3 | 1 1 | 8 2 | use 5.026_000; | ||||
4 | 1 1 1 | 3 1 12 | use strict; | ||||
5 | 1 1 1 | 2 2 25 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 3 6 5 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
2 | |||||||
3 | 1 1 | 7 3 | use 5.026_000; | ||||
4 | 1 1 1 | 2 2 8 | use strict; | ||||
5 | 1 1 1 | 3 1 27 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 3 10 5 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
8 | |||||||
9 | |||||||
10 | sub new { | ||||||
11 | 142 | 1 | 2242 | my ( $class, $key, @data ) = @_; | |||
12 | 142 | 244 | my $self = {}; | ||||
11 | 142 | 1 | 2144 | my ( $class, $key, @data ) = @_; | |||
12 | 142 | 223 | my $self = {}; | ||||
13 | 142 | 262 | $self->{key} = $key; | ||||
14 | 142 142 | 233 451 | @{ $self->{data} } = @data; | ||||
15 | 142 | 234 | $self->{length} = scalar @data; | ||||
16 | 142 | 348 | return bless $self, $class; | ||||
14 | 142 142 | 219 421 | @{ $self->{data} } = @data; | ||||
15 | 142 | 221 | $self->{length} = scalar @data; | ||||
16 | 142 | 312 | return bless $self, $class; | ||||
17 | } | ||||||
18 | |||||||
19 | |||||||
20 | sub getKey { | ||||||
21 | 1 | 1 | 495 | my $self = shift; | |||
22 | 1 | 9 | return $self->{key}; | ||||
21 | 1 | 1 | 471 | my $self = shift; | |||
22 | 1 | 7 | return $self->{key}; | ||||
23 | } | ||||||
24 | |||||||
25 | |||||||
26 | sub getData { | ||||||
27 | 3 | 1 | 7 | my $self = shift; | |||
28 | 3 | 7 | return $self->{data}; | ||||
27 | 3 | 1 | 6 | my $self = shift; | |||
28 | 3 | 9 | return $self->{data}; | ||||
29 | } | ||||||
30 | |||||||
31 | |||||||
32 | sub getDataByIndex { | ||||||
33 | 17586 | 1 | 24231 | my $self = shift; | |||
34 | 17586 | 22900 | my $idx = shift; | ||||
35 | 17586 | 27310 | return $self->{data}[ $idx ] | ||||
33 | 17496 | 1 | 22963 | my $self = shift; | |||
34 | 17496 | 22592 | my $idx = shift; | ||||
35 | 17496 | 27219 | return $self->{data}[ $idx ] | ||||
36 | if $self->hasDataIndex($idx); | ||||||
37 | 14470 | 21382 | return; | ||||
37 | 14395 | 20605 | return; | ||||
38 | } | ||||||
39 | |||||||
40 | |||||||
41 | sub hasDataIndex { | ||||||
42 | 17586 | 1 | 23780 | my $self = shift; | |||
43 | 17586 | 22705 | my $idx = shift; | ||||
44 | 17586 | 32879 | return $idx < $self->{length}; | ||||
42 | 17496 | 1 | 22548 | my $self = shift; | |||
43 | 17496 | 22066 | my $idx = shift; | ||||
44 | 17496 | 31042 | return $idx < $self->{length}; | ||||
45 | } | ||||||
46 | |||||||
47 | 1; | ||||||
48 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::Record; | ||||||
2 | |||||||
3 | 1 1 | 8 2 | use 5.026_000; | ||||
4 | 1 1 1 | 3 1 11 | use strict; | ||||
5 | 1 1 1 | 3 2 19 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 2 7 3 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
2 | |||||||
3 | 1 1 | 9 2 | use 5.026_000; | ||||
4 | 1 1 1 | 3 1 12 | use strict; | ||||
5 | 1 1 1 | 2 1 23 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 2 6 4 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
8 | |||||||
9 | |||||||
10 | sub new { | ||||||
11 | 2926 | 1 | 4220 | my ( $class, $data ) = @_; | |||
12 | 2926 | 5335 | return bless { data => $data }, $class; | ||||
11 | 2911 | 1 | 4143 | my ( $class, $data ) = @_; | |||
12 | 2911 | 5223 | return bless { data => $data }, $class; | ||||
13 | } | ||||||
14 | |||||||
15 | |||||||
16 | sub getData { | ||||||
17 | 6 | 1 | 482 | my $self = shift; | |||
18 | 6 | 34 | return $self->{data}; | ||||
17 | 6 | 1 | 454 | my $self = shift; | |||
18 | 6 | 29 | return $self->{data}; | ||||
19 | } | ||||||
20 | |||||||
21 | |||||||
22 | sub getDataByKey { | ||||||
23 | 4 | 1 | 1423 | my $self = shift; | |||
24 | 4 | 12 | my $key = shift; | ||||
25 | 4 | 17 | return $self->{data}->{$key} | ||||
23 | 4 | 1 | 1339 | my $self = shift; | |||
24 | 4 | 10 | my $key = shift; | ||||
25 | 4 | 18 | return $self->{data}->{$key} | ||||
26 | if $self->hasData($key); | ||||||
27 | 1 | 3 | return; | ||||
27 | 1 | 4 | return; | ||||
28 | } | ||||||
29 | |||||||
30 | |||||||
31 | sub hasData { | ||||||
32 | 4 | 1 | 10 | my $self = shift; | |||
33 | 4 | 10 | my $key = shift; | ||||
34 | 4 | 36 | return defined $self->{data}->{$key}; | ||||
34 | 4 | 33 | 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 | 13 37 | use 5.026_000; | ||||
4 | 1 1 1 | 2 2 10 | use strict; | ||||
5 | 1 1 1 | 3 1 22 | use warnings; | ||||
6 | 1 1 1 | 274 2 16 | use WebService::Hexonet::Connector::Column; | ||||
7 | 1 1 1 | 281 4 23 | use WebService::Hexonet::Connector::Record; | ||||
8 | 1 1 1 | 198 178 4 | use parent qw(WebService::Hexonet::Connector::ResponseTemplate); | ||||
9 | 1 1 1 | 27 2 7 | use POSIX qw(ceil floor); | ||||
10 | 1 1 1 | 302 6586 6 | use List::MoreUtils qw(first_index); | ||||
11 | 1 1 1 | 973 2 57 | use Readonly; | ||||
2 | |||||||
3 | 1 1 | 10 2 | use 5.026_000; | ||||
4 | 1 1 1 | 3 1 13 | use strict; | ||||
5 | 1 1 1 | 2 2 27 | use warnings; | ||||
6 | 1 1 1 | 264 2 17 | use WebService::Hexonet::Connector::Column; | ||||
7 | 1 1 1 | 282 1 18 | use WebService::Hexonet::Connector::Record; | ||||
8 | 1 1 1 | 148 172 3 | use parent qw(WebService::Hexonet::Connector::ResponseTemplate); | ||||
9 | 1 1 1 | 26 2 5 | use POSIX qw(ceil floor); | ||||
10 | 1 1 1 | 308 6215 4 | use List::MoreUtils qw(first_index); | ||||
11 | 1 1 1 | 891 2 49 | use Readonly; | ||||
12 | Readonly my $INDEX_NOT_FOUND => -1; | ||||||
13 | |||||||
14 | 1 1 1 | 4 11 7 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
13 | |||||||
14 | 1 1 1 | 4 9 4 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
15 | |||||||
16 | |||||||
17 | sub new { | ||||||
18 | 42 | 1 | 125 | my ( $class, $raw, $cmd ) = @_; | |||
19 | 42 | 206 | my $self = WebService::Hexonet::Connector::ResponseTemplate->new($raw); | ||||
20 | 42 | 98 | $self = bless $self, $class; | ||||
21 | 42 | 99 | $self->{command} = $cmd; | ||||
22 | 42 | 92 | $self->{columnkeys} = []; | ||||
23 | 42 | 86 | $self->{columns} = []; | ||||
24 | 42 | 89 | $self->{records} = []; | ||||
25 | 42 | 117 | $self->{recordIndex} = 0; | ||||
26 | |||||||
27 | 42 | 134 | my $h = $self->getHash(); | ||||
28 | 42 | 111 | if ( defined $h->{PROPERTY} ) { | ||||
29 | 29 29 | 49 112 | my @keys = keys %{ $h->{PROPERTY} }; | ||||
30 | 29 | 51 | my $count = 0; | ||||
31 | 29 | 63 | foreach my $key (@keys) { | ||||
32 | 141 141 | 185 456 | my @d = @{ $h->{PROPERTY}->{$key} }; | ||||
33 | 141 | 351 | $self->addColumn( $key, @d ); | ||||
34 | 141 | 196 | my $len = scalar @d; | ||||
35 | 141 | 277 | if ( $len > $count ) { | ||||
36 | 43 | 129 | $count = $len; | ||||
18 | 42 | 1 | 109 | my ( $class, $raw, $cmd ) = @_; | |||
19 | 42 | 166 | my $self = WebService::Hexonet::Connector::ResponseTemplate->new($raw); | ||||
20 | 42 | 87 | $self = bless $self, $class; | ||||
21 | 42 | 103 | $self->{command} = $cmd; | ||||
22 | 42 | 85 | $self->{columnkeys} = []; | ||||
23 | 42 | 91 | $self->{columns} = []; | ||||
24 | 42 | 75 | $self->{records} = []; | ||||
25 | 42 | 130 | $self->{recordIndex} = 0; | ||||
26 | |||||||
27 | 42 | 123 | my $h = $self->getHash(); | ||||
28 | 42 | 103 | if ( defined $h->{PROPERTY} ) { | ||||
29 | 29 29 | 44 99 | my @keys = keys %{ $h->{PROPERTY} }; | ||||
30 | 29 | 54 | my $count = 0; | ||||
31 | 29 | 59 | foreach my $key (@keys) { | ||||
32 | 141 141 | 191 439 | my @d = @{ $h->{PROPERTY}->{$key} }; | ||||
33 | 141 | 344 | $self->addColumn( $key, @d ); | ||||
34 | 141 | 200 | my $len = scalar @d; | ||||
35 | 141 | 287 | if ( $len > $count ) { | ||||
36 | 49 | 126 | $count = $len; | ||||
37 | } | ||||||
38 | } | ||||||
39 | 29 | 44 | $count--; | ||||
40 | 29 | 69 | for my $i ( 0 .. $count ) { | ||||
41 | 2925 | 4057 | my %d = (); | ||||
42 | 2925 | 4092 | foreach my $colkey (@keys) { | ||||
43 | 17507 | 25392 | my $col = $self->getColumn($colkey); | ||||
44 | 17507 | 31844 | if ( defined $col ) { | ||||
45 | 17507 | 28362 | my $v = $col->getDataByIndex($i); | ||||
46 | 17507 | 28906 | if ( defined $v ) { | ||||
47 | 3037 | 5142 | $d{$colkey} = $v; | ||||
39 | 29 | 56 | $count--; | ||||
40 | 29 | 67 | for my $i ( 0 .. $count ) { | ||||
41 | 2910 | 3820 | my %d = (); | ||||
42 | 2910 | 3911 | foreach my $colkey (@keys) { | ||||
43 | 17417 | 25109 | my $col = $self->getColumn($colkey); | ||||
44 | 17417 | 26323 | if ( defined $col ) { | ||||
45 | 17417 | 26885 | my $v = $col->getDataByIndex($i); | ||||
46 | 17417 | 27746 | if ( defined $v ) { | ||||
47 | 3022 | 5033 | $d{$colkey} = $v; | ||||
48 | } | ||||||
49 | } | ||||||
50 | } | ||||||
51 | 2925 | 4384 | $self->addRecord( \%d ); | ||||
51 | 2910 | 4363 | $self->addRecord( \%d ); | ||||
52 | } | ||||||
53 | } | ||||||
54 | 42 | 648 | return $self; | ||||
54 | 42 | 571 | return $self; | ||||
55 | } | ||||||
56 | |||||||
57 | |||||||
58 | sub addColumn { | ||||||
59 | 141 | 1 | 438 | my ( $self, $key, @data ) = @_; | |||
60 | 141 141 | 204 393 | push @{ $self->{columns} }, WebService::Hexonet::Connector::Column->new( $key, @data ); | ||||
61 | 141 141 | 200 238 | push @{ $self->{columnkeys} }, $key; | ||||
62 | 141 | 257 | return $self; | ||||
59 | 141 | 1 | 446 | my ( $self, $key, @data ) = @_; | |||
60 | 141 141 | 200 357 | push @{ $self->{columns} }, WebService::Hexonet::Connector::Column->new( $key, @data ); | ||||
61 | 141 141 | 199 240 | push @{ $self->{columnkeys} }, $key; | ||||
62 | 141 | 236 | return $self; | ||||
63 | } | ||||||
64 | |||||||
65 | |||||||
66 | sub addRecord { | ||||||
67 | 2925 | 1 | 4221 | my ( $self, $h ) = @_; | |||
68 | 2925 2925 | 3697 4927 | push @{ $self->{records} }, WebService::Hexonet::Connector::Record->new($h); | ||||
69 | 2925 | 4472 | return $self; | ||||
67 | 2910 | 1 | 4037 | my ( $self, $h ) = @_; | |||
68 | 2910 2910 | 3590 4877 | push @{ $self->{records} }, WebService::Hexonet::Connector::Record->new($h); | ||||
69 | 2910 | 4365 | return $self; | ||||
70 | } | ||||||
71 | |||||||
72 | |||||||
73 | sub getColumn { | ||||||
74 | 17606 | 1 | 25114 | my ( $self, $key ) = @_; | |||
75 | 17606 | 25824 | if ( $self->_hasColumn($key) ) { | ||||
76 | 17589 61548 17589 | 78304 78924 27302 | my $idx = first_index { $_ eq $key } @{ $self->{columnkeys} }; | ||||
77 | 17589 | 30878 | return $self->{columns}[ $idx ]; | ||||
74 | 17516 | 1 | 24338 | my ( $self, $key ) = @_; | |||
75 | 17516 | 26455 | if ( $self->_hasColumn($key) ) { | ||||
76 | 17499 61214 17499 | 76522 76302 26828 | my $idx = first_index { $_ eq $key } @{ $self->{columnkeys} }; | ||||
77 | 17499 | 30547 | return $self->{columns}[ $idx ]; | ||||
78 | } | ||||||
79 | 17 | 87 | return; | ||||
79 | 17 | 84 | return; | ||||
80 | } | ||||||
81 | |||||||
82 | |||||||
83 | sub getColumnIndex { | ||||||
84 | 2 | 1 | 8 | my ( $self, $key, $idx ) = @_; | |||
85 | 2 | 10 | my $col = $self->getColumn($key); | ||||
86 | 2 | 5 | return $col->getDataByIndex($idx) if defined $col; | ||||
87 | 1 | 5 | return; | ||||
84 | 2 | 1 | 10 | my ( $self, $key, $idx ) = @_; | |||
85 | 2 | 5 | my $col = $self->getColumn($key); | ||||
86 | 2 | 6 | return $col->getDataByIndex($idx) if defined $col; | ||||
87 | 1 | 3 | return; | ||||
88 | } | ||||||
89 | |||||||
90 | |||||||
91 | sub getColumnKeys { | ||||||
92 | 3 | 1 | 523 | my $self = shift; | |||
93 | 3 3 | 6 10 | return \@{ $self->{columnkeys} }; | ||||
92 | 3 | 1 | 474 | my $self = shift; | |||
93 | 3 3 | 5 12 | return \@{ $self->{columnkeys} }; | ||||
94 | } | ||||||
95 | |||||||
96 | |||||||
97 | sub getColumns { | ||||||
98 | 1 | 0 | 5 | my $self = shift; | |||
99 | 1 1 | 2 3 | return \@{ $self->{columns} }; | ||||
99 | 1 1 | 2 2 | return \@{ $self->{columns} }; | ||||
100 | } | ||||||
101 | |||||||
102 | |||||||
103 | sub getCommand { | ||||||
104 | 5 | 1 | 13 | my $self = shift; | |||
105 | 5 | 23 | return $self->{command}; | ||||
104 | 5 | 1 | 10 | my $self = shift; | |||
105 | 5 | 19 | return $self->{command}; | ||||
106 | } | ||||||
107 | |||||||
108 | |||||||
109 | sub getCurrentPageNumber { | ||||||
110 | 19 | 1 | 40 | my $self = shift; | |||
111 | 19 | 41 | my $first = $self->getFirstRecordIndex(); | ||||
112 | 19 | 40 | my $limit = $self->getRecordsLimitation(); | ||||
113 | 19 | 57 | if ( defined $first && $limit > 0 ) { | ||||
114 | 14 | 63 | return floor( $first / $limit ) + 1; | ||||
110 | 19 | 1 | 34 | my $self = shift; | |||
111 | 19 | 40 | my $first = $self->getFirstRecordIndex(); | ||||
112 | 19 | 39 | my $limit = $self->getRecordsLimitation(); | ||||
113 | 19 | 47 | if ( defined $first && $limit > 0 ) { | ||||
114 | 14 | 60 | return floor( $first / $limit ) + 1; | ||||
115 | } | ||||||
116 | 5 | 11 | return $INDEX_NOT_FOUND; | ||||
116 | 5 | 7 | return $INDEX_NOT_FOUND; | ||||
117 | } | ||||||
118 | |||||||
119 | |||||||
120 | sub getCurrentRecord { | ||||||
121 | 2 | 1 | 8 | my $self = shift; | |||
122 | 2 | 6 | return $self->{records}[ $self->{recordIndex} ] | ||||
121 | 2 | 1 | 15 | my $self = shift; | |||
122 | 2 | 7 | return $self->{records}[ $self->{recordIndex} ] | ||||
123 | if $self->_hasCurrentRecord(); | ||||||
124 | 1 | 5 | return; | ||||
124 | 1 | 4 | return; | ||||
125 | } | ||||||
126 | |||||||
127 | |||||||
128 | sub getFirstRecordIndex { | ||||||
129 | 28 | 1 | 55 | my $self = shift; | |||
130 | 28 | 65 | my $col = $self->getColumn('FIRST'); | ||||
131 | 28 | 58 | if ( defined $col ) { | ||||
132 | 21 | 46 | my $f = $col->getDataByIndex(0); | ||||
133 | 21 | 42 | if ( defined $f ) { | ||||
134 | 21 | 45 | return int $f; | ||||
129 | 28 | 1 | 56 | my $self = shift; | |||
130 | 28 | 53 | my $col = $self->getColumn('FIRST'); | ||||
131 | 28 | 53 | if ( defined $col ) { | ||||
132 | 21 | 41 | my $f = $col->getDataByIndex(0); | ||||
133 | 21 | 39 | if ( defined $f ) { | ||||
134 | 21 | 52 | return int $f; | ||||
135 | } | ||||||
136 | } | ||||||
137 | 7 7 | 10 15 | my $len = scalar @{ $self->{records} }; | ||||
138 | 7 | 21 | return 0 if ( $len > 0 ); | ||||
139 | 6 | 13 | return; | ||||
138 | 7 | 16 | return 0 if ( $len > 0 ); | ||||
139 | 6 | 11 | return; | ||||
140 | } | ||||||
141 | |||||||
142 | |||||||
143 | sub getLastRecordIndex { | ||||||
144 | 9 | 1 | 28 | my $self = shift; | |||
145 | 9 | 24 | my $col = $self->getColumn('LAST'); | ||||
146 | 9 | 22 | if ( defined $col ) { | ||||
147 | 7 | 21 | my $l = $col->getDataByIndex(0); | ||||
148 | 7 | 35 | if ( defined $l ) { | ||||
149 | 7 | 50 | return int $l; | ||||
144 | 9 | 1 | 24 | my $self = shift; | |||
145 | 9 | 26 | my $col = $self->getColumn('LAST'); | ||||
146 | 9 | 23 | if ( defined $col ) { | ||||
147 | 7 | 17 | my $l = $col->getDataByIndex(0); | ||||
148 | 7 | 17 | if ( defined $l ) { | ||||
149 | 7 | 32 | return int $l; | ||||
150 | } | ||||||
151 | } | ||||||
152 | 2 | 6 | my $len = $self->getRecordsCount(); | ||||
153 | 2 | 7 | if ( $len > 0 ) { | ||||
153 | 2 | 5 | if ( $len > 0 ) { | ||||
154 | 1 | 5 | return ( $len - 1 ); | ||||
155 | } | ||||||
156 | 1 | 4 | return; | ||||
157 | } | ||||||
158 | |||||||
159 | |||||||
160 | sub getListHash { | ||||||
161 | 1 | 1 | 5 | my $self = shift; | |||
162 | 1 | 3 | my @lh = (); | ||||
162 | 1 | 2 | my @lh = (); | ||||
163 | 1 1 | 2 3 | foreach my $rec ( @{ $self->getRecords() } ) { | ||||
164 | 2 | 5 | push @lh, $rec->getData(); | ||||
165 | } | ||||||
166 | 1 | 4 | my $r = { | ||||
166 | 1 | 3 | my $r = { | ||||
167 | LIST => \@lh, | ||||||
168 | meta => { | ||||||
169 | columns => $self->getColumnKeys(), | ||||||
174 | } | ||||||
175 | |||||||
176 | |||||||
177 | sub getNextRecord { | ||||||
178 | 5 | 1 | 16 | my $self = shift; | |||
179 | 5 | 20 | return $self->{records}[ ++$self->{recordIndex} ] | ||||
179 | 5 | 16 | return $self->{records}[ ++$self->{recordIndex} ] | ||||
180 | if ( $self->_hasNextRecord() ); | ||||||
181 | 2 | 8 | return; | ||||
181 | 2 | 9 | return; | ||||
182 | } | ||||||
183 | |||||||
184 | |||||||
185 | sub getNextPageNumber { | ||||||
186 | 5 | 1 | 18 | my $self = shift; | |||
186 | 5 | 1 | 12 | my $self = shift; | |||
187 | 5 | 11 | my $cp = $self->getCurrentPageNumber(); | ||||
188 | 5 | 21 | if ( $cp < 0 ) { | ||||
189 | 1 | 2 | return $INDEX_NOT_FOUND; | ||||
188 | 5 | 15 | if ( $cp < 0 ) { | ||||
189 | 1 | 3 | return $INDEX_NOT_FOUND; | ||||
190 | } | ||||||
191 | 4 | 7 | my $page = $cp + 1; | ||||
192 | 4 | 9 | my $pages = $self->getNumberOfPages(); | ||||
193 | 4 | 14 | return $page if ( $page <= $pages ); | ||||
191 | 4 | 8 | my $page = $cp + 1; | ||||
192 | 4 | 8 | my $pages = $self->getNumberOfPages(); | ||||
193 | 4 | 13 | return $page if ( $page <= $pages ); | ||||
194 | 0 | 0 | return $pages; | ||||
195 | } | ||||||
196 | |||||||
197 | |||||||
198 | sub getNumberOfPages { | ||||||
199 | 9 | 1 | 19 | my $self = shift; | |||
200 | 9 | 20 | my $t = $self->getRecordsTotalCount(); | ||||
201 | 9 | 16 | my $limit = $self->getRecordsLimitation(); | ||||
202 | 9 | 29 | if ( $t > 0 && $limit > 0 ) { | ||||
203 | 8 | 29 | return ceil( $t / $limit ); | ||||
199 | 9 | 1 | 18 | my $self = shift; | |||
200 | 9 | 18 | my $t = $self->getRecordsTotalCount(); | ||||
201 | 9 | 15 | my $limit = $self->getRecordsLimitation(); | ||||
202 | 9 | 24 | if ( $t > 0 && $limit > 0 ) { | ||||
203 | 8 | 26 | return ceil( $t / $limit ); | ||||
204 | } | ||||||
205 | 1 | 4 | return 0; | ||||
206 | } | ||||||
207 | |||||||
208 | |||||||
209 | sub getPagination { | ||||||
210 | 3 | 1 | 473 | my $self = shift; | |||
211 | 3 | 9 | my $r = { | ||||
210 | 3 | 1 | 462 | my $self = shift; | |||
211 | 3 | 10 | my $r = { | ||||
212 | COUNT => $self->getRecordsCount(), | ||||||
213 | CURRENTPAGE => $self->getCurrentPageNumber(), | ||||||
214 | FIRST => $self->getFirstRecordIndex(), | ||||||
219 | PREVIOUSPAGE => $self->getPreviousPageNumber(), | ||||||
220 | TOTAL => $self->getRecordsTotalCount() | ||||||
221 | }; | ||||||
222 | 3 | 12 | return $r; | ||||
222 | 3 | 11 | return $r; | ||||
223 | } | ||||||
224 | |||||||
225 | |||||||
226 | sub getPreviousPageNumber { | ||||||
227 | 5 | 1 | 16 | my $self = shift; | |||
227 | 5 | 1 | 12 | my $self = shift; | |||
228 | 5 | 10 | my $cp = $self->getCurrentPageNumber(); | ||||
229 | 5 | 16 | if ( $cp < 0 ) { | ||||
230 | 1 | 3 | return $INDEX_NOT_FOUND; | ||||
229 | 5 | 17 | if ( $cp < 0 ) { | ||||
230 | 1 | 2 | return $INDEX_NOT_FOUND; | ||||
231 | } | ||||||
232 | 4 | 7 | my $np = $cp - 1; | ||||
233 | 4 | 21 | return $np if ( $np > 0 ); | ||||
234 | 4 | 9 | return $INDEX_NOT_FOUND; | ||||
232 | 4 | 5 | my $np = $cp - 1; | ||||
233 | 4 | 8 | return $np if ( $np > 0 ); | ||||
234 | 4 | 6 | return $INDEX_NOT_FOUND; | ||||
235 | } | ||||||
236 | |||||||
237 | |||||||
238 | sub getPreviousRecord { | ||||||
239 | 4 | 1 | 16 | my $self = shift; | |||
240 | 4 | 13 | return $self->{records}[ --$self->{recordIndex} ] | ||||
239 | 4 | 1 | 14 | my $self = shift; | |||
240 | 4 | 12 | return $self->{records}[ --$self->{recordIndex} ] | ||||
241 | if ( $self->_hasPreviousRecord() ); | ||||||
242 | 3 | 13 | return; | ||||
242 | 3 | 12 | return; | ||||
243 | } | ||||||
244 | |||||||
245 | |||||||
246 | sub getRecord { | ||||||
247 | 3 | 1 | 12 | my ( $self, $idx ) = @_; | |||
248 | 3 | 22 | if ( $idx >= 0 && $self->getRecordsCount() > $idx ) { | ||||
249 | 3 | 22 | return $self->{records}[ $idx ]; | ||||
247 | 3 | 1 | 13 | my ( $self, $idx ) = @_; | |||
248 | 3 | 18 | if ( $idx >= 0 && $self->getRecordsCount() > $idx ) { | ||||
249 | 3 | 18 | return $self->{records}[ $idx ]; | ||||
250 | } | ||||||
251 | 0 | 0 | return; | ||||
252 | } | ||||||
257 | 1 1 | 2 3 | return \@{ $self->{records} }; | ||||
258 | } | ||||||
259 | |||||||
260 | |||||||
261 | sub getRecordsCount { | ||||||
262 | 19 | 1 | 41 | my $self = shift; | |||
263 | 19 19 | 34 46 | my $len = scalar @{ $self->{records} }; | ||||
264 | 19 | 65 | return $len; | ||||
262 | 19 | 1 | 39 | my $self = shift; | |||
263 | 19 19 | 35 43 | my $len = scalar @{ $self->{records} }; | ||||
264 | 19 | 73 | return $len; | ||||
265 | } | ||||||
266 | |||||||
267 | |||||||
268 | sub getRecordsTotalCount { | ||||||
269 | 17 | 1 | 33 | my $self = shift; | |||
270 | 17 | 35 | my $col = $self->getColumn('TOTAL'); | ||||
271 | 17 | 31 | if ( defined $col ) { | ||||
272 | 16 | 30 | my $t = $col->getDataByIndex(0); | ||||
273 | 16 | 31 | if ( defined $t ) { | ||||
274 | 16 | 51 | return int $t; | ||||
269 | 17 | 1 | 36 | my $self = shift; | |||
270 | 17 | 31 | my $col = $self->getColumn('TOTAL'); | ||||
271 | 17 | 35 | if ( defined $col ) { | ||||
272 | 16 | 31 | my $t = $col->getDataByIndex(0); | ||||
273 | 16 | 29 | if ( defined $t ) { | ||||
274 | 16 | 53 | return int $t; | ||||
275 | } | ||||||
276 | } | ||||||
277 | 1 | 4 | return $self->getRecordsCount(); | ||||
277 | 1 | 3 | return $self->getRecordsCount(); | ||||
278 | } | ||||||
279 | |||||||
280 | |||||||
281 | sub getRecordsLimitation { | ||||||
282 | 40 | 1 | 64 | my $self = shift; | |||
283 | 40 | 73 | my $col = $self->getColumn('LIMIT'); | ||||
284 | 40 | 87 | if ( defined $col ) { | ||||
285 | 34 | 72 | my $l = $col->getDataByIndex(0); | ||||
286 | 34 | 73 | if ( defined $l ) { | ||||
287 | 34 | 69 | return int $l; | ||||
282 | 40 | 1 | 65 | my $self = shift; | |||
283 | 40 | 78 | my $col = $self->getColumn('LIMIT'); | ||||
284 | 40 | 83 | if ( defined $col ) { | ||||
285 | 34 | 67 | my $l = $col->getDataByIndex(0); | ||||
286 | 34 | 59 | if ( defined $l ) { | ||||
287 | 34 | 72 | return int $l; | ||||
288 | } | ||||||
289 | } | ||||||
290 | 6 | 16 | return $self->getRecordsCount(); | ||||
290 | 6 | 14 | return $self->getRecordsCount(); | ||||
291 | } | ||||||
292 | |||||||
293 | |||||||
294 | sub hasNextPage { | ||||||
295 | 2 | 1 | 9 | my $self = shift; | |||
296 | 2 | 9 | my $cp = $self->getCurrentPageNumber(); | ||||
297 | 2 | 8 | if ( $cp < 0 ) { | ||||
295 | 2 | 1 | 8 | my $self = shift; | |||
296 | 2 | 7 | my $cp = $self->getCurrentPageNumber(); | ||||
297 | 2 | 11 | if ( $cp < 0 ) { | ||||
298 | 1 | 4 | return 0; | ||||
299 | } | ||||||
300 | 1 | 3 | my $np = $cp + 1; | ||||
301 | 1 | 3 | if ( $np <= $self->getNumberOfPages() ) { | ||||
302 | 1 | 6 | return 1; | ||||
300 | 1 | 2 | my $np = $cp + 1; | ||||
301 | 1 | 2 | if ( $np <= $self->getNumberOfPages() ) { | ||||
302 | 1 | 4 | return 1; | ||||
303 | } | ||||||
304 | 0 | 0 | return 0; | ||||
305 | } | ||||||
306 | |||||||
307 | |||||||
308 | sub hasPreviousPage { | ||||||
309 | 2 | 1 | 11 | my $self = shift; | |||
309 | 2 | 1 | 8 | my $self = shift; | |||
310 | 2 | 5 | my $cp = $self->getCurrentPageNumber(); | ||||
311 | 2 | 9 | if ( $cp < 0 ) { | ||||
312 | 1 | 4 | return 0; | ||||
311 | 2 | 10 | if ( $cp < 0 ) { | ||||
312 | 1 | 5 | return 0; | ||||
313 | } | ||||||
314 | 1 | 2 | my $pp = $cp - 1; | ||||
315 | 1 | 3 | if ( $pp > 0 ) { | ||||
315 | 1 | 4 | if ( $pp > 0 ) { | ||||
316 | 0 | 0 | return 1; | ||||
317 | } | ||||||
318 | 1 | 5 | return 0; | ||||
318 | 1 | 3 | return 0; | ||||
319 | } | ||||||
320 | |||||||
321 | |||||||
322 | sub rewindRecordList { | ||||||
323 | 1 | 1 | 3 | my $self = shift; | |||
325 | 1 | 4 | return $self; | ||||
326 | } | ||||||
327 | |||||||
328 | |||||||
329 | sub _hasColumn { | ||||||
330 | 17606 | 26200 | my ( $self, $key ) = @_; | ||||
331 | 17606 61556 17606 | 28726 80896 27892 | my $idx = first_index { $_ eq $key } @{ $self->{columnkeys} }; | ||||
332 | 17606 | 32961 | return ( $idx > $INDEX_NOT_FOUND ); | ||||
330 | 17516 | 24953 | my ( $self, $key ) = @_; | ||||
331 | 17516 61222 17516 | 28382 77282 27062 | my $idx = first_index { $_ eq $key } @{ $self->{columnkeys} }; | ||||
332 | 17516 | 31131 | return ( $idx > $INDEX_NOT_FOUND ); | ||||
333 | } | ||||||
334 | |||||||
335 | |||||||
336 | sub _hasCurrentRecord { | ||||||
337 | 8 | 15 | my $self = shift; | ||||
338 | 8 8 | 13 23 | my $len = scalar @{ $self->{records} }; | ||||
337 | 8 | 13 | my $self = shift; | ||||
338 | 8 8 | 13 17 | my $len = scalar @{ $self->{records} }; | ||||
339 | 8 | 67 | return ( $len > 0 && $self->{recordIndex} >= 0 && $self->{recordIndex} < $len ); | ||||
340 | } | ||||||
341 | |||||||
342 | |||||||
343 | sub _hasNextRecord { | ||||||
344 | 5 | 10 | my $self = shift; | ||||
345 | 5 | 14 | my $next = $self->{recordIndex} + 1; | ||||
346 | 5 5 | 10 13 | my $len = scalar @{ $self->{records} }; | ||||
347 | 5 | 12 | return ( $self->_hasCurrentRecord() && $next < $len ); | ||||
344 | 5 | 13 | my $self = shift; | ||||
345 | 5 | 12 | my $next = $self->{recordIndex} + 1; | ||||
346 | 5 5 | 9 11 | my $len = scalar @{ $self->{records} }; | ||||
347 | 5 | 14 | return ( $self->_hasCurrentRecord() && $next < $len ); | ||||
348 | } | ||||||
349 | |||||||
350 | |||||||
351 | sub _hasPreviousRecord { | ||||||
352 | 4 | 9 | my $self = shift; | ||||
353 | 4 | 18 | return ( $self->{recordIndex} > 0 && $self->_hasCurrentRecord() ); | ||||
353 | 4 | 17 | return ( $self->{recordIndex} > 0 && $self->_hasCurrentRecord() ); | ||||
354 | } | ||||||
355 | |||||||
356 | 1; | ||||||
357 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::ResponseParser; | ||||||
2 | |||||||
3 | 1 1 | 15 3 | use 5.026_000; | ||||
4 | 1 1 1 | 2 2 11 | use strict; | ||||
5 | 1 1 1 | 3 1 21 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 2 7 4 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
2 | |||||||
3 | 1 1 | 9 2 | use 5.026_000; | ||||
4 | 1 1 1 | 3 2 9 | use strict; | ||||
5 | 1 1 1 | 2 2 21 | use warnings; | ||||
6 | |||||||
7 | 1 1 1 | 3 7 3 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
8 | |||||||
9 | |||||||
10 | sub parse { | ||||||
11 | 97 | 1 | 202 | my $response = shift; | |||
12 | 97 | 183 | my %hash = (); | ||||
13 | 97 | 464 | $response =~ s/\r\n/\n/gmsx; | ||||
14 | 97 | 638 | foreach ( split /\n/msx, $response ) { | ||||
15 | 3664 | 8063 | if (/^([^\=]*[^\t\= ])[\t ]*=[\t ]*(.+)/msx) { | ||||
16 | 3446 | 5259 | my $attr = $1; | ||||
17 | 3446 | 4924 | my $value = $2; | ||||
18 | 3446 | 8831 | $value =~ s/[\t ]*$//msx; | ||||
19 | 3446 | 6326 | if ( $attr =~ /^property\[([^\]]*)\]/imsx ) { | ||||
20 | 3156 | 4976 | if ( !defined $hash{PROPERTY} ) { | ||||
21 | 46 | 93 | $hash{PROPERTY} = {}; | ||||
12 | 97 | 181 | my %hash = (); | ||||
13 | 97 | 414 | $response =~ s/\r\n/\n/gmsx; | ||||
14 | 97 | 629 | foreach ( split /\n/msx, $response ) { | ||||
15 | 3649 | 8307 | if (/^([^\=]*[^\t\= ])[\t ]*=[\t ]*(.+)/msx) { | ||||
16 | 3431 | 5207 | my $attr = $1; | ||||
17 | 3431 | 5021 | my $value = $2; | ||||
18 | 3431 | 9061 | $value =~ s/[\t ]*$//msx; | ||||
19 | 3431 | 6701 | if ( $attr =~ /^property\[([^\]]*)\]/imsx ) { | ||||
20 | 3141 | 5432 | if ( !defined $hash{PROPERTY} ) { | ||||
21 | 46 | 103 | $hash{PROPERTY} = {}; | ||||
22 | } | ||||||
23 | 3156 | 4551 | my $prop = uc $1; | ||||
24 | 3156 | 4495 | $prop =~ s/\s//ogmsx; | ||||
25 | 3156 | 4784 | if ( defined $hash{PROPERTY}{$prop} ) { | ||||
26 | 2913 2913 | 3774 5056 | push @{ $hash{PROPERTY}{$prop} }, $value; | ||||
23 | 3141 | 4560 | my $prop = uc $1; | ||||
24 | 3141 | 4528 | $prop =~ s/\s//ogmsx; | ||||
25 | 3141 | 5185 | if ( defined $hash{PROPERTY}{$prop} ) { | ||||
26 | 2898 2898 | 3931 5343 | push @{ $hash{PROPERTY}{$prop} }, $value; | ||||
27 | } else { | ||||||
28 | 243 | 543 | $hash{PROPERTY}{$prop} = [ $value ]; | ||||
28 | 243 | 591 | $hash{PROPERTY}{$prop} = [ $value ]; | ||||
29 | } | ||||||
30 | } else { | ||||||
31 | 290 | 619 | $hash{ uc $attr } = $value; | ||||
31 | 290 | 623 | $hash{ uc $attr } = $value; | ||||
32 | } | ||||||
33 | } | ||||||
34 | } | ||||||
35 | 97 | 419 | if ( !defined $hash{DESCRIPTION} ) { | ||||
35 | 97 | 338 | if ( !defined $hash{DESCRIPTION} ) { | ||||
36 | 1 | 2 | $hash{DESCRIPTION} = q{}; | ||||
37 | } | ||||||
38 | 97 | 250 | return \%hash; | ||||
38 | 97 | 242 | return \%hash; | ||||
39 | } | ||||||
40 | |||||||
41 | |||||||
42 | sub serialize { | ||||||
43 | 6 | 1 | 37 | my $h = shift; | |||
44 | 6 | 13 | my $plain = '[RESPONSE]'; | ||||
45 | 6 | 17 | if ( defined $h->{PROPERTY} ) { | ||||
46 | 3 | 6 | my $props = $h->{PROPERTY}; | ||||
47 | 3 3 | 7 14 | foreach my $key ( sort keys %{$props} ) { | ||||
48 | 5 | 11 | my $i = 0; | ||||
49 | 5 5 | 9 12 | foreach my $val ( @{ $props->{$key} } ) { | ||||
50 | 11 | 23 | $plain .= "\r\nPROPERTY[${key}][${i}]=${val}"; | ||||
51 | 11 | 18 | $i++; | ||||
43 | 6 | 1 | 40 | my $h = shift; | |||
44 | 6 | 12 | my $plain = '[RESPONSE]'; | ||||
45 | 6 | 15 | if ( defined $h->{PROPERTY} ) { | ||||
46 | 3 | 7 | my $props = $h->{PROPERTY}; | ||||
47 | 3 3 | 6 13 | foreach my $key ( sort keys %{$props} ) { | ||||
48 | 5 | 9 | my $i = 0; | ||||
49 | 5 5 | 7 11 | foreach my $val ( @{ $props->{$key} } ) { | ||||
50 | 11 | 28 | $plain .= "\r\nPROPERTY[${key}][${i}]=${val}"; | ||||
51 | 11 | 20 | $i++; | ||||
52 | } | ||||||
53 | } | ||||||
54 | } | ||||||
55 | 6 | 14 | if ( defined $h->{CODE} ) { | ||||
56 | 5 | 12 | $plain .= "\r\nCODE=" . $h->{CODE}; | ||||
55 | 6 | 15 | if ( defined $h->{CODE} ) { | ||||
56 | 5 | 11 | $plain .= "\r\nCODE=" . $h->{CODE}; | ||||
57 | } | ||||||
58 | 6 | 15 | if ( defined $h->{DESCRIPTION} ) { | ||||
59 | 5 | 11 | $plain .= "\r\nDESCRIPTION=" . $h->{DESCRIPTION}; | ||||
59 | 5 | 12 | $plain .= "\r\nDESCRIPTION=" . $h->{DESCRIPTION}; | ||||
60 | } | ||||||
61 | 6 | 15 | if ( defined $h->{QUEUETIME} ) { | ||||
61 | 6 | 13 | if ( defined $h->{QUEUETIME} ) { | ||||
62 | 1 | 2 | $plain .= "\r\nQUEUETIME=" . $h->{QUEUETIME}; | ||||
63 | } | ||||||
64 | 6 | 16 | if ( defined $h->{RUNTIME} ) { | ||||
65 | 1 | 2 | $plain .= "\r\nRUNTIME=" . $h->{RUNTIME}; | ||||
64 | 6 | 13 | if ( defined $h->{RUNTIME} ) { | ||||
65 | 1 | 3 | $plain .= "\r\nRUNTIME=" . $h->{RUNTIME}; | ||||
66 | } | ||||||
67 | 6 | 13 | $plain .= "\r\nEOF\r\n"; | ||||
68 | 6 | 19 | return $plain; | ||||
67 | 6 | 11 | $plain .= "\r\nEOF\r\n"; | ||||
68 | 6 | 13 | return $plain; | ||||
69 | } | ||||||
70 | |||||||
71 | 1; | ||||||
72 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::ResponseTemplate; | ||||||
2 | |||||||
3 | 1 1 | 321 3 | use 5.026_000; | ||||
4 | 1 1 1 | 3 1 9 | use strict; | ||||
5 | 1 1 1 | 2 2 24 | use warnings; | ||||
6 | 1 1 1 | 274 2 21 | use WebService::Hexonet::Connector::ResponseParser; | ||||
7 | |||||||
8 | 1 1 1 | 3 8 3 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
2 | |||||||
3 | 1 1 | 335 2 | use 5.026_000; | ||||
4 | 1 1 1 | 2 2 9 | use strict; | ||||
5 | 1 1 1 | 3 2 19 | use warnings; | ||||
6 | 1 1 1 | 276 2 19 | use WebService::Hexonet::Connector::ResponseParser; | ||||
7 | |||||||
8 | 1 1 1 | 3 7 3 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
9 | |||||||
10 | |||||||
11 | sub new { | ||||||
12 | 95 | 1 | 5196 | my ( $class, $raw ) = @_; | |||
13 | 95 | 197 | my $self = {}; | ||||
14 | 95 | 424 | if ( !defined $raw || length $raw == 0 ) { | ||||
15 | 7 | 21 | $raw = "[RESPONSE]\r\nCODE=423\r\nDESCRIPTION=Empty API response\r\nEOF\r\n"; | ||||
12 | 95 | 1 | 5002 | my ( $class, $raw ) = @_; | |||
13 | 95 | 185 | my $self = {}; | ||||
14 | 95 | 377 | if ( !defined $raw || length $raw == 0 ) { | ||||
15 | 7 | 19 | $raw = "[RESPONSE]\r\nCODE=423\r\nDESCRIPTION=Empty API response\r\nEOF\r\n"; | ||||
16 | } | ||||||
17 | 95 | 234 | $self->{raw} = $raw; | ||||
18 | 95 | 255 | $self->{hash} = WebService::Hexonet::Connector::ResponseParser::parse($raw); | ||||
19 | 95 | 321 | return bless $self, $class; | ||||
17 | 95 | 230 | $self->{raw} = $raw; | ||||
18 | 95 | 243 | $self->{hash} = WebService::Hexonet::Connector::ResponseParser::parse($raw); | ||||
19 | 95 | 317 | return bless $self, $class; | ||||
20 | } | ||||||
21 | |||||||
22 | |||||||
23 | sub getCode { | ||||||
24 | 2 | 1 | 40 | my $self = shift; | |||
24 | 2 | 1 | 9 | my $self = shift; | |||
25 | 2 | 10 | return ( $self->{hash}->{CODE} + 0 ); | ||||
26 | } | ||||||
27 | |||||||
28 | |||||||
29 | sub getDescription { | ||||||
30 | 3 | 1 | 9 | my $self = shift; | |||
31 | 3 | 17 | return $self->{hash}->{DESCRIPTION}; | ||||
30 | 3 | 1 | 10 | my $self = shift; | |||
31 | 3 | 16 | return $self->{hash}->{DESCRIPTION}; | ||||
32 | } | ||||||
33 | |||||||
34 | |||||||
35 | sub getPlain { | ||||||
36 | 29 | 1 | 120 | my $self = shift; | |||
37 | 29 | 142 | return $self->{raw}; | ||||
36 | 29 | 1 | 106 | my $self = shift; | |||
37 | 29 | 129 | return $self->{raw}; | ||||
38 | } | ||||||
39 | |||||||
40 | |||||||
41 | sub getQueuetime { | ||||||
42 | 2 | 1 | 10 | my $self = shift; | |||
43 | 2 | 7 | if ( defined $self->{hash}->{QUEUETIME} ) { | ||||
44 | 1 | 6 | return ( $self->{hash}->{QUEUETIME} + 0.00 ); | ||||
42 | 2 | 1 | 9 | my $self = shift; | |||
43 | 2 | 6 | if ( defined $self->{hash}->{QUEUETIME} ) { | ||||
44 | 1 | 4 | return ( $self->{hash}->{QUEUETIME} + 0.00 ); | ||||
45 | } | ||||||
46 | 1 | 4 | return 0.00; | ||||
47 | } | ||||||
48 | |||||||
49 | |||||||
50 | sub getHash { | ||||||
51 | 55 | 1 | 135 | my $self = shift; | |||
52 | 55 | 146 | return $self->{hash}; | ||||
51 | 55 | 1 | 119 | my $self = shift; | |||
52 | 55 | 144 | return $self->{hash}; | ||||
53 | } | ||||||
54 | |||||||
55 | |||||||
56 | sub getRuntime { | ||||||
57 | 2 | 1 | 10 | my $self = shift; | |||
58 | 2 | 7 | if ( defined $self->{hash}->{RUNTIME} ) { | ||||
57 | 2 | 1 | 8 | my $self = shift; | |||
58 | 2 | 6 | if ( defined $self->{hash}->{RUNTIME} ) { | ||||
59 | 1 | 6 | return ( $self->{hash}->{RUNTIME} + 0.00 ); | ||||
60 | } | ||||||
61 | 1 | 4 | return 0.00; | ||||
62 | } | ||||||
63 | |||||||
64 | |||||||
65 | sub isError { | ||||||
66 | 2 | 1 | 1817 | my $self = shift; | |||
67 | 2 | 10 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
68 | 2 | 13 | return ( $first eq '5' ); | ||||
66 | 2 | 1 | 1696 | my $self = shift; | |||
67 | 2 | 8 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
68 | 2 | 10 | return ( $first eq '5' ); | ||||
69 | } | ||||||
70 | |||||||
71 | |||||||
72 | sub isSuccess { | ||||||
73 | 17 | 1 | 6079 | my $self = shift; | |||
74 | 17 | 73 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
75 | 17 | 93 | return ( $first eq '2' ); | ||||
73 | 17 | 1 | 4918 | my $self = shift; | |||
74 | 17 | 72 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
75 | 17 | 87 | return ( $first eq '2' ); | ||||
76 | } | ||||||
77 | |||||||
78 | |||||||
79 | sub isTmpError { | ||||||
80 | 1 | 1 | 926 | my $self = shift; | |||
81 | 1 | 4 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
82 | 1 | 5 | return ( $first eq '4' ); | ||||
80 | 1 | 1 | 853 | my $self = shift; | |||
81 | 1 | 5 | my $first = substr $self->{hash}->{CODE}, 0, 1; | ||||
82 | 1 | 6 | return ( $first eq '4' ); | ||||
83 | } | ||||||
84 | |||||||
85 | |||||||
86 | sub isPending { | ||||||
87 | 2 | 1 | 15 | my $self = shift; | |||
88 | 2 | 30 | if ( defined $self->{hash}->{PENDING} ) { | ||||
89 | 1 | 4 | return int( $self->{hash}->{PENDING} ); | ||||
87 | 2 | 1 | 9 | my $self = shift; | |||
88 | 2 | 6 | if ( defined $self->{hash}->{PENDING} ) { | ||||
89 | 1 | 5 | return int( $self->{hash}->{PENDING} ); | ||||
90 | } | ||||||
91 | 1 | 22 | return 0; | ||||
91 | 1 | 39 | return 0; | ||||
92 | } | ||||||
93 | |||||||
94 | 1; | ||||||
95 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::ResponseTemplateManager; | ||||||
2 | |||||||
3 | 1 1 | 12 2 | use 5.026_000; | ||||
4 | 1 1 1 | 3 2 10 | use strict; | ||||
5 | 1 1 1 | 13 2 33 | use warnings; | ||||
6 | 1 1 1 | 3 2 13 | use WebService::Hexonet::Connector::ResponseTemplate; | ||||
7 | 1 1 1 | 6 2 16 | use WebService::Hexonet::Connector::ResponseParser; | ||||
8 | |||||||
9 | 1 1 1 | 2 9 4 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
2 | |||||||
3 | 1 1 | 10 2 | use 5.026_000; | ||||
4 | 1 1 1 | 4 1 12 | use strict; | ||||
5 | 1 1 1 | 2 2 19 | use warnings; | ||||
6 | 1 1 1 | 3 2 15 | use WebService::Hexonet::Connector::ResponseTemplate; | ||||
7 | 1 1 1 | 5 2 15 | use WebService::Hexonet::Connector::ResponseParser; | ||||
8 | |||||||
9 | 1 1 1 | 2 8 4 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
10 | |||||||
11 | my $instance = undef; | ||||||
12 | |||||||
13 | |||||||
14 | sub getInstance { | ||||||
15 | 2 | 1 | 9 | if ( !defined $instance ) { | |||
16 | 1 | 4 | my $self = { templates => {} }; | ||||
15 | 2 | 1 | 8 | if ( !defined $instance ) { | |||
16 | 1 | 3 | my $self = { templates => {} }; | ||||
17 | 1 | 2 | $instance = bless $self, shift; | ||||
18 | 1 | 9 | $instance->addTemplate( '404', $instance->generateTemplate( '421', 'Page not found' ) ); | ||||
19 | 1 | 4 | $instance->addTemplate( '500', $instance->generateTemplate( '500', 'Internal server error' ) ); | ||||
18 | 1 | 3 | $instance->addTemplate( '404', $instance->generateTemplate( '421', 'Page not found' ) ); | ||||
19 | 1 | 3 | $instance->addTemplate( '500', $instance->generateTemplate( '500', 'Internal server error' ) ); | ||||
20 | 1 | 3 | $instance->addTemplate( 'empty', $instance->generateTemplate( '423', 'Empty API response' ) ); | ||||
21 | 1 | 3 | $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 | 4 | $instance->addTemplate( 'httperror', $instance->generateTemplate( '421', 'Command failed due to HTTP communication error' ) ); | ||||
24 | 1 | 3 | $instance->addTemplate( 'unauthorized', $instance->generateTemplate( '530', 'Unauthorized' ) ); | ||||
23 | 1 | 3 | $instance->addTemplate( 'httperror', $instance->generateTemplate( '421', 'Command failed due to HTTP communication error' ) ); | ||||
24 | 1 | 2 | $instance->addTemplate( 'unauthorized', $instance->generateTemplate( '530', 'Unauthorized' ) ); | ||||
25 | } | ||||||
26 | 2 | 5 | return $instance; | ||||
27 | } | ||||||
28 | |||||||
29 | |||||||
30 | sub generateTemplate { | ||||||
31 | 10 | 1 | 477 | my ( $self, $code, $description ) = @_; | |||
32 | 10 | 34 | return "[RESPONSE]\r\nCODE=${code}\r\nDESCRIPTION=${description}\r\nEOF\r\n"; | ||||
31 | 10 | 1 | 505 | my ( $self, $code, $description ) = @_; | |||
32 | 10 | 33 | return "[RESPONSE]\r\nCODE=${code}\r\nDESCRIPTION=${description}\r\nEOF\r\n"; | ||||
33 | } | ||||||
34 | |||||||
35 | |||||||
36 | sub addTemplate { | ||||||
37 | 9 | 1 | 17 | my ( $self, $id, $plain ) = @_; | |||
38 | 9 | 25 | $self->{templates}->{$id} = $plain; | ||||
39 | 9 | 15 | return $instance; | ||||
37 | 9 | 1 | 18 | my ( $self, $id, $plain ) = @_; | |||
38 | 9 | 23 | $self->{templates}->{$id} = $plain; | ||||
39 | 9 | 16 | return $instance; | ||||
40 | } | ||||||
41 | |||||||
42 | |||||||
43 | sub getTemplate { | ||||||
44 | 34 | 1 | 13761 | my ( $self, $id ) = @_; | |||
45 | 34 | 83 | my $plain; | ||||
46 | 34 | 117 | if ( $self->hasTemplate($id) ) { | ||||
47 | 33 | 85 | $plain = $self->{templates}->{$id}; | ||||
44 | 34 | 1 | 13271 | my ( $self, $id ) = @_; | |||
45 | 34 | 80 | my $plain; | ||||
46 | 34 | 112 | if ( $self->hasTemplate($id) ) { | ||||
47 | 33 | 84 | $plain = $self->{templates}->{$id}; | ||||
48 | } else { | ||||||
49 | 1 | 5 | $plain = $self->generateTemplate( '500', 'Response Template not found' ); | ||||
49 | 1 | 6 | $plain = $self->generateTemplate( '500', 'Response Template not found' ); | ||||
50 | } | ||||||
51 | 34 | 157 | return WebService::Hexonet::Connector::ResponseTemplate->new($plain); | ||||
51 | 34 | 137 | return WebService::Hexonet::Connector::ResponseTemplate->new($plain); | ||||
52 | } | ||||||
53 | |||||||
54 | |||||||
55 | sub getTemplates { | ||||||
56 | 1 | 1 | 4 | my $self = shift; | |||
57 | 1 | 3 | my $tmp = {}; | ||||
56 | 1 | 1 | 3 | my $self = shift; | |||
57 | 1 | 4 | my $tmp = {}; | ||||
58 | 1 | 3 | my $tpls = $self->{templates}; | ||||
59 | 1 1 | 3 7 | foreach my $key ( keys %{$tpls} ) { | ||||
60 | 9 | 22 | $tmp->{$key} = WebService::Hexonet::Connector::ResponseTemplate->new( $tpls->{$key} ); | ||||
60 | 9 | 26 | $tmp->{$key} = WebService::Hexonet::Connector::ResponseTemplate->new( $tpls->{$key} ); | ||||
61 | } | ||||||
62 | 1 | 4 | return $tmp; | ||||
62 | 1 | 3 | return $tmp; | ||||
63 | } | ||||||
64 | |||||||
65 | |||||||
66 | sub hasTemplate { | ||||||
67 | 34 | 1 | 86 | my ( $self, $id ) = @_; | |||
68 | 34 | 149 | return defined $self->{templates}->{$id}; | ||||
67 | 34 | 1 | 92 | my ( $self, $id ) = @_; | |||
68 | 34 | 143 | return defined $self->{templates}->{$id}; | ||||
69 | } | ||||||
70 | |||||||
71 | |||||||
72 | sub isTemplateMatchHash { | ||||||
73 | 2 | 1 | 10 | my ( $self, $tpl2, $id ) = @_; | |||
74 | 2 | 7 | my $tpl = $self->getTemplate($id); | ||||
73 | 2 | 1 | 9 | my ( $self, $tpl2, $id ) = @_; | |||
74 | 2 | 5 | my $tpl = $self->getTemplate($id); | ||||
75 | 2 | 5 | my $h = $tpl->getHash(); | ||||
76 | 2 | 16 | return ( $h->{CODE} eq $tpl2->{CODE} ) && ( $h->{DESCRIPTION} eq $tpl2->{DESCRIPTION} ); | ||||
76 | 2 | 13 | return ( $h->{CODE} eq $tpl2->{CODE} ) && ( $h->{DESCRIPTION} eq $tpl2->{DESCRIPTION} ); | ||||
77 | } | ||||||
78 | |||||||
79 | |||||||
80 | sub isTemplateMatchPlain { | ||||||
81 | 1 | 1 | 3 | my ( $self, $plain, $id ) = @_; | |||
82 | 1 | 3 | my $h = WebService::Hexonet::Connector::ResponseParser::parse($plain); | ||||
83 | 1 | 5 | return $self->isTemplateMatchHash( $h, $id ); | ||||
82 | 1 | 2 | my $h = WebService::Hexonet::Connector::ResponseParser::parse($plain); | ||||
83 | 1 | 3 | return $self->isTemplateMatchHash( $h, $id ); | ||||
84 | } | ||||||
85 | |||||||
86 | 1; | ||||||
87 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector::SocketConfig; | ||||||
2 | |||||||
3 | 1 1 | 10 2 | use 5.026_000; | ||||
4 | 1 1 1 | 3 2 12 | use strict; | ||||
5 | 1 1 1 | 3 1 27 | use warnings; | ||||
6 | 1 1 1 | 2 2 3 | use utf8; | ||||
7 | |||||||
8 | 1 1 1 | 13 9 15 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
2 | |||||||
3 | 1 1 | 12 3 | use 5.026_000; | ||||
4 | 1 1 1 | 3 2 9 | use strict; | ||||
5 | 1 1 1 | 3 11 24 | use warnings; | ||||
6 | 1 1 1 | 3 2 3 | use utf8; | ||||
7 | |||||||
8 | 1 1 1 | 25 8 5 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
9 | |||||||
10 | |||||||
11 | sub new { | ||||||
12 | 3 | 1 | 557 | my $class = shift; | |||
13 | 3 | 37 | return bless { | ||||
12 | 3 | 1 | 537 | my $class = shift; | |||
13 | 3 | 35 | return bless { | ||||
14 | entity => q{}, | ||||||
15 | login => q{}, | ||||||
16 | otp => q{}, | ||||||
21 | }, $class; | ||||||
22 | } | ||||||
23 | |||||||
24 | |||||||
25 | sub getPOSTData { | ||||||
26 | 44 | 1 | 109 | my $self = shift; | |||
27 | 44 | 88 | my $data = {}; | ||||
28 | 44 | 139 | if ( length $self->{entity} ) { | ||||
29 | 43 | 103 | $data->{'s_entity'} = $self->{entity}; | ||||
26 | 44 | 1 | 98 | my $self = shift; | |||
27 | 44 | 94 | my $data = {}; | ||||
28 | 44 | 151 | if ( length $self->{entity} ) { | ||||
29 | 43 | 118 | $data->{'s_entity'} = $self->{entity}; | ||||
30 | } | ||||||
31 | 44 | 113 | if ( length $self->{login} ) { | ||||
32 | 26 | 64 | $data->{'s_login'} = $self->{login}; | ||||
31 | 44 | 123 | if ( length $self->{login} ) { | ||||
32 | 26 | 60 | $data->{'s_login'} = $self->{login}; | ||||
33 | } | ||||||
34 | 44 | 117 | if ( length $self->{otp} ) { | ||||
35 | 1 | 3 | $data->{'s_otp'} = $self->{otp}; | ||||
34 | 44 | 114 | if ( length $self->{otp} ) { | ||||
35 | 1 | 2 | $data->{'s_otp'} = $self->{otp}; | ||||
36 | } | ||||||
37 | 44 | 142 | if ( length $self->{pw} ) { | ||||
38 | 26 | 69 | $data->{'s_pw'} = $self->{pw}; | ||||
37 | 44 | 124 | if ( length $self->{pw} ) { | ||||
38 | 26 | 54 | $data->{'s_pw'} = $self->{pw}; | ||||
39 | } | ||||||
40 | 44 | 107 | if ( length $self->{remoteaddr} ) { | ||||
41 | 29 | 68 | $data->{'s_remoteaddr'} = $self->{remoteaddr}; | ||||
40 | 44 | 113 | if ( length $self->{remoteaddr} ) { | ||||
41 | 29 | 69 | $data->{'s_remoteaddr'} = $self->{remoteaddr}; | ||||
42 | } | ||||||
43 | 44 | 106 | if ( length $self->{session} ) { | ||||
44 | 7 | 17 | $data->{'s_session'} = $self->{session}; | ||||
43 | 44 | 117 | if ( length $self->{session} ) { | ||||
44 | 7 | 16 | $data->{'s_session'} = $self->{session}; | ||||
45 | } | ||||||
46 | 44 | 110 | if ( length $self->{user} ) { | ||||
46 | 44 | 114 | if ( length $self->{user} ) { | ||||
47 | 2 | 5 | $data->{'s_user'} = $self->{user}; | ||||
48 | } | ||||||
49 | 44 | 103 | return $data; | ||||
49 | 44 | 99 | return $data; | ||||
50 | } | ||||||
51 | |||||||
52 | |||||||
53 | sub getSession { | ||||||
54 | 3 | 1 | 9 | my $self = shift; | |||
55 | 3 | 13 | return $self->{session}; | ||||
54 | 3 | 1 | 7 | my $self = shift; | |||
55 | 3 | 12 | return $self->{session}; | ||||
56 | } | ||||||
57 | |||||||
58 | |||||||
59 | sub getSystemEntity { | ||||||
60 | 1 | 1 | 3 | my $self = shift; | |||
61 | 1 | 5 | return $self->{entity}; | ||||
61 | 1 | 6 | return $self->{entity}; | ||||
62 | } | ||||||
63 | |||||||
64 | |||||||
65 | sub setLogin { | ||||||
66 | 10 | 1 | 33 | my ( $self, $value ) = @_; | |||
67 | 10 | 35 | $self->{session} = q{}; # Empty string | ||||
68 | 10 | 25 | $self->{login} = $value; | ||||
69 | 10 | 26 | return $self; | ||||
67 | 10 | 31 | $self->{session} = q{}; # Empty string | ||||
68 | 10 | 27 | $self->{login} = $value; | ||||
69 | 10 | 27 | return $self; | ||||
70 | } | ||||||
71 | |||||||
72 | |||||||
73 | sub setOTP { | ||||||
74 | 8 | 1 | 26 | my ( $self, $value ) = @_; | |||
75 | 8 | 22 | $self->{session} = q{}; # Empty string | ||||
76 | 8 | 21 | $self->{otp} = $value; | ||||
74 | 8 | 1 | 24 | my ( $self, $value ) = @_; | |||
75 | 8 | 24 | $self->{session} = q{}; # Empty string | ||||
76 | 8 | 19 | $self->{otp} = $value; | ||||
77 | 8 | 17 | return $self; | ||||
78 | } | ||||||
79 | |||||||
80 | |||||||
81 | sub setPassword { | ||||||
82 | 10 | 1 | 28 | my ( $self, $value ) = @_; | |||
83 | 10 | 29 | $self->{session} = q{}; # Empty string | ||||
82 | 10 | 1 | 31 | my ( $self, $value ) = @_; | |||
83 | 10 | 33 | $self->{session} = q{}; # Empty string | ||||
84 | 10 | 25 | $self->{pw} = $value; | ||||
85 | 10 | 28 | return $self; | ||||
85 | 10 | 22 | return $self; | ||||
86 | } | ||||||
87 | |||||||
88 | |||||||
89 | sub setRemoteAddress { | ||||||
90 | 3 | 1 | 10 | my ( $self, $value ) = @_; | |||
91 | 3 | 10 | $self->{remoteaddr} = $value; | ||||
91 | 3 | 7 | $self->{remoteaddr} = $value; | ||||
92 | 3 | 8 | return $self; | ||||
93 | } | ||||||
94 | |||||||
95 | |||||||
96 | sub setSession { | ||||||
97 | 13 | 1 | 33 | my ( $self, $value ) = @_; | |||
98 | 13 | 34 | $self->{session} = $value; | ||||
99 | 13 | 26 | $self->{login} = q{}; # Empty string | ||||
100 | 13 | 31 | $self->{pw} = q{}; # Empty string | ||||
101 | 13 | 28 | $self->{otp} = q{}; # Empty string | ||||
102 | 13 | 29 | return $self; | ||||
97 | 13 | 1 | 42 | my ( $self, $value ) = @_; | |||
98 | 13 | 32 | $self->{session} = $value; | ||||
99 | 13 | 32 | $self->{login} = q{}; # Empty string | ||||
100 | 13 | 29 | $self->{pw} = q{}; # Empty string | ||||
101 | 13 | 32 | $self->{otp} = q{}; # Empty string | ||||
102 | 13 | 24 | return $self; | ||||
103 | } | ||||||
104 | |||||||
105 | |||||||
106 | sub setSystemEntity { | ||||||
107 | 4 | 1 | 11 | my ( $self, $value ) = @_; | |||
108 | 4 | 10 | $self->{entity} = $value; | ||||
109 | 4 | 9 | return $self; | ||||
108 | 4 | 9 | $self->{entity} = $value; | ||||
109 | 4 | 10 | return $self; | ||||
110 | } | ||||||
111 | |||||||
112 | |||||||
113 | sub setUser { | ||||||
114 | 2 | 1 | 7 | my ( $self, $value ) = @_; | |||
114 | 2 | 1 | 8 | my ( $self, $value ) = @_; | |||
115 | 2 | 8 | $self->{user} = $value; | ||||
116 | 2 | 6 | return $self; | ||||
117 | } |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package WebService::Hexonet::Connector; | ||||||
2 | |||||||
3 | 1 1 | 229201 4 | use 5.026_000; | ||||
4 | 1 1 1 | 3 2 13 | use strict; | ||||
5 | 1 1 1 | 3 2 36 | use warnings; | ||||
6 | 1 1 1 | 328 3 25 | use WebService::Hexonet::Connector::APIClient; | ||||
7 | 1 1 1 | 5 1 12 | use WebService::Hexonet::Connector::Column; | ||||
8 | 1 1 1 | 3 1 13 | use WebService::Hexonet::Connector::Record; | ||||
9 | 1 1 1 | 3 1 14 | use WebService::Hexonet::Connector::Response; | ||||
10 | 1 1 1 | 3 1 11 | use WebService::Hexonet::Connector::ResponseParser; | ||||
11 | 1 1 1 | 3 1 9 | use WebService::Hexonet::Connector::ResponseTemplate; | ||||
12 | 1 1 1 | 2 2 14 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
13 | 1 1 1 | 2 2 16 | use WebService::Hexonet::Connector::SocketConfig; | ||||
14 | |||||||
15 | 1 1 1 | 3 12 10 | use version 0.9917; our $VERSION = version->declare('v2.2.2'); | ||||
2 | |||||||
3 | 1 1 | 274337 5 | use 5.026_000; | ||||
4 | 1 1 1 | 3 1 14 | use strict; | ||||
5 | 1 1 1 | 2 2 32 | use warnings; | ||||
6 | 1 1 1 | 303 2 22 | use WebService::Hexonet::Connector::APIClient; | ||||
7 | 1 1 1 | 5 1 11 | use WebService::Hexonet::Connector::Column; | ||||
8 | 1 1 1 | 3 2 9 | use WebService::Hexonet::Connector::Record; | ||||
9 | 1 1 1 | 3 1 17 | use WebService::Hexonet::Connector::Response; | ||||
10 | 1 1 1 | 2 2 9 | use WebService::Hexonet::Connector::ResponseParser; | ||||
11 | 1 1 1 | 3 1 8 | use WebService::Hexonet::Connector::ResponseTemplate; | ||||
12 | 1 1 1 | 3 1 11 | use WebService::Hexonet::Connector::ResponseTemplateManager; | ||||
13 | 1 1 1 | 2 2 17 | use WebService::Hexonet::Connector::SocketConfig; | ||||
14 | |||||||
15 | 1 1 1 | 4 9 5 | use version 0.9917; our $VERSION = version->declare('v2.2.3'); | ||||
16 | |||||||
17 | 1; | ||||||
18 |