line
stmt
bran
cond
sub
pod
time
code
1
package WWW::SEOGears;
2
3
8
8
245262
use 5.008;
8
33
8
331
4
8
8
45
use strict;
8
23
8
292
5
8
8
42
use Carp qw(carp croak);
8
34
8
487
6
8
8
9042
use Data::Dumper;
8
102839
8
841
7
8
8
7388
use English qw(-no_match_vars);
8
41338
8
55
8
8
8
4001
use List::Util qw(first);
8
16
8
902
9
8
8
45
use warnings FATAL => 'all';
8
18
8
416
10
11
8
8
6886
use Date::Calc qw(Add_Delta_YMDHMS Today_and_Now);
8
336636
8
873
12
8
8
11313
use HTTP::Tiny;
8
418829
8
566
13
8
8
10452
use JSON qw(decode_json);
8
139059
8
50
14
8
8
8477
use URI::Escape qw(uri_escape);
8
10092
8
748
15
16
=head1 NAME
17
18
WWW::SEOGears - Perl Interface for SEOGears API.
19
20
=head1 VERSION
21
22
Version 0.04
23
24
=cut
25
26
our $VERSION = '0.05';
27
28
## no critic (ProhibitConstantPragma)
29
8
21947
use constant VALID_MONTHS => {
30
'1' => 'monthly',
31
'12' => 'yearly',
32
'24' => 'bi-yearly',
33
'36' => 'tri-yearly'
34
8
8
56
};
8
16
35
## use critic
36
37
=head1 SYNOPSIS
38
39
This module provides you with an perl interface to interact with the Seogears API.
40
41
use WWW::SEOGears;
42
my $api = WWW::SEOGears->new( { 'brandname' => $brandname,
43
'brandkey' => $brandkey,
44
'sandbox' => $boolean
45
});
46
$api->newuser($params_for_newuser);
47
$api->statuscheck($params_for_statuscheck);
48
$api->inactivate($params_for_inactivate);
49
$api->update($params_for_update);
50
$api->get_tempauth($params_for_update);
51
52
=head1 SUBROUTINES/METHODS
53
54
=head2 new
55
56
Constructor.
57
58
B takes a hashref that contains:
59
60
Required:
61
62
brandname => Brandname as listed on seogears' end.
63
brandkey => Brandkey received from seogears.
64
65
Will croak if the above keys are not present.
66
67
Optional:
68
sandbox => If specified the sandbox API url is used instead of production.
69
http_opts => Hashref of options that are passed on to the HTTP::Tiny object that is used internally.
70
Example value: { 'agent' => 'WWW-SEOGears', 'timeout' => 20, 'verify_SSL' => 0, 'SSL_options' => {'SSL_verify_mode' => 0x00} }
71
72
Deprecated (will be dropped in the upcoming update): Will emit a warning if used.
73
lwp => hash of options for LWP::UserAgent - will be converted to their corresponding HTTP::Tiny options.
74
Example value: {'parse_head' => 0, 'ssl_opts' => {'verify_hostname' => 0, 'SSL_verify_mode' => 0x00}}
75
76
=cut
77
78
sub new {
79
80
1
1
1
497
my ($class, $opts) = @_;
81
82
1
3
my $self = {};
83
1
3
bless $self, $class;
84
85
1
50
10
$self->{brandname} = delete $opts->{brandname} or croak('brandname is a required parameter');
86
1
50
6
$self->{brandkey} = delete $opts->{brandkey} or croak('brandkey is a required parameter');
87
88
# API urls
89
1
3
$self->{authurl} = 'https://seogearstools.com/api/auth.html';
90
1
3
$self->{loginurl} = 'https://seogearstools.com/api/login.html';
91
1
50
4
if (delete $opts->{sandbox}) {
92
1
3
$self->{userurl} = 'https://seogearstools.com/api/user-sandbox.html';
93
} else {
94
0
0
$self->{userurl} = 'https://seogearstools.com/api/user.html';
95
}
96
97
# Set up the UA object for the queries
98
1
2
my $http_opts;
99
1
50
8
if (exists $opts->{lwp}) {
50
100
0
0
carp(
101
"*******************************************************************\n".
102
"You are using the deprecated option: 'lwp' intended for LWP::UserAgent\n".
103
"Please update your code to use http_opts instead, which takes in options for HTTP::Tiny\n".
104
"The passed in options will be converted to HTTP::Tiny options, but not all options will translate to properly.\n".
105
"This might cause unforeseen issues, so please test fully before using this in production.\n".
106
"*******************************************************************\n".
107
" "
108
);
109
0
0
$http_opts = _translate_lwp_to_http_opts($opts->{lwp});
110
} elsif (exists $opts->{http_opts}) {
111
1
2
$http_opts = $opts->{http_opts};
112
}
113
1
33
3
$http_opts->{agent} ||= 'WWW-SEOGears '.$VERSION;
114
1
2
$self->{_ua} = HTTP::Tiny->new(%{$http_opts});
1
11
115
116
1
87
return $self;
117
}
118
119
=head2 newuser
120
121
Creates a new user via the 'action=new' API call.
122
Since the 'userid' and 'email' can be used to fetch details about the seogears account, storing these values locally is recommended.
123
124
B Requires that you pass in the following parameters for the call:
125
126
userid => '123456789'
127
email => 'test1@testing123.com'
128
name => 'Testing User'
129
phone => '1.5552223333'
130
domain => 'somedomain.com'
131
rep => 'rep@domain.com'
132
placement => 'reg'
133
pack => '32'
134
price => '14.99'
135
months => '12'
136
137
Croaks if it is unable to sanitize the %params passed successfully, or the HTTP request to the API fails.
138
139
B Hash containing the data returned by the API:
140
141
"success" => 1
142
"authkey" => "GB0353566P163045n07157LUFGZntgqNF042MO692S19567CIGHj727437179300tE5nt8C362803K686Yrbj4643zausyiw"
143
"bzid" => "30928"
144
"debuginfo" => "Success"
145
"message" => "New Account Created"
146
147
=cut
148
149
sub newuser {
150
151
0
0
1
0
my ($self, $params) = @_;
152
0
0
0
$self->_sanitize_params('new', $params) or $self->_error('Failed to sanitize params. "'.$self->get_error, 1);
153
0
0
$params->{'brand'} = $self->get_brandname;
154
0
0
$params->{'brandkey'} = $self->get_brandkey;
155
156
0
0
return $self->_make_request_handler('new', $params);
157
}
158
159
=head2 statuscheck
160
161
Fetches information about a user via the 'action=statuscheck' API call.
162
163
B Requires that you pass in the following parameters for the call:
164
165
userid => '123456789'
166
email => 'test1@testing123.com'
167
168
Croaks if it is unable to sanitize the %params passed successfully, or the HTTP request to the API fails.
169
170
B Hash containing the data returned by the API:
171
172
"success" => 1,
173
"inactive" => "0"
174
"authkey" => "WO8407914M283278j87070OPWZGkmvsEG847ZB845Q28584YSBDt684478133472pV3ws1X655571X005Zlhh6810hsxjjka"
175
"bzid" => "30724"
176
"brand" => "brandname"
177
"message" => User is active. See variables for package details."
178
"expdate" => "2014-01-01 12:00:00"
179
"debuginfo" => "User exists. See variables for status and package details."
180
"pack" => "32"
181
"price" => "14.99"
182
"months" => "12"
183
184
=cut
185
186
sub statuscheck {
187
188
0
0
1
0
my ($self, $params) = @_;
189
0
0
0
$self->_sanitize_params('statuscheck', $params) or $self->_error('Failed to sanitize params. "'.$self->get_error, 1);
190
191
0
0
return $self->_make_request_handler('statuscheck', $params);
192
}
193
194
=head2 inactivate
195
196
Inactivates a user via the 'action=inactivate' API call.
197
198
B Requires that you pass in the following parameters for the call:
199
200
"bzid" => "30724"
201
"authkey" => "WO8407914M283278j87070OPWZGkmvsEG847ZB845Q28584YSBDt684478133472pV3ws1X655571X005Zlhh6810hsxjjka"
202
203
Croaks if it is unable to sanitize the %params passed successfully, or the HTTP request to the API fails.
204
205
B Hash containing the data returned by the API:
206
207
'success' => 1,
208
'bzid' => '30724',
209
'debuginfo' => 'Success BZID30724 WO8407914M283278j87070OPWZGkmvsEG847ZB845Q28584YSBDt684478133472pV3ws1X655571X005Zlhh6810hsxjjka'
210
211
=cut
212
213
sub inactivate {
214
215
0
0
1
0
my ($self, $params) = @_;
216
0
0
0
$self->_sanitize_params('inactivate', $params) or $self->_error('Failed to sanitize params. "'.$self->get_error, 1);
217
218
0
0
return $self->_make_request_handler('inactivate', $params);
219
}
220
221
=head2 activate
222
223
Activates a previously inactivated user via the 'action=activate' API call.
224
225
B Requires that you pass in the following parameters for the call:
226
227
'bzid' => '32999'
228
'authkey' => 'BC1052837T155165x75618ZUKZDlbpfMW795RS245L23288ORUUq323360091155yP1ng7E548072L030Zssq0043pldkebf'
229
230
Croaks if it is unable to sanitize the %params passed successfully, or the HTTP request to the API fails.
231
232
B Hash containing the data returned by the API:
233
234
'success' => 1,
235
'bzid' => '32999',
236
'debuginfo' => 'Success BZID32999 BC1052837T155165x75618ZUKZDlbpfMW795RS245L23288ORUUq323360091155yP1ng7E548072L030Zssq0043pldkebf'
237
238
=cut
239
240
sub activate {
241
242
0
0
1
0
my ($self, $params) = @_;
243
0
0
0
$self->_sanitize_params('activate', $params) or $self->_error('Failed to sanitize params. "'.$self->get_error, 1);
244
245
0
0
return $self->_make_request_handler('activate', $params);
246
}
247
248
=head2 update
249
250
Updates/Renews a user via the 'action=update' API call.
251
252
B Requires that you pass in the following parameters for the call:
253
254
"bzid" => "30724"
255
"authkey" => "WO8407914M283278j87070OPWZGkmvsEG847ZB845Q28584YSBDt684478133472pV3ws1X655571X005Zlhh6810hsxjjka"
256
257
Optional params:
258
"email" => "newemail@testing123.com"
259
"phone" => "1.5552224444"
260
"pack" => "33"
261
"months" => "24"
262
"price" => "14.99"
263
264
If pack is specified, then a price must be specified along with it.
265
266
Croaks if it is unable to sanitize the %params passed successfully, or the HTTP request to the API fails.
267
268
B Hash containing the data returned by the API:
269
270
'success' => 1,
271
'bzid' => '30724',
272
'debuginfo' => 'Success'
273
274
=cut
275
276
sub update {
277
278
0
0
1
0
my ($self, $params) = @_;
279
0
0
0
$self->_sanitize_params('update', $params) or $self->_error('Failed to sanitize params. "'.$self->get_error, 1);
280
281
0
0
return $self->_make_request_handler('update', $params);
282
}
283
284
=head2 get_tempauth
285
286
Retrieves the tempauth key for an account from the API.
287
288
B Requires that you pass in the following parameters for the call:
289
290
bzid => '31037'
291
authkey => 'HH1815009C705940t76917IWWAQdvyoDR077CO567M05324BHUCa744638889409oM8kw5E097737M626Gynd3974rsetvzf'
292
293
Croaks if it is unable to sanitize the %params passed successfully, or the HTTP request to the API fails.
294
295
B Hash containing the data returned by the API:
296
297
'success' => 1,
298
'bzid' => '31037',
299
'tempauthkey' => 'OU8937pI03R56Lz493j0958US34Ui9mgJG831JY756X0Tz04WGXVu762IuIxg7643vV6ju9M96J951V430Qvnw41b4qzgp2pu',
300
'message' => ''
301
302
=cut
303
304
sub get_tempauth {
305
306
0
0
1
0
my ($self, $params) = @_;
307
0
0
0
$self->_sanitize_params('auth', $params) or $self->_error('Failed to sanitize params. "'.$self->get_error, 1);
308
309
0
0
return $self->_make_request_handler('auth', $params);
310
}
311
312
=head2 get_templogin_url
313
314
Generates the temporary login URL with which you can access the seogears' control panel. Essentially acts as a wrapper that stringifies the data returned by get_tempauth.
315
316
B Requires that you pass in either:
317
318
userid => '123456789'
319
email => 'test1@testing123.com'
320
321
Or
322
323
bzid => '31037'
324
authkey => 'HH1815009C705940t76917IWWAQdvyoDR077CO567M05324BHUCa744638889409oM8kw5E097737M626Gynd3974rsetvzf'
325
326
If the bzid/authkey are not provied, then it will attempt to look up the proper information using the userid and email provided.
327
328
Croaks if it is unable to sanitize the %params passed successfully, or the HTTP request to the API fails.
329
330
B Returns the login url that can be used to access the control panel on SEOgears.
331
Example: https://seogearstools.com/api/login.html?bzid=31037&tempauthkey=OU8937pI03R56Lz493j0958US34Ui9mgJG831JY756X0Tz04WGXVu762IuIxg7643vV6ju9M96J951V430Qvnw41b4qzgp2pu
332
333
=cut
334
335
sub get_templogin_url {
336
337
0
0
1
0
my ($self, $params) = @_;
338
339
0
0
0
0
if (not ($params->{bzid} and $params->{authkey}) ) {
340
0
0
my $current_info = $self->statuscheck($params);
341
0
0
0
if (not $current_info->{success}) {
342
0
0
$self->_error("Failed to fetch current account information. Error: $current_info->{'debuginfo'}", 1);
343
}
344
0
0
$params = {'bzid' => $current_info->{'bzid'}, 'authkey' => $current_info->{'authkey'}};
345
}
346
347
0
0
my $tempauth = $self->get_tempauth($params);
348
0
0
0
if (not $tempauth->{success}) {
349
0
0
$self->_error("Failed to fetch tempauth key for account. Error: $tempauth->{'debuginfo'}", 1);
350
}
351
352
0
0
return $self->_get_apiurl('login')._stringify_params({'bzid' => $tempauth->{'bzid'}, 'tempauthkey' => $tempauth->{'tempauthkey'}});
353
}
354
355
=head2 get_userurl, get_authurl, get_loginurl
356
357
Return the corresponding api url that is being used.
358
359
=cut
360
361
0
0
1
0
sub get_userurl { return shift->{'userurl'}; }
362
0
0
1
0
sub get_authurl { return shift->{'authurl'}; }
363
0
0
1
0
sub get_loginurl { return shift->{'loginurl'}; }
364
365
=head2 get_error
366
367
Returns $self->{'error'}
368
369
=cut
370
371
0
0
1
0
sub get_error { return shift->{'error'}; }
372
373
=head2 get_brandname
374
375
Returns $self->{'brandname'}
376
377
=cut
378
379
1
1
1
271
sub get_brandname { return shift->{'brandname'}; }
380
381
=head2 get_brandkey
382
383
Returns $self->{'brandkey'}
384
385
=cut
386
387
1
1
1
6
sub get_brandkey { return shift->{'brandkey'}; }
388
389
=head1 Internal Subroutines
390
391
The following are not meant to be used directly, but are available if 'finer' control is required.
392
393
=cut
394
395
=head2 _make_request_handler
396
397
Wraps the call to _make_request and handles error checks.
398
399
B Takes the 'action' and sanitized paramaters hashref as input.
400
401
B Returns undef on failure (sets $self->{error} with the proper error). Returns a hash with the decoded json data from the API server if successful.
402
403
=cut
404
405
sub _make_request_handler {
406
407
0
0
my $self = shift;
408
0
my $action = shift;
409
0
my $params = shift;
410
411
0
0
my $uri = $self->_get_apiurl($action) or return $self->_error($self->get_error, 1);
412
0
$uri .= _stringify_params($params);
413
414
0
my ($output, $error) = $self->_make_request($uri);
415
0
0
if ($error) {
416
0
$self->_error('Failed to process "'.$action.'" request. HTTP request failed: '.$error, 1);
417
}
418
419
0
my $json = eval{ decode_json($output); };
0
420
0
0
if ($EVAL_ERROR){
421
0
$self->_error('Failed to decode JSON - Invalid data returned from server: '.$output, 1);
422
}
423
424
0
return $json;
425
}
426
427
=head2 _make_request
428
429
Makes the HTTP request to the API server.
430
431
B The full uri to perform the HTTP request on.
432
433
B Returns an array containing the http response, and error.
434
If the HTTP request was successful, then the error is blank.
435
If the HTTP request failed, then the response is blank and the error is the status line from the HTTP response.
436
437
=cut
438
439
sub _make_request {
440
441
0
0
my $self = shift;
442
0
my $uri = shift;
443
444
0
my $res = eval {
445
0
0
local $SIG{ ALRM } = sub { croak 'connection timeout' };
0
446
0
0
my $timeout = $self->{_ua}->timeout() || '30';
447
0
alarm $timeout;
448
0
$self->{_ua}->get($uri);
449
};
450
0
alarm 0;
451
452
## no critic (EmptyQuotes BoundaryMatching DotMatchAnything RequireExtendedFormatting)
453
0
0
0
if (
0
0
0
454
# If $res is undef, then request() failed
455
!$res
456
# or if eval_error is set, then either the timeout alarm was triggered, or some other unforeseen error was caught.
457
|| $EVAL_ERROR
458
# or if the previous checks were good, and $ref is an object, then check to see if the status_line says that the connection timed out.
459
|| ( ref $res && $res->{content} =~ m/^could not connect/i )
460
) {
461
# Return 'unable to connect' or whatever the eval_error was as the error.
462
0
0
return ( '', $EVAL_ERROR ? $EVAL_ERROR : 'Unable to connect to server' );
463
} elsif ( $res->{success} ) {
464
# If the response is successful, then return the content.
465
0
return ( $res->{content}, '' );
466
} else {
467
# If the response was not successful, and no evaled error was caught, then return the response status_line as the error.
468
0
return ( '', $res->{status}.' - '.$res->{reason} );
469
}
470
## use critic
471
}
472
473
=head2 _stringify_params
474
475
Stringifies the content of a hash such that the output can be used as the URI body of a GET request.
476
477
B A hashref containing the sanatizied parameters for an API call.
478
479
B String with the keys and values stringified as so '&key1=value1&key2=value2'
480
481
=cut
482
483
sub _stringify_params {
484
485
0
0
my $params = shift;
486
0
my $url;
487
0
foreach my $key (keys %{$params}) {
0
488
## no critic (NoisyQuotes)
489
0
$url .= '&'.$key.'='.uri_escape($params->{$key});
490
## use critic
491
}
492
0
return $url;
493
}
494
495
=head2 _sanitize_params
496
497
sanitizes the data in the hashref passed for the action specified.
498
499
B The 'action', and a hashref that has the data that will be sanitized.
500
501
B Boolean value indicating success. The hash is altered in place as needed.
502
503
=cut
504
505
sub _sanitize_params {
506
507
0
0
my ($self, $action, $params) = @_;
508
0
0
my $required_params = $self->_fetch_required_params($action) or return $self->_error( 'Unknown action specified: ' . $action );
509
0
my $optional_params = $self->_fetch_optional_params($action);
510
511
0
0
if (my $check = _check_params($params, $required_params, $optional_params) ) {
512
0
my $error;
513
0
0
if (ref $check eq 'HASH') {
0
514
0
0
$error .= 'Missing required parameter(s): ' . join (', ', @{ $check->{'required_params'} } ).' ; '
0
515
if $check->{'required_params'};
516
0
0
$error .= 'Blank parameter(s): ' . join (', ', @{ $check->{'blank_params'} } ).' ; '
0
517
if $check->{'blank_params'};
518
} elsif (not ref $check) {
519
0
$error = $check;
520
}
521
0
$self->_error($error);
522
0
return;
523
}
524
525
0
return 1;
526
}
527
528
sub _fetch_required_params {
529
530
0
0
my ($self, $action) = @_;
531
0
my $required_keys_map = {
532
0
'auth' => { map { ($_ => 1) } qw(bzid authkey) },
533
'login' => { },
534
0
'new' => { map { ($_ => 1) } qw(userid name email phone domain rep pack placement price months) },
535
0
'statuscheck' => { map { ($_ => 1) } qw(userid email) },
536
0
'activate' => { map { ($_ => 1) } qw(bzid authkey) },
537
0
'inactivate' => { map { ($_ => 1) } qw(bzid authkey) },
538
0
'update' => { map { ($_ => 1) } qw(bzid authkey) },
539
};
540
541
0
return $required_keys_map->{$action};
542
}
543
544
sub _fetch_optional_params {
545
546
0
0
my ($self, $action) = @_;
547
0
my $optional_keys_map = {
548
0
'update' => { map { ($_ => 1) } qw(email expdate months pack phone price) },
549
};
550
551
0
return $optional_keys_map->{$action};
552
}
553
554
=head2 _check_params
555
556
B : Three hashrefs that contain the following in the specified order:
557
558
1) the hashref to the params that need to be checked.
559
2) the hashref to the 'required' set of params
560
3) the hashref to the 'optional' set of params
561
562
B: Undef if everything is good. If errors are detected, it will:
563
564
either return a hashref that has two arrays:
565
'required_params' - which will list the required params that are missing. And
566
'blank_params' - which will list the params that have blank values specified for them.
567
568
or a string with a specific error message.
569
570
This also 'prunes' the first hashref of params that are not specified in either the required or the optional hashrefs.
571
572
=cut
573
574
sub _check_params {
575
576
0
0
my ($params_to_check, $required_params, $optional_params) = @_;
577
0
my $output;
578
579
0
foreach my $param ( keys %{ $params_to_check } ) {
0
580
0
0
0
if (not (exists $required_params->{$param} or exists $optional_params->{$param} ) ) {
0
581
0
delete $params_to_check->{$param};
582
} elsif (not length $params_to_check->{ $param } ) {
583
0
push @{ $output->{'blank_params'} }, $param;
0
584
}
585
586
0
0
if ( $param eq 'months' ) {
587
0
0
if ( _valid_months($params_to_check->{'months'}) ) {
588
0
$params_to_check->{'expdate'} = _months_from_now($params_to_check->{'months'});
589
} else {
590
0
return 'Invalid value specified for \'months\' parameter: '.$params_to_check->{'months'};
591
}
592
}
593
594
0
0
0
if ($param eq 'pack' and (not $params_to_check->{'price'}) ) {
595
0
return 'Package ID paramater specified without a corresponding "price" parameter';
596
}
597
}
598
599
0
foreach my $required_param ( keys %{ $required_params } ) {
0
600
0
0
0
if (not (exists $params_to_check->{ $required_param } and defined $params_to_check->{ $required_param } ) ) {
601
0
push @{ $output->{'required_params'} }, $required_param;
0
602
}
603
}
604
605
0
return $output;
606
}
607
608
=head2 _valid_months
609
610
Returns true if the 'months' value specified is a valid. Currently, you can set renewals to occur on a monthly or yearly (upto 3 years), so the valid values are:
611
612
1
613
12
614
24
615
36
616
617
=cut
618
619
sub _valid_months {
620
621
0
0
my $months = shift;
622
0
0
if (VALID_MONTHS->{$months}) {
623
0
return 1;
624
}
625
0
return;
626
}
627
628
=head2 _get_apiurl
629
630
Depending on the action passed, it will return the initial part of the URL that you can use along with the _stringify_params method to generate the full GET url.
631
632
Valid actions and the corresponding strings that are returned:
633
634
'auth' => get_authurl().'?'
635
'login' => get_loginurl().'?'
636
'new' => get_userurl().'?action=new'
637
'statuscheck' => get_userurl().'?action=statuscheck'
638
'inactivate' => get_userurl().'?action=inactivate'
639
'update' => get_userurl().'?action=update'
640
641
If no valid action is specified, it will set the $self->{error} and return;
642
643
=cut
644
645
sub _get_apiurl {
646
647
0
0
my $self = shift;
648
0
my $action = shift;
649
650
## no critic (NoisyQuotes)
651
0
my $uri_map = {
652
'auth' => $self->get_authurl().'?',
653
'login' => $self->get_loginurl().'?',
654
'new' => $self->get_userurl().'?action=new',
655
'statuscheck' => $self->get_userurl().'?action=statuscheck',
656
'activate' => $self->get_userurl().'?action=activate',
657
'inactivate' => $self->get_userurl().'?action=inactivate',
658
'update' => $self->get_userurl().'?action=update',
659
};
660
## use critic
661
662
0
0
if (not exists $uri_map->{$action} ) {
663
0
$self->_error('Unknown action specified.');
664
0
return;
665
}
666
0
return $uri_map->{$action};
667
}
668
669
=head2 _error
670
671
Internal method that is used to report and set $self->{'error'}.
672
673
It will croak if called with a true second argument. Such as:
674
675
$self->_error($msg, 1);
676
677
=cut
678
679
sub _error {
680
681
0
0
my ($self, $msg, $croak) = @_;
682
0
$self->{'error'} = $msg;
683
0
0
if ($croak) {
684
0
croak $msg
685
};
686
}
687
688
=head2 _months_from_now
689
690
Internal helper method that will calculate the expiration date thats x months in the future - calculated via Date::Calc's Add_Delta_YMDHMS().
691
692
=cut
693
694
sub _months_from_now {
695
696
0
0
my $months = shift;
697
0
my @date = Add_Delta_YMDHMS( Today_and_Now(), 0, $months, 0, 0, 0, 0);
698
0
return sprintf '%d-%02d-%02d %02d:%02d:%02d', @date;
699
}
700
701
=head2 _translate_lwp_to_http_opts
702
703
Helper method that translates the passed in LWP opts hashref to a corresponding HTTP::Tiny opts hashref.
704
705
=cut
706
707
sub _translate_lwp_to_http_opts {
708
709
0
0
my $lwp_opts = shift;
710
0
my $http_opts;
711
712
0
foreach my $opt (qw(agent cookie_jar default_headers local_address max_redirect max_size proxy timeout ssl_opts)) {
713
0
0
0
if ($opt eq 'default_headers' and ref $lwp_opts->{$opt} eq 'HTTP::Headers') {
0
0
714
0
$http_opts->{$opt} = $lwp_opts->{$opt}->as_string;
715
} elsif ($opt eq 'ssl_opts') {
716
0
0
$http_opts->{verify_SSL} = delete $lwp_opts->{$opt}->{'verify_hostname'} if exists $lwp_opts->{$opt}->{'verify_hostname'};
717
0
0
$http_opts->{SSL_options} = $lwp_opts->{$opt} if keys %{$lwp_opts->{$opt}};
0
718
} elsif (defined $lwp_opts->{$opt}) {
719
0
$http_opts->{$opt} = $lwp_opts->{$opt};
720
}
721
}
722
0
return $http_opts;
723
}
724
725
=head1 AUTHOR
726
727
Rishwanth Yeddula, C<< >>
728
729
=head1 ACKNOWLEDGMENTS
730
731
Thanks to L for funding the development of this module and providing test resources.
732
733
=head1 BUGS
734
735
Please report any bugs or feature requests to C, or through
736
the web interface at L. I will be notified, and then you'll
737
automatically be notified of progress on your bug as I make changes.
738
739
=head1 SUPPORT
740
741
You can find documentation for this module with the perldoc command.
742
743
perldoc WWW::SEOGears
744
745
You can also review the API documentation provided by SEOgears for more information.
746
747
=over 4
748
749
=item * RT: CPAN's request tracker (report bugs here)
750
751
L
752
753
=item * AnnoCPAN: Annotated CPAN documentation
754
755
L
756
757
=item * CPAN Ratings
758
759
L
760
761
=item * Search CPAN
762
763
L
764
765
=back
766
767
=head1 LICENSE AND COPYRIGHT
768
769
Copyright 2014 Rishwanth Yeddula.
770
771
This program is free software; you can redistribute it and/or modify it
772
under the terms of the the Artistic License (2.0). You may obtain a
773
copy of the full license at:
774
775
L
776
777
Any use, modification, and distribution of the Standard or Modified
778
Versions is governed by this Artistic License. By using, modifying or
779
distributing the Package, you accept this license. Do not use, modify,
780
or distribute the Package, if you do not accept this license.
781
782
If your Modified Version has been derived from a Modified Version made
783
by someone other than you, you are nevertheless required to ensure that
784
your Modified Version complies with the requirements of this license.
785
786
This license does not grant you the right to use any trademark, service
787
mark, tradename, or logo of the Copyright Holder.
788
789
This license includes the non-exclusive, worldwide, free-of-charge
790
patent license to make, have made, use, offer to sell, sell, import and
791
otherwise transfer the Package with respect to any patent claims
792
licensable by the Copyright Holder that are necessarily infringed by the
793
Package. If you institute patent litigation (including a cross-claim or
794
counterclaim) against any party alleging that the Package constitutes
795
direct or contributory patent infringement, then this Artistic License
796
to you shall terminate on the date that such litigation is filed.
797
798
Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
799
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
800
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
801
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
802
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
803
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
804
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
805
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
806
807
808
=cut
809
810
1; # End of WWW::SEOGears