File Coverage

blib/lib/WWW/SEOGears.pm
Criterion Covered Total %
statement 54 198 27.2
branch 5 80 6.2
condition 1 29 3.4
subroutine 15 39 38.4
pod 14 14 100.0
total 89 360 24.7


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