Revision history for GraphQL-Client.
+0.602 2020-03-17 18:27:46-06:00 MST7MDT
+ * Add support for GRAPHQL_CLIENT_OPTIONS environment variable.
+ * Fix a slew of CLI option problems.
+
0.601 2020-03-15 20:38:38-06:00 MST7MDT
* Rename "class" attribute to "transport_class".
- * Minor pod fixups.
0.600 2020-03-15 18:08:57-06:00 MST7MDT
* Initial public release.
README
bin/graphql
lib/GraphQL/Client.pm
+lib/GraphQL/Client/CLI.pm
lib/GraphQL/Client/http.pm
lib/GraphQL/Client/https.pm
t/00-compile.t
t/00-report-prereqs.dd
t/00-report-prereqs.t
+t/cli.t
t/client.t
t/http.t
t/https.t
{
- "abstract" : "A GraphQL client",
+ "abstract" : "Command-line GraphQL client",
"author" : [
"Charles McGarvey <chazmcgarvey@brokenzipper.com>"
],
},
"requires" : {
"Carp" : "0",
- "Getopt::Long" : "0",
+ "Getopt::Long" : "2.39",
"HTTP::AnyUA" : "0",
"HTTP::AnyUA::Util" : "0",
"JSON::MaybeXS" : "0",
"Module::Load" : "0",
"Scalar::Util" : "0",
+ "Text::ParseWords" : "0",
"namespace::clean" : "0",
"overload" : "0",
"parent" : "0",
"provides" : {
"GraphQL::Client" : {
"file" : "lib/GraphQL/Client.pm",
- "version" : "0.601"
+ "version" : "0.602"
+ },
+ "GraphQL::Client::CLI" : {
+ "file" : "lib/GraphQL/Client/CLI.pm",
+ "version" : "0.602"
},
"GraphQL::Client::Error" : {
"file" : "lib/GraphQL/Client.pm",
- "version" : "0.601"
+ "version" : "0.602"
},
"GraphQL::Client::http" : {
"file" : "lib/GraphQL/Client/http.pm",
- "version" : "0.601"
+ "version" : "0.602"
},
"GraphQL::Client::https" : {
"file" : "lib/GraphQL/Client/https.pm",
- "version" : "0.601"
+ "version" : "0.602"
}
},
"release_status" : "stable",
"web" : "https://github.com/chazmcgarvey/graphql-client"
}
},
- "version" : "0.601",
+ "version" : "0.602",
"x_authority" : "cpan:CCM",
"x_generated_by_perl" : "v5.28.0",
"x_serialization_backend" : "Cpanel::JSON::XS version 4.15",
---
-abstract: 'A GraphQL client'
+abstract: 'Command-line GraphQL client'
author:
- 'Charles McGarvey <chazmcgarvey@brokenzipper.com>'
build_requires:
provides:
GraphQL::Client:
file: lib/GraphQL/Client.pm
- version: '0.601'
+ version: '0.602'
+ GraphQL::Client::CLI:
+ file: lib/GraphQL/Client/CLI.pm
+ version: '0.602'
GraphQL::Client::Error:
file: lib/GraphQL/Client.pm
- version: '0.601'
+ version: '0.602'
GraphQL::Client::http:
file: lib/GraphQL/Client/http.pm
- version: '0.601'
+ version: '0.602'
GraphQL::Client::https:
file: lib/GraphQL/Client/https.pm
- version: '0.601'
+ version: '0.602'
recommends:
HTTP::Tiny: '0'
Pod::Usage: '0'
requires:
Carp: '0'
- Getopt::Long: '0'
+ Getopt::Long: '2.39'
HTTP::AnyUA: '0'
HTTP::AnyUA::Util: '0'
JSON::MaybeXS: '0'
Module::Load: '0'
Scalar::Util: '0'
+ Text::ParseWords: '0'
namespace::clean: '0'
overload: '0'
parent: '0'
bugtracker: https://github.com/chazmcgarvey/graphql-client/issues
homepage: https://github.com/chazmcgarvey/graphql-client
repository: https://github.com/chazmcgarvey/graphql-client.git
-version: '0.601'
+version: '0.602'
x_authority: cpan:CCM
x_generated_by_perl: v5.28.0
x_serialization_backend: 'YAML::Tiny version 1.73'
use ExtUtils::MakeMaker;
my %WriteMakefileArgs = (
- "ABSTRACT" => "A GraphQL client",
+ "ABSTRACT" => "Command-line GraphQL client",
"AUTHOR" => "Charles McGarvey <chazmcgarvey\@brokenzipper.com>",
"CONFIGURE_REQUIRES" => {
"ExtUtils::MakeMaker" => 0
"NAME" => "GraphQL::Client",
"PREREQ_PM" => {
"Carp" => 0,
- "Getopt::Long" => 0,
+ "Getopt::Long" => "2.39",
"HTTP::AnyUA" => 0,
"HTTP::AnyUA::Util" => 0,
"JSON::MaybeXS" => 0,
"Module::Load" => 0,
"Scalar::Util" => 0,
+ "Text::ParseWords" => 0,
"namespace::clean" => 0,
"overload" => 0,
"parent" => 0,
"Test::More" => 0,
"lib" => 0
},
- "VERSION" => "0.601",
+ "VERSION" => "0.602",
"test" => {
"TESTS" => "t/*.t"
}
"File::Spec" => 0,
"FindBin" => 0,
"Future" => 0,
- "Getopt::Long" => 0,
+ "Getopt::Long" => "2.39",
"HTTP::AnyUA" => 0,
"HTTP::AnyUA::Backend" => 0,
"HTTP::AnyUA::Util" => 0,
"Test::Deep" => 0,
"Test::Exception" => 0,
"Test::More" => 0,
+ "Text::ParseWords" => 0,
"lib" => 0,
"namespace::clean" => 0,
"overload" => 0,
NAME
- GraphQL::Client - A GraphQL client
+ graphql - Command-line GraphQL client
VERSION
- version 0.601
+ version 0.602
SYNOPSIS
- my $graphql = GraphQL::Client->new(url => 'http://localhost:4000/graphql');
+ graphql <URL> <QUERY> [ [--variables JSON] | [--variable KEY=VALUE]... ]
+ [--operation-name NAME] [--transport KEY=VALUE]...
+ [--[no-]unpack] [--format json|json:pretty|yaml|perl|csv|tsv|table]
+ [--output FILE]
- # Example: Hello world!
-
- my $response = $graphql->execute('{hello}');
-
- # Example: Kitchen sink
-
- my $query = q[
- query GetHuman {
- human(id: $human_id) {
- name
- height
- }
- }
- ];
- my $variables = {
- human_id => 1000,
- };
- my $operation_name = 'GetHuman';
- my $transport_options = {
- headers => {
- authorization => 'Bearer s3cr3t',
- },
- };
- my $response = $graphql->execute($query, $variables, $operation_name, $transport_options);
-
- # Example: Asynchronous with Mojo::UserAgent (promisify requires Future::Mojo)
-
- my $ua = Mojo::UserAgent->new;
- my $graphql = GraphQL::Client->new(ua => $ua, url => 'http://localhost:4000/graphql');
-
- my $future = $graphql->execute('{hello}');
-
- $future->promisify->then(sub {
- my $response = shift;
- ...
- });
+ graphql --version|--help|--manual
DESCRIPTION
- GraphQL::Client provides a simple way to execute GraphQL
- <https://graphql.org/> queries and mutations on a server.
+ graphql is a command-line program for executing queries and mutations
+ on a GraphQL <https://graphql.org/> server.
- This module is the programmatic interface. There is also a "CLI
- program".
+INSTALL
- GraphQL servers are usually served over HTTP. The provided transport,
- GraphQL::Client::http, lets you plug in your own user agent, so this
- client works naturally with HTTP::Tiny, Mojo::UserAgent, and more. You
- can also use HTTP::AnyUA middleware.
+ There are several ways to install graphql to your system.
-ATTRIBUTES
+ from CPAN
- url
+ You can install graphql using cpanm:
- The URL of a GraphQL endpoint, e.g. "http://myapiserver/graphql".
+ cpanm GraphQL::Client
- unpack
+ from GitHub
- Whether or not to "unpack" the response, which enables a different
- style for error-handling.
+ You can also choose to download graphql as a self-contained executable:
- Default is 0.
+ curl -OL https://raw.githubusercontent.com/chazmcgarvey/graphql-client/solo/graphql
+ chmod +x graphql
- See "ERROR HANDLING".
+ To hack on the code, clone the repo instead:
- transport_class
+ git clone https://github.com/chazmcgarvey/graphql-client.git
+ cd graphql-client
+ make bootstrap # installs dependencies; requires cpanm
- The package name of a transport.
+OPTIONS
- This is optional if the correct transport can be correctly determined
- from the "url".
+ --url URL
- transport
+ The URL of the GraphQL server endpoint.
- The transport object.
+ If no --url option is given, the first argument is assumed to be the
+ URL.
- By default this is automatically constructed based on "transport_class"
- or "url".
+ This option is required.
-METHODS
+ Alias: -u
- new
+ --query STR
- $graphql = GraphQL::Client->new(%attributes);
+ The query or mutation to execute.
- Construct a new client.
+ If no --query option is given, the next argument (after URL) is assumed
+ to be the query.
- execute
+ If the value is "-" (which is the default), the query will be read from
+ STDIN.
- $response = $graphql->execute($query);
- $response = $graphql->execute($query, \%variables);
- $response = $graphql->execute($query, \%variables, $operation_name);
- $response = $graphql->execute($query, \%variables, $operation_name, \%transport_options);
- $response = $graphql->execute($query, \%variables, \%transport_options);
+ See: https://graphql.org/learn/queries/
- Execute a request on a GraphQL server, and get a response.
+ Alias: --mutation
- By default, the response will either be a hashref with the following
- structure or a Future that resolves to such a hashref, depending on the
- transport and how it is configured.
+ --variables JSON
- {
- data => {
- field1 => {...}, # or [...]
- ...
- },
- errors => [
- { message => 'some error message blah blah blah' },
- ...
- ],
- }
+ Provide the variables as a JSON object.
- Note: Setting the "unpack" attribute affects the response shape.
+ Aliases: --vars, -V
-ERROR HANDLING
+ --variable KEY=VALUE
- There are two different styles for handling errors.
+ An alternative way to provide variables one at a time. This option can
+ be repeated to provide multiple variables.
- If "unpack" is 0 (off, the default), every response -- whether success
- or failure -- is enveloped like this:
+ If used in combination with "--variables JSON", this option is silently
+ ignored.
- {
- data => {...},
- errors => [...],
- }
+ See: https://graphql.org/learn/queries/#variables
+
+ Aliases: --var, -d
+
+ --operation-name NAME
+
+ Inform the server which query/mutation to execute.
+
+ Alias: -n
+
+ --output FILE
+
+ Write the response to a file instead of STDOUT.
+
+ Alias: -o
+
+ --transport KEY=VALUE
+
+ Key-value pairs for configuring the transport (usually HTTP).
+
+ Alias: -t
+
+ --format STR
+
+ Specify the output format to use. See "FORMAT".
+
+ Alias: -f
+
+ --unpack
+
+ Enables unpack mode.
+
+ By default, the response structure is printed as-is from the server,
+ and the program exits 0.
+
+ When 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.
+
+ See "EXAMPLES".
+
+FORMAT
+
+ The argument for "--format STR" can be one of:
+
+ * csv - Comma-separated values (requires Text::CSV)
+
+ * json:pretty - Human-readable JSON (default)
+
+ * json - JSON
+
+ * perl - Perl code (requires Data::Dumper)
- where data might be missing or undef if errors occurred (though not
- necessarily) and errors will be missing if the response completed
- without error.
+ * table - Table (requires Text::Table::Any)
- It is up to you to check for errors in the response, so your code might
- look like this:
+ * tsv - Tab-separated values (requires Text::CSV)
- my $response = $graphql->execute(...);
- if (my $errors = $response->{errors}) {
- # handle $errors
+ * yaml - YAML (requires YAML)
+
+ The csv, tsv, and table formats will only work if the response has a
+ particular shape:
+
+ {
+ "data" : {
+ "onefield" : [
+ {
+ "key" : "value",
+ ...
+ },
+ ...
+ ]
+ }
}
- else {
- my $data = $response->{data};
- # do something with $data
+
+ or
+
+ {
+ "data" : {
+ "onefield" : [
+ "value",
+ ...
+ ]
+ }
}
- If unpack is 1 (on), then "execute" will return just the data if there
- were no errors, otherwise it will throw an exception. So your code
- would instead look like this:
+ 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
+ Text::Table::Tiny, but this can be overridden using the 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 "@BACKENDS" in Text::Table::Any.
+
+EXAMPLES
+
+ Different ways to provide the query/mutation to execute:
+
+ graphql http://myserver/graphql {hello}
+
+ echo {hello} | graphql http://myserver/graphql
+
+ graphql http://myserver/graphql <<END
+ > {hello}
+ > END
+
+ 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
+
+ graphql http://myserver/graphql --vars '{"episode":"JEDI"}'
+
+ Configure the transport:
+
+ graphql http://myserver/graphql {hello} -t headers.authorization='Basic s3cr3t'
+
+ This example shows the effect of "--unpack":
- my $data = eval { $graphql->execute(...) };
- if (my $error = $@) {
- my $resp = $error->{response};
- # handle errors
+ graphql http://myserver/graphql {hello}
+
+ # Output:
+ {
+ "data" : {
+ "hello" : "Hello world!"
+ }
}
- else {
- # do something with $data
+
+ graphql http://myserver/graphql {hello} --unpack
+
+ # Output:
+ {
+ "hello" : "Hello world!"
}
- Or if you want to handle errors in a different stack frame, your code
- is simply this:
+ENVIRONMENT
- my $data = $graphql->execute(...);
- # do something with $data
+ Some environment variables affect the way graphql behaves:
- Both styles map to Future responses intuitively. If unpack is 0, the
- response always resolves to the envelope structure. If unpack is 1,
- successful responses will resolve to just the data and errors will
- fail/reject.
+ * GRAPHQL_CLIENT_DEBUG - Set to 1 to print diagnostic messages to
+ STDERR.
-SEE ALSO
+ * GRAPHQL_CLIENT_HTTP_USER_AGENT - Set the HTTP user agent string.
+
+ * GRAPHQL_CLIENT_OPTIONS - Set the default set of options.
+
+ * PERL_TEXT_TABLE - Set table format backend; see "FORMAT".
+
+EXIT STATUS
+
+ Here is a consolidated summary of what exit statuses mean:
- * graphql - CLI program
+ * 0 - Success
- * GraphQL - Perl implementation of a GraphQL server
+ * 1 - Client or server errors
+
+ * 2 - Option usage is wrong
+
+ * 3 - Could not format the response as requested
+
+SEE ALSO
- * https://graphql.org/ - GraphQL project website
+ * GraphQL::Client - Programmatic interface
BUGS
#! perl
-# PODNAME: graphql
# ABSTRACT: Command-line GraphQL client
+# PODNAME: graphql
+
# FATPACK - Do not remove this line.
use warnings;
use strict;
-use Getopt::Long;
-use GraphQL::Client;
-use JSON::MaybeXS;
-
-our $VERSION = '0.601'; # VERSION
-
-my $version;
-my $help;
-my $manual;
-my $url;
-my $transport = {};
-my $query = '-';
-my $variables = {};
-my $operation_name;
-my $format = 'json:pretty';
-my $unpack = 0;
-my $outfile;
-GetOptions(
- 'version' => \$version,
- 'help|h|?' => \$help,
- 'manual|man' => \$manual,
- 'url|u=s' => \$url,
- 'query|mutation=s' => \$query,
- 'variables|vars|V=s' => \$variables,
- 'variable|var|d=s%' => \$variables,
- 'operation-name|n=s' => \$operation_name,
- 'transport|t=s%' => \$transport,
- 'format|f=s' => \$format,
- 'unpack!' => \$unpack,
- 'output|o=s' => \$outfile,
-) 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 '-';
-
-if (!$url) {
- print STDERR "The <URL> or --url option argument is required.\n";
- pod2usage(2);
-}
-
-$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);
-
-eval { $client->transport };
-if (my $err = $@) {
- warn $err if $ENV{GRAPHQL_CLIENT_DEBUG};
- print STDERR "Could not construct a transport for URL: $url\n";
- print STDERR "Is this URL correct?\n";
- pod2usage(2);
-}
-
-if (!$query || $query eq '-') {
- 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->execute($query, $variables, $operation_name, $transport);
-my $err = $resp->{errors};
-$unpack = 0 if $err;
-my $data = $unpack ? $resp->{data} : $resp;
-
-if ($outfile) {
- open(my $out, '>', $outfile) or die "Open $outfile failed: $!";
- *STDOUT = $out;
-}
-
-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;
- }
-}
-
-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;
-}
+use GraphQL::Client::CLI;
-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:
+our $VERSION = '0.602'; # VERSION
- 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;
- }
-}
+GraphQL::Client::CLI->main(@ARGV);
__END__
=head1 VERSION
-version 0.601
+version 0.602
=head1 SYNOPSIS
=head2 C<--variable KEY=VALUE>
-An alternative way to provide variables. Repeat this option to provide multiple variables.
+An alternative way to provide variables one at a time. This option can be repeated to provide
+multiple variables.
If used in combination with L</"--variables JSON">, this option is silently ignored.
=item *
+C<GRAPHQL_CLIENT_OPTIONS> - Set the default set of options.
+
+=item *
+
C<PERL_TEXT_TABLE> - Set table format backend; see L</FORMAT>.
=back
=back
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<GraphQL::Client> - Programmatic interface
+
+=back
+
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website
use Scalar::Util qw(reftype);
use namespace::clean;
-our $VERSION = '0.601'; # VERSION
+our $VERSION = '0.602'; # VERSION
sub _croak { require Carp; goto &Carp::croak }
sub _throw { GraphQL::Client::Error->throw(@_) }
=head1 VERSION
-version 0.601
+version 0.602
=head1 SYNOPSIS
--- /dev/null
+package GraphQL::Client::CLI;
+# ABSTRACT: Implementation of the graphql CLI program
+
+use warnings;
+use strict;
+
+use Text::ParseWords;
+use Getopt::Long 2.39 qw(GetOptionsFromArray);
+use GraphQL::Client;
+use JSON::MaybeXS;
+use namespace::clean;
+
+our $VERSION = '0.602'; # VERSION
+
+sub _croak { require Carp; goto &Carp::croak }
+
+sub new {
+ my $class = shift;
+ bless {}, $class;
+}
+
+sub main {
+ my $self = shift;
+ $self = $self->new if !ref $self;
+
+ my $options = eval { $self->_get_options(@_) };
+ if (my $err = $@) {
+ print STDERR $err;
+ _pod2usage(2);
+ }
+
+ if ($options->{version}) {
+ print "graphql $VERSION\n";
+ exit 0;
+ }
+ if ($options->{help}) {
+ _pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS)]);
+ }
+ if ($options->{manual}) {
+ _pod2usage(-exitval => 0, -verbose => 2);
+ }
+
+ my $url = $options->{url};
+ if (!$url) {
+ print STDERR "The <URL> or --url option argument is required.\n";
+ _pod2usage(2);
+ }
+
+ my $variables = $options->{variables};
+ my $query = $options->{query};
+ my $operation_name = $options->{operation_name};
+ my $unpack = $options->{unpack};
+ my $outfile = $options->{outfile};
+ my $format = $options->{format};
+ my $transport = $options->{transport};
+
+ my $client = GraphQL::Client->new(url => $url);
+
+ eval { $client->transport };
+ if (my $err = $@) {
+ warn $err if $ENV{GRAPHQL_CLIENT_DEBUG};
+ print STDERR "Could not construct a transport for URL: $url\n";
+ print STDERR "Is this URL correct?\n";
+ _pod2usage(2);
+ }
+
+ if ($query eq '-') {
+ print STDERR "Interactive mode engaged! Waiting for a query on <STDIN>...\n"
+ if -t STDIN; ## no critic (InputOutput::ProhibitInteractiveTest)
+ $query = do { local $/; <STDIN> };
+ }
+
+ my $resp = $client->execute($query, $variables, $operation_name, $transport);
+ my $err = $resp->{errors};
+ $unpack = 0 if $err;
+ my $data = $unpack ? $resp->{data} : $resp;
+
+ if ($outfile) {
+ open(my $out, '>', $outfile) or die "Open $outfile failed: $!";
+ *STDOUT = $out;
+ }
+
+ _print_data($data, $format);
+
+ exit($unpack && $err ? 1 : 0);
+}
+
+sub _get_options {
+ my $self = shift;
+ my @args = @_;
+
+ unshift @args, shellwords($ENV{GRAPHQL_CLIENT_OPTIONS} || '');
+
+ my %options = (
+ format => 'json:pretty',
+ unpack => 0,
+ );
+
+ GetOptionsFromArray(\@args,
+ 'version' => \$options{version},
+ 'help|h|?' => \$options{help},
+ 'manual|man' => \$options{manual},
+ 'url|u=s' => \$options{url},
+ 'query|mutation=s' => \$options{query},
+ 'variables|vars|V=s' => \$options{variables},
+ 'variable|var|d=s%' => \$options{variables},
+ 'operation-name|n=s' => \$options{operation_name},
+ 'transport|t=s%' => \$options{transport},
+ 'format|f=s' => \$options{format},
+ 'unpack!' => \$options{unpack},
+ 'output|o=s' => \$options{outfile},
+ ) or _pod2usage(2);
+
+ $options{url} = shift @args if !$options{url};
+ $options{query} = shift @args if !$options{query};
+
+ $options{query} ||= '-';
+
+ my $transport = eval { _expand_vars($options{transport}) };
+ die "Two or more --transport keys are incompatible.\n" if $@;
+
+ if (ref $options{variables}) {
+ $options{variables} = eval { _expand_vars($options{variables}) };
+ die "Two or more --variable keys are incompatible.\n" if $@;
+ }
+ elsif ($options{variables}) {
+ $options{variables} = eval { JSON::MaybeXS->new->decode($options{variables}) };
+ die "The --variables JSON does not parse.\n" if $@;
+ }
+
+ return \%options;
+}
+
+sub _print_data {
+ my ($data, $format) = @_;
+ $format = lc($format || 'json:pretty');
+ if ($format eq 'json' || $format eq 'json:pretty') {
+ my %opts = (allow_nonref => 1, 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;
+ $unpacked = $data->{data} if $data && $data->{data};
+
+ # 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;
+ }
+}
+
+sub _parse_path {
+ my $path = shift;
+
+ my @path;
+
+ my @segments = map { split(/\./, $_) } split(/(\[[^\.\]]+\])\.?/, $path);
+ for my $segment (@segments) {
+ if ($segment =~ /\[([^\.\]]+)\]/) {
+ $path[-1]{type} = 'ARRAY' if @path;
+ push @path, {
+ name => $1,
+ index => 1,
+ };
+ }
+ else {
+ $path[-1]{type} = 'HASH' if @path;
+ push @path, {
+ name => $segment,
+ };
+ }
+ }
+
+ return \@path;
+}
+
+sub _expand_vars {
+ my $vars = shift;
+
+ my $root = {};
+
+ while (my ($key, $value) = each %$vars) {
+ my $parsed_path = _parse_path($key);
+
+ my $curr = $root;
+ for my $segment (@$parsed_path) {
+ my $name = $segment->{name};
+ my $type = $segment->{type} || '';
+ my $next = $type eq 'HASH' ? {} : $type eq 'ARRAY' ? [] : $value;
+ if (ref $curr eq 'HASH') {
+ _croak 'Conflicting keys' if $segment->{index};
+ if (defined $curr->{$name}) {
+ _croak 'Conflicting keys' if $type ne ref $curr->{$name};
+ $next = $curr->{$name};
+ }
+ else {
+ $curr->{$name} = $next;
+ }
+ }
+ elsif (ref $curr eq 'ARRAY') {
+ _croak 'Conflicting keys' if !$segment->{index};
+ if (defined $curr->[$name]) {
+ _croak 'Conflicting keys' if $type ne ref $curr->[$name];
+ $next = $curr->[$name];
+ }
+ else {
+ $curr->[$name] = $next;
+ }
+ }
+ else {
+ _croak 'Conflicting keys';
+ }
+ $curr = $next;
+ }
+ }
+
+ return $root;
+}
+
+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;
+ }
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+GraphQL::Client::CLI - Implementation of the graphql CLI program
+
+=head1 VERSION
+
+version 0.602
+
+=head1 DESCRIPTION
+
+This is the actual implementation of L<graphql>.
+
+The interface is B<EXPERIMENTAL>. Don't rely on it.
+
+=head1 METHODS
+
+=head2 new
+
+Construct a new CLI.
+
+=head2 main
+
+Run the script.
+
+=head1 BUGS
+
+Please report any bugs or feature requests on the bugtracker website
+L<https://github.com/chazmcgarvey/graphql-client/issues>
+
+When submitting a bug or request, please include a test-file or a
+patch to an existing test-file that illustrates the bug or desired
+feature.
+
+=head1 AUTHOR
+
+Charles McGarvey <chazmcgarvey@brokenzipper.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2020 by Charles McGarvey.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
use HTTP::AnyUA;
use namespace::clean;
-our $VERSION = '0.601'; # VERSION
+our $VERSION = '0.602'; # VERSION
sub _croak { require Carp; goto &Carp::croak }
my $reason = $resp->{reason} // '';
my $message = "HTTP transport returned $resp->{status} ($reason): $content";
+ chomp $message;
+
return {
error => $message,
response => $data,
=head1 VERSION
-version 0.601
+version 0.602
=head1 SYNOPSIS
Get a response from the GraphQL server.
-The C<%data> structure must have a C<query> key whose value is the query or mutation string. It may
-optionally have a C<variables> hashref and an C<operationName> string.
+The C<%request> structure must have a C<query> key whose value is the query or mutation string. It
+may optionally have a C<variables> hashref and an C<operationName> string.
The C<%options> structure is optional and may contain options passed through to the user agent. The
only useful options are C<headers> (which should have a hashref value) and C<method> and C<url> to
data => {...},
errors => [...],
},
- error => 'Something happened', # may be ommitted if no error occurred
+ error => 'Something happened', # omitted if no error occurred
details => { # optional information which may aide troubleshooting
},
}
use parent 'GraphQL::Client::http';
-our $VERSION = '0.601'; # VERSION
+our $VERSION = '0.602'; # VERSION
sub new {
my $class = shift;
=head1 VERSION
-version 0.601
+version 0.602
=head1 DESCRIPTION
use Test::More;
-plan tests => 4 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
+plan tests => 5 + ($ENV{AUTHOR_TESTING} ? 1 : 0);
my @module_files = (
'GraphQL/Client.pm',
+ 'GraphQL/Client/CLI.pm',
'GraphQL/Client/http.pm',
'GraphQL/Client/https.pm'
);
},
'requires' => {
'Carp' => '0',
- 'Getopt::Long' => '0',
+ 'Getopt::Long' => '2.39',
'HTTP::AnyUA' => '0',
'HTTP::AnyUA::Util' => '0',
'JSON::MaybeXS' => '0',
'Module::Load' => '0',
'Scalar::Util' => '0',
+ 'Text::ParseWords' => '0',
'namespace::clean' => '0',
'overload' => '0',
'parent' => '0',
--- /dev/null
+#!/usr/bin/env perl
+
+use warnings;
+use strict;
+
+use Test::Exception;
+use Test::More;
+
+use GraphQL::Client::CLI;
+
+subtest 'get_options' => sub {
+ my $expected = {
+ format => 'json:pretty',
+ help => undef,
+ manual => undef,
+ operation_name => undef,
+ outfile => undef,
+ query => 'bar',
+ transport => undef,
+ unpack => 0,
+ url => 'foo',
+ variables => undef,
+ version => undef,
+ };
+
+ my $r = GraphQL::Client::CLI->_get_options(qw{--url foo --query bar});
+ is_deeply($r, $expected, '--url and --query set options') or diag explain $r;
+
+ $r = GraphQL::Client::CLI->_get_options(qw{foo --query bar});
+ is_deeply($r, $expected, '--url is optional') or diag explain $r;
+
+ $r = GraphQL::Client::CLI->_get_options(qw{foo bar});
+ is_deeply($r, $expected, '--query is also optional') or diag explain $r;
+};
+
+subtest 'expand_vars' => sub {
+ my $r = GraphQL::Client::CLI::_expand_vars({
+ 'foo.bar' => 'baz',
+ 'foo.qux.muf' => 42,
+ 'arr1[1].tut' => 'whatever',
+ 'arr2[1][0].meh'=> 3.1415,
+ });
+ is_deeply($r, {
+ foo => {
+ bar => 'baz',
+ qux => {
+ muf => 42,
+ },
+ },
+ arr1 => [
+ undef,
+ {
+ tut => 'whatever',
+ }
+ ],
+ arr2 => [
+ undef,
+ [
+ {
+ meh => 3.1415,
+ },
+ ],
+ ],
+ }, 'expand all the vars') or diag explain $r;
+
+ throws_ok {
+ GraphQL::Client::CLI::_expand_vars({
+ 'foo[0]' => 'baz',
+ 'foo.bar' => 'muf',
+ });
+ } qr/^Conflicting keys/, 'throw if conflict between hash and array';
+
+ throws_ok {
+ GraphQL::Client::CLI::_expand_vars({
+ 'foo' => 'baz',
+ 'foo.bar' => 'muf',
+ });
+ } qr/^Conflicting keys/, 'throw if conflict between hash and scalar';
+};
+
+done_testing;
$req = ($mock->requests)[-1];
is_deeply($req->[1], {
baz => 'qux',
- }, 'operation name can be ommitted with transport options');
+ }, 'operation name can be omitted with transport options');
};
subtest 'success response' => sub {
my @files = (
'bin/graphql',
'lib/GraphQL/Client.pm',
+ 'lib/GraphQL/Client/CLI.pm',
'lib/GraphQL/Client/http.pm',
'lib/GraphQL/Client/https.pm',
't/00-compile.t',
't/00-report-prereqs.dd',
't/00-report-prereqs.t',
+ 't/cli.t',
't/client.t',
't/http.t',
't/https.t',
my @files = (
'bin/graphql',
'lib/GraphQL/Client.pm',
+ 'lib/GraphQL/Client/CLI.pm',
'lib/GraphQL/Client/http.pm',
'lib/GraphQL/Client/https.pm',
't/00-compile.t',
't/00-report-prereqs.dd',
't/00-report-prereqs.t',
+ 't/cli.t',
't/client.t',
't/http.t',
't/https.t',
projects / chaz / graphql-client / commitdiff
