-#!/usr/bin/env perl
+#! perl
# PODNAME: graphql
# ABSTRACT: Command-line GraphQL client
+# FATPACK - Do not remove this line.
+
use warnings;
use strict;
use Getopt::Long;
use GraphQL::Client;
-use Scalar::Util qw(reftype);
+use JSON::MaybeXS;
our $VERSION = '999.999'; # VERSION
my $url;
-my $transport = {};
-my $query = '-';
-my $variables = {};
-my $format = 'json:pretty';
-my $unpack = 0;
+my $transport = {};
+my $query = '-';
+my $variables = {};
+my $operation_name;
+my $format = 'json:pretty';
+my $unpack = 0;
my $outfile;
+my $version;
+my $help;
+my $manual;
GetOptions(
- 'url|u=s' => \$url,
- 'transport|t=s%' => \$transport,
- 'query|mutation=s' => \$query,
- 'variable|var|d=s%' => \$variables,
- 'format|f=s' => \$format,
- 'unpack!' => \$unpack,
- 'output|o=s' => \$outfile,
-) or die "Invalid options.\n";
+ 'url|u=s' => \$url,
+ 'query|mutation=s' => \$query,
+ 'variables|vars|V=s' => \$variables,
+ 'variable|var|d=s%' => \$variables,
+ 'operation-name=s' => \$operation_name,
+ 'transport|t=s%' => \$transport,
+ 'format|f=s' => \$format,
+ 'unpack!' => \$unpack,
+ 'output|o=s' => \$outfile,
+ 'version' => \$version,
+ 'help|h|?' => \$help,
+ 'manual|man' => \$manual,
+) or pod2usage(2);
+
+if ($version) {
+ print "graphql $VERSION\n";
+ exit 0;
+}
+if ($help) {
+ pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS)]);
+}
+if ($manual) {
+ pod2usage(-exitval => 0, -verbose => 2);
+}
$url = shift if !$url;
$query = shift if !$query || $query eq '-';
-my $client = GraphQL::Client->new(
- %$transport,
- url => $url,
-);
+$transport = expand_vars($transport);
+
+if (ref $variables) {
+ $variables = expand_vars($variables);
+}
+else {
+ $variables = JSON::MaybeXS->new->decode($variables);
+}
+
+my $client = GraphQL::Client->new(url => $url);
$client->transport; # just make sure we can load the transport
if (!$query || $query eq '-') {
- print STDERR "Interactive mode engaged! Waiting for a query on <STDIN>...\n" if -t STDIN;
+ print STDERR "Interactive mode engaged! Waiting for a query on <STDIN>...\n"
+ if -t STDIN; ## no critic (InputOutput::ProhibitInteractiveTest)
$query = do { local $/; <> };
}
-my $resp = $client->request($query, $variables);
+my $resp = $client->request($query, $variables, $operation_name, $transport);
my $err = $resp->{errors};
-my $data = !$unpack || $err ? $resp : $resp->{data};
+$unpack = 0 if $err;
+my $data = $unpack ? $resp->{data} : $resp;
if ($outfile) {
open(my $out, '>', $outfile) or die "Open $outfile failed: $!";
*STDOUT = $out;
}
-$format = lc($format);
-if ($format eq 'json') {
- require JSON::MaybeXS;
- print JSON::MaybeXS->new(utf8 => 1)->encode($data);
-}
-elsif ($format eq 'json:pretty') {
- require JSON::MaybeXS;
- print JSON::MaybeXS->new(utf8 => 1, pretty => 1)->encode($data);
-}
-elsif ($format eq 'yaml') {
- require YAML;
- print YAML::Dump($data);
+print_data($data, $format);
+
+exit($unpack && $err ? 1 : 0);
+
+sub print_data {
+ my ($data, $format) = @_;
+ $format = lc($format || 'json:pretty');
+ if ($format eq 'json' || $format eq 'json:pretty') {
+ my %opts = (canonical => 1, utf8 => 1);
+ $opts{pretty} = 1 if $format eq 'json:pretty';
+ print JSON::MaybeXS->new(%opts)->encode($data);
+ }
+ elsif ($format eq 'yaml') {
+ eval { require YAML } or die "Missing dependency: YAML\n";
+ print YAML::Dump($data);
+ }
+ elsif ($format eq 'csv' || $format eq 'tsv' || $format eq 'table') {
+ my $sep = $format eq 'tsv' ? "\t" : ',';
+
+ my $unpacked = $data;
+ $unpacked = $data->{data} if !$unpack && !$err;
+
+ # check the response to see if it can be formatted
+ my @columns;
+ my $rows = [];
+ if (keys %$unpacked == 1) {
+ my ($val) = values %$unpacked;
+ if (ref $val eq 'ARRAY') {
+ my $first = $val->[0];
+ if ($first && ref $first eq 'HASH') {
+ @columns = sort keys %$first;
+ $rows = [
+ map { [@{$_}{@columns}] } @$val
+ ];
+ }
+ elsif ($first) {
+ @columns = keys %$unpacked;
+ $rows = [map { [$_] } @$val];
+ }
+ }
+ }
+
+ if (@columns) {
+ if ($format eq 'table') {
+ eval { require Text::Table::Any } or die "Missing dependency: Text::Table::Any\n";
+ my $table = Text::Table::Any::table(
+ header_row => 1,
+ rows => [[@columns], @$rows],
+ backend => $ENV{PERL_TEXT_TABLE},
+ );
+ print $table;
+ }
+ else {
+ eval { require Text::CSV } or die "Missing dependency: Text::CSV\n";
+ my $csv = Text::CSV->new({binary => 1, sep => $sep, eol => $/});
+ $csv->print(*STDOUT, [@columns]);
+ for my $row (@$rows) {
+ $csv->print(*STDOUT, $row);
+ }
+ }
+ }
+ else {
+ print_data($data);
+ print STDERR sprintf("Error: Response could not be formatted as %s.\n", uc($format));
+ exit 3;
+ }
+ }
+ elsif ($format eq 'perl') {
+ eval { require Data::Dumper } or die "Missing dependency: Data::Dumper\n";
+ print Data::Dumper::Dumper($data);
+ }
+ else {
+ print STDERR "Error: Format not supported: $format\n";
+ print_data($data);
+ exit 3;
+ }
}
-else {
- require Data::Dumper;
- print Data::Dumper::Dumper($data);
+
+sub expand_vars {
+ my $vars = shift;
+
+ my %out;
+ while (my ($key, $value) = each %$vars) {
+ my $var = $value;
+ my @segments = split(/\./, $key);
+ for my $segment (reverse @segments) {
+ my $saved = $var;
+ if ($segment =~ /^(\d+)$/) {
+ $var = [];
+ $var->[$segment] = $saved;
+ }
+ else {
+ $var = {};
+ $var->{$segment} = $saved;
+ }
+ }
+ %out = (%out, %$var);
+ }
+
+ return \%out;
}
-exit($unpack && $err ? 1 : 0);
+sub pod2usage {
+ eval { require Pod::Usage };
+ if ($@) {
+ my $ref = $VERSION eq '999.999' ? 'master' : "v$VERSION";
+ my $exit = (@_ == 1 && $_[0] =~ /^\d+$/ && $_[0]) //
+ (@_ % 2 == 0 && {@_}->{'-exitval'}) // 2;
+ print STDERR <<END;
+Online documentation is available at:
+
+ https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
+
+Tip: To enable inline documentation, install the Pod::Usage module.
+
+END
+ exit $exit;
+ }
+ else {
+ goto &Pod::Usage::pod2usage;
+ }
+}
=head1 SYNOPSIS
graphql <URL> <QUERY> [--var key=value]... [--transport key=value]...
- [--[no-]unpack] [--format json|json:pretty|yaml]
+ [--[no-]unpack] [--format json|json:pretty|yaml|csv|tsv]
=head1 DESCRIPTION
C<graphql> is a command-line program for executing queries and mutations on
a L<GraphQL|https://graphql.org/> server.
+=head1 INSTALL
+
+There are several ways to install F<graphql> to your system.
+
+=head2 from CPAN
+
+You can install F<graphql> using L<cpanm>:
+
+ cpanm GraphQL::Client
+
+=head2 from GitHub
+
+You can also choose to download F<graphql> as a self-contained executable:
+
+ curl -OL https://raw.githubusercontent.com/chazmcgarvey/graphql-client/solo/graphql
+ chmod +x graphql
+
+To hack on the code, clone the repo instead:
+
+ git clone https://github.com/chazmcgarvey/graphql-client.git
+ cd graphql-client
+ make bootstrap # installs dependencies; requires cpanm
+
=head1 OPTIONS
=head2 --url STR
The query or mutation to execute.
-If no C<--query> option is given, the first argument (after URL) is assumed to
-be the query.
+If no C<--query> option is given, the first argument (after URL) is assumed to be the query.
-If the value is C<-> (which is the default), the query will be read from
-C<STDIN>.
+If the value is C<-> (which is the default), the query will be read from C<STDIN>.
See: L<https://graphql.org/learn/queries/>
Alias: C<--mutation>
+=head2 --variables JSON
+
+Provide the variables as a JSON object.
+
+Aliases: C<--vars>, C<-V>
+
=head2 --variable KEY=VALUE
-A key-value pair
+An alternative way to provide variables individually. Repeat this option to provide multiple
+variables.
+
+If used in combination with L</"--variables JSON">, this option is silently ignored.
See: L<https://graphql.org/learn/queries/#variables>
Alias: C<-t>
+=head2 --format STR
+
+Specify the output format to use. See L</FORMAT>.
+
+Alias: C<-f>
+
=head2 --unpack
Enables C<unpack> mode.
-By default, the response structure is printed as-is from the server, and the
-program exits 0.
+By default, the response structure is printed as-is from the server, and the program exits 0.
-When C<unpack> mode is enabled, if the response completes with no errors, only
-the data section of the response is printed and the program exits 0. If the
-response has errors, the whole response structure is printed as-is and the
-program exits 1.
+When C<unpack> mode is enabled, if the response completes with no errors, only the data section of
+the response is printed and the program exits 0. If the response has errors, the whole response
+structure is printed as-is and the program exits 1.
-=head2 --format STR
+See L</EXAMPLES>.
+
+=head1 FORMAT
-Sets the output format. Possible values include:
+The C<--format> argument can be one of:
=for :list
-* C<json:pretty> (default)
-* C<json>
-* C<yaml>
-* C<dump>
+* C<csv> - Comma-separated values (requires L<Text::CSV>)
+* C<json:pretty> - Pretty JSON (default)
+* C<json> - JSON
+* C<perl> - Perl code (requires L<Data::Dumper>)
+* C<table> - Table (requires L<Text::Table::Any>)
+* C<tsv> - Tab-separated values (requires L<Text::CSV>)
+* C<yaml> - YAML (requires L<YAML>)
-Alias: C<-f>
+The C<csv>, C<tsv>, and C<table> formats will only work if the response has a particular shape:
+
+ {
+ "data" : {
+ "onefield" : [
+ {
+ "key" : "value",
+ ...
+ },
+ ...
+ ]
+ }
+ }
+
+or
+
+ {
+ "data" : {
+ "onefield" : [
+ "value",
+ ...
+ ]
+ }
+ }
+
+If the response cannot be formatted, the default format will be used instead, an error message will
+be printed to STDERR, and the program will exit 3.
+
+Table formatting can be done by one of several different modules, each with its own features and
+bugs. The default module is L<Text::Table::Tiny>, but this can be overridden using the
+C<PERL_TEXT_TABLE> environment variable if desired, like this:
+
+ PERL_TEXT_TABLE=Text::Table::HTML graphql ... -f table
+
+The list of supported modules is at L<Text::Table::Any/@BACKENDS>.
=head1 EXAMPLES
-Different ways to provide the query/mutation:
+Different ways to provide the query/mutation to execute:
- graphql http://localhost:4000/graphql {hello}
+ graphql http://myserver/graphql {hello}
- echo {hello} | graphql http://localhost:4000/graphql
+ echo {hello} | graphql http://myserver/graphql
- graphql http://localhost:4000/graphql <<END
+ graphql http://myserver/graphql <<END
> {hello}
> END
- graphql http://localhost:4000/graphql
+ graphql http://myserver/graphql
Interactive mode engaged! Waiting for a query on <STDIN>...
{hello}
^D
+Execute a query with variables:
+
+ graphql http://myserver/graphql <<END --var episode=JEDI
+ > query HeroNameAndFriends($episode: Episode) {
+ > hero(episode: $episode) {
+ > name
+ > friends {
+ > name
+ > }
+ > }
+ > }
+ > END
+
+Configure the transport:
+
+ graphql http://myserver/graphql {hello} -t headers.authorization='Basic s3cr3t'
+
This example shows the effect of L<--unpack>:
- graphql http://localhost:4000/graphql {hello}
+ graphql http://myserver/graphql {hello}
# Output:
{
}
}
- graphql --unpack http://localhost:4000/graphql {hello}
+ graphql http://myserver/graphql {hello} --unpack
# Output:
{
"hello" : "Hello world!"
}
-Execute a query with variables:
+=head1 ENVIRONMENT
- graphql unpack http://localhost:4000/graphql <<END --var episode=JEDI
- > query HeroNameAndFriends($episode: Episode) {
- > hero(episode: $episode) {
- > name
- > friends {
- > name
- > }
- > }
- > }
- > END
+Some environment variables affect the way C<graphql> behaves:
+
+=for :list
+* C<GRAPHQL_CLIENT_DEBUG> - Set to 1 to print diagnostic messages to STDERR.
+* C<PERL_TEXT_TABLE> - Set table format backend; see L</FORMAT>.
use strict;
use Module::Load qw(load);
+use Scalar::Util qw(reftype);
use Throw;
our $VERSION = '999.999'; # VERSION
sub request {
my $self = shift;
- my ($query, $variables, $options) = @_;
+ my ($query, $variables, $operation_name, $options) = @_;
- my $transport_opts = {%{$options || {}}};
- my $operation_name = delete($transport_opts->{operation_name}) // delete($transport_opts->{operationName});
+ if ((reftype($operation_name) || '') eq 'HASH') {
+ $options = $operation_name;
+ $operation_name = undef;
+ }
my $request = {
query => $query,
- $variables ? (variables => $variables) : (),
+ ($variables && %$variables) ? (variables => $variables) : (),
$operation_name ? (operationName => $operation_name) : (),
};
- my $resp = $self->transport->request($request, $transport_opts);
+ my $resp = $self->transport->request($request, $options);
return $self->_handle_response($resp);
}
+my $ERROR_MESSAGE = 'The GraphQL server returned errors';
sub _handle_response {
my $self = shift;
my ($resp) = @_;
if (eval { $resp->isa('Future') }) {
return $resp->followed_by(sub {
my $f = shift;
- if (my $exception = $f->failure) {
- if ($self->unpack || !$exception->{errors}) {
- return Future->fail($exception);
+ if (my ($exception, $category, @details) = $f->failure) {
+ if (!$exception->{errors}) {
+ return Future->fail($exception, $category, @details);
+ }
+ if ($self->unpack) {
+ return Future->fail($ERROR_MESSAGE, 'graphql', $exception, @details);
}
return Future->done($exception);
}
else {
- my $resp = $f->get;
+ my ($resp, @other) = $f->get;
if ($self->unpack) {
if ($resp->{errors}) {
- return Future->fail($resp);
+ return Future->fail($ERROR_MESSAGE, 'graphql', $resp, @other);
}
return Future->done($resp->{data});
}
else {
if ($self->unpack) {
if ($resp->{errors}) {
- throw 'The GraphQL server returned errors', {
- %$resp,
- type => 'graphql',
+ throw $ERROR_MESSAGE, {
+ type => 'graphql',
+ response => $resp,
};
}
return $resp->{data};
$self->{transport} //= do {
my $class = $self->_transport_class;
eval { load $class };
- if (my $err = $@) {
+ if ((my $err = $@) || !$class->can('request')) {
+ $err ||= "Loaded $class, but it doesn't look like a proper transport.\n";
warn $err if $ENV{GRAPHQL_CLIENT_DEBUG};
_croak "Failed to load transport for \"${class}\"";
}
$response = $client->request($query);
$response = $client->request($query, \%variables);
+ $response = $client->request($query, \%variables, $operation_name);
+ $response = $client->request($query, \%variables, $operation_name, \%transport_options);
$response = $client->request($query, \%variables, \%transport_options);
Get a response from the GraphQL server.