]>
Dogcows Code - chaz/graphql-client/blob - 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 = '999.999'; # 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 binmode(STDOUT
, 'encoding(UTF-8)');
88 _print_data
($data, $format);
90 exit($unpack && $err ? 1 : 0);
97 unshift @args, shellwords
($ENV{GRAPHQL_CLIENT_OPTIONS
} || '');
99 # assume UTF-8 args if non-ASCII
100 @args = map { decode
('UTF-8', $_) } @args if grep { /\P{ASCII}/ } @args;
103 format
=> 'json:pretty',
107 GetOptionsFromArray
(\
@args,
108 'version' => \
$options{version
},
109 'help|h|?' => \
$options{help
},
110 'manual|man' => \
$options{manual
},
111 'url|u=s' => \
$options{url
},
112 'query|mutation=s' => \
$options{query
},
113 'variables|vars|V=s' => \
$options{variables
},
114 'variable|var|d=s%' => \
$options{variables
},
115 'operation-name|n=s' => \
$options{operation_name
},
116 'transport|t=s%' => \
$options{transport
},
117 'format|f=s' => \
$options{format
},
118 'unpack!' => \
$options{unpack},
119 'output|o=s' => \
$options{outfile
},
122 $options{url
} = shift @args if !$options{url
};
123 $options{query
} = shift @args if !$options{query
};
125 $options{query
} ||= '-';
127 my $transport = eval { _expand_vars
($options{transport
}) };
128 die "Two or more --transport keys are incompatible.\n" if $@;
130 if (ref $options{variables
}) {
131 $options{variables
} = eval { _expand_vars
($options{variables
}) };
132 die "Two or more --variable keys are incompatible.\n" if $@;
134 elsif ($options{variables
}) {
135 $options{variables
} = eval { $JSON->decode($options{variables
}) };
136 die "The --variables JSON does not parse.\n" if $@;
144 if (ref($item) eq 'ARRAY') {
145 my $first = @$item && $item->[0];
146 return join(',', @$item) if !ref($first);
147 return join(',', map { $JSON->encode($_) } @$item);
149 return $JSON->encode($item) if ref($item) eq 'HASH';
154 my ($data, $format) = @_;
155 $format = lc($format || 'json:pretty');
156 if ($format eq 'json' || $format eq 'json:pretty') {
157 my %opts = (allow_nonref
=> 1, canonical
=> 1);
158 $opts{pretty
} = 1 if $format eq 'json:pretty';
159 print JSON
::MaybeXS-
>new(%opts)->encode($data);
161 elsif ($format eq 'yaml') {
162 eval { require YAML
} or die "Missing dependency: YAML\n";
163 print YAML
::Dump
($data);
165 elsif ($format eq 'csv' || $format eq 'tsv' || $format eq 'table') {
166 my $sep = $format eq 'tsv' ? "\t" : ',';
168 my $unpacked = $data;
169 # $unpacked = $data->{data} if !$unpack && !$err;
170 $unpacked = $data->{data
} if $data && $data->{data
};
172 # check the response to see if it can be formatted
175 if (keys %$unpacked == 1) {
176 my ($val) = values %$unpacked;
177 if (ref $val eq 'ARRAY') {
178 my $first = $val->[0];
179 if ($first && ref $first eq 'HASH') {
180 @columns = sort keys %$first;
182 map { [map { _stringify
($_) } @{$_}{@columns}] } @$val
186 @columns = keys %$unpacked;
187 $rows = [map { [map { _stringify
($_) } $_] } @$val];
193 if ($format eq 'table') {
194 eval { require Text
::Table
::Any
} or die "Missing dependency: Text::Table::Any\n";
195 my $table = Text
::Table
::Any
::table
(
197 rows
=> [[@columns], @$rows],
198 backend
=> $ENV{PERL_TEXT_TABLE
},
203 eval { require Text
::CSV
} or die "Missing dependency: Text::CSV\n";
204 my $csv = Text
::CSV-
>new({binary
=> 1, sep
=> $sep, eol
=> $/});
205 $csv->print(*STDOUT
, [@columns]);
206 for my $row (@$rows) {
207 $csv->print(*STDOUT
, $row);
213 print STDERR
sprintf("Error: Response could not be formatted as %s.\n", uc($format));
217 elsif ($format eq 'perl') {
218 eval { require Data
::Dumper
} or die "Missing dependency: Data::Dumper\n";
219 print Data
::Dumper
::Dumper
($data);
222 print STDERR
"Error: Format not supported: $format\n";
233 my @segments = map { split(/\./, $_) } split(/(\[[^\.\]]+\])\.?/, $path);
234 for my $segment (@segments) {
235 if ($segment =~ /\[([^\.\]]+)\]/) {
236 $path[-1]{type
} = 'ARRAY' if @path;
243 $path[-1]{type
} = 'HASH' if @path;
258 while (my ($key, $value) = each %$vars) {
259 my $parsed_path = _parse_path
($key);
262 for my $segment (@$parsed_path) {
263 my $name = $segment->{name
};
264 my $type = $segment->{type
} || '';
265 my $next = $type eq 'HASH' ? {} : $type eq 'ARRAY' ? [] : $value;
266 if (ref $curr eq 'HASH') {
267 _croak
'Conflicting keys' if $segment->{index};
268 if (defined $curr->{$name}) {
269 _croak
'Conflicting keys' if $type ne ref $curr->{$name};
270 $next = $curr->{$name};
273 $curr->{$name} = $next;
276 elsif (ref $curr eq 'ARRAY') {
277 _croak
'Conflicting keys' if !$segment->{index};
278 if (defined $curr->[$name]) {
279 _croak
'Conflicting keys' if $type ne ref $curr->[$name];
280 $next = $curr->[$name];
283 $curr->[$name] = $next;
287 _croak
'Conflicting keys';
297 eval { require Pod
::Usage
};
299 my $ref = $VERSION eq '999.999' ? 'master' : "v$VERSION";
300 my $exit = (@_ == 1 && $_[0] =~ /^\d+$/ && $_[0]) //
301 (@_ % 2 == 0 && {@_}->{'-exitval'}) // 2;
303 Online documentation is available at:
305 https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
307 Tip: To enable inline documentation, install the Pod::Usage module.
313 goto &Pod
::Usage
::pod2usage
;
322 This is the actual implementation of L<graphql>.
324 The interface is B<EXPERIMENTAL>. Don't rely on it.
This page took 0.059949 seconds and 4 git commands to generate.