From: Charles McGarvey Date: Wed, 18 Mar 2020 00:29:08 +0000 (-0600) Subject: Release 0.602 X-Git-Tag: solo-0.602^0 X-Git-Url: https://git.dogcows.com/gitweb?a=commitdiff_plain;h=5a60339982e6233eed810a7d120e7e74642006ea;p=chaz%2Fgraphql-client Release 0.602 --- diff --git a/README b/README index ae64d68..8d89255 100644 --- a/README +++ b/README @@ -1,188 +1,270 @@ NAME - GraphQL::Client - A GraphQL client + graphql - Command-line GraphQL client VERSION - version 0.601 + version 0.602 SYNOPSIS - my $graphql = GraphQL::Client->new(url => 'http://localhost:4000/graphql'); + graphql [ [--variables JSON] | [--variable KEY=VALUE]... ] + [--operation-name NAME] [--transport KEY=VALUE]... + [--[no-]unpack] [--format json|json:pretty|yaml|perl|csv|tsv|table] + [--output FILE] - # Example: Hello world! - - my $response = $graphql->execute('{hello}'); - - # Example: Kitchen sink - - my $query = q[ - query GetHuman { - human(id: $human_id) { - name - height - } - } - ]; - my $variables = { - human_id => 1000, - }; - my $operation_name = 'GetHuman'; - my $transport_options = { - headers => { - authorization => 'Bearer s3cr3t', - }, - }; - my $response = $graphql->execute($query, $variables, $operation_name, $transport_options); - - # Example: Asynchronous with Mojo::UserAgent (promisify requires Future::Mojo) - - my $ua = Mojo::UserAgent->new; - my $graphql = GraphQL::Client->new(ua => $ua, url => 'http://localhost:4000/graphql'); - - my $future = $graphql->execute('{hello}'); - - $future->promisify->then(sub { - my $response = shift; - ... - }); + graphql --version|--help|--manual DESCRIPTION - GraphQL::Client provides a simple way to execute GraphQL - queries and mutations on a server. + graphql is a command-line program for executing queries and mutations + on a GraphQL server. - This module is the programmatic interface. There is also a "CLI - program". +INSTALL - GraphQL servers are usually served over HTTP. The provided transport, - GraphQL::Client::http, lets you plug in your own user agent, so this - client works naturally with HTTP::Tiny, Mojo::UserAgent, and more. You - can also use HTTP::AnyUA middleware. + There are several ways to install graphql to your system. -ATTRIBUTES + from CPAN - url + You can install graphql using cpanm: - The URL of a GraphQL endpoint, e.g. "http://myapiserver/graphql". + cpanm GraphQL::Client - unpack + from GitHub - Whether or not to "unpack" the response, which enables a different - style for error-handling. + You can also choose to download graphql as a self-contained executable: - Default is 0. + curl -OL https://raw.githubusercontent.com/chazmcgarvey/graphql-client/solo/graphql + chmod +x graphql - See "ERROR HANDLING". + To hack on the code, clone the repo instead: - transport_class + git clone https://github.com/chazmcgarvey/graphql-client.git + cd graphql-client + make bootstrap # installs dependencies; requires cpanm - The package name of a transport. +OPTIONS - This is optional if the correct transport can be correctly determined - from the "url". + --url URL - transport + The URL of the GraphQL server endpoint. - The transport object. + If no --url option is given, the first argument is assumed to be the + URL. - By default this is automatically constructed based on "transport_class" - or "url". + This option is required. -METHODS + Alias: -u - new + --query STR - $graphql = GraphQL::Client->new(%attributes); + The query or mutation to execute. - Construct a new client. + If no --query option is given, the next argument (after URL) is assumed + to be the query. - execute + If the value is "-" (which is the default), the query will be read from + STDIN. - $response = $graphql->execute($query); - $response = $graphql->execute($query, \%variables); - $response = $graphql->execute($query, \%variables, $operation_name); - $response = $graphql->execute($query, \%variables, $operation_name, \%transport_options); - $response = $graphql->execute($query, \%variables, \%transport_options); + See: https://graphql.org/learn/queries/ - Execute a request on a GraphQL server, and get a response. + Alias: --mutation - By default, the response will either be a hashref with the following - structure or a Future that resolves to such a hashref, depending on the - transport and how it is configured. + --variables JSON - { - data => { - field1 => {...}, # or [...] - ... - }, - errors => [ - { message => 'some error message blah blah blah' }, - ... - ], - } + Provide the variables as a JSON object. - Note: Setting the "unpack" attribute affects the response shape. + Aliases: --vars, -V -ERROR HANDLING + --variable KEY=VALUE - There are two different styles for handling errors. + An alternative way to provide variables one at a time. This option can + be repeated to provide multiple variables. - If "unpack" is 0 (off, the default), every response -- whether success - or failure -- is enveloped like this: + If used in combination with "--variables JSON", this option is silently + ignored. - { - data => {...}, - errors => [...], - } + See: https://graphql.org/learn/queries/#variables + + Aliases: --var, -d + + --operation-name NAME + + Inform the server which query/mutation to execute. + + Alias: -n + + --output FILE + + Write the response to a file instead of STDOUT. + + Alias: -o + + --transport KEY=VALUE + + Key-value pairs for configuring the transport (usually HTTP). + + Alias: -t + + --format STR + + Specify the output format to use. See "FORMAT". + + Alias: -f + + --unpack + + Enables unpack mode. + + By default, the response structure is printed as-is from the server, + and the program exits 0. + + When 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. + + See "EXAMPLES". + +FORMAT + + The argument for "--format STR" can be one of: + + * csv - Comma-separated values (requires Text::CSV) + + * json:pretty - Human-readable JSON (default) + + * json - JSON + + * perl - Perl code (requires Data::Dumper) - where data might be missing or undef if errors occurred (though not - necessarily) and errors will be missing if the response completed - without error. + * table - Table (requires Text::Table::Any) - It is up to you to check for errors in the response, so your code might - look like this: + * tsv - Tab-separated values (requires Text::CSV) - my $response = $graphql->execute(...); - if (my $errors = $response->{errors}) { - # handle $errors + * yaml - YAML (requires YAML) + + The csv, tsv, and table formats will only work if the response has a + particular shape: + + { + "data" : { + "onefield" : [ + { + "key" : "value", + ... + }, + ... + ] + } } - else { - my $data = $response->{data}; - # do something with $data + + or + + { + "data" : { + "onefield" : [ + "value", + ... + ] + } } - If unpack is 1 (on), then "execute" will return just the data if there - were no errors, otherwise it will throw an exception. So your code - would instead look like this: + 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 + Text::Table::Tiny, but this can be overridden using the 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 "@BACKENDS" in Text::Table::Any. + +EXAMPLES + + Different ways to provide the query/mutation to execute: + + graphql http://myserver/graphql {hello} + + echo {hello} | graphql http://myserver/graphql + + graphql http://myserver/graphql < {hello} + > END + + graphql http://myserver/graphql + Interactive mode engaged! Waiting for a query on ... + {hello} + ^D + + Execute a query with variables: + + graphql http://myserver/graphql < query HeroNameAndFriends($episode: Episode) { + > hero(episode: $episode) { + > name + > friends { + > name + > } + > } + > } + > END + + graphql http://myserver/graphql --vars '{"episode":"JEDI"}' + + Configure the transport: + + graphql http://myserver/graphql {hello} -t headers.authorization='Basic s3cr3t' + + This example shows the effect of "--unpack": - my $data = eval { $graphql->execute(...) }; - if (my $error = $@) { - my $resp = $error->{response}; - # handle errors + graphql http://myserver/graphql {hello} + + # Output: + { + "data" : { + "hello" : "Hello world!" + } } - else { - # do something with $data + + graphql http://myserver/graphql {hello} --unpack + + # Output: + { + "hello" : "Hello world!" } - Or if you want to handle errors in a different stack frame, your code - is simply this: +ENVIRONMENT - my $data = $graphql->execute(...); - # do something with $data + Some environment variables affect the way graphql behaves: - Both styles map to Future responses intuitively. If unpack is 0, the - response always resolves to the envelope structure. If unpack is 1, - successful responses will resolve to just the data and errors will - fail/reject. + * GRAPHQL_CLIENT_DEBUG - Set to 1 to print diagnostic messages to + STDERR. -SEE ALSO + * GRAPHQL_CLIENT_HTTP_USER_AGENT - Set the HTTP user agent string. + + * GRAPHQL_CLIENT_OPTIONS - Set the default set of options. + + * PERL_TEXT_TABLE - Set table format backend; see "FORMAT". + +EXIT STATUS + + Here is a consolidated summary of what exit statuses mean: - * graphql - CLI program + * 0 - Success - * GraphQL - Perl implementation of a GraphQL server + * 1 - Client or server errors + + * 2 - Option usage is wrong + + * 3 - Could not format the response as requested + +SEE ALSO - * https://graphql.org/ - GraphQL project website + * GraphQL::Client - Programmatic interface BUGS diff --git a/graphql b/graphql index 1d9c919..a290db8 100755 --- a/graphql +++ b/graphql @@ -1,6 +1,7 @@ #!/usr/bin/env perl -# PODNAME: graphql # ABSTRACT: Command-line GraphQL client +# PODNAME: graphql + # This chunk of stuff was generated by App::FatPacker. To find the original @@ -55,16 +56,48 @@ $fatpacked{"Future/Utils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FU package Future::Utils;use strict;use warnings;our$VERSION='0.43';use Exporter 'import';sub export_to_level {my$pkg=shift;local$Exporter::ExportLevel=1 + shift;$pkg->import(@_)}our@EXPORT_OK=qw(call call_with_escape repeat try_repeat try_repeat_until_success repeat_until_success fmap fmap_concat fmap1 fmap_scalar fmap0 fmap_void);use Carp;our@CARP_NOT=qw(Future);use Future;sub call(&) {my ($code)=@_;return Future->call($code)}sub call_with_escape(&) {my ($code)=@_;my$escape_f=Future->new;return Future->wait_any(Future->call($code,$escape_f),$escape_f,)}sub _repeat {my ($code,$return,$trialp,$cond,$sense,$is_try)=@_;my$prev=$$trialp;while(1){my$trial=$$trialp ||= Future->call($code,$prev);$prev=$trial;if(!$trial->is_ready){$return ||= $trial->new;$trial->on_ready(sub {return if $$trialp->is_cancelled;_repeat($code,$return,$trialp,$cond,$sense,$is_try)});return$return}my$stop;if(not eval {$stop=!$cond->($trial)^ $sense;1}){$return ||= $trial->new;$return->fail($@);return$return}if($stop){$return ||= $trial->new;$trial->on_done($return);$trial->on_fail($return);return$return}if(!$is_try and $trial->failure){carp "Using Future::Utils::repeat to retry a failure is deprecated; use try_repeat instead"}undef $$trialp}}sub repeat(&@) {my$code=shift;my%args=@_;defined($args{while})+ defined($args{until})==1 or defined($args{foreach})or defined($args{generate})or croak "Expected one of 'while', 'until', 'foreach' or 'generate'";if($args{foreach}){$args{generate}and croak "Cannot use both 'foreach' and 'generate'";my$array=delete$args{foreach};$args{generate}=sub {@$array ? shift @$array : ()}}if($args{generate}){my$generator=delete$args{generate};my$otherwise=delete$args{otherwise};my$done;my$orig_code=$code;$code=sub {my ($last_trial_f)=@_;my$again=my ($value)=$generator->($last_trial_f);if($again){unshift @_,$value;goto &$orig_code}$done++;if($otherwise){goto &$otherwise}else {return$last_trial_f || Future->done}};if(my$orig_while=delete$args{while}){$args{while}=sub {$orig_while->($_[0])and!$done}}elsif(my$orig_until=delete$args{until}){$args{while}=sub {!$orig_until->($_[0])and!$done}}else {$args{while}=sub {!$done}}}my$future=$args{return};my$trial;$args{while}and $future=_repeat($code,$future,\$trial,$args{while},0,$args{try});$args{until}and $future=_repeat($code,$future,\$trial,$args{until},1,$args{try});$future->on_cancel(sub {$trial->cancel});return$future}sub try_repeat(&@) {&repeat(@_,try=>1)}sub try_repeat_until_success(&@) {my$code=shift;my%args=@_;defined($args{while})or defined($args{until})and croak "Cannot pass 'while' or 'until' to try_repeat_until_success";&try_repeat($code,while=>sub {shift->failure},%args)}*repeat_until_success=\&try_repeat_until_success;sub _fmap_slot {my ($slots,undef,$code,$generator,$collect,$results,$return)=@_;SLOT: while(1){my (undef,$idx)=my@args=@_;unless($slots->[$idx]){my$item;unless(($item)=$generator->()){undef$slots->[$idx];defined and return$return for @$slots;$return ||= Future->new;$return->done(@$results);return$return}my$f=$slots->[$idx]=Future->call($code,local $_=$item);if($collect eq "array"){push @$results,my$r=[];$f->on_done(sub {@$r=@_})}elsif($collect eq "scalar"){push @$results,undef;my$r=\$results->[-1];$f->on_done(sub {$$r=$_[0]})}}my$f=$slots->[$idx];if(!$f->is_ready){$args[-1]=($return ||= $f->new);$f->on_done(sub {_fmap_slot(@args)});$f->on_fail($return);my$i=$idx + 1;while($i!=$idx){$i++;$i %= @$slots;next if defined$slots->[$i];$_[1]=$i;redo SLOT}return$return}if($f->failure){$return ||= $f->new;$return->fail($f->failure);return$return}undef$slots->[$idx]}}sub _fmap {my$code=shift;my%args=@_;my$concurrent=$args{concurrent}|| 1;my@slots;my$results=[];my$future=$args{return};my$generator;if($generator=$args{generate}){}elsif(my$array=$args{foreach}){$generator=sub {return unless @$array;shift @$array}}else {croak "Expected either 'generate' or 'foreach'"}for my$idx (0 .. $concurrent-1){$future=_fmap_slot(\@slots,$idx,$code,$generator,$args{collect},$results,$future);last if$future->is_ready}$future->on_fail(sub {!defined $_ or $_->is_ready or $_->cancel for@slots});$future->on_cancel(sub {!defined $_ or $_->is_ready or $_->cancel for@slots});return$future}sub fmap_concat(&@) {my$code=shift;my%args=@_;_fmap($code,%args,collect=>"array")->then(sub {return Future->done(map {@$_}@_)})}*fmap=\&fmap_concat;sub fmap_scalar(&@) {my$code=shift;my%args=@_;_fmap($code,%args,collect=>"scalar")}*fmap1=\&fmap_scalar;sub fmap_void(&@) {my$code=shift;my%args=@_;_fmap($code,%args,collect=>"void")}*fmap0=\&fmap_void;0x55AA; FUTURE_UTILS +$fatpacked{"Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG'; + use 5.004;use strict;use warnings;package Getopt::Long;use vars qw($VERSION);$VERSION=2.51;use vars qw($VERSION_STRING);$VERSION_STRING="2.51";use Exporter;use vars qw(@ISA @EXPORT @EXPORT_OK);@ISA=qw(Exporter);sub GetOptions(@);sub GetOptionsFromArray(@);sub GetOptionsFromString(@);sub Configure(@);sub HelpMessage(@);sub VersionMessage(@);BEGIN {@EXPORT=qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);@EXPORT_OK=qw(&HelpMessage &VersionMessage &Configure &GetOptionsFromArray &GetOptionsFromString)}use vars@EXPORT,@EXPORT_OK;use vars qw($error $debug $major_version $minor_version);use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough);use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);my$bundling_values;sub config(@);sub ConfigDefaults();sub ParseOptionSpec($$);sub OptCtl($);sub FindOption($$$$$);sub ValidValue ($$$$$);my$requested_version=0;sub ConfigDefaults() {if (defined$ENV{"POSIXLY_CORRECT"}){$genprefix="(--|-)";$autoabbrev=0;$bundling=0;$getopt_compat=0;$order=$REQUIRE_ORDER}else {$genprefix="(--|-|\\+)";$autoabbrev=1;$bundling=0;$getopt_compat=1;$order=$PERMUTE}$debug=0;$error=0;$ignorecase=1;$passthrough=0;$gnu_compat=0;$longprefix="(--)";$bundling_values=0}sub import {my$pkg=shift;my@syms=();my@config=();my$dest=\@syms;for (@_){if ($_ eq ':config'){$dest=\@config;next}push(@$dest,$_)}local$Exporter::ExportLevel=1;push(@syms,qw(&GetOptions))if@syms;$requested_version=0;$pkg->SUPER::import(@syms);Configure(@config)if@config}($REQUIRE_ORDER,$PERMUTE,$RETURN_IN_ORDER)=(0..2);($major_version,$minor_version)=$VERSION =~ /^(\d+)\.(\d+)/;ConfigDefaults();package Getopt::Long::Parser;my$default_config=do {Getopt::Long::Configure ()};sub new {my$that=shift;my$class=ref($that)|| $that;my%atts=@_;my$self={caller_pkg=>(caller)[0]};bless ($self,$class);if (defined$atts{config}){my$save=Getopt::Long::Configure ($default_config,@{$atts{config}});$self->{settings}=Getopt::Long::Configure ($save);delete ($atts{config})}else {$self->{settings}=$default_config}if (%atts){die(__PACKAGE__.": unhandled attributes: ".join(" ",sort(keys(%atts)))."\n")}$self}sub configure {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings},@_);$self->{settings}=Getopt::Long::Configure ($save)}sub getoptions {my ($self)=shift;return$self->getoptionsfromarray(\@ARGV,@_)}sub getoptionsfromarray {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings});my$ret=0;$Getopt::Long::caller=$self->{caller_pkg};eval {local ($SIG{__DIE__})='DEFAULT';$ret=Getopt::Long::GetOptionsFromArray (@_)};Getopt::Long::Configure ($save);die ($@)if $@;return$ret}package Getopt::Long;use constant CTL_TYPE=>0;use constant CTL_CNAME=>1;use constant CTL_DEFAULT=>2;use constant CTL_DEST=>3;use constant CTL_DEST_SCALAR=>0;use constant CTL_DEST_ARRAY=>1;use constant CTL_DEST_HASH=>2;use constant CTL_DEST_CODE=>3;use constant CTL_AMIN=>4;use constant CTL_AMAX=>5;use constant PAT_INT=>"[-+]?_*[0-9][0-9_]*";use constant PAT_XINT=>"(?:"."[-+]?_*[1-9][0-9_]*"."|"."0x_*[0-9a-f][0-9a-f_]*"."|"."0b_*[01][01_]*"."|"."0[0-7_]*".")";use constant PAT_FLOAT=>"[-+]?"."(?=[0-9.])"."[0-9_]*"."(\.[0-9_]+)?"."([eE][-+]?[0-9_]+)?";sub GetOptions(@) {unshift(@_,\@ARGV);goto&GetOptionsFromArray}sub GetOptionsFromString(@) {my ($string)=shift;require Text::ParseWords;my$args=[Text::ParseWords::shellwords($string)];$caller ||= (caller)[0];my$ret=GetOptionsFromArray($args,@_);return ($ret,$args)if wantarray;if (@$args){$ret=0;warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n")}$ret}sub GetOptionsFromArray(@) {my ($argv,@optionlist)=@_;my$argend='--';my%opctl=();my$pkg=$caller || (caller)[0];my@ret=();my%linkage;my$userlinkage;my$opt;my$prefix=$genprefix;$error='';if ($debug){local ($^W)=0;print STDERR ("Getopt::Long $Getopt::Long::VERSION_STRING ","called from package \"$pkg\".","\n ","argv: ",defined($argv)? UNIVERSAL::isa($argv,'ARRAY')? "(@$argv)" : $argv : "","\n ","autoabbrev=$autoabbrev,"."bundling=$bundling,","bundling_values=$bundling_values,","getopt_compat=$getopt_compat,","gnu_compat=$gnu_compat,","order=$order,","\n ","ignorecase=$ignorecase,","requested_version=$requested_version,","passthrough=$passthrough,","genprefix=\"$genprefix\",","longprefix=\"$longprefix\".","\n")}$userlinkage=undef;if (@optionlist && ref($optionlist[0])and UNIVERSAL::isa($optionlist[0],'HASH')){$userlinkage=shift (@optionlist);print STDERR ("=> user linkage: $userlinkage\n")if$debug}if (@optionlist && $optionlist[0]=~ /^\W+$/ &&!($optionlist[0]eq '<>' && @optionlist > 0 && ref($optionlist[1]))){$prefix=shift (@optionlist);$prefix =~ s/(\W)/\\$1/g;$prefix="([" .$prefix ."])";print STDERR ("=> prefix=\"$prefix\"\n")if$debug}%opctl=();while (@optionlist){my$opt=shift (@optionlist);unless (defined($opt)){$error .= "Undefined argument in option spec\n";next}$opt=$+ if$opt =~ /^$prefix+(.*)$/s;if ($opt eq '<>'){if ((defined$userlinkage)&&!(@optionlist > 0 && ref($optionlist[0]))&& (exists$userlinkage->{$opt})&& ref($userlinkage->{$opt})){unshift (@optionlist,$userlinkage->{$opt})}unless (@optionlist > 0 && ref($optionlist[0])&& ref($optionlist[0])eq 'CODE'){$error .= "Option spec <> requires a reference to a subroutine\n";shift (@optionlist)if@optionlist && ref($optionlist[0]);next}$linkage{'<>'}=shift (@optionlist);next}my ($name,$orig)=ParseOptionSpec ($opt,\%opctl);unless (defined$name){$error .= $orig;shift (@optionlist)if@optionlist && ref($optionlist[0]);next}if (defined$userlinkage){unless (@optionlist > 0 && ref($optionlist[0])){if (exists$userlinkage->{$orig}&& ref($userlinkage->{$orig})){print STDERR ("=> found userlinkage for \"$orig\": ","$userlinkage->{$orig}\n")if$debug;unshift (@optionlist,$userlinkage->{$orig})}else {next}}}if (@optionlist > 0 && ref($optionlist[0])){print STDERR ("=> link \"$orig\" to $optionlist[0]\n")if$debug;my$rl=ref($linkage{$orig}=shift (@optionlist));if ($rl eq "ARRAY"){$opctl{$name}[CTL_DEST]=CTL_DEST_ARRAY}elsif ($rl eq "HASH"){$opctl{$name}[CTL_DEST]=CTL_DEST_HASH}elsif ($rl eq "SCALAR" || $rl eq "REF"){}elsif ($rl eq "CODE"){}else {$error .= "Invalid option linkage for \"$opt\"\n"}}else {my$ov=$orig;$ov =~ s/\W/_/g;if ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;")}elsif ($opctl{$name}[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;")}else {print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;")}}if ($opctl{$name}[CTL_TYPE]eq 'I' && ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY || $opctl{$name}[CTL_DEST]==CTL_DEST_HASH)){$error .= "Invalid option linkage for \"$opt\"\n"}}$error .= "GetOptionsFromArray: 1st parameter is not an array reference\n" unless$argv && UNIVERSAL::isa($argv,'ARRAY');die ($error)if$error;$error=0;if (defined($auto_version)? $auto_version : ($requested_version >= 2.3203)){if (!defined($opctl{version})){$opctl{version}=['','version',0,CTL_DEST_CODE,undef];$linkage{version}=\&VersionMessage}$auto_version=1}if (defined($auto_help)? $auto_help : ($requested_version >= 2.3203)){if (!defined($opctl{help})&&!defined($opctl{'?'})){$opctl{help}=$opctl{'?'}=['','help',0,CTL_DEST_CODE,undef];$linkage{help}=\&HelpMessage}$auto_help=1}if ($debug){my ($arrow,$k,$v);$arrow="=> ";while (($k,$v)=each(%opctl)){print STDERR ($arrow,"\$opctl{$k} = $v ",OptCtl($v),"\n");$arrow=" "}}my$goon=1;while ($goon && @$argv > 0){$opt=shift (@$argv);print STDERR ("=> arg \"",$opt,"\"\n")if$debug;if (defined($opt)&& $opt eq $argend){push (@ret,$argend)if$passthrough;last}my$tryopt=$opt;my$found;my$key;my$arg;my$ctl;($found,$opt,$ctl,$arg,$key)=FindOption ($argv,$prefix,$argend,$opt,\%opctl);if ($found){next unless defined$opt;my$argcnt=0;while (defined$arg){print STDERR ("=> cname for \"$opt\" is ")if$debug;$opt=$ctl->[CTL_CNAME];print STDERR ("\"$ctl->[CTL_CNAME]\"\n")if$debug;if (defined$linkage{$opt}){print STDERR ("=> ref(\$L{$opt}) -> ",ref($linkage{$opt}),"\n")if$debug;if (ref($linkage{$opt})eq 'SCALAR' || ref($linkage{$opt})eq 'REF'){if ($ctl->[CTL_TYPE]eq '+'){print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")if$debug;if (defined ${$linkage{$opt}}){${$linkage{$opt}}+= $arg}else {${$linkage{$opt}}=$arg}}elsif ($ctl->[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> ref(\$L{$opt}) auto-vivified"," to ARRAY\n")if$debug;my$t=$linkage{$opt};$$t=$linkage{$opt}=[];print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")if$debug;push (@{$linkage{$opt}},$arg)}elsif ($ctl->[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> ref(\$L{$opt}) auto-vivified"," to HASH\n")if$debug;my$t=$linkage{$opt};$$t=$linkage{$opt}={};print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")if$debug;$linkage{$opt}->{$key}=$arg}else {print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")if$debug;${$linkage{$opt}}=$arg}}elsif (ref($linkage{$opt})eq 'ARRAY'){print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")if$debug;push (@{$linkage{$opt}},$arg)}elsif (ref($linkage{$opt})eq 'HASH'){print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")if$debug;$linkage{$opt}->{$key}=$arg}elsif (ref($linkage{$opt})eq 'CODE'){print STDERR ("=> &L{$opt}(\"$opt\"",$ctl->[CTL_DEST]==CTL_DEST_HASH ? ", \"$key\"" : "",", \"$arg\")\n")if$debug;my$eval_error=do {local $@;local$SIG{__DIE__}='DEFAULT';eval {&{$linkage{$opt}}(Getopt::Long::CallBack->new (name=>$opt,ctl=>$ctl,opctl=>\%opctl,linkage=>\%linkage,prefix=>$prefix,),$ctl->[CTL_DEST]==CTL_DEST_HASH ? ($key): (),$arg)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("Invalid REF type \"",ref($linkage{$opt}),"\" in linkage\n");die("Getopt::Long -- internal error!\n")}}elsif ($ctl->[CTL_DEST]==CTL_DEST_ARRAY){if (defined$userlinkage->{$opt}){print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")if$debug;push (@{$userlinkage->{$opt}},$arg)}else {print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")if$debug;$userlinkage->{$opt}=[$arg]}}elsif ($ctl->[CTL_DEST]==CTL_DEST_HASH){if (defined$userlinkage->{$opt}){print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")if$debug;$userlinkage->{$opt}->{$key}=$arg}else {print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")if$debug;$userlinkage->{$opt}={$key=>$arg}}}else {if ($ctl->[CTL_TYPE]eq '+'){print STDERR ("=> \$L{$opt} += \"$arg\"\n")if$debug;if (defined$userlinkage->{$opt}){$userlinkage->{$opt}+= $arg}else {$userlinkage->{$opt}=$arg}}else {print STDERR ("=>\$L{$opt} = \"$arg\"\n")if$debug;$userlinkage->{$opt}=$arg}}$argcnt++;last if$argcnt >= $ctl->[CTL_AMAX]&& $ctl->[CTL_AMAX]!=-1;undef($arg);if ($argcnt < $ctl->[CTL_AMIN]){if (@$argv){if (ValidValue($ctl,$argv->[0],1,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}warn("Value \"$$argv[0]\" invalid for option $opt\n");$error++}else {warn("Insufficient arguments for option $opt\n");$error++}}if (@$argv && ValidValue($ctl,$argv->[0],0,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}}}elsif ($order==$PERMUTE){my$cb;if (defined ($cb=$linkage{'<>'})){print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")if$debug;my$eval_error=do {local $@;local$SIG{__DIE__}='DEFAULT';eval {&$cb($tryopt)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("=> saving \"$tryopt\" ","(not an option, may permute)\n")if$debug;push (@ret,$tryopt)}next}else {unshift (@$argv,$tryopt);return ($error==0)}}if (@ret && ($order==$PERMUTE || $passthrough)){print STDERR ("=> restoring \"",join('" "',@ret),"\"\n")if$debug;unshift (@$argv,@ret)}return ($error==0)}sub OptCtl ($) {my ($v)=@_;my@v=map {defined($_)? ($_): ("")}@$v;"[".join(",","\"$v[CTL_TYPE]\"","\"$v[CTL_CNAME]\"","\"$v[CTL_DEFAULT]\"",("\$","\@","\%","\&")[$v[CTL_DEST]|| 0],$v[CTL_AMIN]|| '',$v[CTL_AMAX]|| '',)."]"}sub ParseOptionSpec ($$) {my ($opt,$opctl)=@_;if ($opt !~ m;^ + ( + # Option name + (?: \w+[-\w]* ) + # Aliases + (?: \| (?: . [^|!+=:]* )? )* + )? + ( + # Either modifiers ... + [!+] + | + # ... or a value/dest/repeat specification + [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )? + | + # ... or an optional-with-default spec + : (?: -?\d+ | \+ ) [@%]? + )? + $;x){return (undef,"Error in option spec: \"$opt\"\n")}my ($names,$spec)=($1,$2);$spec='' unless defined$spec;my$orig;my@names;if (defined$names){@names=split (/\|/,$names);$orig=$names[0]}else {@names=('');$orig=''}my$entry;if ($spec eq '' || $spec eq '+' || $spec eq '!'){$entry=[$spec,$orig,undef,CTL_DEST_SCALAR,0,0]}elsif ($spec =~ /^:(-?\d+|\+)([@%])?$/){my$def=$1;my$dest=$2;my$type=$def eq '+' ? 'I' : 'i';$dest ||= '$';$dest=$dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;$entry=[$type,$orig,$def eq '+' ? undef : $def,$dest,0,1]}else {my ($mand,$type,$dest)=$spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;return (undef,"Cannot repeat while bundling: \"$opt\"\n")if$bundling && defined($4);my ($mi,$cm,$ma)=($5,$6,$7);return (undef,"{0} is useless in option spec: \"$opt\"\n")if defined($mi)&&!$mi &&!defined($ma)&&!defined($cm);$type='i' if$type eq 'n';$dest ||= '$';$dest=$dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;$mi=$mand eq '=' ? 1 : 0 unless defined$mi;$mand=$mi ? '=' : ':';$ma=$mi ? $mi : 1 unless defined$ma || defined$cm;return (undef,"Max must be greater than zero in option spec: \"$opt\"\n")if defined($ma)&&!$ma;return (undef,"Max less than min in option spec: \"$opt\"\n")if defined($ma)&& $ma < $mi;$entry=[$type,$orig,undef,$dest,$mi,$ma||-1]}my$dups='';for (@names){$_=lc ($_)if$ignorecase > (($bundling && length($_)==1)? 1 : 0);if (exists$opctl->{$_}){$dups .= "Duplicate specification \"$opt\" for option \"$_\"\n"}if ($spec eq '!'){$opctl->{"no$_"}=$entry;$opctl->{"no-$_"}=$entry;$opctl->{$_}=[@$entry];$opctl->{$_}->[CTL_TYPE]=''}else {$opctl->{$_}=$entry}}if ($dups && $^W){for (split(/\n+/,$dups)){warn($_."\n")}}($names[0],$orig)}sub FindOption ($$$$$) {my ($argv,$prefix,$argend,$opt,$opctl)=@_;print STDERR ("=> find \"$opt\"\n")if$debug;return (0)unless defined($opt);return (0)unless$opt =~ /^($prefix)(.*)$/s;return (0)if$opt eq "-" &&!defined$opctl->{''};$opt=substr($opt,length($1));my$starter=$1;print STDERR ("=> split \"$starter\"+\"$opt\"\n")if$debug;my$optarg;my$rest;if (($starter=~/^$longprefix$/ || ($getopt_compat && ($bundling==0 || $bundling==2)))&& (my$oppos=index($opt,'=',1))> 0){my$optorg=$opt;$opt=substr($optorg,0,$oppos);$optarg=substr($optorg,$oppos + 1);print STDERR ("=> option \"",$opt,"\", optarg = \"$optarg\"\n")if$debug}my$tryopt=$opt;if (($bundling || $bundling_values)&& $starter eq '-'){$tryopt=$ignorecase ? lc($opt): $opt;if ($bundling==2 && length($tryopt)> 1 && defined ($opctl->{$tryopt})){print STDERR ("=> $starter$tryopt overrides unbundling\n")if$debug}elsif ($bundling_values){$tryopt=$opt;$rest=length ($tryopt)> 0 ? substr ($tryopt,1): '';$tryopt=substr ($tryopt,0,1);$tryopt=lc ($tryopt)if$ignorecase > 1;print STDERR ("=> $starter$tryopt unbundled from ","$starter$tryopt$rest\n")if$debug;$optarg=$rest eq '' ? undef : $rest;$rest=undef}else {$tryopt=$opt;$rest=length ($tryopt)> 0 ? substr ($tryopt,1): '';$tryopt=substr ($tryopt,0,1);$tryopt=lc ($tryopt)if$ignorecase > 1;print STDERR ("=> $starter$tryopt unbundled from ","$starter$tryopt$rest\n")if$debug;$rest=undef unless$rest ne ''}}elsif ($autoabbrev && $opt ne ""){my@names=sort(keys (%$opctl));$opt=lc ($opt)if$ignorecase;$tryopt=$opt;my$pat=quotemeta ($opt);my@hits=grep (/^$pat/,@names);print STDERR ("=> ",scalar(@hits)," hits (@hits) with \"$pat\" ","out of ",scalar(@names),"\n")if$debug;unless ((@hits <= 1)|| (grep ($_ eq $opt,@hits)==1)){my%hit;for (@hits){my$hit=$opctl->{$_}->[CTL_CNAME]if defined$opctl->{$_}->[CTL_CNAME];$hit="no" .$hit if$opctl->{$_}->[CTL_TYPE]eq '!';$hit{$hit}=1}if (keys(%hit)==2){if ($auto_version && exists($hit{version})){delete$hit{version}}elsif ($auto_help && exists($hit{help})){delete$hit{help}}}unless (keys(%hit)==1){return (0)if$passthrough;warn ("Option ",$opt," is ambiguous (",join(", ",@hits),")\n");$error++;return (1,undef)}@hits=keys(%hit)}if (@hits==1 && $hits[0]ne $opt){$tryopt=$hits[0];$tryopt=lc ($tryopt)if$ignorecase > (($bundling && length($tryopt)==1)? 1 : 0);print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")if$debug}}elsif ($ignorecase){$tryopt=lc ($opt)}my$ctl=$opctl->{$tryopt};unless (defined$ctl){return (0)if$passthrough;if ($bundling==1 && length($starter)==1){$opt=substr($opt,0,1);unshift (@$argv,$starter.$rest)if defined$rest}if ($opt eq ""){warn ("Missing option after ",$starter,"\n")}else {warn ("Unknown option: ",$opt,"\n")}$error++;return (1,undef)}$opt=$tryopt;print STDERR ("=> found ",OptCtl($ctl)," for \"",$opt,"\"\n")if$debug;my$type=$ctl->[CTL_TYPE];my$arg;if ($type eq '' || $type eq '!' || $type eq '+'){if (defined$optarg){return (0)if$passthrough;warn ("Option ",$opt," does not take an argument\n");$error++;undef$opt;undef$optarg if$bundling_values}elsif ($type eq '' || $type eq '+'){$arg=1}else {$opt =~ s/^no-?//i;$arg=0}unshift (@$argv,$starter.$rest)if defined$rest;return (1,$opt,$ctl,$arg)}my$mand=$ctl->[CTL_AMIN];if ($gnu_compat){my$optargtype=0;if (defined($optarg)){$optargtype=(length($optarg)==0)? 1 : 2}elsif (defined$rest || @$argv > 0){$optargtype=3}if(($optargtype==0)&&!$mand){if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}my$val =defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0;return (1,$opt,$ctl,$val)}return (1,$opt,$ctl,$type eq 's' ? '' : 0)if$optargtype==1}if (defined$optarg ? ($optarg eq ''):!(defined$rest || @$argv > 0)){if ($mand){return (0)if$passthrough;warn ("Option ",$opt," requires an argument\n");$error++;return (1,undef)}if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}return (1,$opt,$ctl,defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0)}$arg=(defined$rest ? $rest : (defined$optarg ? $optarg : shift (@$argv)));my$key;if ($ctl->[CTL_DEST]==CTL_DEST_HASH && defined$arg){($key,$arg)=($arg =~ /^([^=]*)=(.*)$/s)? ($1,$2): ($arg,defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: ($mand ? undef : ($type eq 's' ? "" : 1)));if (!defined$arg){warn ("Option $opt, key \"$key\", requires a value\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}}my$key_valid=$ctl->[CTL_DEST]==CTL_DEST_HASH ? "[^=]+=" : "";if ($type eq 's'){return (1,$opt,$ctl,$arg,$key)if$mand;return (1,$opt,$ctl,$arg,$key)if$ctl->[CTL_DEST]==CTL_DEST_HASH;return (1,$opt,$ctl,$arg,$key)if defined$optarg || defined$rest;return (1,$opt,$ctl,$arg,$key)if$arg eq "-";if ($arg eq $argend || $arg =~ /^$prefix.+/){unshift (@$argv,$arg);$arg=''}}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;if ($bundling && defined$rest && $rest =~ /^($key_valid)($o_valid)(.*)$/si){($key,$arg,$rest)=($1,$2,$+);chop($key)if$key;$arg=($type eq 'o' && $arg =~ /^0/)? oct($arg): 0+$arg;unshift (@$argv,$starter.$rest)if defined$rest && $rest ne ''}elsif ($arg =~ /^$o_valid$/si){$arg =~ tr/_//d;$arg=($type eq 'o' && $arg =~ /^0/)? oct($arg): 0+$arg}else {if (defined$optarg || $mand){if ($passthrough){unshift (@$argv,defined$rest ? $starter.$rest : $arg)unless defined$optarg;return (0)}warn ("Value \"",$arg,"\" invalid for option ",$opt," (",$type eq 'o' ? "extended " : '',"number expected)\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}$arg=defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: 0}}}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;if ($bundling && defined$rest && $rest =~ /^($key_valid)($o_valid)(.*)$/s){$arg =~ tr/_//d;($key,$arg,$rest)=($1,$2,$+);chop($key)if$key;unshift (@$argv,$starter.$rest)if defined$rest && $rest ne ''}elsif ($arg =~ /^$o_valid$/){$arg =~ tr/_//d}else {if (defined$optarg || $mand){if ($passthrough){unshift (@$argv,defined$rest ? $starter.$rest : $arg)unless defined$optarg;return (0)}warn ("Value \"",$arg,"\" invalid for option ",$opt," (real number expected)\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);$arg=0.0}}}else {die("Getopt::Long internal error (Can't happen)\n")}return (1,$opt,$ctl,$arg,$key)}sub ValidValue ($$$$$) {my ($ctl,$arg,$mand,$argend,$prefix)=@_;if ($ctl->[CTL_DEST]==CTL_DEST_HASH){return 0 unless$arg =~ /[^=]+=(.*)/;$arg=$1}my$type=$ctl->[CTL_TYPE];if ($type eq 's'){return (1)if$mand;return (1)if$arg eq "-";return 0 if$arg eq $argend || $arg =~ /^$prefix.+/;return 1}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;return$arg =~ /^$o_valid$/si}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;return$arg =~ /^$o_valid$/}die("ValidValue: Cannot happen\n")}sub Configure (@) {my (@options)=@_;my$prevconfig=[$error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values ];if (ref($options[0])eq 'ARRAY'){($error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values)=@{shift(@options)}}my$opt;for$opt (@options){my$try=lc ($opt);my$action=1;if ($try =~ /^no_?(.*)$/s){$action=0;$try=$+}if (($try eq 'default' or $try eq 'defaults')&& $action){ConfigDefaults ()}elsif (($try eq 'posix_default' or $try eq 'posix_defaults')){local$ENV{POSIXLY_CORRECT};$ENV{POSIXLY_CORRECT}=1 if$action;ConfigDefaults ()}elsif ($try eq 'auto_abbrev' or $try eq 'autoabbrev'){$autoabbrev=$action}elsif ($try eq 'getopt_compat'){$getopt_compat=$action;$genprefix=$action ? "(--|-|\\+)" : "(--|-)"}elsif ($try eq 'gnu_getopt'){if ($action){$gnu_compat=1;$bundling=1;$getopt_compat=0;$genprefix="(--|-)";$order=$PERMUTE;$bundling_values=0}}elsif ($try eq 'gnu_compat'){$gnu_compat=$action;$bundling=0;$bundling_values=1}elsif ($try =~ /^(auto_?)?version$/){$auto_version=$action}elsif ($try =~ /^(auto_?)?help$/){$auto_help=$action}elsif ($try eq 'ignorecase' or $try eq 'ignore_case'){$ignorecase=$action}elsif ($try eq 'ignorecase_always' or $try eq 'ignore_case_always'){$ignorecase=$action ? 2 : 0}elsif ($try eq 'bundling'){$bundling=$action;$bundling_values=0 if$action}elsif ($try eq 'bundling_override'){$bundling=$action ? 2 : 0;$bundling_values=0 if$action}elsif ($try eq 'bundling_values'){$bundling_values=$action;$bundling=0 if$action}elsif ($try eq 'require_order'){$order=$action ? $REQUIRE_ORDER : $PERMUTE}elsif ($try eq 'permute'){$order=$action ? $PERMUTE : $REQUIRE_ORDER}elsif ($try eq 'pass_through' or $try eq 'passthrough'){$passthrough=$action}elsif ($try =~ /^prefix=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .quotemeta($genprefix).")";eval {'' =~ /$genprefix/};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^prefix_pattern=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .$genprefix .")" unless$genprefix =~ /^\(.*\)$/;eval {'' =~ m"$genprefix"};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^long_prefix_pattern=(.+)$/ && $action){$longprefix=$1;$longprefix="(" .$longprefix .")" unless$longprefix =~ /^\(.*\)$/;eval {'' =~ m"$longprefix"};die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n")if $@}elsif ($try eq 'debug'){$debug=$action}else {die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")}}$prevconfig}sub config (@) {Configure (@_)}sub VersionMessage(@) {my$pa=setup_pa_args("version",@_);my$v=$main::VERSION;my$fh=$pa->{-output}|| (($pa->{-exitval}eq "NOEXIT" || $pa->{-exitval}< 2)? \*STDOUT : \*STDERR);print$fh (defined($pa->{-message})? $pa->{-message}: (),$0,defined$v ? " version $v" : (),"\n","(",__PACKAGE__,"::","GetOptions"," version ",defined($Getopt::Long::VERSION_STRING)? $Getopt::Long::VERSION_STRING : $VERSION,";"," Perl version ",$] >= 5.006 ? sprintf("%vd",$^V): $],")\n");exit($pa->{-exitval})unless$pa->{-exitval}eq "NOEXIT"}sub HelpMessage(@) {eval {require Pod::Usage;import Pod::Usage;1}|| die("Cannot provide help: cannot load Pod::Usage\n");pod2usage(setup_pa_args("help",@_))}sub setup_pa_args($@) {my$tag=shift;@_=()if @_==2 && $_[0]eq $tag;my$pa;if (@_ > 1){$pa={@_ }}else {$pa=shift || {}}if (UNIVERSAL::isa($pa,'HASH')){$pa->{-message}=$pa->{-msg};delete($pa->{-msg})}elsif ($pa =~ /^-?\d+$/){$pa={-exitval=>$pa }}else {$pa={-message=>$pa }}$pa->{-verbose}=0 unless exists($pa->{-verbose});$pa->{-exitval}=0 unless exists($pa->{-exitval});$pa}sub VERSION {$requested_version=$_[1]if @_ > 1;shift->SUPER::VERSION(@_)}package Getopt::Long::CallBack;sub new {my ($pkg,%atts)=@_;bless {%atts },$pkg}sub name {my$self=shift;''.$self->{name}}use overload '""'=>\&name,fallback=>1;1; +GETOPT_LONG + $fatpacked{"GraphQL/Client.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPHQL_CLIENT'; - package GraphQL::Client;use warnings;use strict;use Module::Load qw(load);use Scalar::Util qw(reftype);use namespace::clean;our$VERSION='0.601';sub _croak {require Carp;goto&Carp::croak}sub _throw {GraphQL::Client::Error->throw(@_)}sub new {my$class=shift;bless {@_},$class}sub execute {my$self=shift;my ($query,$variables,$operation_name,$options)=@_;if ((reftype($operation_name)|| '')eq 'HASH'){$options=$operation_name;$operation_name=undef}my$request={query=>$query,($variables && %$variables)? (variables=>$variables): (),$operation_name ? (operationName=>$operation_name): (),};return$self->_handle_result($self->transport->execute($request,$options))}sub _handle_result {my$self=shift;my ($result)=@_;my$handle_result=sub {my$result=shift;my$resp=$result->{response};if (my$exception=$result->{error}){unshift @{$resp->{errors}},{message=>"$exception",}}if ($self->unpack){if ($resp->{errors}){_throw$resp->{errors}[0]{message},{type=>'graphql',response=>$resp,details=>$result->{details},}}return$resp->{data}}return$resp};if (eval {$result->isa('Future')}){return$result->transform(done=>sub {my$result=shift;my$resp=eval {$handle_result->($result)};if (my$err=$@){Future::Exception->throw("$err",$err->{type},$err->{response},$err->{details})}return$resp},)}else {return$handle_result->($result)}}sub url {my$self=shift;$self->{url}}sub transport_class {my$self=shift;$self->{transport_class}}sub transport {my$self=shift;$self->{transport}//= do {my$class=$self->_autodetermine_transport_class;eval {load$class};if ((my$err=$@)||!$class->can('execute')){$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}\""}$class->new(%$self)}}sub unpack {my$self=shift;$self->{unpack}//= 0}sub _url_protocol {my$self=shift;my$url=$self->url;my ($protocol)=$url =~ /^([^+:]+)/;return$protocol}sub _autodetermine_transport_class {my$self=shift;my$class=$self->transport_class;return _expand_class($class)if$class;my$protocol=$self->_url_protocol;_croak 'Failed to determine transport from URL' if!$protocol;$class=lc($protocol);$class =~ s/[^a-z]/_/g;return _expand_class($class)}sub _expand_class {my$class=shift;$class="GraphQL::Client::$class" unless$class =~ s/^\+//;$class}{package GraphQL::Client::Error;use warnings;use strict;use overload '""'=>\&error,fallback=>1;sub new {bless {%{$_[2]|| {}},error=>$_[1]|| 'Something happened'},$_[0]}sub error {"$_[0]->{error}"}sub type {"$_[0]->{type}"}sub throw {my$self=shift;die$self if ref$self;die$self->new(@_)}}1; + package GraphQL::Client;use warnings;use strict;use Module::Load qw(load);use Scalar::Util qw(reftype);use namespace::clean;our$VERSION='0.602';sub _croak {require Carp;goto&Carp::croak}sub _throw {GraphQL::Client::Error->throw(@_)}sub new {my$class=shift;bless {@_},$class}sub execute {my$self=shift;my ($query,$variables,$operation_name,$options)=@_;if ((reftype($operation_name)|| '')eq 'HASH'){$options=$operation_name;$operation_name=undef}my$request={query=>$query,($variables && %$variables)? (variables=>$variables): (),$operation_name ? (operationName=>$operation_name): (),};return$self->_handle_result($self->transport->execute($request,$options))}sub _handle_result {my$self=shift;my ($result)=@_;my$handle_result=sub {my$result=shift;my$resp=$result->{response};if (my$exception=$result->{error}){unshift @{$resp->{errors}},{message=>"$exception",}}if ($self->unpack){if ($resp->{errors}){_throw$resp->{errors}[0]{message},{type=>'graphql',response=>$resp,details=>$result->{details},}}return$resp->{data}}return$resp};if (eval {$result->isa('Future')}){return$result->transform(done=>sub {my$result=shift;my$resp=eval {$handle_result->($result)};if (my$err=$@){Future::Exception->throw("$err",$err->{type},$err->{response},$err->{details})}return$resp},)}else {return$handle_result->($result)}}sub url {my$self=shift;$self->{url}}sub transport_class {my$self=shift;$self->{transport_class}}sub transport {my$self=shift;$self->{transport}//= do {my$class=$self->_autodetermine_transport_class;eval {load$class};if ((my$err=$@)||!$class->can('execute')){$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}\""}$class->new(%$self)}}sub unpack {my$self=shift;$self->{unpack}//= 0}sub _url_protocol {my$self=shift;my$url=$self->url;my ($protocol)=$url =~ /^([^+:]+)/;return$protocol}sub _autodetermine_transport_class {my$self=shift;my$class=$self->transport_class;return _expand_class($class)if$class;my$protocol=$self->_url_protocol;_croak 'Failed to determine transport from URL' if!$protocol;$class=lc($protocol);$class =~ s/[^a-z]/_/g;return _expand_class($class)}sub _expand_class {my$class=shift;$class="GraphQL::Client::$class" unless$class =~ s/^\+//;$class}{package GraphQL::Client::Error;use warnings;use strict;use overload '""'=>\&error,fallback=>1;sub new {bless {%{$_[2]|| {}},error=>$_[1]|| 'Something happened'},$_[0]}sub error {"$_[0]->{error}"}sub type {"$_[0]->{type}"}sub throw {my$self=shift;die$self if ref$self;die$self->new(@_)}}1; GRAPHQL_CLIENT +$fatpacked{"GraphQL/Client/CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPHQL_CLIENT_CLI'; + package GraphQL::Client::CLI;use warnings;use strict;use Text::ParseWords;use Getopt::Long 2.39 qw(GetOptionsFromArray);use GraphQL::Client;use JSON::MaybeXS;use namespace::clean;our$VERSION='0.602';sub _croak {require Carp;goto&Carp::croak}sub new {my$class=shift;bless {},$class}sub main {my$self=shift;$self=$self->new if!ref$self;my$options=eval {$self->_get_options(@_)};if (my$err=$@){print STDERR$err;_pod2usage(2)}if ($options->{version}){print "graphql $VERSION\n";exit 0}if ($options->{help}){_pod2usage(-exitval=>0,-verbose=>99,-sections=>[qw(NAME SYNOPSIS OPTIONS)])}if ($options->{manual}){_pod2usage(-exitval=>0,-verbose=>2)}my$url=$options->{url};if (!$url){print STDERR "The or --url option argument is required.\n";_pod2usage(2)}my$variables=$options->{variables};my$query=$options->{query};my$operation_name=$options->{operation_name};my$unpack=$options->{unpack};my$outfile=$options->{outfile};my$format=$options->{format};my$transport=$options->{transport};my$client=GraphQL::Client->new(url=>$url);eval {$client->transport};if (my$err=$@){warn$err if$ENV{GRAPHQL_CLIENT_DEBUG};print STDERR "Could not construct a transport for URL: $url\n";print STDERR "Is this URL correct?\n";_pod2usage(2)}if ($query eq '-'){print STDERR "Interactive mode engaged! Waiting for a query on ...\n" if -t STDIN;$query=do {local $/;}}my$resp=$client->execute($query,$variables,$operation_name,$transport);my$err=$resp->{errors};$unpack=0 if$err;my$data=$unpack ? $resp->{data}: $resp;if ($outfile){open(my$out,'>',$outfile)or die "Open $outfile failed: $!";*STDOUT=$out}_print_data($data,$format);exit($unpack && $err ? 1 : 0)}sub _get_options {my$self=shift;my@args=@_;unshift@args,shellwords($ENV{GRAPHQL_CLIENT_OPTIONS}|| '');my%options=(format=>'json:pretty',unpack=>0,);GetOptionsFromArray(\@args,'version'=>\$options{version},'help|h|?'=>\$options{help},'manual|man'=>\$options{manual},'url|u=s'=>\$options{url},'query|mutation=s'=>\$options{query},'variables|vars|V=s'=>\$options{variables},'variable|var|d=s%'=>\$options{variables},'operation-name|n=s'=>\$options{operation_name},'transport|t=s%'=>\$options{transport},'format|f=s'=>\$options{format},'unpack!'=>\$options{unpack},'output|o=s'=>\$options{outfile},)or _pod2usage(2);$options{url}=shift@args if!$options{url};$options{query}=shift@args if!$options{query};$options{query}||= '-';my$transport=eval {_expand_vars($options{transport})};die "Two or more --transport keys are incompatible.\n" if $@;if (ref$options{variables}){$options{variables}=eval {_expand_vars($options{variables})};die "Two or more --variable keys are incompatible.\n" if $@}elsif ($options{variables}){$options{variables}=eval {JSON::MaybeXS->new->decode($options{variables})};die "The --variables JSON does not parse.\n" if $@}return \%options}sub _print_data {my ($data,$format)=@_;$format=lc($format || 'json:pretty');if ($format eq 'json' || $format eq 'json:pretty'){my%opts=(allow_nonref=>1,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$data && $data->{data};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}}sub _parse_path {my$path=shift;my@path;my@segments=map {split(/\./,$_)}split(/(\[[^\.\]]+\])\.?/,$path);for my$segment (@segments){if ($segment =~ /\[([^\.\]]+)\]/){$path[-1]{type}='ARRAY' if@path;push@path,{name=>$1,index=>1,}}else {$path[-1]{type}='HASH' if@path;push@path,{name=>$segment,}}}return \@path}sub _expand_vars {my$vars=shift;my$root={};while (my ($key,$value)=each %$vars){my$parsed_path=_parse_path($key);my$curr=$root;for my$segment (@$parsed_path){my$name=$segment->{name};my$type=$segment->{type}|| '';my$next=$type eq 'HASH' ? {}: $type eq 'ARRAY' ? []: $value;if (ref$curr eq 'HASH'){_croak 'Conflicting keys' if$segment->{index};if (defined$curr->{$name}){_croak 'Conflicting keys' if$type ne ref$curr->{$name};$next=$curr->{$name}}else {$curr->{$name}=$next}}elsif (ref$curr eq 'ARRAY'){_croak 'Conflicting keys' if!$segment->{index};if (defined$curr->[$name]){_croak 'Conflicting keys' if$type ne ref$curr->[$name];$next=$curr->[$name]}else {$curr->[$name]=$next}}else {_croak 'Conflicting keys'}$curr=$next}}return$root}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 <{url}|| $self->url;my$method=delete$options->{method}|| $self->method;$request && ref($request)eq 'HASH' or _croak q{Usage: $http->execute(\%request)};$request->{query}or _croak q{Request must have a query};$url or _croak q{URL must be provided};my$data={%$request};if ($method eq 'GET' || $method eq 'HEAD'){$data->{variables}=$self->json->encode($data->{variables})if$data->{variables};my$params=www_form_urlencode($data);my$sep=$url =~ /^[^#]+\?/ ? '&' : '?';$url =~ s/#/${sep}${params}#/ or $url .= "${sep}${params}"}else {my$encoded_data=$self->json->encode($data);$options->{content}=$encoded_data;$options->{headers}{'content-length'}=length$encoded_data;$options->{headers}{'content-type'}='application/json'}return$self->_handle_response($self->any_ua->request($method,$url,$options))}sub _handle_response {my$self=shift;my ($resp)=@_;if (eval {$resp->isa('Future')}){return$resp->followed_by(sub {my$f=shift;if (my ($exception,$category,@other)=$f->failure){if (ref$exception eq 'HASH'){my$resp=$exception;return Future->done($self->_handle_error($resp))}return Future->done({error=>$exception,response=>undef,details=>{exception_details=>[$category,@other],},})}my$resp=$f->get;return Future->done($self->_handle_success($resp))})}else {return$self->_handle_error($resp)if!$resp->{success};return$self->_handle_success($resp)}}sub _handle_error {my$self=shift;my ($resp)=@_;my$data=eval {$self->json->decode($resp->{content})};my$content=$resp->{content}// 'No content';my$reason=$resp->{reason}// '';my$message="HTTP transport returned $resp->{status} ($reason): $content";return {error=>$message,response=>$data,details=>{http_response=>$resp,},}}sub _handle_success {my$self=shift;my ($resp)=@_;my$data=eval {$self->json->decode($resp->{content})};if (my$exception=$@){return {error=>"HTTP transport failed to decode response: $exception",response=>undef,details=>{http_response=>$resp,},}}return {response=>$data,details=>{http_response=>$resp,},}}sub ua {my$self=shift;$self->{ua}//= do {require HTTP::Tiny;HTTP::Tiny->new(agent=>$ENV{GRAPHQL_CLIENT_HTTP_USER_AGENT}// "perl-graphql-client/$VERSION",)}}sub any_ua {my$self=shift;$self->{any_ua}//= HTTP::AnyUA->new(ua=>$self->ua)}sub url {my$self=shift;$self->{url}}sub method {my$self=shift;$self->{method}// 'POST'}sub json {my$self=shift;$self->{json}//= do {require JSON::MaybeXS;JSON::MaybeXS->new(utf8=>1)}}1; + package GraphQL::Client::http;use 5.010;use warnings;use strict;use HTTP::AnyUA::Util qw(www_form_urlencode);use HTTP::AnyUA;use namespace::clean;our$VERSION='0.602';sub _croak {require Carp;goto&Carp::croak}sub new {my$class=shift;my$self=@_ % 2==0 ? {@_}: $_[0];bless$self,$class}sub execute {my$self=shift;my ($request,$options)=@_;my$url=delete$options->{url}|| $self->url;my$method=delete$options->{method}|| $self->method;$request && ref($request)eq 'HASH' or _croak q{Usage: $http->execute(\%request)};$request->{query}or _croak q{Request must have a query};$url or _croak q{URL must be provided};my$data={%$request};if ($method eq 'GET' || $method eq 'HEAD'){$data->{variables}=$self->json->encode($data->{variables})if$data->{variables};my$params=www_form_urlencode($data);my$sep=$url =~ /^[^#]+\?/ ? '&' : '?';$url =~ s/#/${sep}${params}#/ or $url .= "${sep}${params}"}else {my$encoded_data=$self->json->encode($data);$options->{content}=$encoded_data;$options->{headers}{'content-length'}=length$encoded_data;$options->{headers}{'content-type'}='application/json'}return$self->_handle_response($self->any_ua->request($method,$url,$options))}sub _handle_response {my$self=shift;my ($resp)=@_;if (eval {$resp->isa('Future')}){return$resp->followed_by(sub {my$f=shift;if (my ($exception,$category,@other)=$f->failure){if (ref$exception eq 'HASH'){my$resp=$exception;return Future->done($self->_handle_error($resp))}return Future->done({error=>$exception,response=>undef,details=>{exception_details=>[$category,@other],},})}my$resp=$f->get;return Future->done($self->_handle_success($resp))})}else {return$self->_handle_error($resp)if!$resp->{success};return$self->_handle_success($resp)}}sub _handle_error {my$self=shift;my ($resp)=@_;my$data=eval {$self->json->decode($resp->{content})};my$content=$resp->{content}// 'No content';my$reason=$resp->{reason}// '';my$message="HTTP transport returned $resp->{status} ($reason): $content";chomp$message;return {error=>$message,response=>$data,details=>{http_response=>$resp,},}}sub _handle_success {my$self=shift;my ($resp)=@_;my$data=eval {$self->json->decode($resp->{content})};if (my$exception=$@){return {error=>"HTTP transport failed to decode response: $exception",response=>undef,details=>{http_response=>$resp,},}}return {response=>$data,details=>{http_response=>$resp,},}}sub ua {my$self=shift;$self->{ua}//= do {require HTTP::Tiny;HTTP::Tiny->new(agent=>$ENV{GRAPHQL_CLIENT_HTTP_USER_AGENT}// "perl-graphql-client/$VERSION",)}}sub any_ua {my$self=shift;$self->{any_ua}//= HTTP::AnyUA->new(ua=>$self->ua)}sub url {my$self=shift;$self->{url}}sub method {my$self=shift;$self->{method}// 'POST'}sub json {my$self=shift;$self->{json}//= do {require JSON::MaybeXS;JSON::MaybeXS->new(utf8=>1)}}1; GRAPHQL_CLIENT_HTTP $fatpacked{"GraphQL/Client/https.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPHQL_CLIENT_HTTPS'; - package GraphQL::Client::https;use warnings;use strict;use parent 'GraphQL::Client::http';our$VERSION='0.601';sub new {my$class=shift;GraphQL::Client::http->new(@_)}1; + package GraphQL::Client::https;use warnings;use strict;use parent 'GraphQL::Client::http';our$VERSION='0.602';sub new {my$class=shift;GraphQL::Client::http->new(@_)}1; GRAPHQL_CLIENT_HTTPS $fatpacked{"HTTP/AnyUA.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA'; @@ -608,214 +641,11 @@ unshift @INC, bless \%fatpacked, $class; use warnings; use strict; -use Getopt::Long; -use GraphQL::Client; -use JSON::MaybeXS; - -our $VERSION = '0.601'; # VERSION - -my $version; -my $help; -my $manual; -my $url; -my $transport = {}; -my $query = '-'; -my $variables = {}; -my $operation_name; -my $format = 'json:pretty'; -my $unpack = 0; -my $outfile; -GetOptions( - 'version' => \$version, - 'help|h|?' => \$help, - 'manual|man' => \$manual, - 'url|u=s' => \$url, - 'query|mutation=s' => \$query, - 'variables|vars|V=s' => \$variables, - 'variable|var|d=s%' => \$variables, - 'operation-name|n=s' => \$operation_name, - 'transport|t=s%' => \$transport, - 'format|f=s' => \$format, - 'unpack!' => \$unpack, - 'output|o=s' => \$outfile, -) 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 '-'; +use GraphQL::Client::CLI; -if (!$url) { - print STDERR "The or --url option argument is required.\n"; - pod2usage(2); -} - -$transport = expand_vars($transport); +our $VERSION = '0.602'; # VERSION -if (ref $variables) { - $variables = expand_vars($variables); -} -else { - $variables = JSON::MaybeXS->new->decode($variables); -} - -my $client = GraphQL::Client->new(url => $url); - -eval { $client->transport }; -if (my $err = $@) { - warn $err if $ENV{GRAPHQL_CLIENT_DEBUG}; - print STDERR "Could not construct a transport for URL: $url\n"; - print STDERR "Is this URL correct?\n"; - pod2usage(2); -} - -if (!$query || $query eq '-') { - print STDERR "Interactive mode engaged! Waiting for a query on ...\n" - if -t STDIN; ## no critic (InputOutput::ProhibitInteractiveTest) - $query = do { local $/; <> }; -} - -my $resp = $client->execute($query, $variables, $operation_name, $transport); -my $err = $resp->{errors}; -$unpack = 0 if $err; -my $data = $unpack ? $resp->{data} : $resp; - -if ($outfile) { - open(my $out, '>', $outfile) or die "Open $outfile failed: $!"; - *STDOUT = $out; -} - -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; - } -} - -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; -} - -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 <main(@ARGV); __END__ @@ -829,7 +659,7 @@ graphql - Command-line GraphQL client =head1 VERSION -version 0.601 +version 0.602 =head1 SYNOPSIS @@ -900,7 +730,8 @@ Aliases: C<--vars>, C<-V> =head2 C<--variable KEY=VALUE> -An alternative way to provide variables. Repeat this option to provide multiple variables. +An alternative way to provide variables one at a time. This option can be repeated to provide +multiple variables. If used in combination with L, this option is silently ignored. @@ -1086,6 +917,10 @@ C - Set the HTTP user agent string. =item * +C - Set the default set of options. + +=item * + C - Set table format backend; see L. =back @@ -1114,6 +949,16 @@ C<3> - Could not format the response as requested =back +=head1 SEE ALSO + +=over 4 + +=item * + +L - Programmatic interface + +=back + =head1 BUGS Please report any bugs or feature requests on the bugtracker website