]> Dogcows Code - chaz/graphql-client/commitdiff
add lots of changes
authorCharles McGarvey <chazmcgarvey@brokenzipper.com>
Sat, 14 Mar 2020 20:30:18 +0000 (14:30 -0600)
committerCharles McGarvey <chazmcgarvey@brokenzipper.com>
Sat, 14 Mar 2020 20:30:18 +0000 (14:30 -0600)
.editorconfig
bin/graphql
lib/GraphQL/Client.pm
lib/GraphQL/Client/http.pm

index e5c1fe13a630a7439b6bf4181593455786fb33f5..44a1f8e0426b580a7d6258b2258a8538aa00e4ec 100644 (file)
@@ -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
index 071cac713fbf6e0c825e3f924b6a8246e6e55f1c..a94aa018a147d6f5100015e644c49246bda348e1 100755 (executable)
-#!/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
@@ -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<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>
 
@@ -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</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:
     {
@@ -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 <<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>.
 
index 345fd286ca440de1b782c07cba911c62e0f6d8a5..faa5edaf59dc3d823b119a474cd873ba4f6904cd 100644 (file)
@@ -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.
index 5b9b634f8fa53630576ae087debbf168a2d462aa..b6e608f853f64a339848227ccdc08626d2436bd8 100644 (file)
@@ -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<HTTP::AnyUA/"SUPPORTED USER AGENTS">.
 
+=attr any_ua
+
+The L<HTTP::AnyUA> 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:
This page took 0.045715 seconds and 4 git commands to generate.