From dfa1c3680f0f1e5ccc6d85b4fa5a4916bf31b23d Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Sat, 14 Mar 2020 14:30:18 -0600 Subject: [PATCH] add lots of changes --- .editorconfig | 2 +- bin/graphql | 368 +++++++++++++++++++++++++++++-------- lib/GraphQL/Client.pm | 38 ++-- lib/GraphQL/Client/http.pm | 58 ++++-- 4 files changed, 358 insertions(+), 108 deletions(-) diff --git a/.editorconfig b/.editorconfig index e5c1fe1..44a1f8e 100644 --- a/.editorconfig +++ b/.editorconfig @@ -9,7 +9,7 @@ end_of_line = lf insert_final_newline = true trim_trailing_whitespace = true -[{**.pl,**.pm,**.pod,**.t}] +[{**.pl,**.pm,**.pod,**.t,bin/graphql}] indent_style = space indent_size = 4 max_line_length = 100 diff --git a/bin/graphql b/bin/graphql index 071cac7..a94aa01 100755 --- a/bin/graphql +++ b/bin/graphql @@ -1,86 +1,242 @@ -#!/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 ...\n" if -t STDIN; + print STDERR "Interactive mode engaged! Waiting for a query on ...\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 < [--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 is a command-line program for executing queries and mutations on a L server. +=head1 INSTALL + +There are several ways to install F to your system. + +=head2 from CPAN + +You can install F using L: + + cpanm GraphQL::Client + +=head2 from GitHub + +You can also choose to download F 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 @@ -95,19 +251,26 @@ Alias: C<-u> 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. +If the value is C<-> (which is the default), the query will be read from C. See: L 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, this option is silently ignored. See: L @@ -119,50 +282,110 @@ Key-value pairs for configuring the transport (usually HTTP). Alias: C<-t> +=head2 --format STR + +Specify the output format to use. See L. + +Alias: C<-f> + =head2 --unpack Enables C 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 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 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. + +=head1 FORMAT -Sets the output format. Possible values include: +The C<--format> argument can be one of: =for :list -* C (default) -* C -* C -* C +* C - Comma-separated values (requires L) +* C - Pretty JSON (default) +* C - JSON +* C - Perl code (requires L) +* C - Table (requires L) +* C - Tab-separated values (requires L) +* C - YAML (requires L) -Alias: C<-f> +The C, C, and C
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, but this can be overridden using the +C environment variable if desired, like this: + + PERL_TEXT_TABLE=Text::Table::HTML graphql ... -f table + +The list of supported modules is at L. =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 < {hello} > END - graphql http://localhost:4000/graphql + 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 + +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: { @@ -171,23 +394,18 @@ This example shows the effect of L<--unpack>: } } - 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 < query HeroNameAndFriends($episode: Episode) { - > hero(episode: $episode) { - > name - > friends { - > name - > } - > } - > } - > END +Some environment variables affect the way C behaves: + +=for :list +* C - Set to 1 to print diagnostic messages to STDERR. +* C - Set table format backend; see L. diff --git a/lib/GraphQL/Client.pm b/lib/GraphQL/Client.pm index 345fd28..faa5eda 100644 --- a/lib/GraphQL/Client.pm +++ b/lib/GraphQL/Client.pm @@ -5,6 +5,7 @@ use warnings; use strict; use Module::Load qw(load); +use Scalar::Util qw(reftype); use Throw; our $VERSION = '999.999'; # VERSION @@ -18,21 +19,24 @@ sub new { 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) = @_; @@ -40,17 +44,20 @@ sub _handle_response { 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}); } @@ -61,9 +68,9 @@ sub _handle_response { 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}; @@ -87,7 +94,8 @@ sub transport { $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}\""; } @@ -159,6 +167,8 @@ Construct a new client. $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. diff --git a/lib/GraphQL/Client/http.pm b/lib/GraphQL/Client/http.pm index 5b9b634..b6e608f 100644 --- a/lib/GraphQL/Client/http.pm +++ b/lib/GraphQL/Client/http.pm @@ -1,6 +1,7 @@ package GraphQL::Client::http; # ABSTRACT: GraphQL over HTTP +use 5.010; use warnings; use strict; @@ -18,8 +19,8 @@ sub request { my $self = shift; my ($request, $options) = @_; - my $url = $options->{url} || $self->url; - my $method = $options->{method} || $self->method; + my $url = delete $options->{url} || $self->url; + my $method = delete $options->{method} || $self->method; my $data = {%$request}; @@ -36,7 +37,7 @@ sub request { $options->{headers}{'content-type'} = 'application/json'; } - return $self->_handle_response($self->_any_ua->request($method, $url, $options)); + return $self->_handle_response($self->any_ua->request($method, $url, $options)); } sub _handle_response { @@ -46,23 +47,40 @@ sub _handle_response { my $handle_error = sub { my $resp = shift; - return { - errors => [ - { - message => "HTTP transport returned $resp->{status}: $resp->{content}", - x_transport_response => $resp, - }, - ], - }; + my $data = eval { $self->json->decode($resp->{content}) }; + if ($@) { + my $content = $resp->{content} // 'No content'; + my $reason = $resp->{reason} // ''; + $data = { + errors => [ + { + message => "HTTP transport returned $resp->{status} ($reason): $content", + }, + ], + }; + } + + return ($data, 'graphql', $resp); }; my $handle_response = sub { my $resp = shift; return $handle_error->($resp) if !$resp->{success}; - return $self->json->decode($resp->{content}); + my $data = eval { $self->json->decode($resp->{content}) }; + if (my $err = $@) { + warn $err if $ENV{GRAPHQL_CLIENT_DEBUG}; + $data = { + errors => [ + { + message => 'HTTP transport failed to decode response from GraphQL server.', + }, + ], + }; + } + return $data; }; - if ($self->_any_ua->response_is_future) { + if ($self->any_ua->response_is_future) { return $resp->transform( done => $handle_response, fail => $handle_error, @@ -83,6 +101,11 @@ sub ua { }; } +sub any_ua { + my $self = shift; + $self->{any_ua} //= HTTP::AnyUA->new(ua => $self->ua); +} + sub url { my $self = shift; $self->{url}; @@ -101,11 +124,6 @@ sub json { }; } -sub _any_ua { - my $self = shift; - $self->{_any_ua} //= HTTP::AnyUA->new(ua => $self->ua); -} - 1; __END__ @@ -164,6 +182,10 @@ A user agent, such as: See L. +=attr any_ua + +The L instance. Can be used to apply middleware if desired. + =attr method The HTTP method to use when querying the GraphQL server. Can be one of: -- 2.45.2