From: Charles McGarvey Date: Wed, 18 Mar 2020 00:29:08 +0000 (-0600) Subject: Version 0.602 X-Git-Url: https://git.dogcows.com/gitweb?a=commitdiff_plain;h=794f74f42c89ba45a33f0c6c1461c769580aca8f;p=chaz%2Fgraphql-client Version 0.602 --- diff --git a/Changes b/Changes index 81a7db9..24d3189 100644 --- a/Changes +++ b/Changes @@ -1,8 +1,11 @@ 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. diff --git a/MANIFEST b/MANIFEST index 8c517a2..b03df18 100644 --- a/MANIFEST +++ b/MANIFEST @@ -8,11 +8,13 @@ Makefile.PL 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 diff --git a/META.json b/META.json index 7139b38..c98c070 100644 --- a/META.json +++ b/META.json @@ -1,5 +1,5 @@ { - "abstract" : "A GraphQL client", + "abstract" : "Command-line GraphQL client", "author" : [ "Charles McGarvey " ], @@ -72,12 +72,13 @@ }, "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", @@ -114,19 +115,23 @@ "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", @@ -141,7 +146,7 @@ "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", diff --git a/META.yml b/META.yml index 727e00d..95a9518 100644 --- a/META.yml +++ b/META.yml @@ -1,5 +1,5 @@ --- -abstract: 'A GraphQL client' +abstract: 'Command-line GraphQL client' author: - 'Charles McGarvey ' build_requires: @@ -33,27 +33,31 @@ no_index: 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' @@ -64,7 +68,7 @@ resources: 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' diff --git a/Makefile.PL b/Makefile.PL index 7d75ca6..2c7c27a 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -7,7 +7,7 @@ use 5.010; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( - "ABSTRACT" => "A GraphQL client", + "ABSTRACT" => "Command-line GraphQL client", "AUTHOR" => "Charles McGarvey ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 @@ -21,12 +21,13 @@ my %WriteMakefileArgs = ( "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, @@ -46,7 +47,7 @@ my %WriteMakefileArgs = ( "Test::More" => 0, "lib" => 0 }, - "VERSION" => "0.601", + "VERSION" => "0.602", "test" => { "TESTS" => "t/*.t" } @@ -59,7 +60,7 @@ my %FallbackPrereqs = ( "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, @@ -71,6 +72,7 @@ my %FallbackPrereqs = ( "Test::Deep" => 0, "Test::Exception" => 0, "Test::More" => 0, + "Text::ParseWords" => 0, "lib" => 0, "namespace::clean" => 0, "overload" => 0, diff --git a/README b/README index ae64d68..8d89255 100644 --- a/README +++ b/README @@ -1,188 +1,270 @@ 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 [ [--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 - queries and mutations on a server. + graphql is a command-line program for executing queries and mutations + on a GraphQL 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 < {hello} + > END + + graphql http://myserver/graphql + Interactive mode engaged! Waiting for a query on ... + {hello} + ^D + + Execute a query with variables: + + graphql http://myserver/graphql < 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 diff --git a/bin/graphql b/bin/graphql index 6825edc..e5c6784 100755 --- a/bin/graphql +++ b/bin/graphql @@ -1,220 +1,18 @@ #! 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 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 ...\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 <main(@ARGV); __END__ @@ -228,7 +26,7 @@ graphql - Command-line GraphQL client =head1 VERSION -version 0.601 +version 0.602 =head1 SYNOPSIS @@ -299,7 +97,8 @@ Aliases: C<--vars>, C<-V> =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, this option is silently ignored. @@ -485,6 +284,10 @@ C - Set the HTTP user agent string. =item * +C - Set the default set of options. + +=item * + C - Set table format backend; see L. =back @@ -513,6 +316,16 @@ C<3> - Could not format the response as requested =back +=head1 SEE ALSO + +=over 4 + +=item * + +L - Programmatic interface + +=back + =head1 BUGS Please report any bugs or feature requests on the bugtracker website diff --git a/lib/GraphQL/Client.pm b/lib/GraphQL/Client.pm index 8b93e4b..c4a6119 100644 --- a/lib/GraphQL/Client.pm +++ b/lib/GraphQL/Client.pm @@ -8,7 +8,7 @@ use Module::Load qw(load); 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(@_) } @@ -171,7 +171,7 @@ GraphQL::Client - A GraphQL client =head1 VERSION -version 0.601 +version 0.602 =head1 SYNOPSIS diff --git a/lib/GraphQL/Client/CLI.pm b/lib/GraphQL/Client/CLI.pm new file mode 100644 index 0000000..bb2ab03 --- /dev/null +++ b/lib/GraphQL/Client/CLI.pm @@ -0,0 +1,350 @@ +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 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 ...\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 _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 <. + +The interface is B. 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 + +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 + +=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 diff --git a/lib/GraphQL/Client/http.pm b/lib/GraphQL/Client/http.pm index a53228a..667e44e 100644 --- a/lib/GraphQL/Client/http.pm +++ b/lib/GraphQL/Client/http.pm @@ -9,7 +9,7 @@ use HTTP::AnyUA::Util qw(www_form_urlencode); use HTTP::AnyUA; use namespace::clean; -our $VERSION = '0.601'; # VERSION +our $VERSION = '0.602'; # VERSION sub _croak { require Carp; goto &Carp::croak } @@ -90,6 +90,8 @@ sub _handle_error { my $reason = $resp->{reason} // ''; my $message = "HTTP transport returned $resp->{status} ($reason): $content"; + chomp $message; + return { error => $message, response => $data, @@ -169,7 +171,7 @@ GraphQL::Client::http - GraphQL over HTTP =head1 VERSION -version 0.601 +version 0.602 =head1 SYNOPSIS @@ -279,8 +281,8 @@ See L. Get a response from the GraphQL server. -The C<%data> structure must have a C key whose value is the query or mutation string. It may -optionally have a C hashref and an C string. +The C<%request> structure must have a C key whose value is the query or mutation string. It +may optionally have a C hashref and an C string. The C<%options> structure is optional and may contain options passed through to the user agent. The only useful options are C (which should have a hashref value) and C and C to @@ -294,7 +296,7 @@ such a hashref: 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 }, } diff --git a/lib/GraphQL/Client/https.pm b/lib/GraphQL/Client/https.pm index f73b48f..6df0df9 100644 --- a/lib/GraphQL/Client/https.pm +++ b/lib/GraphQL/Client/https.pm @@ -6,7 +6,7 @@ use strict; use parent 'GraphQL::Client::http'; -our $VERSION = '0.601'; # VERSION +our $VERSION = '0.602'; # VERSION sub new { my $class = shift; @@ -27,7 +27,7 @@ GraphQL::Client::https - GraphQL over HTTPS =head1 VERSION -version 0.601 +version 0.602 =head1 DESCRIPTION diff --git a/t/00-compile.t b/t/00-compile.t index 676ed70..9c2c700 100644 --- a/t/00-compile.t +++ b/t/00-compile.t @@ -6,10 +6,11 @@ use warnings; 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' ); diff --git a/t/00-report-prereqs.dd b/t/00-report-prereqs.dd index 8ec21f8..fa4b219 100644 --- a/t/00-report-prereqs.dd +++ b/t/00-report-prereqs.dd @@ -48,12 +48,13 @@ do { my $x = { }, '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', diff --git a/t/cli.t b/t/cli.t new file mode 100755 index 0000000..2ae980e --- /dev/null +++ b/t/cli.t @@ -0,0 +1,81 @@ +#!/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; diff --git a/t/client.t b/t/client.t index 1dd0cd4..841bd8c 100755 --- a/t/client.t +++ b/t/client.t @@ -60,7 +60,7 @@ subtest 'request to transport' => sub { $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 { diff --git a/xt/author/eol.t b/xt/author/eol.t index aae18ba..afb6494 100644 --- a/xt/author/eol.t +++ b/xt/author/eol.t @@ -9,11 +9,13 @@ use Test::EOL; 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', diff --git a/xt/author/no-tabs.t b/xt/author/no-tabs.t index f70f55c..68ac37b 100644 --- a/xt/author/no-tabs.t +++ b/xt/author/no-tabs.t @@ -9,11 +9,13 @@ use Test::NoTabs; 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',