Dogcows Code - chaz/graphql-client/blob - lib/GraphQL/Client/CLI.pm

   1 package GraphQL::Client::CLI;
   2 # ABSTRACT: Implementation of the graphql CLI program
   3
   4 use warnings;
   5 use strict;
   6
   7 use Encode qw(decode);
   8 use Getopt::Long 2.39 qw(GetOptionsFromArray);
   9 use GraphQL::Client;
  10 use JSON::MaybeXS;
  11 use Text::ParseWords;
  12 use namespace::clean;
  13
  14 our $VERSION = '999.999'; # VERSION
  15
  16 my $JSON = JSON::MaybeXS->new(canonical => 1);
  17
  18 sub _croak { require Carp; goto &Carp::croak }
  19
  20 sub new {
  21     my $class = shift;
  22     bless {}, $class;
  23 }
  24
  25 sub main {
  26     my $self = shift;
  27     $self = $self->new if !ref $self;
  28
  29     my $options = eval { $self->_get_options(@_) };
  30     if (my $err = $@) {
  31         print STDERR $err;
  32         _pod2usage(2);
  33     }
  34
  35     if ($options->{version}) {
  36         print "graphql $VERSION\n";
  37         exit 0;
  38     }
  39     if ($options->{help}) {
  40         _pod2usage(-exitval => 0, -verbose => 99, -sections => [qw(NAME SYNOPSIS OPTIONS)]);
  41     }
  42     if ($options->{manual}) {
  43         _pod2usage(-exitval => 0, -verbose => 2);
  44     }
  45
  46     my $url = $options->{url};
  47     if (!$url) {
  48         print STDERR "The <URL> or --url option argument is required.\n";
  49         _pod2usage(2);
  50     }
  51
  52     my $variables = $options->{variables};
  53     my $query = $options->{query};
  54     my $operation_name = $options->{operation_name};
  55     my $unpack = $options->{unpack};
  56     my $outfile = $options->{outfile};
  57     my $format = $options->{format};
  58     my $transport = $options->{transport};
  59
  60     my $client = GraphQL::Client->new(url => $url);
  61
  62     eval { $client->transport };
  63     if (my $err = $@) {
  64         warn $err if $ENV{GRAPHQL_CLIENT_DEBUG};
  65         print STDERR "Could not construct a transport for URL: $url\n";
  66         print STDERR "Is this URL correct?\n";
  67         _pod2usage(2);
  68     }
  69
  70     if ($query eq '-') {
  71         print STDERR "Interactive mode engaged! Waiting for a query on <STDIN>...\n"
  72             if -t STDIN; ## no critic (InputOutput::ProhibitInteractiveTest)
  73         binmode(STDIN, 'encoding(UTF-8)');
  74         $query = do { local $/; <STDIN> };
  75     }
  76
  77     my $resp = $client->execute($query, $variables, $operation_name, $transport);
  78     my $err  = $resp->{errors};
  79     $unpack = 0 if $err;
  80     my $data = $unpack ? $resp->{data} : $resp;
  81
  82     if ($outfile) {
  83         open(my $out, '>', $outfile) or die "Open $outfile failed: $!";
  84         *STDOUT = $out;
  85     }
  86
  87     if (my $filter = $options->{filter}) {
  88         eval { require JSON::Path::Evaluator } or die "Missing dependency: JSON::Path\n";
  89         my @values = JSON::Path::Evaluator::evaluate_jsonpath($data, $filter);
  90         if (@values == 1) {
  91             $data = $values[0];
  92         }
  93         else {
  94             $data = \@values;
  95         }
  96     }
  97
  98     binmode(STDOUT, 'encoding(UTF-8)');
  99     _print_data($data, $format);
 100
 101     exit($unpack && $err ? 1 : 0);
 102 }
 103
 104 sub _get_options {
 105     my $self = shift;
 106     my @args = @_;
 107
 108     unshift @args, shellwords($ENV{GRAPHQL_CLIENT_OPTIONS} || '');
 109
 110     # assume UTF-8 args if non-ASCII
 111     @args = map { decode('UTF-8', $_) } @args if grep { /\P{ASCII}/ } @args;
 112
 113     my %options = (
 114         format  => 'json:pretty',
 115         unpack  => 0,
 116     );
 117
 118     GetOptionsFromArray(\@args,
 119         'version'               => \$options{version},
 120         'help|h|?'              => \$options{help},
 121         'manual|man'            => \$options{manual},
 122         'url|u=s'               => \$options{url},
 123         'query|mutation=s'      => \$options{query},
 124         'variables|vars|V=s'    => \$options{variables},
 125         'variable|var|d=s%'     => \$options{variables},
 126         'operation-name|n=s'    => \$options{operation_name},
 127         'transport|t=s%'        => \$options{transport},
 128         'format|f=s'            => \$options{format},
 129         'filter|p=s'            => \$options{filter},
 130         'unpack!'               => \$options{unpack},
 131         'output|o=s'            => \$options{outfile},
 132     ) or _pod2usage(2);
 133
 134     $options{url}   = shift @args if !$options{url};
 135     $options{query} = shift @args if !$options{query};
 136
 137     $options{query} ||= '-';
 138
 139     my $transport = eval { _expand_vars($options{transport}) };
 140     die "Two or more --transport keys are incompatible.\n" if $@;
 141     $options{transport} = $transport if ref $transport eq 'HASH' && %$transport;
 142
 143     if (ref $options{variables}) {
 144         $options{variables} = eval { _expand_vars($options{variables}) };
 145         die "Two or more --variable keys are incompatible.\n" if $@;
 146     }
 147     elsif ($options{variables}) {
 148         $options{variables} = eval { $JSON->decode($options{variables}) };
 149         die "The --variables JSON does not parse.\n" if $@;
 150     }
 151
 152     return \%options;
 153 }
 154
 155 sub _stringify {
 156     my ($item) = @_;
 157     if (ref($item) eq 'ARRAY') {
 158         my $first = @$item && $item->[0];
 159         return join(',', @$item) if !ref($first);
 160         return join(',', map { $JSON->encode($_) } @$item);
 161     }
 162     return $JSON->encode($item) if ref($item) eq 'HASH';
 163     return $item;
 164 }
 165
 166 sub _print_data {
 167     my ($data, $format) = @_;
 168     $format = lc($format || 'json:pretty');
 169     if ($format eq 'json' || $format eq 'json:pretty') {
 170         my %opts = (allow_nonref => 1, canonical => 1);
 171         $opts{pretty} = 1 if $format eq 'json:pretty';
 172         print JSON::MaybeXS->new(%opts)->encode($data);
 173     }
 174     elsif ($format eq 'yaml') {
 175         eval { require YAML } or die "Missing dependency: YAML\n";
 176         print YAML::Dump($data);
 177     }
 178     elsif ($format eq 'csv' || $format eq 'tsv' || $format eq 'table') {
 179         my $sep = $format eq 'tsv' ? "\t" : ',';
 180
 181         my $unpacked = $data;
 182         # $unpacked = $data->{data} if !$unpack && !$err;
 183         $unpacked = $data->{data} if ref $data eq 'HASH' && $data->{data};
 184
 185         # check the response to see if it can be formatted
 186         my @columns;
 187         my $rows = [];
 188         if (ref $unpacked eq 'HASH') {
 189             if (keys %$unpacked == 1) {
 190                 my ($val) = values %$unpacked;
 191                 if (ref $val eq 'ARRAY') {
 192                     my $first = $val->[0];
 193                     if ($first && ref $first eq 'HASH') {
 194                         @columns = sort keys %$first;
 195                         $rows = [
 196                             map { [map { _stringify($_) } @{$_}{@columns}] } @$val
 197                         ];
 198                     }
 199                     elsif ($first) {
 200                         @columns = keys %$unpacked;
 201                         $rows = [map { [map { _stringify($_) } $_] } @$val];
 202                     }
 203                 }
 204             }
 205         }
 206         elsif (ref $unpacked eq 'ARRAY') {
 207             my $first = $unpacked->[0];
 208             if ($first && ref $first eq 'HASH') {
 209                 @columns = sort keys %$first;
 210                 $rows = [
 211                     map { [map { _stringify($_) } @{$_}{@columns}] } @$unpacked
 212                 ];
 213             }
 214             elsif ($first) {
 215                 @columns = qw(column);
 216                 $rows = [map { [map { _stringify($_) } $_] } @$unpacked];
 217             }
 218         }
 219
 220         if (@columns) {
 221             if ($format eq 'table') {
 222                 eval { require Text::Table::Any } or die "Missing dependency: Text::Table::Any\n";
 223                 my $table = Text::Table::Any::table(
 224                     header_row  => 1,
 225                     rows        => [[@columns], @$rows],
 226                     backend     => $ENV{PERL_TEXT_TABLE},
 227                 );
 228                 print $table;
 229             }
 230             else {
 231                 eval { require Text::CSV } or die "Missing dependency: Text::CSV\n";
 232                 my $csv = Text::CSV->new({binary => 1, sep => $sep, eol => $/});
 233                 $csv->print(*STDOUT, [@columns]);
 234                 for my $row (@$rows) {
 235                     $csv->print(*STDOUT, $row);
 236                 }
 237             }
 238         }
 239         else {
 240             _print_data($data);
 241             print STDERR sprintf("Error: Response could not be formatted as %s.\n", uc($format));
 242             exit 3;
 243         }
 244     }
 245     elsif ($format eq 'string') {
 246         if (!ref $data) {
 247             print $data, "\n";
 248         }
 249         elsif (ref $data eq 'ARRAY') {
 250             print join("\n", @$data);
 251         }
 252         else {
 253             _print_data($data);
 254             print STDERR sprintf("Error: Response could not be formatted as %s.\n", $format);
 255             exit 3;
 256         }
 257     }
 258     elsif ($format eq 'perl') {
 259         eval { require Data::Dumper } or die "Missing dependency: Data::Dumper\n";
 260         print Data::Dumper::Dumper($data);
 261     }
 262     else {
 263         _print_data($data);
 264         print STDERR "Error: Format not supported: $format\n";
 265         exit 3;
 266     }
 267 }
 268
 269 sub _parse_path {
 270     my $path = shift;
 271
 272     my @path;
 273
 274     my @segments = map { split(/\./, $_) } split(/(\[[^\.\]]+\])\.?/, $path);
 275     for my $segment (@segments) {
 276         if ($segment =~ /\[([^\.\]]+)\]/) {
 277             $path[-1]{type} = 'ARRAY' if @path;
 278             push @path, {
 279                 name  => $1,
 280                 index => 1,
 281             };
 282         }
 283         else {
 284             $path[-1]{type} = 'HASH' if @path;
 285             push @path, {
 286                 name => $segment,
 287             };
 288         }
 289     }
 290
 291     return \@path;
 292 }
 293
 294 sub _expand_vars {
 295     my $vars = shift;
 296
 297     my $root = {};
 298
 299     while (my ($key, $value) = each %$vars) {
 300         my $parsed_path = _parse_path($key);
 301
 302         my $curr = $root;
 303         for my $segment (@$parsed_path) {
 304             my $name = $segment->{name};
 305             my $type = $segment->{type} || '';
 306             my $next = $type eq 'HASH' ? {} : $type eq 'ARRAY' ? [] : $value;
 307             if (ref $curr eq 'HASH') {
 308                 _croak 'Conflicting keys' if $segment->{index};
 309                 if (defined $curr->{$name}) {
 310                     _croak 'Conflicting keys' if $type ne ref $curr->{$name};
 311                     $next = $curr->{$name};
 312                 }
 313                 else {
 314                     $curr->{$name} = $next;
 315                 }
 316             }
 317             elsif (ref $curr eq 'ARRAY') {
 318                 _croak 'Conflicting keys' if !$segment->{index};
 319                 if (defined $curr->[$name]) {
 320                     _croak 'Conflicting keys' if $type ne ref $curr->[$name];
 321                     $next = $curr->[$name];
 322                 }
 323                 else {
 324                     $curr->[$name] = $next;
 325                 }
 326             }
 327             else {
 328                 _croak 'Conflicting keys';
 329             }
 330             $curr = $next;
 331         }
 332     }
 333
 334     return $root;
 335 }
 336
 337 sub _pod2usage {
 338     eval { require Pod::Usage };
 339     if ($@) {
 340         my $ref  = $VERSION eq '999.999' ? 'master' : "v$VERSION";
 341         my $exit = (@_ == 1 && $_[0] =~ /^\d+$/ && $_[0]) //
 342                    (@_ % 2 == 0 && {@_}->{'-exitval'})    // 2;
 343         print STDERR <<END;
 344 Online documentation is available at:
 345
 346   https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
 347
 348 Tip: To enable inline documentation, install the Pod::Usage module.
 349
 350 END
 351         exit $exit;
 352     }
 353     else {
 354         goto &Pod::Usage::pod2usage;
 355     }
 356 }
 357
 358 1;
 359 __END__
 360
 361 =head1 DESCRIPTION
 362
 363 This is the actual implementation of L<graphql>.
 364
 365 The interface is B<EXPERIMENTAL>. Don't rely on it.
 366
 367 =method new
 368
 369 Construct a new CLI.
 370
 371 =method main
 372
 373 Run the script.