File Coverage

blib/lib/WWW/GoDaddy/REST/Schema.pm
Criterion Covered Total %
statement 81 113 71.6
branch 23 50 46.0
condition 12 26 46.1
subroutine 14 16 87.5
pod 3 12 25.0
total 133 217 61.2


line stmt bran cond sub pod time code
1             package WWW::GoDaddy::REST::Schema;
2              
3 4     4   18 use Moose;
  4         6  
  4         35  
4 4     4   22938 use WWW::GoDaddy::REST::Util qw( abs_url build_complex_query_url );
  4         7  
  4         29  
5              
6             extends 'WWW::GoDaddy::REST::Resource';
7              
8             sub resource_field_names {
9 0     0 0 0 my $self = shift;
10 0         0 my %res_fields = %{ $self->f('resourceFields') };
  0         0  
11 0         0 return keys %res_fields;
12             }
13              
14             sub resource_field {
15 3     3 0 4 my $self = shift;
16 3         9 my $name = shift;
17 3         9 my $res_fields = $self->f('resourceFields');
18 3 50       11 if ( !exists $res_fields->{$name} ) {
19 0         0 return undef;
20             }
21 3         12 return $res_fields->{$name};
22             }
23              
24             sub resource_field_type {
25 3     3 0 3 my $self = shift;
26 3         5 my $name = shift;
27 3   50     14 my $opts = shift || {};
28              
29 3   50     10 my $type = $self->resource_field($name)->{'type'} || 'string';
30 3         12 my $want_array = wantarray;
31 3         6 my $auto_upconvert_reference = $opts->{auto_upconvert_reference};
32 3         4 my $qualify_schema_types = $opts->{qualify_schema_types};
33              
34 3 0 33     9 if ( $want_array or $auto_upconvert_reference or $qualify_schema_types ) {
      33        
35 3         11 my ( $a_type, $b_type ) = split( /[\[\]]/, $type );
36              
37 3 100       11 my $compound_type = $b_type ? 1 : 0;
38              
39 3 50       9 if ($auto_upconvert_reference) {
40              
41             # some schemas don't properly use the 'reference' type to indicate
42             # the complex relationship. Convention seems to favor two sorts
43             # of field names that link to complex types:
44             # mySchemaId
45             # my_schema_id
46 0 0 0     0 if ( !$compound_type && $name =~ /^(.*)(_id|Id)$/ ) {
47 0         0 my $possible_schema = $self->client->schema($1);
48 0 0       0 if ($possible_schema) {
49 0         0 $compound_type = 1;
50 0         0 $a_type = 'reference';
51 0         0 $b_type = $possible_schema->id;
52             }
53             }
54             }
55              
56 3 50       7 if ($qualify_schema_types) {
57 0 0       0 if ($compound_type) {
58 0         0 my $possible_schema = $self->client->schema($b_type);
59 0 0       0 if ($possible_schema) {
60 0         0 $b_type = $possible_schema->link('self');
61             }
62             }
63             else {
64 0         0 my $possible_schema = $self->client->schema($a_type);
65 0 0       0 if ($possible_schema) {
66 0         0 $a_type = $possible_schema->link('self');
67             }
68             }
69             }
70              
71 3 50       7 if ($want_array) {
72 3 100       7 if ($compound_type) {
73 1         4 return ( $a_type, $b_type );
74             }
75             else {
76 2         8 return ( undef, $a_type );
77             }
78             }
79             else {
80 0 0       0 if ($compound_type) {
81 0         0 $type = sprintf( '%s[%s]', $a_type, $b_type );
82             }
83             else {
84 0         0 $type = $a_type;
85             }
86             }
87             }
88 0         0 return $type;
89             }
90              
91             sub query {
92 8     8 1 14 my $self = shift;
93              
94 8 100       29 if ( !ref( $_[0] ) ) {
95 5         18 return $self->query_by_id(@_);
96             }
97             else {
98 3         11 return $self->query_complex(@_);
99             }
100              
101             }
102              
103             sub query_complex {
104 3     3 1 4 my $self = shift;
105              
106 3         11 my ( $query_params, $http_opts ) = _separate_query_and_http_params(@_);
107              
108 3         11 my $url = build_complex_query_url( $self->query_url, @{$query_params} );
  3         14  
109              
110 3         107 my $resource = $self->client->http_request_as_resource( 'GET', $url, undef, $http_opts );
111              
112 3 100       29 return wantarray ? $resource->items() : $resource;
113             }
114              
115             sub query_by_id {
116 20     20 1 33 my $self = shift;
117 20         42 my $id = shift;
118 20   100     71 my $opts = shift || {};
119 20   100     75 my $http_opts = shift || {};
120              
121 20         783 my $client = $self->client;
122 20         101 my $url = build_complex_query_url( $self->query_url($id), $opts );
123              
124 20         183 return $client->http_request_as_resource( 'GET', $url, undef, $http_opts );
125             }
126              
127             sub _separate_query_and_http_params {
128 3     3   6 my @all = @_;
129              
130 3 50       9 if ( !@all ) {
131 0         0 return ();
132             }
133              
134 3         4 my ( $query_opts, $http_opts );
135              
136 3 50 33     23 if ( @all && _looks_like_http_options( $all[-1] ) ) {
137 0         0 $http_opts = pop @all;
138 0         0 $query_opts = \@all;
139             }
140             else {
141 3         4 $http_opts = undef;
142 3         6 $query_opts = \@all;
143             }
144 3         8 return ( $query_opts, $http_opts );
145             }
146              
147             sub _looks_like_http_options {
148 3     3   3 my $item = shift;
149 3   33     29 return ref($item) eq 'HASH' && exists $item->{timeout};
150             }
151              
152             sub create {
153 3     3 0 4 my $self = shift;
154              
155 3         92 my $client = $self->client;
156 3         6 my $url = $self->query_url;
157              
158 3         24 return $client->http_request_as_resource( 'POST', $url, @_ );
159             }
160              
161             sub is_queryable {
162 0     0 0 0 my $self = shift;
163 0 0       0 if ( $self->id eq 'schema' ) {
164 0         0 return 1;
165             }
166 0 0       0 if ( $self->link('collection') ) {
167 0         0 return 1;
168             }
169             }
170              
171             sub query_url {
172 27     27 0 43 my $self = shift;
173 27         43 my ($id) = @_;
174              
175 27 50       142 my $base_url = $self->id eq 'schema' ? $self->link('schemas') : $self->link('collection');
176 27 50       86 if ( !defined $base_url ) {
177 0         0 die( "Unable to build a query url: schema '" . $self->id . "' has no 'collection' link" );
178             }
179 27 100       80 if ( defined $id ) {
180 21         102 return abs_url( $base_url, $id );
181             }
182 6         12 return $base_url;
183             }
184              
185             our %REGISTRY;
186              
187             sub registry_add {
188 88     88 0 96 my $class = shift;
189 88         170 my %schemas = @_;
190 88         219 while ( my ( $key, $object ) = each(%schemas) ) {
191 88         361 $REGISTRY{$key} = $object;
192             }
193             }
194              
195             sub registry_lookup {
196 42     42 0 81 my $class = shift;
197 42         71 my @possibles = @_;
198 42         78 foreach my $find (@possibles) {
199 42 100       97 next unless defined $find;
200 38 100 66     238 if ( exists $REGISTRY{$find} and defined $REGISTRY{$find} ) {
201 37         216 return $REGISTRY{$find};
202             }
203 1         6 while ( my ( $key, $schema ) = each %REGISTRY ) {
204 22 50       57 if ( lc($find) eq lc($key) ) {
205 0         0 return $schema;
206             }
207             }
208             }
209 5         125 return;
210              
211             }
212              
213             sub registry_list {
214 4     4 0 9 my $class = shift;
215 4         6 my %seen;
216 4         18 return grep { not $seen{ $_->id }++ } values %REGISTRY;
  88         197  
217             }
218              
219             1;
220              
221             =head1 NAME
222              
223             WWW::GoDaddy::REST::Schema - schema specific resource class
224              
225             =head1 SYNOPSIS
226              
227             $schema = $client->schema('the_name');
228             $scehama = $resource->schema();
229              
230             =head1 DESCRIPTION
231              
232             This is used to represent a 'schema' which is a very common resource in the
233             Go Daddy(r) API specification.
234              
235             It is a sub class of L<WWW::GoDaddy::REST::Resource>.
236              
237             =head1 METHODS
238              
239             =over 4
240              
241             =item query
242              
243             This is a helper method that, based on the parameters
244             will choose to call C<query_by_id> or C<query_complex>.
245              
246             You probably should not be calling this directly.
247              
248             See the C<query> method on L<WWW::GoDaddy::REST|WWW::GoDaddy::REST>.
249              
250             Example:
251              
252             $schema->query('1234'); # query_by_id('1234')
253             $schema->query('1234', { opt => '1' } ); # query_by_id('1234', { opt => '1' } )
254              
255             =item query_by_id
256              
257             Returns a L<Resource|WWW::GoDaddy::REST::Resource> given
258             an C<id> parameter and an optional hash reference with additional key value pairs.
259              
260             You probably should not be calling this directly.
261              
262             See the C<query> method on the L<client instance|WWW::GoDaddy::REST>.
263              
264             Example:
265              
266             $resource = $schema->query_by_id('1234');
267             $resource = $schema->query_by_id('1234', { opt => '1' } );
268              
269             =item query_complex
270              
271             Search against the collection defined by this resource.
272              
273             Returns a L<Collection|WWW::GoDaddy::REST::Collection> given a hash ref with
274             key value pairs.
275              
276             Example:
277              
278             $resource = $schema->query_complex( { opt => '1' } );
279              
280             =back
281              
282             =head1 AUTHOR
283              
284             David Bartle, C<< <davidb@mediatemple.net> >>
285              
286             =head1 COPYRIGHT & LICENSE
287              
288             Copyright (c) 2014 Go Daddy Operating Company, LLC
289              
290             Permission is hereby granted, free of charge, to any person obtaining a
291             copy of this software and associated documentation files (the "Software"),
292             to deal in the Software without restriction, including without limitation
293             the rights to use, copy, modify, merge, publish, distribute, sublicense,
294             and/or sell copies of the Software, and to permit persons to whom the
295             Software is furnished to do so, subject to the following conditions:
296              
297             The above copyright notice and this permission notice shall be included in
298             all copies or substantial portions of the Software.
299              
300             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
301             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
302             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
303             THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
304             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
305             FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
306             DEALINGS IN THE SOFTWARE.
307              
308             =cut