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 <URL> <QUERY> [ [--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
- <https://graphql.org/> queries and mutations on a server.
+ graphql is a command-line program for executing queries and mutations
+ on a GraphQL <https://graphql.org/> 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 <<END
+ > {hello}
+ > END
+
+ graphql http://myserver/graphql
+ Interactive mode engaged! Waiting for a query on <STDIN>...
+ {hello}
+ ^D
+
+ Execute a query with variables:
+
+ graphql http://myserver/graphql <<END --var episode=JEDI
+ > 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
#!/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
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 : "<undef>","\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($_)? ($_): ("<undef>")}@$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 <URL> 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 <STDIN>...\n" if -t STDIN;$query=do {local $/;<STDIN>}}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 <<END;exit$exit}else {goto&Pod::Usage::pod2usage}}1;
+ Online documentation is available at:
+
+ https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
+
+ Tip: To enable inline documentation, install the Pod::Usage module.
+
+ END
+GRAPHQL_CLIENT_CLI
+
$fatpacked{"GraphQL/Client/http.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GRAPHQL_CLIENT_HTTP';
- 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.601';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";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';
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 <URL> 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 <STDIN>...\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 <<END;
-Online documentation is available at:
-
- https://github.com/chazmcgarvey/graphql-client/blob/$ref/README.md
-
-Tip: To enable inline documentation, install the Pod::Usage module.
-
-END
- exit $exit;
- }
- else {
- goto &Pod::Usage::pod2usage;
- }
-}
+GraphQL::Client::CLI->main(@ARGV);
__END__
=head1 VERSION
-version 0.601
+version 0.602
=head1 SYNOPSIS
=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</"--variables JSON">, this option is silently ignored.
=item *
+C<GRAPHQL_CLIENT_OPTIONS> - Set the default set of options.
+
+=item *
+
C<PERL_TEXT_TABLE> - Set table format backend; see L</FORMAT>.
=back
=back
+=head1 SEE ALSO
+
+=over 4
+
+=item *
+
+L<GraphQL::Client> - Programmatic interface
+
+=back
+
=head1 BUGS
Please report any bugs or feature requests on the bugtracker website
projects / chaz / graphql-client / commitdiff
