File Coverage

blib/lib/WWW/LogicBoxes/Role/Command.pm
Criterion Covered Total %
statement 24 42 57.1
branch 0 12 0.0
condition 0 3 0.0
subroutine 8 11 72.7
pod 1 1 100.0
total 33 69 47.8


line stmt bran cond sub pod time code
1             package WWW::LogicBoxes::Role::Command;
2              
3 38     38   482503 use strict;
  38         115  
  38         1418  
4 38     38   242 use warnings;
  38         96  
  38         1147  
5              
6 38     38   762 use Moose::Role;
  38         183735  
  38         314  
7 38     38   217635 use MooseX::Params::Validate;
  38         184077  
  38         352  
8              
9 38     38   20910 use WWW::LogicBoxes::Types qw( HashRef Str );
  38         103  
  38         422  
10              
11 38     38   441243 use JSON qw( decode_json );
  38         467294  
  38         2507  
12              
13 38     38   6362 use Try::Tiny;
  38         102  
  38         4279  
14 38     38   256 use Carp;
  38         2068  
  38         21616  
15              
16             requires 'response_type';
17             with 'WWW::LogicBoxes::Role::Command::Raw',
18             'WWW::LogicBoxes::Role::Command::Contact',
19             'WWW::LogicBoxes::Role::Command::Customer',
20             'WWW::LogicBoxes::Role::Command::Domain',
21             'WWW::LogicBoxes::Role::Command::Domain::Availability',
22             'WWW::LogicBoxes::Role::Command::Domain::PrivateNameServer',
23             'WWW::LogicBoxes::Role::Command::Domain::Registration',
24             'WWW::LogicBoxes::Role::Command::Domain::Transfer';
25              
26             our $VERSION = '1.11.0'; # VERSION
27             # ABSTRACT: Submission of LogicBoxes Commands
28              
29             # Used to force json as the response_type and restore the existing type afterwards
30             around submit => sub {
31             my $orig = shift;
32             my $self = shift;
33             my $args = shift;
34              
35             my $current_response_type = $self->response_type;
36              
37             my $response;
38             try {
39             if( $current_response_type ne 'json' ) {
40             $self->response_type('json');
41             }
42              
43             $response = $self->$orig( $args );
44             }
45             catch {
46             croak $_;
47             }
48             finally {
49             if($self->response_type ne $current_response_type) {
50             $self->response_type($current_response_type);
51             }
52             };
53              
54             return $response;
55             };
56              
57             sub submit {
58 0     0 1   my $self = shift;
59 0           my (%args) = validated_hash(
60             \@_,
61             method => { isa => Str },
62             params => { isa => HashRef, optional => 1 },
63             );
64              
65 0           my $response;
66             try {
67 0     0     my $method = $args{method};
68 0           my $raw_json = $self->$method( $args{params} );
69              
70 0 0         if($raw_json =~ /^\d+$/) {
    0          
    0          
71             # When just an id is returned, JSON is not used
72 0           $response = { id => $raw_json };
73             }
74             elsif( $raw_json =~ m/^(?:true|false)$/i ) {
75             # When just a true/false is returned, JSON is not used
76 0           $response = { result => $raw_json };
77             }
78             elsif( $raw_json =~ m/^Success/i ) {
79 0           $response = { result => $raw_json };
80             }
81             else {
82 0           $response = decode_json( $raw_json );
83             }
84             }
85             catch {
86 0     0     croak "Error Making LogicBoxes Request: $_";
87 0           };
88              
89 0 0 0       if(exists $response->{status} && lc $response->{status} eq "error") {
90 0 0         if( exists $response->{message} ) {
    0          
91 0           croak $response->{message};
92             }
93             elsif( exists $response->{error} ) {
94 0           croak $response->{error};
95             }
96              
97 0           croak 'Unknown error';
98             }
99              
100 0           return $response;
101             }
102              
103             1;
104              
105             __END__
106             =pod
107              
108             =head1 NAME
109              
110             WWW::LogicBoxes::Role::Command - Basic Logic for Submission of Requests to LogicBoxes
111              
112             =head1 SYNOPSIS
113              
114             use WWW::LogicBoxes;
115             use WWW::LogicBoxes::Contact;
116              
117             my $logic_boxes = WWW::LogicBoxes->new( ... );
118             my $contact = WWW::LogicBoxes::Contact->new( ... );
119              
120             my $response = $logic_boxes->submit({
121             method => 'contacts__add',
122             params => $contact->construct_creation_request(),
123             });
124              
125             =head1 WITH
126              
127             =over 4
128              
129             =item L<WWW::LogicBoxes::Role::Command::Raw>
130              
131             =item L<WWW::LogicBoxes::Role::Command::Contact>
132              
133             =item L<WWW::LogicBoxes::Role::Command::Customer>
134              
135             =item L<WWW::LogicBoxes::Role::Command::Domain>
136              
137             =item L<WWW::LogicBoxes::Role::Command::Domain::Availability>
138              
139             =item L<WWW::LogicBoxes::Role::Command::Domain::PrivateNameServer>
140              
141             =item L<WWW::LogicBoxes::Role::Command::Domain::Registration>
142              
143             =back
144              
145             =head1 REQUIRES
146              
147             response_type
148              
149             =head1 DESCRIPTION
150              
151             Primary interface to L<LogicBoxes|http://www.logicboxes.com> API that is used by the rest of the WWW::LogicBoxes::Role::Command::* roles. The only reason a consumer would use the submit method directly would be if there was no corresponding Command for the needed operation.
152              
153             =head1 METHODS
154              
155             =head2 submit
156              
157             use WWW::LogicBoxes;
158             use WWW::LogicBoxes::Contact;
159              
160             my $logic_boxes = WWW::LogicBoxes->new( ... );
161             my $contact = WWW::LogicBoxes::Contact->new( ... );
162              
163             my $response = $logic_boxes->submit({
164             method => 'contacts__add',
165             params => $contact->construct_creation_request(), # Optional for some methods
166             });
167              
168             The submit method is what sends requests over to L<LogicBoxes|http://www.logicboxes.com>. It accepts a L<raw method|WWW::LogicBoxes::Role::Command::Raw> and an optional HashRef of params (almost all methods require params to be provided, but not all do). For details on the structure of the params please see L<WWW::LogicBoxes::Role::Command::Raw>.
169              
170             The submit method returns a HashRef that represents the data returned by LogicBoxes. There is logic built into submit such that requests are always made with a JSON response which is what drives the creation of the HashRef form the response.
171              
172             =cut