line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::OpenSRS::OMA::Response; # internal package, defined below |
2
|
|
|
|
|
|
|
1; |
3
|
|
|
|
|
|
|
package Net::OpenSRS::OMA; |
4
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
27630
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
44
|
|
6
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
33
|
|
7
|
1
|
|
|
1
|
|
1519
|
use JSON; |
|
1
|
|
|
|
|
71946
|
|
|
1
|
|
|
|
|
8
|
|
8
|
1
|
|
|
1
|
|
2202
|
use LWP::UserAgent; |
|
1
|
|
|
|
|
159957
|
|
|
1
|
|
|
|
|
46
|
|
9
|
1
|
|
|
1
|
|
13
|
use Carp; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
8080
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = "0.02"; |
12
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Net::OpenSRS::OMA - Client library for the OpenSRS Mail API |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use Data::Dumper; |
21
|
|
|
|
|
|
|
use Net::OpenSRS::OMA; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my $oma = new Net::OpenSRS::OMA( |
24
|
|
|
|
|
|
|
uri => 'https://admin.a.hostedemail.com/api', |
25
|
|
|
|
|
|
|
user => 'admin@domain.adm', |
26
|
|
|
|
|
|
|
client => 'my client 0.1', |
27
|
|
|
|
|
|
|
password => 'abc123', |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
my $response = $oma->get_user( |
32
|
|
|
|
|
|
|
user => 'user@domain.com' |
33
|
|
|
|
|
|
|
); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
if ($response->is_success) |
36
|
|
|
|
|
|
|
{ |
37
|
|
|
|
|
|
|
print Dumper $response->content; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
elsif ($response->error) |
40
|
|
|
|
|
|
|
{ |
41
|
|
|
|
|
|
|
print "Request didn't work at OMA level: " . $response->error . "\n"; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
else |
44
|
|
|
|
|
|
|
{ |
45
|
|
|
|
|
|
|
print "Request didn't work at HTTP level: " . $response->http_status; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
This module requires these modules. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=over |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=item LWP::UserAgent |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=item LWP::Protocol::https |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=item JSON |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=back |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 CAVEAT |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
This API is still under development and thus the |
65
|
|
|
|
|
|
|
method calls, arguments and functions are subject to change. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Consult the API documentation for up to date information. |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 METHODS |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=cut |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head2 new |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Create and return a new Net::OpenSRS::OMA object. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Takes the following arguments (in a single hash argument) |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
uri - base uri for the api: http://example.com/api/ |
80
|
|
|
|
|
|
|
user - username for authentication |
81
|
|
|
|
|
|
|
password - password for authentication |
82
|
|
|
|
|
|
|
token - token for authentication |
83
|
|
|
|
|
|
|
client - client identification string |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
uri, user and either password or token are required. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=cut |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub new($@) |
90
|
|
|
|
|
|
|
{ |
91
|
1
|
|
|
1
|
1
|
21
|
my $proto = shift; |
92
|
1
|
|
33
|
|
|
9
|
my $class = ref($proto) || $proto; |
93
|
1
|
|
|
|
|
7
|
my %args = @_; |
94
|
1
|
|
|
|
|
2
|
my $self = {}; |
95
|
1
|
50
|
33
|
|
|
12
|
unless ($args{uri} && $args{user} && |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
96
|
|
|
|
|
|
|
($args{password} || $args{token} )) |
97
|
|
|
|
|
|
|
{ |
98
|
0
|
|
|
|
|
0
|
warn('Need uri, user and password or token'); |
99
|
0
|
|
|
|
|
0
|
return undef; |
100
|
|
|
|
|
|
|
} |
101
|
1
|
|
|
|
|
5
|
$self->{URI} = $args{uri}; |
102
|
1
|
|
|
|
|
3
|
my $client = $args{client}; |
103
|
1
|
50
|
|
|
|
4
|
$client = "Perl OMA Client\\$VERSION" unless $client; |
104
|
1
|
|
|
|
|
5
|
$self->{CREDENTIALS} = { |
105
|
|
|
|
|
|
|
user => $args{user}, |
106
|
|
|
|
|
|
|
client => $client |
107
|
|
|
|
|
|
|
}; |
108
|
|
|
|
|
|
|
|
109
|
1
|
50
|
|
|
|
5
|
if ($args{password}) {$self->{CREDENTIALS}->{password} = $args{password}} |
|
1
|
|
|
|
|
3
|
|
110
|
0
|
|
|
|
|
0
|
else { $self->{CREDENTIALS}->{token} = $args{token}} |
111
|
|
|
|
|
|
|
|
112
|
1
|
|
|
|
|
10
|
$self->{UA} = LWP::UserAgent->new; |
113
|
1
|
|
|
|
|
3792
|
$self->{UA}->agent($client); |
114
|
|
|
|
|
|
|
|
115
|
1
|
|
|
|
|
103
|
return bless($self, $class); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head2 uri |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Get the API address this object is using |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head2 user |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Get the username this object is using |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 client |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
Get the client identifier string this object is using |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=cut |
131
|
|
|
|
|
|
|
|
132
|
0
|
|
|
0
|
1
|
0
|
sub uri($){return $_[0]->{URI}}; |
133
|
0
|
|
|
0
|
1
|
0
|
sub user($){return $_[0]->{CREDENTIALS}->{user}} |
134
|
0
|
|
|
0
|
1
|
0
|
sub client($){return $_[0]->{CREDENTIALS}->{client}} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head2 API Methods |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
API methods are called as object methods. All methods take a hash argument, that hash has |
139
|
|
|
|
|
|
|
a credentials hashref added, is converted to JSON and sent to the API. Method calls return a |
140
|
|
|
|
|
|
|
Net::OpenSRS::OMA::Response object containing the response from the server. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
Consult the API documentation for the arguments and response formats for each method. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
The callable methods are: |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=over |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=item add_role |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item authenticate |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item change_company |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=item change_company_bulletin |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item change_domain |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=item change_domain_bulletin |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item change_user |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=item change_brand |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=item create_workgroup |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=item delete_company |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=item delete_domain |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=item delete_user |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=item delete_workgroup |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=item echo |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=item generate_token |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item get_company |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=item get_company_bulletin |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=item get_company_changes |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
=item get_deleted_contacts |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=item get_deleted_messages |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=item get_domain |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
=item get_domain_bulletin |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item get_domain_changes |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item get_user |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=item get_user_attribute_history |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=item get_user_changes |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=item get_user_folders |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=item get_user_messages |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
=item get_valid_languages |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=item get_valid_timezones |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=item logout_user |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=item migration_add |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=item migration_jobs |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=item migration_status |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=item migration_threads |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=item migration_trace |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item move_user_messages |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
=item post_domain_bulletin |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=item post_company_bulletin |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item remove_role |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=item rename_user |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=item restore_deleted_contacts |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=item restore_deleted_messages |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=item restore_domain |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=item restore_user |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item search_brand_members |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item search_brands |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=item search_companies |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item search_domains |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=item search_users |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=item search_workgroups |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=item set_role |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=item stats_summary |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=item stats_list |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=item stats_snapshot |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=back |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=cut |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
my @_methods = qw( |
263
|
|
|
|
|
|
|
add_role |
264
|
|
|
|
|
|
|
authenticate |
265
|
|
|
|
|
|
|
change_company |
266
|
|
|
|
|
|
|
change_company_bulletin |
267
|
|
|
|
|
|
|
change_domain |
268
|
|
|
|
|
|
|
change_domain_bulletin |
269
|
|
|
|
|
|
|
change_user |
270
|
|
|
|
|
|
|
change_brand |
271
|
|
|
|
|
|
|
create_workgroup |
272
|
|
|
|
|
|
|
delete_company |
273
|
|
|
|
|
|
|
delete_domain |
274
|
|
|
|
|
|
|
delete_user |
275
|
|
|
|
|
|
|
delete_workgroup |
276
|
|
|
|
|
|
|
echo |
277
|
|
|
|
|
|
|
generate_token |
278
|
|
|
|
|
|
|
get_company |
279
|
|
|
|
|
|
|
get_company_bulletin |
280
|
|
|
|
|
|
|
get_company_changes |
281
|
|
|
|
|
|
|
get_deleted_contacts |
282
|
|
|
|
|
|
|
get_deleted_messages |
283
|
|
|
|
|
|
|
get_domain |
284
|
|
|
|
|
|
|
get_domain_bulletin |
285
|
|
|
|
|
|
|
get_domain_changes |
286
|
|
|
|
|
|
|
get_user |
287
|
|
|
|
|
|
|
get_user_attribute_history |
288
|
|
|
|
|
|
|
get_user_changes |
289
|
|
|
|
|
|
|
get_user_folders |
290
|
|
|
|
|
|
|
get_user_messages |
291
|
|
|
|
|
|
|
get_valid_languages |
292
|
|
|
|
|
|
|
get_valid_timezones |
293
|
|
|
|
|
|
|
logout_user |
294
|
|
|
|
|
|
|
migration_add |
295
|
|
|
|
|
|
|
migration_jobs |
296
|
|
|
|
|
|
|
migration_status |
297
|
|
|
|
|
|
|
migration_threads |
298
|
|
|
|
|
|
|
migration_trace |
299
|
|
|
|
|
|
|
move_user_messages |
300
|
|
|
|
|
|
|
post_domain_bulletin |
301
|
|
|
|
|
|
|
post_company_bulletin |
302
|
|
|
|
|
|
|
remove_role |
303
|
|
|
|
|
|
|
rename_user |
304
|
|
|
|
|
|
|
restore_deleted_contacts |
305
|
|
|
|
|
|
|
restore_deleted_messages |
306
|
|
|
|
|
|
|
restore_domain |
307
|
|
|
|
|
|
|
restore_user |
308
|
|
|
|
|
|
|
search_brand_members |
309
|
|
|
|
|
|
|
search_brands |
310
|
|
|
|
|
|
|
search_companies |
311
|
|
|
|
|
|
|
search_domains |
312
|
|
|
|
|
|
|
search_users |
313
|
|
|
|
|
|
|
search_workgroups |
314
|
|
|
|
|
|
|
set_role |
315
|
|
|
|
|
|
|
stats_summary |
316
|
|
|
|
|
|
|
stats_list |
317
|
|
|
|
|
|
|
stats_snapshot |
318
|
|
|
|
|
|
|
); |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
my @_deprecated_methods = qw( |
321
|
|
|
|
|
|
|
_audit |
322
|
|
|
|
|
|
|
_change_brand |
323
|
|
|
|
|
|
|
_delete_brand |
324
|
|
|
|
|
|
|
_get_brand |
325
|
|
|
|
|
|
|
_get_brand_changes |
326
|
|
|
|
|
|
|
_get_brand_trace |
327
|
|
|
|
|
|
|
_get_company_trace |
328
|
|
|
|
|
|
|
_get_domain_trace |
329
|
|
|
|
|
|
|
_get_user_trace |
330
|
|
|
|
|
|
|
_id_to_name |
331
|
|
|
|
|
|
|
_list_brand_traces |
332
|
|
|
|
|
|
|
_list_company_traces |
333
|
|
|
|
|
|
|
_list_domain_traces |
334
|
|
|
|
|
|
|
_list_user_traces |
335
|
|
|
|
|
|
|
_name_to_id |
336
|
|
|
|
|
|
|
); |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
our $AUTOLOAD; |
339
|
|
|
|
|
|
|
sub AUTOLOAD { |
340
|
1
|
50
|
|
1
|
|
4694
|
return if our $AUTOLOAD =~ /::DESTROY$/; |
341
|
1
|
|
|
|
|
4
|
my $self = shift; |
342
|
1
|
|
|
|
|
3
|
my $sub = $AUTOLOAD; |
343
|
1
|
|
|
|
|
14
|
(my $method = $sub) =~ s/.*:://; |
344
|
1
|
50
|
|
|
|
5
|
unless (grep {$_ eq $method} (@_methods, @_deprecated_methods)) |
|
70
|
|
|
|
|
800
|
|
345
|
|
|
|
|
|
|
{ |
346
|
0
|
|
|
|
|
0
|
croak("Undefined method $AUTOLOAD"); |
347
|
|
|
|
|
|
|
} |
348
|
1
|
|
|
|
|
6
|
my %body = @_; |
349
|
1
|
|
|
|
|
643
|
return $self->_do_method($method, \%body); |
350
|
|
|
|
|
|
|
} |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
# |
354
|
|
|
|
|
|
|
# don't call this |
355
|
|
|
|
|
|
|
# |
356
|
|
|
|
|
|
|
sub _do_method($$$) |
357
|
|
|
|
|
|
|
{ |
358
|
1
|
|
|
1
|
|
4
|
my ($self, $method, $body) = @_; |
359
|
1
|
|
|
|
|
10
|
my $muri = $self->{URI} . '/' . $method; |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
# create request body (add credentials) |
362
|
1
|
|
|
|
|
6
|
my %body_copy = %$body; |
363
|
1
|
|
|
|
|
6
|
$body_copy{'credentials'} = $self->{'CREDENTIALS'}; |
364
|
1
|
|
|
|
|
9
|
my $body_text = to_json(\%body_copy); |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# create request |
367
|
1
|
|
|
|
|
76
|
my $request = HTTP::Request->new(POST => $muri); |
368
|
1
|
|
|
|
|
24401
|
$request->content_type('application/json'); |
369
|
1
|
|
|
|
|
67
|
$request->content($body_text); |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
#send request |
372
|
1
|
|
|
|
|
36
|
my $response = $self->{UA}->request($request); |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# deal with response |
375
|
1
|
50
|
|
|
|
1609807
|
if ($response->is_success) |
376
|
|
|
|
|
|
|
{ |
377
|
1
|
|
|
|
|
11
|
my $j; |
378
|
1
|
|
|
|
|
4
|
eval {$j = from_json($response->content)}; |
|
1
|
|
|
|
|
10
|
|
379
|
1
|
50
|
|
|
|
119
|
if ($@) |
380
|
|
|
|
|
|
|
{ |
381
|
0
|
|
|
|
|
0
|
warn "Invalid JSON from API: -(" . $response->content . ")-"; |
382
|
0
|
|
|
|
|
0
|
$j = ''; |
383
|
|
|
|
|
|
|
} |
384
|
1
|
|
|
|
|
5
|
return new Net::OpenSRS::OMA::Response( |
385
|
|
|
|
|
|
|
status => $response->status_line, |
386
|
|
|
|
|
|
|
raw_content => $response->content, |
387
|
|
|
|
|
|
|
content => $j, |
388
|
|
|
|
|
|
|
); |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
else |
391
|
|
|
|
|
|
|
{ |
392
|
0
|
|
|
|
|
0
|
return new Net::OpenSRS::OMA::Response( |
393
|
|
|
|
|
|
|
status => $response->status_line, |
394
|
|
|
|
|
|
|
); |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
1; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
package Net::OpenSRS::OMA::Response; |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=head1 RESPONSE OBJECT METHODS |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
=cut |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
sub new($@) |
409
|
|
|
|
|
|
|
{ |
410
|
1
|
|
|
1
|
|
25
|
my $proto = shift; |
411
|
1
|
|
33
|
|
|
9
|
my $class = ref($proto) || $proto; |
412
|
1
|
|
|
|
|
6
|
my %args = @_; |
413
|
1
|
|
|
|
|
2
|
my $self = {}; |
414
|
1
|
50
|
|
|
|
5
|
$self->{CONTENT} = $args{content} if $args{content}; |
415
|
1
|
50
|
|
|
|
5
|
$self->{RAW_CONTENT} = $args{raw_content} if $args{raw_content}; |
416
|
1
|
50
|
|
|
|
4
|
$self->{HTTP_STATUS} = $args{status} if $args{status}; |
417
|
1
|
|
|
|
|
41
|
return bless($self, $class); |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=head2 is_success |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
Returns true if the HTTP status of the request was 200, the response had valid |
423
|
|
|
|
|
|
|
JSON content, and the 'success' field of the response is true. |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=cut |
426
|
|
|
|
|
|
|
sub is_success($) |
427
|
|
|
|
|
|
|
{ |
428
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
429
|
|
|
|
|
|
|
return |
430
|
0
|
|
0
|
|
|
0
|
$self->{HTTP_STATUS} =~ /^200/ && |
431
|
|
|
|
|
|
|
$self->{CONTENT} && |
432
|
|
|
|
|
|
|
$self->{CONTENT}->{success} ; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=head2 content |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
Returns a hashref, the decoded JSON content of the response, or undef if |
438
|
|
|
|
|
|
|
there is no content. |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=cut |
441
|
|
|
|
|
|
|
|
442
|
0
|
|
|
0
|
|
0
|
sub content($) {return $_[0]->{CONTENT}}; |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head2 raw_content |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
Returns a scalar, string, the raw response fromt he server, or undef if |
447
|
|
|
|
|
|
|
there is no content |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=cut |
450
|
|
|
|
|
|
|
|
451
|
0
|
|
|
0
|
|
0
|
sub raw_content($) {return $_[0]->{RAW_CONTENT}}; |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=head2 http_status |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
Returns a scalar, the HTTP status of the request, from the LWP module. |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=cut |
458
|
|
|
|
|
|
|
|
459
|
1
|
|
|
1
|
|
700
|
sub http_status($) {return $_[0]->{HTTP_STATUS}}; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=head2 error_number |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
Returns a scalar, the error number from the JSON content of the response, |
464
|
|
|
|
|
|
|
or undef if no error number. |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
=cut |
467
|
|
|
|
|
|
|
|
468
|
0
|
|
|
0
|
|
|
sub error_number($) {return $_[0]->{CONTENT}->{error_number}}; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=head2 error |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
Returns a scalar, the error string from the JSON content of the response, |
473
|
|
|
|
|
|
|
or undef if no error string. |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=cut |
476
|
|
|
|
|
|
|
|
477
|
0
|
|
|
0
|
|
|
sub error($) {return $_[0]->{CONTENT}->{error}}; |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
1; |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=head1 AUTHOR |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
Richard Platel |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
Copyright 2012 Richard Platel |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=cut |