]>
Dogcows Code - chaz/graphql-client/blob - lib/GraphQL/Client/CLI.pm
1 package GraphQL
::Client
::CLI
;
2 # ABSTRACT: Implementation of the graphql CLI program
8 use Getopt
::Long
2.39 qw(GetOptionsFromArray);
14 our $VERSION = '0.605'; # VERSION
16 my $JSON = JSON
::MaybeXS-
>new(canonical
=> 1);
18 sub _croak
{ require Carp
; goto &Carp
::croak
}
27 $self = $self->new if !ref $self;
29 my $options = eval { $self->_get_options(@_) };
35 if ($options->{version
}) {
36 print "graphql $VERSION\n";
39 if ($options->{help
}) {
40 _pod2usage
(-exitval
=> 0, -verbose
=> 99, -sections
=> [qw(NAME SYNOPSIS OPTIONS)]);
42 if ($options->{manual
}) {
43 _pod2usage
(-exitval
=> 0, -verbose
=> 2);
46 my $url = $options->{url
};
48 print STDERR
"The <URL> or --url option argument is required.\n";
52 my $variables = $options->{variables
};
53 my $query = $options->{query
};
54 my $operation_name = $options->{operation_name
};
55 my $unpack = $options->{unpack};
56 my $outfile = $options->{outfile
};
57 my $format = $options->{format
};
58 my $transport = $options->{transport
};
60 my $client = GraphQL
::Client-
>new(url
=> $url);
62 eval { $client->transport };
64 warn $err if $ENV{GRAPHQL_CLIENT_DEBUG
};
65 print STDERR
"Could not construct a transport for URL: $url\n";
66 print STDERR
"Is this URL correct?\n";
71 print STDERR
"Interactive mode engaged! Waiting for a query on <STDIN>...\n"
72 if -t STDIN
; ## no critic (InputOutput::ProhibitInteractiveTest)
73 binmode(STDIN
, 'encoding(UTF-8)');
74 $query = do { local $/; <STDIN
> };
77 my $resp = $client->execute($query, $variables, $operation_name, $transport);
78 my $err = $resp->{errors
};
80 my $data = $unpack ? $resp->{data
} : $resp;
83 open(my $out, '>', $outfile) or die "Open $outfile failed: $!";
87 if (my $filter = $options->{filter
}) {
88 eval { require JSON
::Path
::Evaluator
} or die "Missing dependency: JSON::Path\n";
89 my @values = JSON
::Path
::Evaluator
::evaluate_jsonpath
($data, $filter);
98 binmode(STDOUT
, 'encoding(UTF-8)');
99 _print_data
($data, $format);
101 exit($unpack && $err ? 1 : 0);
108 unshift @args, shellwords
($ENV{GRAPHQL_CLIENT_OPTIONS
} || '');
110 # assume UTF-8 args if non-ASCII
111 @args = map { decode
('UTF-8', $_) } @args if grep { /\P{ASCII}/ } @args;
114 format
=> 'json:pretty',
118 GetOptionsFromArray
(\
@args,
119 'version' => \
$options{version
},
120 'help|h|?' => \
$options{help
},
121 'manual|man' => \
$options{manual
},
122 'url|u=s' => \
$options{url
},
123 'query|mutation=s' => \
$options{query
},
124 'variables|vars|V=s' => \
$options{variables
},
125 'variable|var|d=s%' => \
$options{variables
},
126 'operation-name|n=s' => \
$options{operation_name
},
127 'transport|t=s%' => \
$options{transport
},
128 'format|f=s' => \
$options{format
},
129 'filter|p=s' => \
$options{filter
},
130 'unpack!' => \
$options{unpack},
131 'output|o=s' => \
$options{outfile
},
134 $options{url
} = shift @args if !$options{url
};
135 $options{query
} = shift @args if !$options{query
};
137 $options{query
} ||= '-';
139 my $transport = eval { _expand_vars
($options{transport
}) };
140 die "Two or more --transport keys are incompatible.\n" if $@;
141 $options{transport
} = $transport if ref $transport eq 'HASH' && %$transport;
143 if (ref $options{variables
}) {
144 $options{variables
} = eval { _expand_vars
($options{variables
}) };
145 die "Two or more --variable keys are incompatible.\n" if $@;
147 elsif ($options{variables
}) {
148 $options{variables
} = eval { $JSON->decode($options{variables
}) };
149 die "The --variables JSON does not parse.\n" if $@;
157 if (ref($item) eq 'ARRAY') {
158 my $first = @$item && $item->[0];
159 return join(',', @$item) if !ref($first);
160 return join(',', map { $JSON->encode($_) } @$item);
162 return $JSON->encode($item) if ref($item) eq 'HASH';
167 my ($data, $format) = @_;
168 $format = lc($format || 'json:pretty');
169 if ($format eq 'json' || $format eq 'json:pretty') {
170 my %opts = (allow_nonref
=> 1, canonical
=> 1);
171 $opts{pretty
} = 1 if $format eq 'json:pretty';
172 print JSON
::MaybeXS-
>new(%opts)->encode($data);
174 elsif ($format eq 'yaml') {
175 eval { require YAML
} or die "Missing dependency: YAML\n";
176 print YAML
::Dump
($data);
178 elsif ($format eq 'csv' || $format eq 'tsv' || $format eq 'table') {
179 my $sep = $format eq 'tsv' ? "\t" : ',';
181 my $unpacked = $data;
182 # $unpacked = $data->{data} if !$unpack && !$err;
183 $unpacked = $data->{data
} if ref $data eq 'HASH' && $data->{data
};
185 # check the response to see if it can be formatted
188 if (ref $unpacked eq 'HASH') {
189 if (keys %$unpacked == 1) {
190 my ($val) = values %$unpacked;
191 if (ref $val eq 'ARRAY') {
192 my $first = $val->[0];
193 if ($first && ref $first eq 'HASH') {
194 @columns = sort keys %$first;
196 map { [map { _stringify
($_) } @{$_}{@columns}] } @$val
200 @columns = keys %$unpacked;
201 $rows = [map { [map { _stringify
($_) } $_] } @$val];
206 elsif (ref $unpacked eq 'ARRAY') {
207 my $first = $unpacked->[0];
208 if ($first && ref $first eq 'HASH') {
209 @columns = sort keys %$first;
211 map { [map { _stringify
($_) } @{$_}{@columns}] } @$unpacked
215 @columns = qw(column);
216 $rows = [map { [map { _stringify
($_) } $_] } @$unpacked];
221 if ($format eq 'table') {
222 eval { require Text
::Table
::Any
} or die "Missing dependency: Text::Table::Any\n";
223 my $table = Text
::Table
::Any
::table
(
225 rows
=> [[@columns], @$rows],
226 backend
=> $ENV{PERL_TEXT_TABLE
},
231 eval { require Text
::CSV
} or die "Missing dependency: Text::CSV\n";
232 my $csv = Text
::CSV-
>new({binary
=> 1, sep
=> $sep, eol
=> $/});
233 $csv->print(*STDOUT
, [@columns]);
234 for my $row (@$rows) {
235 $csv->print(*STDOUT
, $row);
241 print STDERR
sprintf("Error: Response could not be formatted as %s.\n", uc($format));
245 elsif ($format eq 'string') {
249 elsif (ref $data eq 'ARRAY') {
250 print join("\n", @$data);
254 print STDERR
sprintf("Error: Response could not be formatted as %s.\n", $format);
258 elsif ($format eq 'perl') {
259 eval { require Data
::Dumper
} or die "Missing dependency: Data::Dumper\n";
260 print Data
::Dumper
::Dumper
($data);
264 print STDERR
"Error: Format not supported: $format\n";
274 my @segments = map { split(/\./, $_) } split(/(\[[^\.\]]+\])\.?/, $path);
275 for my $segment (@segments) {
276 if ($segment =~ /\[([^\.\]]+)\]/) {
277 $path[-1]{type
} = 'ARRAY' if @path;
284 $path[-1]{type
} = 'HASH' if @path;
299 while (my ($key, $value) = each %$vars) {
300 my $parsed_path = _parse_path
($key);
303 for my $segment (@$parsed_path) {
304 my $name = $segment->{name
};
305 my $type = $segment->{type
} || '';
306 my $next = $type eq 'HASH' ? {} : $type eq 'ARRAY' ? [] : $value;
307 if (ref $curr eq 'HASH') {
308 _croak
'Conflicting keys' if $segment->{index};
309 if (defined $curr->{$name}) {
310 _croak
'Conflicting keys' if $type ne ref $curr->{$name};
311 $next = $curr->{$name};
314 $curr->{$name} = $next;
317 elsif (ref $curr eq 'ARRAY') {
318 _croak
'Conflicting keys' if !$segment->{index};
319 if (defined $curr->[$name]) {
320 _croak
'Conflicting keys' if $type ne ref $curr->[$name];
321 $next = $curr->[$name];
324 $curr->[$name] = $next;
328 _croak
'Conflicting keys';
338 eval { require Pod
::Usage
};
340 my $ref = $VERSION eq '999.999' ? 'master' : "v$VERSION";
341 my $exit = (@_ == 1 && $_[0] =~ /^\d+$/ && $_[0]) //
342 (@_ % 2 == 0 && {@_}->{'-exitval'}) // 2;
344 Online documentation is available at:
346 https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
348 Tip: To enable inline documentation, install the Pod::Usage module.
354 goto &Pod
::Usage
::pod2usage
;
368 GraphQL::Client::CLI - Implementation of the graphql CLI program
376 This is the actual implementation of L<graphql>.
378 The interface is B<EXPERIMENTAL>. Don't rely on it.
392 Please report any bugs or feature requests on the bugtracker website
393 L<https://github.com/chazmcgarvey/graphql-client/issues>
395 When submitting a bug or request, please include a test-file or a
396 patch to an existing test-file that illustrates the bug or desired
401 Charles McGarvey <ccm@cpan.org>
403 =head1 COPYRIGHT AND LICENSE
405 This software is copyright (c) 2020 by Charles McGarvey.
407 This is free software; you can redistribute it and/or modify it under
408 the same terms as the Perl 5 programming language system itself.
This page took 0.058879 seconds and 4 git commands to generate.