File Coverage

blib/lib/WWW/GoDaddy/REST/Shell/QueryCommand.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package WWW::GoDaddy::REST::Shell::QueryCommand;
2              
3 1     1   1728 use strict;
  1         2  
  1         53  
4 1     1   8 use warnings;
  1         3  
  1         46  
5              
6 1     1   7 use Carp;
  1         2  
  1         109  
7 1     1   332 use List::MoreUtils qw( natatime );
  0            
  0            
8             use Sub::Exporter -setup => {
9             exports => [qw(run_query smry_query help_query comp_query)],
10             groups => { default => [qw(run_query smry_query help_query comp_query)] }
11             };
12              
13             sub run_query {
14             my ( $self, $schema_name, @args ) = @_;
15              
16             my $usage = "Usage: query [schema] [[field] [modifier] [value]] ...\n";
17              
18             if ( !$schema_name ) {
19             warn($usage);
20             return 0;
21             }
22              
23             my $client = $self->client();
24             my $schema = $client->schema($schema_name);
25             if ( !$schema ) {
26             warn("'$schema_name' is not a recognized schema");
27             return 0;
28             }
29              
30             if ( !$schema->is_queryable ) {
31             warn(
32             "This schema has no 'collection' link. It does not look like it can be queried. You can always try using a direct URL as a way around this if you know a URL exists to query this."
33             );
34             return 0;
35             }
36              
37             my @filters = grep { !/=/ } @args;
38             my %uri_params = map { split '=' } grep {/=/} @args;
39              
40             if ( @filters % 3 != 0 ) {
41             warn($usage);
42             return 0;
43             }
44              
45             my $iterator = natatime 3, @filters;
46              
47             my $filter = {};
48             while ( my ( $field, $cmp, $value ) = $iterator->() ) {
49             $filter->{$field} ||= [];
50             push @{ $filter->{$field} },
51             {
52             'modifier' => $cmp,
53             'value' => $value
54             };
55             }
56              
57             my $collection = eval { $client->query( $schema_name, $filter, \%uri_params ); };
58             if ($@) {
59             if ( UNIVERSAL::isa( $@, 'WWW::GoDaddy::REST::Resource' ) ) {
60             $self->page( $@->to_string(1) . "\n" );
61             }
62             else {
63             carp($@);
64             }
65             return 0;
66             }
67              
68             $self->page( $collection->to_string(1) . "\n" );
69             return 1;
70             }
71              
72             sub smry_query {
73             return "search for items in a schema"
74             }
75              
76             sub help_query {
77             return <<HELP
78             Search for items in a collection of a given schema.
79              
80             Usage:
81             query [schema] [[field] [modifier] [value]] ... [[arbitrary=param] [arbitrary=param]] ...
82              
83             Example:
84             query user fname eq john
85             query pancakes limit=10
86             HELP
87             }
88              
89             sub comp_query {
90             my ( $self, $word, $line, $start ) = @_;
91              
92             my @words = $self->line_parsed($line);
93             my $client = $self->client();
94              
95             my $comp_schema = ( @words < 2 or ( @words == 2 and $start < length($line) ) );
96             if ($comp_schema) {
97             return grep { index( $_, $word ) == 0 }
98             grep { $client->schema($_)->is_queryable } $self->schema_names();
99             }
100              
101             my $schema_name = $words[1];
102             my $schema = $client->schema($schema_name);
103             if ( !$schema ) {
104              
105             # bad schema name - bail
106             return ();
107             }
108              
109             my %filters = %{ $schema->f('collectionFilters') };
110              
111             my $comp_field = ( ( @words + 1 ) % 3 == 0 or ( @words % 3 == 0 and $start < length($line) ) );
112             if ($comp_field) {
113             my @fields = sort keys %filters;
114             return grep { index( $_, $word ) == 0 } @fields;
115             }
116              
117             my $comp_modifier
118             = ( ( @words + 1 ) % 3 == 1 or ( @words % 3 == 1 and $start < length($line) ) );
119             if ($comp_modifier) {
120             my $in_field_named = ( @words % 3 == 1 ) ? $words[-2] : $words[-1];
121             if ( !$filters{$in_field_named} ) {
122              
123             # bad field name - bail
124             return ();
125             }
126             my @modifiers = sort @{ $filters{$in_field_named}->{modifiers} };
127             return ( grep { index( $_, $word ) == 0 } @modifiers );
128             }
129              
130             return ();
131              
132             }
133              
134             1;
135              
136             =head1 AUTHOR
137              
138             David Bartle, C<< <davidb@mediatemple.net> >>
139              
140             =head1 COPYRIGHT & LICENSE
141              
142             Copyright (c) 2014 Go Daddy Operating Company, LLC
143              
144             Permission is hereby granted, free of charge, to any person obtaining a
145             copy of this software and associated documentation files (the "Software"),
146             to deal in the Software without restriction, including without limitation
147             the rights to use, copy, modify, merge, publish, distribute, sublicense,
148             and/or sell copies of the Software, and to permit persons to whom the
149             Software is furnished to do so, subject to the following conditions:
150              
151             The above copyright notice and this permission notice shall be included in
152             all copies or substantial portions of the Software.
153              
154             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
155             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
156             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
157             THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
158             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
159             FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
160             DEALINGS IN THE SOFTWARE.
161              
162             =cut