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 = '0.600'; # VERSION
  15
  16 my $version;
  17 my $help;
  18 my $manual;
  19 my $url;
  20 my $transport       = {};
  21 my $query           = '-';
  22 my $variables       = {};
  23 my $operation_name;
  24 my $format          = 'json:pretty';
  25 my $unpack          = 0;
  26 my $outfile;
  27 GetOptions(
  28     'version'               => \$version,
  29     'help|h|?'              => \$help,
  30     'manual|man'            => \$manual,
  31     'url|u=s'               => \$url,
  32     'query|mutation=s'      => \$query,
  33     'variables|vars|V=s'    => \$variables,
  34     'variable|var|d=s%'     => \$variables,
  35     'operation-name|n=s'    => \$operation_name,
  36     'transport|t=s%'        => \$transport,
  37     'format|f=s'            => \$format,
  38     'unpack!'               => \$unpack,
  39     'output|o=s'            => \$outfile,
  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 if (!$url) {
  57     print STDERR "The <URL> or --url option argument is required.\n";
  58     pod2usage(2);
  59 }
  60
  61 $transport = expand_vars($transport);
  62
  63 if (ref $variables) {
  64     $variables = expand_vars($variables);
  65 }
  66 else {
  67     $variables = JSON::MaybeXS->new->decode($variables);
  68 }
  69
  70 my $client = GraphQL::Client->new(url => $url);
  71
  72 eval { $client->transport };
  73 if (my $err = $@) {
  74     warn $err if $ENV{GRAPHQL_CLIENT_DEBUG};
  75     print STDERR "Could not construct a transport for URL: $url\n";
  76     print STDERR "Is this URL correct?\n";
  77     pod2usage(2);
  78 }
  79
  80 if (!$query || $query eq '-') {
  81     print STDERR "Interactive mode engaged! Waiting for a query on <STDIN>...\n"
  82         if -t STDIN; ## no critic (InputOutput::ProhibitInteractiveTest)
  83     $query = do { local $/; <> };
  84 }
  85
  86 my $resp = $client->execute($query, $variables, $operation_name, $transport);
  87 my $err  = $resp->{errors};
  88 $unpack = 0 if $err;
  89 my $data = $unpack ? $resp->{data} : $resp;
  90
  91 if ($outfile) {
  92     open(my $out, '>', $outfile) or die "Open $outfile failed: $!";
  93     *STDOUT = $out;
  94 }
  95
  96 print_data($data, $format);
  97
  98 exit($unpack && $err ? 1 : 0);
  99
 100 sub print_data {
 101     my ($data, $format) = @_;
 102     $format = lc($format || 'json:pretty');
 103     if ($format eq 'json' || $format eq 'json:pretty') {
 104         my %opts = (canonical => 1, utf8 => 1);
 105         $opts{pretty} = 1 if $format eq 'json:pretty';
 106         print JSON::MaybeXS->new(%opts)->encode($data);
 107     }
 108     elsif ($format eq 'yaml') {
 109         eval { require YAML } or die "Missing dependency: YAML\n";
 110         print YAML::Dump($data);
 111     }
 112     elsif ($format eq 'csv' || $format eq 'tsv' || $format eq 'table') {
 113         my $sep = $format eq 'tsv' ? "\t" : ',';
 114
 115         my $unpacked = $data;
 116         $unpacked = $data->{data} if !$unpack && !$err;
 117
 118         # check the response to see if it can be formatted
 119         my @columns;
 120         my $rows = [];
 121         if (keys %$unpacked == 1) {
 122             my ($val) = values %$unpacked;
 123             if (ref $val eq 'ARRAY') {
 124                 my $first = $val->[0];
 125                 if ($first && ref $first eq 'HASH') {
 126                     @columns = sort keys %$first;
 127                     $rows = [
 128                         map { [@{$_}{@columns}] } @$val
 129                     ];
 130                 }
 131                 elsif ($first) {
 132                     @columns = keys %$unpacked;
 133                     $rows = [map { [$_] } @$val];
 134                 }
 135             }
 136         }
 137
 138         if (@columns) {
 139             if ($format eq 'table') {
 140                 eval { require Text::Table::Any } or die "Missing dependency: Text::Table::Any\n";
 141                 my $table = Text::Table::Any::table(
 142                     header_row  => 1,
 143                     rows        => [[@columns], @$rows],
 144                     backend     => $ENV{PERL_TEXT_TABLE},
 145                 );
 146                 print $table;
 147             }
 148             else {
 149                 eval { require Text::CSV } or die "Missing dependency: Text::CSV\n";
 150                 my $csv = Text::CSV->new({binary => 1, sep => $sep, eol => $/});
 151                 $csv->print(*STDOUT, [@columns]);
 152                 for my $row (@$rows) {
 153                     $csv->print(*STDOUT, $row);
 154                 }
 155             }
 156         }
 157         else {
 158             print_data($data);
 159             print STDERR sprintf("Error: Response could not be formatted as %s.\n", uc($format));
 160             exit 3;
 161         }
 162     }
 163     elsif ($format eq 'perl') {
 164         eval { require Data::Dumper } or die "Missing dependency: Data::Dumper\n";
 165         print Data::Dumper::Dumper($data);
 166     }
 167     else {
 168         print STDERR "Error: Format not supported: $format\n";
 169         print_data($data);
 170         exit 3;
 171     }
 172 }
 173
 174 sub expand_vars {
 175     my $vars = shift;
 176
 177     my %out;
 178     while (my ($key, $value) = each %$vars) {
 179         my $var = $value;
 180         my @segments = split(/\./, $key);
 181         for my $segment (reverse @segments) {
 182             my $saved = $var;
 183             if ($segment =~ /^(\d+)$/) {
 184                 $var = [];
 185                 $var->[$segment] = $saved;
 186             }
 187             else {
 188                 $var = {};
 189                 $var->{$segment} = $saved;
 190             }
 191         }
 192         %out = (%out, %$var);
 193     }
 194
 195     return \%out;
 196 }
 197
 198 sub pod2usage {
 199     eval { require Pod::Usage };
 200     if ($@) {
 201         my $ref  = $VERSION eq '999.999' ? 'master' : "v$VERSION";
 202         my $exit = (@_ == 1 && $_[0] =~ /^\d+$/ && $_[0]) //
 203                    (@_ % 2 == 0 && {@_}->{'-exitval'})    // 2;
 204         print STDERR <<END;
 205 Online documentation is available at:
 206
 207   https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
 208
 209 Tip: To enable inline documentation, install the Pod::Usage module.
 210
 211 END
 212         exit $exit;
 213     }
 214     else {
 215         goto &Pod::Usage::pod2usage;
 216     }
 217 }
 218
 219 __END__
 220
 221 =pod
 222
 223 =encoding UTF-8
 224
 225 =head1 NAME
 226
 227 graphql - Command-line GraphQL client
 228
 229 =head1 VERSION
 230
 231 version 0.600
 232
 233 =head1 SYNOPSIS
 234
 235     graphql <URL> <QUERY> [ [--variables JSON] | [--variable KEY=VALUE]... ]
 236             [--operation-name NAME] [--transport KEY=VALUE]...
 237             [--[no-]unpack] [--format json|json:pretty|yaml|perl|csv|tsv|table]
 238             [--output FILE]
 239
 240     graphql --version|--help|--manual
 241
 242 =head1 DESCRIPTION
 243
 244 C<graphql> is a command-line program for executing queries and mutations on
 245 a L<GraphQL|https://graphql.org/> server.
 246
 247 =head1 INSTALL
 248
 249 There are several ways to install F<graphql> to your system.
 250
 251 =head2 from CPAN
 252
 253 You can install F<graphql> using L<cpanm>:
 254
 255     cpanm GraphQL::Client
 256
 257 =head2 from GitHub
 258
 259 You can also choose to download F<graphql> as a self-contained executable:
 260
 261     curl -OL https://raw.githubusercontent.com/chazmcgarvey/graphql-client/solo/graphql
 262     chmod +x graphql
 263
 264 To hack on the code, clone the repo instead:
 265
 266     git clone https://github.com/chazmcgarvey/graphql-client.git
 267     cd graphql-client
 268     make bootstrap      # installs dependencies; requires cpanm
 269
 270 =head1 OPTIONS
 271
 272 =head2 C<--url URL>
 273
 274 The URL of the GraphQL server endpoint.
 275
 276 If no C<--url> option is given, the first argument is assumed to be the URL.
 277
 278 This option is required.
 279
 280 Alias: C<-u>
 281
 282 =head2 C<--query STR>
 283
 284 The query or mutation to execute.
 285
 286 If no C<--query> option is given, the next argument (after URL) is assumed to be the query.
 287
 288 If the value is "-" (which is the default), the query will be read from C<STDIN>.
 289
 290 See: L<https://graphql.org/learn/queries/>
 291
 292 Alias: C<--mutation>
 293
 294 =head2 C<--variables JSON>
 295
 296 Provide the variables as a JSON object.
 297
 298 Aliases: C<--vars>, C<-V>
 299
 300 =head2 C<--variable KEY=VALUE>
 301
 302 An alternative way to provide variables. Repeat this option to provide multiple variables.
 303
 304 If used in combination with L</"--variables JSON">, this option is silently ignored.
 305
 306 See: L<https://graphql.org/learn/queries/#variables>
 307
 308 Aliases: C<--var>, C<-d>
 309
 310 =head2 C<--operation-name NAME>
 311
 312 Inform the server which query/mutation to execute.
 313
 314 Alias: C<-n>
 315
 316 =head2 C<--output FILE>
 317
 318 Write the response to a file instead of STDOUT.
 319
 320 Alias: C<-o>
 321
 322 =head2 C<--transport KEY=VALUE>
 323
 324 Key-value pairs for configuring the transport (usually HTTP).
 325
 326 Alias: C<-t>
 327
 328 =head2 C<--format STR>
 329
 330 Specify the output format to use. See L</FORMAT>.
 331
 332 Alias: C<-f>
 333
 334 =head2 C<--unpack>
 335
 336 Enables unpack mode.
 337
 338 By default, the response structure is printed as-is from the server, and the program exits 0.
 339
 340 When unpack mode is enabled, if the response completes with no errors, only the data section of
 341 the response is printed and the program exits 0. If the response has errors, the whole response
 342 structure is printed as-is and the program exits 1.
 343
 344 See L</EXAMPLES>.
 345
 346 =head1 FORMAT
 347
 348 The argument for L</"--format STR"> can be one of:
 349
 350 =over 4
 351
 352 =item *
 353
 354 C<csv> - Comma-separated values (requires L<Text::CSV>)
 355
 356 =item *
 357
 358 C<json:pretty> - Human-readable JSON (default)
 359
 360 =item *
 361
 362 C<json> - JSON
 363
 364 =item *
 365
 366 C<perl> - Perl code (requires L<Data::Dumper>)
 367
 368 =item *
 369
 370 C<table> - Table (requires L<Text::Table::Any>)
 371
 372 =item *
 373
 374 C<tsv> - Tab-separated values (requires L<Text::CSV>)
 375
 376 =item *
 377
 378 C<yaml> - YAML (requires L<YAML>)
 379
 380 =back
 381
 382 The C<csv>, C<tsv>, and C<table> formats will only work if the response has a particular shape:
 383
 384     {
 385         "data" : {
 386             "onefield" : [
 387                 {
 388                     "key" : "value",
 389                     ...
 390                 },
 391                 ...
 392             ]
 393         }
 394     }
 395
 396 or
 397
 398     {
 399         "data" : {
 400             "onefield" : [
 401                 "value",
 402                 ...
 403             ]
 404         }
 405     }
 406
 407 If the response cannot be formatted, the default format will be used instead, an error message will
 408 be printed to STDERR, and the program will exit 3.
 409
 410 Table formatting can be done by one of several different modules, each with its own features and
 411 bugs. The default module is L<Text::Table::Tiny>, but this can be overridden using the
 412 C<PERL_TEXT_TABLE> environment variable if desired, like this:
 413
 414     PERL_TEXT_TABLE=Text::Table::HTML graphql ... -f table
 415
 416 The list of supported modules is at L<Text::Table::Any/@BACKENDS>.
 417
 418 =head1 EXAMPLES
 419
 420 Different ways to provide the query/mutation to execute:
 421
 422     graphql http://myserver/graphql {hello}
 423
 424     echo {hello} | graphql http://myserver/graphql
 425
 426     graphql http://myserver/graphql <<END
 427     > {hello}
 428     > END
 429
 430     graphql http://myserver/graphql
 431     Interactive mode engaged! Waiting for a query on <STDIN>...
 432     {hello}
 433     ^D
 434
 435 Execute a query with variables:
 436
 437     graphql http://myserver/graphql <<END --var episode=JEDI
 438     > query HeroNameAndFriends($episode: Episode) {
 439     >   hero(episode: $episode) {
 440     >     name
 441     >     friends {
 442     >       name
 443     >     }
 444     >   }
 445     > }
 446     > END
 447
 448     graphql http://myserver/graphql --vars '{"episode":"JEDI"}'
 449
 450 Configure the transport:
 451
 452     graphql http://myserver/graphql {hello} -t headers.authorization='Basic s3cr3t'
 453
 454 This example shows the effect of L</--unpack>:
 455
 456     graphql http://myserver/graphql {hello}
 457
 458     # Output:
 459     {
 460         "data" : {
 461             "hello" : "Hello world!"
 462         }
 463     }
 464
 465     graphql http://myserver/graphql {hello} --unpack
 466
 467     # Output:
 468     {
 469         "hello" : "Hello world!"
 470     }
 471
 472 =head1 ENVIRONMENT
 473
 474 Some environment variables affect the way C<graphql> behaves:
 475
 476 =over 4
 477
 478 =item *
 479
 480 C<GRAPHQL_CLIENT_DEBUG> - Set to 1 to print diagnostic messages to STDERR.
 481
 482 =item *
 483
 484 C<GRAPHQL_CLIENT_HTTP_USER_AGENT> - Set the HTTP user agent string.
 485
 486 =item *
 487
 488 C<PERL_TEXT_TABLE> - Set table format backend; see L</FORMAT>.
 489
 490 =back
 491
 492 =head1 EXIT STATUS
 493
 494 Here is a consolidated summary of what exit statuses mean:
 495
 496 =over 4
 497
 498 =item *
 499
 500 C<0> - Success
 501
 502 =item *
 503
 504 C<1> - Client or server errors
 505
 506 =item *
 507
 508 C<2> - Option usage is wrong
 509
 510 =item *
 511
 512 C<3> - Could not format the response as requested
 513
 514 =back
 515
 516 =head1 BUGS
 517
 518 Please report any bugs or feature requests on the bugtracker website
 519 L<https://github.com/chazmcgarvey/graphql-client/issues>
 520
 521 When submitting a bug or request, please include a test-file or a
 522 patch to an existing test-file that illustrates the bug or desired
 523 feature.
 524
 525 =head1 AUTHOR
 526
 527 Charles McGarvey <chazmcgarvey@brokenzipper.com>
 528
 529 =head1 COPYRIGHT AND LICENSE
 530
 531 This software is copyright (c) 2020 by Charles McGarvey.
 532
 533 This is free software; you can redistribute it and/or modify it under
 534 the same terms as the Perl 5 programming language system itself.
 535
 536 =cut