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
 142     if (ref $options{variables}) {
 143         $options{variables} = eval { _expand_vars($options{variables}) };
 144         die "Two or more --variable keys are incompatible.\n" if $@;
 145     }
 146     elsif ($options{variables}) {
 147         $options{variables} = eval { $JSON->decode($options{variables}) };
 148         die "The --variables JSON does not parse.\n" if $@;
 149     }
 150
 151     return \%options;
 152 }
 153
 154 sub _stringify {
 155     my ($item) = @_;
 156     if (ref($item) eq 'ARRAY') {
 157         my $first = @$item && $item->[0];
 158         return join(',', @$item) if !ref($first);
 159         return join(',', map { $JSON->encode($_) } @$item);
 160     }
 161     return $JSON->encode($item) if ref($item) eq 'HASH';
 162     return $item;
 163 }
 164
 165 sub _print_data {
 166     my ($data, $format) = @_;
 167     $format = lc($format || 'json:pretty');
 168     if ($format eq 'json' || $format eq 'json:pretty') {
 169         my %opts = (allow_nonref => 1, canonical => 1);
 170         $opts{pretty} = 1 if $format eq 'json:pretty';
 171         print JSON::MaybeXS->new(%opts)->encode($data);
 172     }
 173     elsif ($format eq 'yaml') {
 174         eval { require YAML } or die "Missing dependency: YAML\n";
 175         print YAML::Dump($data);
 176     }
 177     elsif ($format eq 'csv' || $format eq 'tsv' || $format eq 'table') {
 178         my $sep = $format eq 'tsv' ? "\t" : ',';
 179
 180         my $unpacked = $data;
 181         # $unpacked = $data->{data} if !$unpack && !$err;
 182         $unpacked = $data->{data} if ref $data eq 'HASH' && $data->{data};
 183
 184         # check the response to see if it can be formatted
 185         my @columns;
 186         my $rows = [];
 187         if (ref $unpacked eq 'HASH') {
 188             if (keys %$unpacked == 1) {
 189                 my ($val) = values %$unpacked;
 190                 if (ref $val eq 'ARRAY') {
 191                     my $first = $val->[0];
 192                     if ($first && ref $first eq 'HASH') {
 193                         @columns = sort keys %$first;
 194                         $rows = [
 195                             map { [map { _stringify($_) } @{$_}{@columns}] } @$val
 196                         ];
 197                     }
 198                     elsif ($first) {
 199                         @columns = keys %$unpacked;
 200                         $rows = [map { [map { _stringify($_) } $_] } @$val];
 201                     }
 202                 }
 203             }
 204         }
 205         elsif (ref $unpacked eq 'ARRAY') {
 206             my $first = $unpacked->[0];
 207             if ($first && ref $first eq 'HASH') {
 208                 @columns = sort keys %$first;
 209                 $rows = [
 210                     map { [map { _stringify($_) } @{$_}{@columns}] } @$unpacked
 211                 ];
 212             }
 213             elsif ($first) {
 214                 @columns = qw(column);
 215                 $rows = [map { [map { _stringify($_) } $_] } @$unpacked];
 216             }
 217         }
 218
 219         if (@columns) {
 220             if ($format eq 'table') {
 221                 eval { require Text::Table::Any } or die "Missing dependency: Text::Table::Any\n";
 222                 my $table = Text::Table::Any::table(
 223                     header_row  => 1,
 224                     rows        => [[@columns], @$rows],
 225                     backend     => $ENV{PERL_TEXT_TABLE},
 226                 );
 227                 print $table;
 228             }
 229             else {
 230                 eval { require Text::CSV } or die "Missing dependency: Text::CSV\n";
 231                 my $csv = Text::CSV->new({binary => 1, sep => $sep, eol => $/});
 232                 $csv->print(*STDOUT, [@columns]);
 233                 for my $row (@$rows) {
 234                     $csv->print(*STDOUT, $row);
 235                 }
 236             }
 237         }
 238         else {
 239             _print_data($data);
 240             print STDERR sprintf("Error: Response could not be formatted as %s.\n", uc($format));
 241             exit 3;
 242         }
 243     }
 244     elsif ($format eq 'string') {
 245         if (!ref $data) {
 246             print $data, "\n";
 247         }
 248         elsif (ref $data eq 'ARRAY') {
 249             print join("\n", @$data);
 250         }
 251         else {
 252             _print_data($data);
 253             print STDERR sprintf("Error: Response could not be formatted as %s.\n", $format);
 254             exit 3;
 255         }
 256     }
 257     elsif ($format eq 'perl') {
 258         eval { require Data::Dumper } or die "Missing dependency: Data::Dumper\n";
 259         print Data::Dumper::Dumper($data);
 260     }
 261     else {
 262         _print_data($data);
 263         print STDERR "Error: Format not supported: $format\n";
 264         exit 3;
 265     }
 266 }
 267
 268 sub _parse_path {
 269     my $path = shift;
 270
 271     my @path;
 272
 273     my @segments = map { split(/\./, $_) } split(/(\[[^\.\]]+\])\.?/, $path);
 274     for my $segment (@segments) {
 275         if ($segment =~ /\[([^\.\]]+)\]/) {
 276             $path[-1]{type} = 'ARRAY' if @path;
 277             push @path, {
 278                 name  => $1,
 279                 index => 1,
 280             };
 281         }
 282         else {
 283             $path[-1]{type} = 'HASH' if @path;
 284             push @path, {
 285                 name => $segment,
 286             };
 287         }
 288     }
 289
 290     return \@path;
 291 }
 292
 293 sub _expand_vars {
 294     my $vars = shift;
 295
 296     my $root = {};
 297
 298     while (my ($key, $value) = each %$vars) {
 299         my $parsed_path = _parse_path($key);
 300
 301         my $curr = $root;
 302         for my $segment (@$parsed_path) {
 303             my $name = $segment->{name};
 304             my $type = $segment->{type} || '';
 305             my $next = $type eq 'HASH' ? {} : $type eq 'ARRAY' ? [] : $value;
 306             if (ref $curr eq 'HASH') {
 307                 _croak 'Conflicting keys' if $segment->{index};
 308                 if (defined $curr->{$name}) {
 309                     _croak 'Conflicting keys' if $type ne ref $curr->{$name};
 310                     $next = $curr->{$name};
 311                 }
 312                 else {
 313                     $curr->{$name} = $next;
 314                 }
 315             }
 316             elsif (ref $curr eq 'ARRAY') {
 317                 _croak 'Conflicting keys' if !$segment->{index};
 318                 if (defined $curr->[$name]) {
 319                     _croak 'Conflicting keys' if $type ne ref $curr->[$name];
 320                     $next = $curr->[$name];
 321                 }
 322                 else {
 323                     $curr->[$name] = $next;
 324                 }
 325             }
 326             else {
 327                 _croak 'Conflicting keys';
 328             }
 329             $curr = $next;
 330         }
 331     }
 332
 333     return $root;
 334 }
 335
 336 sub _pod2usage {
 337     eval { require Pod::Usage };
 338     if ($@) {
 339         my $ref  = $VERSION eq '999.999' ? 'master' : "v$VERSION";
 340         my $exit = (@_ == 1 && $_[0] =~ /^\d+$/ && $_[0]) //
 341                    (@_ % 2 == 0 && {@_}->{'-exitval'})    // 2;
 342         print STDERR <<END;
 343 Online documentation is available at:
 344
 345   https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
 346
 347 Tip: To enable inline documentation, install the Pod::Usage module.
 348
 349 END
 350         exit $exit;
 351     }
 352     else {
 353         goto &Pod::Usage::pod2usage;
 354     }
 355 }
 356
 357 1;
 358 __END__
 359
 360 =head1 DESCRIPTION
 361
 362 This is the actual implementation of L<graphql>.
 363
 364 The interface is B<EXPERIMENTAL>. Don't rely on it.
 365
 366 =method new
 367
 368 Construct a new CLI.
 369
 370 =method main
 371
 372 Run the script.