Dogcows Code - chaz/graphql-client/blob - bin/graphql

   1 #! perl
   2 # PODNAME: graphql
   3 # ABSTRACT: Command-line GraphQL client
   4
   5 # FATPACK - Do not remove this line.
   6
   7 use warnings;
   8 use strict;
   9
  10 use Getopt::Long;
  11 use GraphQL::Client;
  12 use JSON::MaybeXS;
  13
  14 our $VERSION = '999.999'; # VERSION
  15
  16 my $url;
  17 my $transport       = {};
  18 my $query           = '-';
  19 my $variables       = {};
  20 my $operation_name;
  21 my $format          = 'json:pretty';
  22 my $unpack          = 0;
  23 my $outfile;
  24 my $version;
  25 my $help;
  26 my $manual;
  27 GetOptions(
  28     'url|u=s'               => \$url,
  29     'query|mutation=s'      => \$query,
  30     'variables|vars|V=s'    => \$variables,
  31     'variable|var|d=s%'     => \$variables,
  32     'operation-name=s'      => \$operation_name,
  33     'transport|t=s%'        => \$transport,
  34     'format|f=s'            => \$format,
  35     'unpack!'               => \$unpack,
  36     'output|o=s'            => \$outfile,
  37     'version'               => \$version,
  38     'help|h|?'              => \$help,
  39     'manual|man'            => \$manual,
  40 ) or pod2usage(2);
  41
  42 if ($version) {
  43     print "graphql $VERSION\n";
  44     exit 0;
  45 }
  46 if ($help) {
  47     pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS)]);
  48 }
  49 if ($manual) {
  50     pod2usage(-exitval => 0, -verbose => 2);
  51 }
  52
  53 $url    = shift if !$url;
  54 $query  = shift if !$query || $query eq '-';
  55
  56 $transport = expand_vars($transport);
  57
  58 if (ref $variables) {
  59     $variables = expand_vars($variables);
  60 }
  61 else {
  62     $variables = JSON::MaybeXS->new->decode($variables);
  63 }
  64
  65 my $client = GraphQL::Client->new(url => $url);
  66 $client->transport;     # just make sure we can load the transport
  67
  68 if (!$query || $query eq '-') {
  69     print STDERR "Interactive mode engaged! Waiting for a query on <STDIN>...\n"
  70         if -t STDIN; ## no critic (InputOutput::ProhibitInteractiveTest)
  71     $query = do { local $/; <> };
  72 }
  73
  74 my $resp = $client->request($query, $variables, $operation_name, $transport);
  75 my $err  = $resp->{errors};
  76 $unpack = 0 if $err;
  77 my $data = $unpack ? $resp->{data} : $resp;
  78
  79 if ($outfile) {
  80     open(my $out, '>', $outfile) or die "Open $outfile failed: $!";
  81     *STDOUT = $out;
  82 }
  83
  84 print_data($data, $format);
  85
  86 exit($unpack && $err ? 1 : 0);
  87
  88 sub print_data {
  89     my ($data, $format) = @_;
  90     $format = lc($format || 'json:pretty');
  91     if ($format eq 'json' || $format eq 'json:pretty') {
  92         my %opts = (canonical => 1, utf8 => 1);
  93         $opts{pretty} = 1 if $format eq 'json:pretty';
  94         print JSON::MaybeXS->new(%opts)->encode($data);
  95     }
  96     elsif ($format eq 'yaml') {
  97         eval { require YAML } or die "Missing dependency: YAML\n";
  98         print YAML::Dump($data);
  99     }
 100     elsif ($format eq 'csv' || $format eq 'tsv' || $format eq 'table') {
 101         my $sep = $format eq 'tsv' ? "\t" : ',';
 102
 103         my $unpacked = $data;
 104         $unpacked = $data->{data} if !$unpack && !$err;
 105
 106         # check the response to see if it can be formatted
 107         my @columns;
 108         my $rows = [];
 109         if (keys %$unpacked == 1) {
 110             my ($val) = values %$unpacked;
 111             if (ref $val eq 'ARRAY') {
 112                 my $first = $val->[0];
 113                 if ($first && ref $first eq 'HASH') {
 114                     @columns = sort keys %$first;
 115                     $rows = [
 116                         map { [@{$_}{@columns}] } @$val
 117                     ];
 118                 }
 119                 elsif ($first) {
 120                     @columns = keys %$unpacked;
 121                     $rows = [map { [$_] } @$val];
 122                 }
 123             }
 124         }
 125
 126         if (@columns) {
 127             if ($format eq 'table') {
 128                 eval { require Text::Table::Any } or die "Missing dependency: Text::Table::Any\n";
 129                 my $table = Text::Table::Any::table(
 130                     header_row  => 1,
 131                     rows        => [[@columns], @$rows],
 132                     backend     => $ENV{PERL_TEXT_TABLE},
 133                 );
 134                 print $table;
 135             }
 136             else {
 137                 eval { require Text::CSV } or die "Missing dependency: Text::CSV\n";
 138                 my $csv = Text::CSV->new({binary => 1, sep => $sep, eol => $/});
 139                 $csv->print(*STDOUT, [@columns]);
 140                 for my $row (@$rows) {
 141                     $csv->print(*STDOUT, $row);
 142                 }
 143             }
 144         }
 145         else {
 146             print_data($data);
 147             print STDERR sprintf("Error: Response could not be formatted as %s.\n", uc($format));
 148             exit 3;
 149         }
 150     }
 151     elsif ($format eq 'perl') {
 152         eval { require Data::Dumper } or die "Missing dependency: Data::Dumper\n";
 153         print Data::Dumper::Dumper($data);
 154     }
 155     else {
 156         print STDERR "Error: Format not supported: $format\n";
 157         print_data($data);
 158         exit 3;
 159     }
 160 }
 161
 162 sub expand_vars {
 163     my $vars = shift;
 164
 165     my %out;
 166     while (my ($key, $value) = each %$vars) {
 167         my $var = $value;
 168         my @segments = split(/\./, $key);
 169         for my $segment (reverse @segments) {
 170             my $saved = $var;
 171             if ($segment =~ /^(\d+)$/) {
 172                 $var = [];
 173                 $var->[$segment] = $saved;
 174             }
 175             else {
 176                 $var = {};
 177                 $var->{$segment} = $saved;
 178             }
 179         }
 180         %out = (%out, %$var);
 181     }
 182
 183     return \%out;
 184 }
 185
 186 sub pod2usage {
 187     eval { require Pod::Usage };
 188     if ($@) {
 189         my $ref  = $VERSION eq '999.999' ? 'master' : "v$VERSION";
 190         my $exit = (@_ == 1 && $_[0] =~ /^\d+$/ && $_[0]) //
 191                    (@_ % 2 == 0 && {@_}->{'-exitval'})    // 2;
 192         print STDERR <<END;
 193 Online documentation is available at:
 194
 195   https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
 196
 197 Tip: To enable inline documentation, install the Pod::Usage module.
 198
 199 END
 200         exit $exit;
 201     }
 202     else {
 203         goto &Pod::Usage::pod2usage;
 204     }
 205 }
 206
 207 =head1 SYNOPSIS
 208
 209     graphql <URL> <QUERY> [--var key=value]... [--transport key=value]...
 210             [--[no-]unpack] [--format json|json:pretty|yaml|csv|tsv]
 211
 212 =head1 DESCRIPTION
 213
 214 C<graphql> is a command-line program for executing queries and mutations on
 215 a L<GraphQL|https://graphql.org/> server.
 216
 217 =head1 INSTALL
 218
 219 There are several ways to install F<graphql> to your system.
 220
 221 =head2 from CPAN
 222
 223 You can install F<graphql> using L<cpanm>:
 224
 225     cpanm GraphQL::Client
 226
 227 =head2 from GitHub
 228
 229 You can also choose to download F<graphql> as a self-contained executable:
 230
 231     curl -OL https://raw.githubusercontent.com/chazmcgarvey/graphql-client/solo/graphql
 232     chmod +x graphql
 233
 234 To hack on the code, clone the repo instead:
 235
 236     git clone https://github.com/chazmcgarvey/graphql-client.git
 237     cd graphql-client
 238     make bootstrap      # installs dependencies; requires cpanm
 239
 240 =head1 OPTIONS
 241
 242 =head2 --url STR
 243
 244 The URL of the GraphQL server endpoint.
 245
 246 If no C<--url> option is given, the first argument is assumed to be the URL.
 247
 248 Alias: C<-u>
 249
 250 =head2 --query STR
 251
 252 The query or mutation to execute.
 253
 254 If no C<--query> option is given, the first argument (after URL) is assumed to be the query.
 255
 256 If the value is C<-> (which is the default), the query will be read from C<STDIN>.
 257
 258 See: L<https://graphql.org/learn/queries/>
 259
 260 Alias: C<--mutation>
 261
 262 =head2 --variables JSON
 263
 264 Provide the variables as a JSON object.
 265
 266 Aliases: C<--vars>, C<-V>
 267
 268 =head2 --variable KEY=VALUE
 269
 270 An alternative way to provide variables individually. Repeat this option to provide multiple
 271 variables.
 272
 273 If used in combination with L</"--variables JSON">, this option is silently ignored.
 274
 275 See: L<https://graphql.org/learn/queries/#variables>
 276
 277 Aliases: C<--var>, C<-d>
 278
 279 =head2 --transport KEY=VALUE
 280
 281 Key-value pairs for configuring the transport (usually HTTP).
 282
 283 Alias: C<-t>
 284
 285 =head2 --format STR
 286
 287 Specify the output format to use. See L</FORMAT>.
 288
 289 Alias: C<-f>
 290
 291 =head2 --unpack
 292
 293 Enables C<unpack> mode.
 294
 295 By default, the response structure is printed as-is from the server, and the program exits 0.
 296
 297 When C<unpack> mode is enabled, if the response completes with no errors, only the data section of
 298 the response is printed and the program exits 0. If the response has errors, the whole response
 299 structure is printed as-is and the program exits 1.
 300
 301 See L</EXAMPLES>.
 302
 303 =head1 FORMAT
 304
 305 The C<--format> argument can be one of:
 306
 307 =for :list
 308 * C<csv> - Comma-separated values (requires L<Text::CSV>)
 309 * C<json:pretty> - Pretty JSON (default)
 310 * C<json> - JSON
 311 * C<perl> - Perl code (requires L<Data::Dumper>)
 312 * C<table> - Table (requires L<Text::Table::Any>)
 313 * C<tsv> - Tab-separated values (requires L<Text::CSV>)
 314 * C<yaml> - YAML (requires L<YAML>)
 315
 316 The C<csv>, C<tsv>, and C<table> formats will only work if the response has a particular shape:
 317
 318     {
 319         "data" : {
 320             "onefield" : [
 321                 {
 322                     "key" : "value",
 323                     ...
 324                 },
 325                 ...
 326             ]
 327         }
 328     }
 329
 330 or
 331
 332     {
 333         "data" : {
 334             "onefield" : [
 335                 "value",
 336                 ...
 337             ]
 338         }
 339     }
 340
 341 If the response cannot be formatted, the default format will be used instead, an error message will
 342 be printed to STDERR, and the program will exit 3.
 343
 344 Table formatting can be done by one of several different modules, each with its own features and
 345 bugs. The default module is L<Text::Table::Tiny>, but this can be overridden using the
 346 C<PERL_TEXT_TABLE> environment variable if desired, like this:
 347
 348     PERL_TEXT_TABLE=Text::Table::HTML graphql ... -f table
 349
 350 The list of supported modules is at L<Text::Table::Any/@BACKENDS>.
 351
 352 =head1 EXAMPLES
 353
 354 Different ways to provide the query/mutation to execute:
 355
 356     graphql http://myserver/graphql {hello}
 357
 358     echo {hello} | graphql http://myserver/graphql
 359
 360     graphql http://myserver/graphql <<END
 361     > {hello}
 362     > END
 363
 364     graphql http://myserver/graphql
 365     Interactive mode engaged! Waiting for a query on <STDIN>...
 366     {hello}
 367     ^D
 368
 369 Execute a query with variables:
 370
 371     graphql http://myserver/graphql <<END --var episode=JEDI
 372     > query HeroNameAndFriends($episode: Episode) {
 373     >   hero(episode: $episode) {
 374     >     name
 375     >     friends {
 376     >       name
 377     >     }
 378     >   }
 379     > }
 380     > END
 381
 382 Configure the transport:
 383
 384     graphql http://myserver/graphql {hello} -t headers.authorization='Basic s3cr3t'
 385
 386 This example shows the effect of L<--unpack>:
 387
 388     graphql http://myserver/graphql {hello}
 389
 390     # Output:
 391     {
 392         "data" : {
 393             "hello" : "Hello world!"
 394         }
 395     }
 396
 397     graphql http://myserver/graphql {hello} --unpack
 398
 399     # Output:
 400     {
 401         "hello" : "Hello world!"
 402     }
 403
 404 =head1 ENVIRONMENT
 405
 406 Some environment variables affect the way C<graphql> behaves:
 407
 408 =for :list
 409 * C<GRAPHQL_CLIENT_DEBUG> - Set to 1 to print diagnostic messages to STDERR.
 410 * C<PERL_TEXT_TABLE> - Set table format backend; see L</FORMAT>.
 411