From 561cc477b0f6bb51dc5eabaab46699ed7e329c9e Mon Sep 17 00:00:00 2001 From: Charles McGarvey Date: Sun, 15 Mar 2020 18:10:11 -0600 Subject: [PATCH 1/1] Release 0.600 --- README | 202 ++++++++++ graphql | 1137 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 1339 insertions(+) create mode 100644 README create mode 100755 graphql diff --git a/README b/README new file mode 100644 index 0000000..ba5570e --- /dev/null +++ b/README @@ -0,0 +1,202 @@ +NAME + + GraphQL::Client - A GraphQL client + +VERSION + + version 0.600 + +SYNOPSIS + + my $graphql = GraphQL::Client->new(url => 'http://localhost:4000/graphql'); + + # 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; + ... + }); + +DESCRIPTION + + GraphQL::Client provides a simple way to execute GraphQL + queries and mutations on a server. + + This module is the programmatic interface. There is also a graphql. + + 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. + +ATTRIBUTES + + url + + The URL of a GraphQL endpoint, e.g. "http://myapiserver/graphql". + + class + + The package name of a transport. + + By default this is automatically determined from the protocol portion + of the "url". + + transport + + The transport object. + + By default this is automatically constructed based on the "class". + + unpack + + Whether or not to "unpack" the response, which enables a different + style for error-handling. + + Default is 0. + + See "ERROR HANDLING". + +METHODS + + new + + $graphql = GraphQL::Client->new(%attributes); + + Construct a new client. + + execute + + $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); + + Execute a request on a GraphQL server, and get a response. + + 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. + + { + data => { + field1 => {...}, # or [...] + ... + }, + errors => [ + { message => 'some error message blah blah blah' }, + ... + ], + } + + Note: Setting the "unpack" attribute affects the response shape. + +ERROR HANDLING + + There are two different styles for handling errors. + + If "unpack" is 0 (off), every response -- whether success or failure -- + is enveloped like this: + + { + data => {...}, + errors => [...], + } + + where data might be missing or undef if errors occurred (though not + necessarily) and errors will be missing if the response completed + without error. + + It is up to you to check for errors in the response, so your code might + look like this: + + my $response = $graphql->execute(...); + if (my $errors = $response->{errors}) { + # handle $errors + } + else { + my $data = $response->{data}; + # do something with $data + } + + 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: + + my $data = eval { $graphql->execute(...) }; + if (my $error = $@) { + # handle errors + } + else { + # do something with $data + } + + Or if you want to handle errors in a different stack frame, your code + is simply this: + + my $data = $graphql->execute(...); + # do something with $data + + 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. + +SEE ALSO + + * graphql - CLI program + + * GraphQL - Perl implementation of a GraphQL server + + * https://graphql.org/ - GraphQL project website + +BUGS + + Please report any bugs or feature requests on the bugtracker website + https://github.com/chazmcgarvey/graphql-client/issues + + When submitting a bug or request, please include a test-file or a patch + to an existing test-file that illustrates the bug or desired feature. + +AUTHOR + + Charles McGarvey + +COPYRIGHT AND LICENSE + + This software is copyright (c) 2020 by Charles McGarvey. + + This is free software; you can redistribute it and/or modify it under + the same terms as the Perl 5 programming language system itself. + diff --git a/graphql b/graphql new file mode 100755 index 0000000..f2d1345 --- /dev/null +++ b/graphql @@ -0,0 +1,1137 @@ +#!/usr/bin/env perl +# PODNAME: graphql +# ABSTRACT: Command-line GraphQL client + + +# This chunk of stuff was generated by App::FatPacker. To find the original +# file's code, look for the end of this BEGIN block or the string 'FATPACK' +BEGIN { +my %fatpacked; + +$fatpacked{"B/Hooks/EndOfScope.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'B_HOOKS_ENDOFSCOPE'; + package B::Hooks::EndOfScope;use strict;use warnings;our$VERSION='0.24';use 5.006001;BEGIN {use Module::Implementation 0.05;Module::Implementation::build_loader_sub(implementations=>['XS','PP' ],symbols=>['on_scope_end' ],)->()}use Sub::Exporter::Progressive 0.001006 -setup=>{exports=>['on_scope_end' ],groups=>{default=>['on_scope_end']},};1; +B_HOOKS_ENDOFSCOPE + +$fatpacked{"B/Hooks/EndOfScope/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'B_HOOKS_ENDOFSCOPE_PP'; + package B::Hooks::EndOfScope::PP;use warnings;use strict;our$VERSION='0.24';use constant _PERL_VERSION=>"$]";BEGIN {if (_PERL_VERSION =~ /^5\.009/){die "By design B::Hooks::EndOfScope does not operate in pure-perl mode on perl 5.9.X\n"}elsif (_PERL_VERSION < '5.010'){require B::Hooks::EndOfScope::PP::HintHash;*on_scope_end=\&B::Hooks::EndOfScope::PP::HintHash::on_scope_end}else {require B::Hooks::EndOfScope::PP::FieldHash;*on_scope_end=\&B::Hooks::EndOfScope::PP::FieldHash::on_scope_end}}use Sub::Exporter::Progressive 0.001006 -setup=>{exports=>['on_scope_end'],groups=>{default=>['on_scope_end']},};sub __invoke_callback {local $@;eval {$_[0]->();1}or do {my$err=$@;require Carp;Carp::cluck((join ' ','A scope-end callback raised an exception, which can not be propagated when','B::Hooks::EndOfScope operates in pure-perl mode. Your program will CONTINUE','EXECUTION AS IF NOTHING HAPPENED AFTER THIS WARNING. Below is the complete','exception text, followed by a stack-trace of the callback execution:',)."\n\n$err\n\r");sleep 1 if -t *STDERR}}1; +B_HOOKS_ENDOFSCOPE_PP + +$fatpacked{"B/Hooks/EndOfScope/PP/FieldHash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'B_HOOKS_ENDOFSCOPE_PP_FIELDHASH'; + package B::Hooks::EndOfScope::PP::FieldHash;use strict;use warnings;our$VERSION='0.24';use Tie::Hash ();use Hash::Util::FieldHash 'fieldhash';fieldhash my%hh;{package B::Hooks::EndOfScope::PP::_TieHintHashFieldHash;our@ISA=('Tie::StdHash');sub DELETE {my$ret=shift->SUPER::DELETE(@_);B::Hooks::EndOfScope::PP::__invoke_callback($_)for @$ret;$ret}}sub on_scope_end (&) {$^H |= 0x020000;tie(%hh,'B::Hooks::EndOfScope::PP::_TieHintHashFieldHash')unless tied%hh;push @{$hh{\%^H}||= []},$_[0]}1; +B_HOOKS_ENDOFSCOPE_PP_FIELDHASH + +$fatpacked{"B/Hooks/EndOfScope/PP/HintHash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'B_HOOKS_ENDOFSCOPE_PP_HINTHASH'; + package B::Hooks::EndOfScope::PP::HintHash;use strict;use warnings;our$VERSION='0.24';use Scalar::Util ();use constant _NEEDS_MEMORY_CORRUPTION_FIXUP=>("$]" >= 5.008 and "$]" < 5.008004)? 1 : 0;use constant _PERL_VERSION=>"$]";sub on_scope_end (&) {$^H |= 0x020000 if _PERL_VERSION >= 5.008;local %^H=%^H if _PERL_VERSION < 5.008;bless \%^H,'B::Hooks::EndOfScope::PP::HintHash::__GraveyardTransport' if (_NEEDS_MEMORY_CORRUPTION_FIXUP and ref \%^H eq 'HASH');push @{$^H{sprintf '__B_H_EOS__guardstack_0X%x',Scalar::Util::refaddr(\%^H)}||= bless ([],'B::Hooks::EndOfScope::PP::_SG_STACK')},$_[0]}sub B::Hooks::EndOfScope::PP::_SG_STACK::DESTROY {B::Hooks::EndOfScope::PP::__invoke_callback($_)for @{$_[0]}}{my@Hint_Hash_Graveyard;push@Hint_Hash_Graveyard,\@Hint_Hash_Graveyard if _NEEDS_MEMORY_CORRUPTION_FIXUP;sub B::Hooks::EndOfScope::PP::HintHash::__GraveyardTransport::DESTROY {push@Hint_Hash_Graveyard,$_[0];bless $_[0],'B::Hooks::EndOfScope::PP::HintHash::__DeactivateGraveyardTransport';%{$_[0]}=()}}1; +B_HOOKS_ENDOFSCOPE_PP_HINTHASH + +$fatpacked{"B/Hooks/EndOfScope/XS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'B_HOOKS_ENDOFSCOPE_XS'; + package B::Hooks::EndOfScope::XS;use strict;use warnings;our$VERSION='0.24';use 5.008004;use Variable::Magic 0.48 ();use Sub::Exporter::Progressive 0.001006 -setup=>{exports=>['on_scope_end'],groups=>{default=>['on_scope_end']},};my$wiz=Variable::Magic::wizard data=>sub {[$_[1]]},free=>sub {$_->()for @{$_[1]};()},local=>\undef ;sub on_scope_end (&) {$^H |= 0x020000;if (my$stack=Variable::Magic::getdata %^H,$wiz){push @{$stack},$_[0]}else {Variable::Magic::cast %^H,$wiz,$_[0]}}1; +B_HOOKS_ENDOFSCOPE_XS + +$fatpacked{"Dist/CheckConflicts.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'DIST_CHECKCONFLICTS'; + package Dist::CheckConflicts;BEGIN {$Dist::CheckConflicts::AUTHORITY='cpan:DOY'}$Dist::CheckConflicts::VERSION='0.11';use strict;use warnings;use 5.006;use base 'Exporter';our@EXPORT=our@EXPORT_OK=(qw(conflicts check_conflicts calculate_conflicts dist));use Carp;use Module::Runtime 0.009 'module_notional_filename','require_module';my%CONFLICTS;my%HAS_CONFLICTS;my%DISTS;sub import {my$pkg=shift;my$for=caller;my ($conflicts,$alsos,$dist);($conflicts,@_)=_strip_opt('-conflicts'=>@_);($alsos,@_)=_strip_opt('-also'=>@_);($dist,@_)=_strip_opt('-dist'=>@_);my%conflicts=%{$conflicts || {}};for my$also (@{$alsos || []}){eval {require_module($also)}or next;if (!exists$CONFLICTS{$also}){$also .= '::Conflicts';eval {require_module($also)}or next}if (!exists$CONFLICTS{$also}){next}my%also_confs=$also->conflicts;for my$also_conf (keys%also_confs){$conflicts{$also_conf}=$also_confs{$also_conf}if!exists$conflicts{$also_conf}|| $conflicts{$also_conf}lt $also_confs{$also_conf}}}$CONFLICTS{$for}=\%conflicts;$DISTS{$for}=$dist || $for;if (grep {$_ eq ':runtime'}@_){for my$conflict (keys%conflicts){$HAS_CONFLICTS{$conflict}||= [];push @{$HAS_CONFLICTS{$conflict}},$for}for my$conflict (keys%conflicts){if (exists$INC{module_notional_filename($conflict)}){_check_version([$for],$conflict)}}@INC=grep {!(ref($_)eq 'ARRAY' && @$_ > 1 && $_->[1]==\%CONFLICTS)}@INC;unshift@INC,[sub {my ($sub,$file)=@_;(my$mod=$file)=~ s{\.pm$}{};$mod =~ s{/}{::}g;return unless$mod =~ /[\w:]+/;return unless defined$HAS_CONFLICTS{$mod};{local$HAS_CONFLICTS{$mod};require$file}_check_version($HAS_CONFLICTS{$mod},$mod);my$called;return sub {return 0 if$called;$_="1;";$called=1;return 1}},\%CONFLICTS,]}$pkg->export_to_level(1,@_)}sub _strip_opt {my ($opt,@args)=@_;my$val;for my$idx (0 .. $#args - 1){if (defined$args[$idx]&& $args[$idx]eq $opt){$val=(splice@args,$idx,2)[1];last}}return ($val,@args)}sub _check_version {my ($fors,$mod)=@_;for my$for (@$fors){my$conflict_ver=$CONFLICTS{$for}{$mod};my$version=do {no strict 'refs';${${$mod .'::'}{VERSION}}};if ($version le $conflict_ver){warn <dist;my@conflicts=$package->calculate_conflicts;return unless@conflicts;my$err="Conflicts detected for $dist:\n";for my$conflict (@conflicts){$err .= " $conflict->{package} is version " ."$conflict->{installed}, but must be greater than version " ."$conflict->{required}\n"}die$err}sub calculate_conflicts {my$package=shift;my%conflicts=$package->conflicts;my@ret;CONFLICT: for my$conflict (keys%conflicts){my$success=do {local$SIG{__WARN__}=sub {};eval {require_module($conflict)}};my$error=$@;my$file=module_notional_filename($conflict);next if not $success and $error =~ /Can't locate \Q$file\E in \@INC/;warn "Warning: $conflict did not compile" if not $success;my$installed=$success ? $conflict->VERSION : 'unknown';push@ret,{package=>$conflict,installed=>$installed,required=>$conflicts{$conflict},}if not $success or $installed le $conflicts{$conflict}}return sort {$a->{package}cmp $b->{package}}@ret}1; + Conflict detected for $DISTS{$for}: + $mod is version $version, but must be greater than version $conflict_ver + EOF +DIST_CHECKCONFLICTS + +$fatpacked{"Future.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FUTURE'; + package Future;use strict;use warnings;no warnings 'recursion';our$VERSION='0.43';use Carp qw();use Scalar::Util qw(weaken blessed reftype);use B qw(svref_2object);use Time::HiRes qw(gettimeofday tv_interval);require overload;require Future::Exception;our@CARP_NOT=qw(Future::Utils);use constant DEBUG=>!!$ENV{PERL_FUTURE_DEBUG};our$TIMES=DEBUG || $ENV{PERL_FUTURE_TIMES};use constant {CB_DONE=>1<<0,CB_FAIL=>1<<1,CB_CANCEL=>1<<2,CB_SELF=>1<<3,CB_RESULT=>1<<4,CB_SEQ_ONDONE=>1<<5,CB_SEQ_ONFAIL=>1<<6,CB_SEQ_IMDONE=>1<<7,CB_SEQ_IMFAIL=>1<<8,};use constant CB_ALWAYS=>CB_DONE|CB_FAIL|CB_CANCEL;sub CvNAME_FILE_LINE {my ($code)=@_;my$cv=svref_2object($code);my$name=join "::",$cv->STASH->NAME,$cv->GV->NAME;return$name unless$cv->GV->NAME eq "__ANON__";my$cop=$cv->START;$cop=$cop->next while$cop and ref$cop ne "B::COP" and ref$cop ne "B::NULL";return$cv->GV->NAME if ref$cop eq "B::NULL";sprintf "%s(%s line %d)",$cv->GV->NAME,$cop->file,$cop->line}sub _callable {my ($cb)=@_;defined$cb and (reftype($cb)eq 'CODE' || overload::Method($cb,'&{}'))}sub new {my$proto=shift;return bless {ready=>0,callbacks=>[],(DEBUG ? (do {my$at=Carp::shortmess("constructed");chomp$at;$at =~ s/\.$//;constructed_at=>$at}): ()),($TIMES ? (btime=>[gettimeofday ]): ()),},(ref$proto || $proto)}*AWAIT_CLONE=sub {shift->new};my$GLOBAL_END;END {$GLOBAL_END=1}sub DESTROY_debug {my$self=shift;return if$GLOBAL_END;return if$self->{ready}and ($self->{reported}or!$self->{failure});my$lost_at=join " line ",(caller)[1,2];if($self->{ready}and $self->{failure}){warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at with an unreported failure of: " .$self->{failure}[0]."\n"}elsif(!$self->{ready}){warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at before it was ready.\n"}}*DESTROY=\&DESTROY_debug if DEBUG;sub wrap {my$class=shift;my@values=@_;if(@values==1 and blessed$values[0]and $values[0]->isa(__PACKAGE__)){return$values[0]}else {return$class->done(@values)}}sub call {my$class=shift;my ($code,@args)=@_;my$f;eval {$f=$code->(@args);1}or $f=$class->fail($@);blessed$f and $f->isa("Future")or $f=$class->fail("Expected " .CvNAME_FILE_LINE($code)." to return a Future");return$f}sub _shortmess {my$at=Carp::shortmess($_[0]);chomp$at;$at =~ s/\.$//;return$at}sub _mark_ready {my$self=shift;$self->{ready}=1;$self->{ready_at}=_shortmess $_[0]if DEBUG;if($TIMES){$self->{rtime}=[gettimeofday ]}delete$self->{on_cancel};$_->[0]and $_->[0]->_revoke_on_cancel($_->[1])for @{$self->{revoke_when_ready}};delete$self->{revoke_when_ready};my$callbacks=delete$self->{callbacks}or return;my$cancelled=$self->{cancelled};my$fail=defined$self->{failure};my$done=!$fail &&!$cancelled;my@result=$done ? $self->get : $fail ? $self->failure : ();for my$cb (@$callbacks){my ($flags,$code)=@$cb;my$is_future=blessed($code)&& $code->isa("Future");next if$done and not($flags & CB_DONE);next if$fail and not($flags & CB_FAIL);next if$cancelled and not($flags & CB_CANCEL);$self->{reported}=1 if$fail;if($is_future){$done ? $code->done(@result): $fail ? $code->fail(@result): $code->cancel}elsif($flags & (CB_SEQ_ONDONE|CB_SEQ_ONFAIL)){my (undef,undef,$fseq)=@$cb;if(!$fseq){Carp::carp +(DEBUG ? "${\$self->__selfstr} ($self->{constructed_at})" : "${\$self->__selfstr} $self")." lost a sequence Future";next}my$f2;if($done and $flags & CB_SEQ_ONDONE or $fail and $flags & CB_SEQ_ONFAIL){if($flags & CB_SEQ_IMDONE){$fseq->done(@$code);next}elsif($flags & CB_SEQ_IMFAIL){$fseq->fail(@$code);next}my@args=(($flags & CB_SELF ? $self : ()),($flags & CB_RESULT ? @result : ()),);unless(eval {$f2=$code->(@args);1}){$fseq->fail($@);next}unless(blessed$f2 and $f2->isa("Future")){$fseq->fail("Expected " .CvNAME_FILE_LINE($code)." to return a Future");next}$fseq->on_cancel($f2)}else {$f2=$self}if($f2->is_ready){$f2->on_ready($fseq)if!$f2->{cancelled}}else {push @{$f2->{callbacks}},[CB_DONE|CB_FAIL,$fseq ];weaken($f2->{callbacks}[-1][1])}}else {$code->(($flags & CB_SELF ? $self : ()),($flags & CB_RESULT ? @result : ()),)}}}sub is_ready {my$self=shift;return$self->{ready}}*AWAIT_IS_READY=\&is_ready;sub is_done {my$self=shift;return$self->{ready}&&!$self->{failure}&&!$self->{cancelled}}sub is_failed {my$self=shift;return$self->{ready}&&!!$self->{failure}}sub is_cancelled {my$self=shift;return$self->{cancelled}}*AWAIT_IS_CANCELLED=\&is_cancelled;sub state {my$self=shift;return!$self->{ready}? "pending" : DEBUG ? $self->{ready_at}: $self->{failure}? "failed" : $self->{cancelled}? "cancelled" : "done"}sub done {my$self=shift;if(ref$self){$self->{cancelled}and return$self;$self->{ready}and Carp::croak "${\$self->__selfstr} is already ".$self->state." and cannot be ->done";$self->{subs}and Carp::croak "${\$self->__selfstr} is not a leaf Future, cannot be ->done";$self->{result}=[@_ ];$self->_mark_ready("done")}else {$self=$self->new;$self->{ready}=1;$self->{ready_at}=_shortmess "done" if DEBUG;$self->{result}=[@_ ]}return$self}*AWAIT_NEW_DONE=*AWAIT_DONE=\&done;sub fail {my$self=shift;my ($exception,@more)=@_;if(ref$exception eq "Future::Exception"){@more=($exception->category,$exception->details);$exception=$exception->message}$exception or Carp::croak "$self ->fail requires an exception that is true";if(ref$self){$self->{cancelled}and return$self;$self->{ready}and Carp::croak "${\$self->__selfstr} is already ".$self->state." and cannot be ->fail'ed";$self->{subs}and Carp::croak "${\$self->__selfstr} is not a leaf Future, cannot be ->fail'ed";$self->{failure}=[$exception,@more ];$self->_mark_ready("failed")}else {$self=$self->new;$self->{ready}=1;$self->{ready_at}=_shortmess "failed" if DEBUG;$self->{failure}=[$exception,@more ]}return$self}*AWAIT_NEW_FAIL=*AWAIT_FAIL=\&fail;sub die :method {my$self=shift;my ($exception,@more)=@_;if(!ref$exception and $exception !~ m/\n$/){$exception .= sprintf " at %s line %d\n",(caller)[1,2]}$self->fail($exception,@more)}sub on_cancel {my$self=shift;my ($code)=@_;my$is_future=blessed($code)&& $code->isa("Future");$is_future or _callable($code)or Carp::croak "Expected \$code to be callable or a Future in ->on_cancel";$self->{ready}and return$self;push @{$self->{on_cancel}},$code;if($is_future){push @{$code->{revoke_when_ready}},my$r=[$self,\$self->{on_cancel}[-1]];weaken($r->[0]);weaken($r->[1])}return$self}sub AWAIT_ON_CANCEL {my$self=shift;my ($f2)=@_;push @{$self->{on_cancel}},$f2;push @{$f2->{revoke_when_ready}},my$r=[$self,\$self->{on_cancel}[-1]];weaken($r->[0]);weaken($r->[1])}sub _revoke_on_cancel {my$self=shift;my ($ref)=@_;undef $$ref;$self->{empty_on_cancel_slots}++;my$on_cancel=$self->{on_cancel}or return;if(@$on_cancel >= 8 and $self->{empty_on_cancel_slots}>= 0.5 * @$on_cancel){my$idx=0;while($idx < @$on_cancel){defined$on_cancel->[$idx]and $idx++,next;splice @$on_cancel,$idx,1,()}$self->{empty_on_cancel_slots}=0}}sub on_ready {my$self=shift;my ($code)=@_;my$is_future=blessed($code)&& $code->isa("Future");$is_future or _callable($code)or Carp::croak "Expected \$code to be callable or a Future in ->on_ready";if($self->{ready}){my$fail=defined$self->{failure};my$done=!$fail &&!$self->{cancelled};$self->{reported}=1 if$fail;$is_future ? ($done ? $code->done($self->get): $fail ? $code->fail($self->failure): $code->cancel): $code->($self)}else {push @{$self->{callbacks}},[CB_ALWAYS|CB_SELF,$self->wrap_cb(on_ready=>$code)]}return$self}sub AWAIT_ON_READY {my$self=shift;my ($code)=@_;push @{$self->{callbacks}},[CB_ALWAYS|CB_SELF,$self->wrap_cb(on_ready=>$code)]}sub get {my$self=shift;$self->block_until_ready unless$self->{ready};if(my$failure=$self->{failure}){$self->{reported}=1;my$exception=$failure->[0];$exception=Future::Exception->new(@$failure)if @$failure > 1;!ref$exception && $exception =~ m/\n$/ ? CORE::die$exception : Carp::croak$exception}$self->{cancelled}and Carp::croak "${\$self->__selfstr} was cancelled";return$self->{result}->[0]unless wantarray;return @{$self->{result}}}*AWAIT_GET=\&get;sub await {my$self=shift;Carp::croak "$self is not yet complete and does not provide ->await"}sub block_until_ready {my$self=shift;until($self->{ready}){$self->await}return$self}sub unwrap {shift;my@values=@_;if(@values==1 and blessed$values[0]and $values[0]->isa(__PACKAGE__)){return$values[0]->get}else {return$values[0]if!wantarray;return@values}}sub on_done {my$self=shift;my ($code)=@_;my$is_future=blessed($code)&& $code->isa("Future");$is_future or _callable($code)or Carp::croak "Expected \$code to be callable or a Future in ->on_done";if($self->{ready}){return$self if$self->{failure}or $self->{cancelled};$is_future ? $code->done($self->get): $code->($self->get)}else {push @{$self->{callbacks}},[CB_DONE|CB_RESULT,$self->wrap_cb(on_done=>$code)]}return$self}sub failure {my$self=shift;$self->block_until_ready unless$self->{ready};return unless$self->{failure};$self->{reported}=1;return$self->{failure}->[0]if!wantarray;return @{$self->{failure}}}sub on_fail {my$self=shift;my ($code)=@_;my$is_future=blessed($code)&& $code->isa("Future");$is_future or _callable($code)or Carp::croak "Expected \$code to be callable or a Future in ->on_fail";if($self->{ready}){return$self if not $self->{failure};$self->{reported}=1;$is_future ? $code->fail($self->failure): $code->($self->failure)}else {push @{$self->{callbacks}},[CB_FAIL|CB_RESULT,$self->wrap_cb(on_fail=>$code)]}return$self}sub cancel {my$self=shift;return$self if$self->{ready};$self->{cancelled}++;my$on_cancel=delete$self->{on_cancel};for my$code ($on_cancel ? reverse @$on_cancel : ()){defined$code or next;my$is_future=blessed($code)&& $code->isa("Future");$is_future ? $code->cancel : $code->($self)}$self->_mark_ready("cancel");return$self}sub _sequence {my$f1=shift;my ($code,$flags)=@_;my$func=(caller 1)[3];$func =~ s/^.*:://;$flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL)or _callable($code)or Carp::croak "Expected \$code to be callable in ->$func";if(!defined wantarray){Carp::carp "Calling ->$func in void context"}if($f1->is_ready){return$f1 if$f1->is_done and not($flags & CB_SEQ_ONDONE)or $f1->failure and not($flags & CB_SEQ_ONFAIL);if($flags & CB_SEQ_IMDONE){return Future->done(@$code)}elsif($flags & CB_SEQ_IMFAIL){return Future->fail(@$code)}my@args=(($flags & CB_SELF ? $f1 : ()),($flags & CB_RESULT ? $f1->is_done ? $f1->get : $f1->failure ? $f1->failure : (): ()),);my$fseq;unless(eval {$fseq=$code->(@args);1}){return Future->fail($@)}unless(blessed$fseq and $fseq->isa("Future")){return Future->fail("Expected " .CvNAME_FILE_LINE($code)." to return a Future")}return$fseq}my$fseq=$f1->new;$fseq->on_cancel($f1);$code=$f1->wrap_cb(sequence=>$code)unless$flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL);push @{$f1->{callbacks}},[CB_DONE|CB_FAIL|$flags,$code,$fseq ];weaken($f1->{callbacks}[-1][2]);return$fseq}my$make_donecatchfail_sub=sub {my ($with_f,$done_code,$fail_code,@catch_list)=@_;my$func=(caller 1)[3];$func =~ s/^.*:://;!$done_code or _callable($done_code)or Carp::croak "Expected \$done_code to be callable in ->$func";!$fail_code or _callable($fail_code)or Carp::croak "Expected \$fail_code to be callable in ->$func";my%catch_handlers=@catch_list;_callable($catch_handlers{$_})or Carp::croak "Expected catch handler for '$_' to be callable in ->$func" for keys%catch_handlers;sub {my$self=shift;my@maybe_self=$with_f ? ($self): ();if(!$self->{failure}){return$self unless$done_code;return$done_code->(@maybe_self,$self->get)}else {my$name=$self->{failure}[1];if(defined$name and $catch_handlers{$name}){return$catch_handlers{$name}->(@maybe_self,$self->failure)}return$self unless$fail_code;return$fail_code->(@maybe_self,$self->failure)}}};sub then {my$self=shift;my$done_code=shift;my$fail_code=(@_ % 2)? pop : undef;my@catch_list=@_;if($done_code and!@catch_list and!$fail_code){return$self->_sequence($done_code,CB_SEQ_ONDONE|CB_RESULT)}return$self->_sequence($make_donecatchfail_sub->(0,$done_code,$fail_code,@catch_list,),CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF)}sub else {my$self=shift;my ($fail_code)=@_;return$self->_sequence($fail_code,CB_SEQ_ONFAIL|CB_RESULT)}sub catch {my$self=shift;my$fail_code=(@_ % 2)? pop : undef;my@catch_list=@_;return$self->_sequence($make_donecatchfail_sub->(0,undef,$fail_code,@catch_list,),CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF)}sub transform {my$self=shift;my%args=@_;my$xfrm_done=$args{done};my$xfrm_fail=$args{fail};return$self->_sequence(sub {my$self=shift;if(!$self->{failure}){return$self unless$xfrm_done;my@result=$xfrm_done->($self->get);return$self->new->done(@result)}else {return$self unless$xfrm_fail;my@failure=$xfrm_fail->($self->failure);return$self->new->fail(@failure)}},CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF)}sub then_with_f {my$self=shift;my$done_code=shift;my$fail_code=(@_ % 2)? pop : undef;my@catch_list=@_;if($done_code and!@catch_list and!$fail_code){return$self->_sequence($done_code,CB_SEQ_ONDONE|CB_SELF|CB_RESULT)}return$self->_sequence($make_donecatchfail_sub->(1,$done_code,$fail_code,@catch_list,),CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF)}sub then_done {my$self=shift;my (@result)=@_;return$self->_sequence(\@result,CB_SEQ_ONDONE|CB_SEQ_IMDONE)}sub then_fail {my$self=shift;my (@failure)=@_;return$self->_sequence(\@failure,CB_SEQ_ONDONE|CB_SEQ_IMFAIL)}sub else_with_f {my$self=shift;my ($fail_code)=@_;return$self->_sequence($fail_code,CB_SEQ_ONFAIL|CB_SELF|CB_RESULT)}sub else_done {my$self=shift;my (@result)=@_;return$self->_sequence(\@result,CB_SEQ_ONFAIL|CB_SEQ_IMDONE)}sub else_fail {my$self=shift;my (@failure)=@_;return$self->_sequence(\@failure,CB_SEQ_ONFAIL|CB_SEQ_IMFAIL)}sub catch_with_f {my$self=shift;my$fail_code=(@_ % 2)? pop : undef;my@catch_list=@_;return$self->_sequence($make_donecatchfail_sub->(1,undef,$fail_code,@catch_list,),CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF)}sub followed_by {my$self=shift;my ($code)=@_;return$self->_sequence($code,CB_SEQ_ONDONE|CB_SEQ_ONFAIL|CB_SELF)}sub without_cancel {my$self=shift;my$new=$self->new;$self->on_ready(sub {my$self=shift;if($self->failure){$new->fail($self->failure)}else {$new->done($self->get)}});$new->{orig}=$self;$new->on_ready(sub {undef $_[0]->{orig}});return$new}sub retain {my$self=shift;return$self->on_ready(sub {undef$self})}sub _new_convergent {shift;my ($subs)=@_;for my$sub (@$subs){blessed$sub and $sub->isa("Future")or Carp::croak "Expected a Future, got $sub"}my$self;ref($_)eq "Future" or $self=$_->new,last for @$subs;$self ||= Future->new;$self->{subs}=$subs;$self->on_cancel(sub {for my$sub (@$subs){$sub->cancel if$sub and!$sub->{ready}}});return$self}sub wait_all {my$class=shift;my@subs=@_;unless(@subs){my$self=$class->done;$self->{subs}=[];return$self}my$self=Future->_new_convergent(\@subs);my$pending=0;$_->{ready}or $pending++ for@subs;if(!$pending){$self->{result}=[@subs ];$self->_mark_ready("wait_all");return$self}weaken(my$weakself=$self);my$sub_on_ready=sub {return unless my$self=$weakself;$pending--;$pending and return;$self->{result}=[@subs ];$self->_mark_ready("wait_all")};for my$sub (@subs){$sub->{ready}or $sub->on_ready($sub_on_ready)}return$self}sub wait_any {my$class=shift;my@subs=@_;unless(@subs){my$self=$class->fail("Cannot ->wait_any with no subfutures");$self->{subs}=[];return$self}my$self=Future->_new_convergent(\@subs);my$immediate_ready;for my$sub (@subs){$sub->{ready}and $immediate_ready=$sub,last}if($immediate_ready){for my$sub (@subs){$sub->{ready}or $sub->cancel}if($immediate_ready->{failure}){$self->{failure}=[$immediate_ready->failure ]}else {$self->{result}=[$immediate_ready->get ]}$self->_mark_ready("wait_any");return$self}my$pending=0;weaken(my$weakself=$self);my$sub_on_ready=sub {return unless my$self=$weakself;return if$self->{result}or $self->{failure};return if --$pending and $_[0]->{cancelled};if($_[0]->{cancelled}){$self->{failure}=["All component futures were cancelled" ]}elsif($_[0]->{failure}){$self->{failure}=[$_[0]->failure ]}else {$self->{result}=[$_[0]->get ]}for my$sub (@subs){$sub->{ready}or $sub->cancel}$self->_mark_ready("wait_any")};for my$sub (@subs){$sub->on_ready($sub_on_ready);$pending++}return$self}sub needs_all {my$class=shift;my@subs=@_;unless(@subs){my$self=$class->done;$self->{subs}=[];return$self}my$self=Future->_new_convergent(\@subs);my$immediate_fail;for my$sub (@subs){$sub->{ready}and $sub->{failure}and $immediate_fail=$sub,last}if($immediate_fail){for my$sub (@subs){$sub->{ready}or $sub->cancel}$self->{failure}=[$immediate_fail->failure ];$self->_mark_ready("needs_all");return$self}my$pending=0;$_->{ready}or $pending++ for@subs;if(!$pending){$self->{result}=[map {$_->get}@subs ];$self->_mark_ready("needs_all");return$self}weaken(my$weakself=$self);my$sub_on_ready=sub {return unless my$self=$weakself;return if$self->{result}or $self->{failure};if($_[0]->{cancelled}){$self->{failure}=["A component future was cancelled" ];for my$sub (@subs){$sub->cancel if!$sub->{ready}}$self->_mark_ready("needs_all")}elsif(my@failure=$_[0]->failure){$self->{failure}=\@failure;for my$sub (@subs){$sub->cancel if!$sub->{ready}}$self->_mark_ready("needs_all")}else {$pending--;$pending and return;$self->{result}=[map {$_->get}@subs ];$self->_mark_ready("needs_all")}};for my$sub (@subs){$sub->{ready}or $sub->on_ready($sub_on_ready)}return$self}sub needs_any {my$class=shift;my@subs=@_;unless(@subs){my$self=$class->fail("Cannot ->needs_any with no subfutures");$self->{subs}=[];return$self}my$self=Future->_new_convergent(\@subs);my$immediate_done;my$pending=0;for my$sub (@subs){$sub->{ready}and!$sub->{failure}and $immediate_done=$sub,last;$sub->{ready}or $pending++}if($immediate_done){for my$sub (@subs){$sub->{ready}? $sub->{reported}=1 : $sub->cancel}$self->{result}=[$immediate_done->get ];$self->_mark_ready("needs_any");return$self}my$immediate_fail=1;for my$sub (@subs){$sub->{ready}or $immediate_fail=0,last}if($immediate_fail){$_->{reported}=1 for@subs;$self->{failure}=[$subs[-1]->{failure}];$self->_mark_ready("needs_any");return$self}weaken(my$weakself=$self);my$sub_on_ready=sub {return unless my$self=$weakself;return if$self->{result}or $self->{failure};return if --$pending and $_[0]->{cancelled};if($_[0]->{cancelled}){$self->{failure}=["All component futures were cancelled" ];$self->_mark_ready("needs_any")}elsif(my@failure=$_[0]->failure){$pending and return;$self->{failure}=\@failure;$self->_mark_ready("needs_any")}else {$self->{result}=[$_[0]->get ];for my$sub (@subs){$sub->cancel if!$sub->{ready}}$self->_mark_ready("needs_any")}};for my$sub (@subs){$sub->{ready}or $sub->on_ready($sub_on_ready)}return$self}sub pending_futures {my$self=shift;$self->{subs}or Carp::croak "Cannot call ->pending_futures on a non-convergent Future";return grep {not $_->{ready}}@{$self->{subs}}}sub ready_futures {my$self=shift;$self->{subs}or Carp::croak "Cannot call ->ready_futures on a non-convergent Future";return grep {$_->{ready}}@{$self->{subs}}}sub done_futures {my$self=shift;$self->{subs}or Carp::croak "Cannot call ->done_futures on a non-convergent Future";return grep {$_->{ready}and not $_->{failure}and not $_->{cancelled}}@{$self->{subs}}}sub failed_futures {my$self=shift;$self->{subs}or Carp::croak "Cannot call ->failed_futures on a non-convergent Future";return grep {$_->{ready}and $_->{failure}}@{$self->{subs}}}sub cancelled_futures {my$self=shift;$self->{subs}or Carp::croak "Cannot call ->cancelled_futures on a non-convergent Future";return grep {$_->{ready}and $_->{cancelled}}@{$self->{subs}}}sub set_label {my$self=shift;($self->{label})=@_;return$self}sub label {my$self=shift;return$self->{label}}sub __selfstr {my$self=shift;return "$self" unless defined$self->{label};return "$self (\"$self->{label}\")"}sub btime {my$self=shift;return$self->{btime}}sub rtime {my$self=shift;return$self->{rtime}}sub elapsed {my$self=shift;return undef unless defined$self->{btime}and defined$self->{rtime};return$self->{elapsed}||= tv_interval($self->{btime},$self->{rtime})}sub wrap_cb {my$self=shift;my ($op,$cb)=@_;return$cb}0x55AA; +FUTURE + +$fatpacked{"Future/Exception.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FUTURE_EXCEPTION'; + package Future::Exception;use strict;use warnings;our$VERSION='0.43';use overload '""'=>"message",fallback=>1;sub from_future {my$class=shift;my ($f)=@_;return$class->new($f->failure)}sub new {my$class=shift;bless [@_ ],$class}sub message {shift->[0]}sub category {shift->[1]}sub details {my$self=shift;@{$self}[2..$#$self]}sub throw {my$class=shift;my ($message,$category,@details)=@_;$message =~ m/\n$/ or $message .= sprintf " at %s line %d.\n",(caller)[1,2];die$class->new($message,$category,@details)}sub as_future {my$self=shift;return Future->fail($self->message,$self->category,$self->details)}0x55AA; +FUTURE_EXCEPTION + +$fatpacked{"Future/Mutex.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FUTURE_MUTEX'; + package Future::Mutex;use strict;use warnings;use 5.010;our$VERSION='0.43';use Future;sub new {my$class=shift;my%params=@_;return bless {avail=>$params{count}// 1,queue=>[],},$class}sub enter {my$self=shift;my ($code)=@_;my$down_f;if($self->{avail}){$self->{avail}--;$down_f=Future->done}else {push @{$self->{queue}},$down_f=Future->new}my$up=sub {if(my$next_f=shift @{$self->{queue}}){$next_f->done}else {$self->{avail}++}};$down_f->then($code)->on_ready($up)}sub available {my$self=shift;return$self->{avail}}0x55AA; +FUTURE_MUTEX + +$fatpacked{"Future/Queue.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FUTURE_QUEUE'; + package Future::Queue;use strict;use warnings;our$VERSION='0.43';sub new {my$class=shift;return bless {items=>[],waiters=>[],},$class}sub push :method {my$self=shift;my ($item)=@_;push @{$self->{items}},$item;(shift @{$self->{waiters}})->done if @{$self->{waiters}}}sub shift :method {my$self=shift;if(@{$self->{items}}){return Future->done(shift @{$self->{items}})}push @{$self->{waiters}},my$f=Future->new;return$f->then(sub {return Future->done(shift @{$self->{items}})})}0x55AA; +FUTURE_QUEUE + +$fatpacked{"Future/Utils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FUTURE_UTILS'; + 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{"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.600';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 class {my$self=shift;$self->{class}}sub transport {my$self=shift;$self->{transport}//= do {my$class=$self->_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 _transport_class {my$self=shift;return _expand_class($self->{class})if$self->{class};my$protocol=$self->_url_protocol;_croak 'Failed to determine transport from URL' if!$protocol;my$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/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.600';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; +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.600';sub new {my$class=shift;GraphQL::Client::http->new(@_)}1; +GRAPHQL_CLIENT_HTTPS + +$fatpacked{"HTTP/AnyUA.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA'; + package HTTP::AnyUA;use 5.010;use warnings;use strict;our$VERSION='0.904';use HTTP::AnyUA::Util;use Module::Loader;use Scalar::Util;our$BACKEND_NAMESPACE;our$MIDDLEWARE_NAMESPACE;our@BACKENDS;our%REGISTERED_BACKENDS;BEGIN {$BACKEND_NAMESPACE=__PACKAGE__ .'::Backend';$MIDDLEWARE_NAMESPACE=__PACKAGE__ .'::Middleware'}sub _debug_log {print STDERR join(' ',@_),"\n" if$ENV{PERL_HTTP_ANYUA_DEBUG}}sub _croak {require Carp;Carp::croak(@_)}sub _usage {_croak("Usage: @_\n")}sub new {my$class=shift;unshift @_,'ua' if @_ % 2;my%args=@_;$args{ua}or _usage(q{HTTP::AnyUA->new(ua => $user_agent, %attr)});my$self;my@attr=qw(ua backend response_is_future);for my$attr (@attr){$self->{$attr}=$args{$attr}if defined$args{$attr}}bless$self,$class;$self->_debug_log('Created with user agent',$self->ua);$self->ua;$self->response_is_future($args{response_is_future})if defined$args{response_is_future};return$self}sub ua {shift->{ua}or _croak 'User agent is required'}sub response_is_future {my$self=shift;my$val=shift;if (defined$val){$self->_debug_log('Set response_is_future to',$val ? 'ON' : 'OFF');$self->_check_response_is_future($val);$self->{response_is_future}=$val;$self->_module_loader->load('Future')if$self->{response_is_future}}elsif (!defined$self->{response_is_future}&& $self->{backend}){$self->{response_is_future}=$self->backend->response_is_future;$self->_module_loader->load('Future')if$self->{response_is_future}}return$self->{response_is_future}|| ''}sub backend {my$self=shift;return$self->{backend}if defined$self->{backend};$self->{backend}=$self->_build_backend;$self->_check_response_is_future($self->response_is_future);return$self->{backend}}sub request {my ($self,$method,$url,$args)=@_;$args ||= {};@_==3 || (@_==4 && ref$args eq 'HASH')or _usage(q{$any_ua->request($method, $url, \%options)});my$resp=eval {$self->backend->request(uc($method)=>$url,$args)};if (my$err=$@){return$self->_wrap_internal_exception($err)}return$self->_wrap_response($resp)}for my$sub_name (qw{get head put post delete}){my%swap=(SUBNAME=>$sub_name,METHOD=>uc($sub_name));my$code=q[ + sub {{SUBNAME}} { + my ($self, $url, $args) = @_; + @_ == 2 || (@_ == 3 && ref $args eq 'HASH') + or _usage(q{$any_ua->{{SUBNAME}}($url, \%options)}); + return $self->request('{{METHOD}}', $url, $args); + } + ];$code =~ s/\{\{([A-Z_]+)\}\}/$swap{$1}/ge;eval$code}sub post_form {my ($self,$url,$data,$args)=@_;(@_==3 || @_==4 && ref$args eq 'HASH')or _usage(q{$any_ua->post_form($url, $formdata, \%options)});my$headers=HTTP::AnyUA::Util::normalize_headers($args->{headers});delete$args->{headers};return$self->request(POST=>$url,{%$args,content=>HTTP::AnyUA::Util::www_form_urlencode($data),headers=>{%$headers,'content-type'=>'application/x-www-form-urlencoded',},})}sub mirror {my ($self,$url,$file,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or _usage(q{$any_ua->mirror($url, $filepath, \%options)});$args->{headers}=HTTP::AnyUA::Util::normalize_headers($args->{headers});if (-e $file and my$mtime=(stat($file))[9]){$args->{headers}{'if-modified-since'}||= HTTP::AnyUA::Util::http_date($mtime)}my$tempfile=$file .int(rand(2**31));require Fcntl;sysopen(my$fh,$tempfile,Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY())or return$self->_wrap_internal_exception(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);binmode$fh;$args->{data_callback}=sub {print$fh $_[0]};my$resp=$self->request(GET=>$url,$args);my$finish=sub {my$resp=shift;close$fh or return HTTP::AnyUA::Util::internal_exception(qq/Error: Caught error closing temporary file $tempfile: $!\n/);if ($resp->{success}){rename($tempfile,$file)or return HTTP::AnyUA::Util::internal_exception(qq/Error replacing $file with $tempfile: $!\n/);my$lm=$resp->{headers}{'last-modified'};if ($lm and my$mtime=HTTP::AnyUA::Util::parse_http_date($lm)){utime($mtime,$mtime,$file)}}unlink($tempfile);$resp->{success}||= $resp->{status}eq '304';return$resp};if ($self->response_is_future){return$resp->followed_by(sub {my$future=shift;my@resp=$future->is_done ? $future->get : $future->failure;my$resp=$finish->(@resp);if ($resp->{success}){return Future->done(@resp)}else {return Future->fail(@resp)}})}else {return$finish->($resp)}}sub apply_middleware {my$self=shift;my$class=shift;if (!ref$class){$class="${MIDDLEWARE_NAMESPACE}::${class}" unless$class =~ s/^\+//;$self->_module_loader->load($class)}$self->{backend}=$class->wrap($self->backend,@_);$self->_check_response_is_future($self->response_is_future);return$self}sub register_backend {my ($class,$ua_type,$backend_class)=@_;@_==3 or _usage(q{HTTP::AnyUA->register_backend($ua_type, $backend_package)});if ($backend_class){$backend_class="${BACKEND_NAMESPACE}::${backend_class}" unless$backend_class =~ s/^\+//;$REGISTERED_BACKENDS{$ua_type}=$backend_class}else {delete$REGISTERED_BACKENDS{$ua_type}}}sub _wrap_response {my$self=shift;my$resp=shift;if ($self->response_is_future &&!$self->backend->response_is_future){if ($resp->{success}){$self->_debug_log('Wrapped successful response in a Future');$resp=Future->done($resp)}else {$self->_debug_log('Wrapped failed response in a Future');$resp=Future->fail($resp)}}return$resp}sub _wrap_internal_exception {shift->_wrap_response(HTTP::AnyUA::Util::internal_exception(@_))}sub _module_loader {shift->{_module_loader}||= Module::Loader->new}sub _build_backend {my$self=shift;my$ua=shift || $self->ua or _croak 'User agent is required';my$ua_type=Scalar::Util::blessed($ua);my@classes;if ($ua_type){push@classes,$REGISTERED_BACKENDS{$ua_type}if$REGISTERED_BACKENDS{$ua_type};push@classes,"${BACKEND_NAMESPACE}::${ua_type}";if (!@BACKENDS){@BACKENDS=sort$self->_module_loader->find_modules($BACKEND_NAMESPACE);$self->_debug_log('Found backends to try (' .join(', ',@BACKENDS).')')}for my$backend_type (@BACKENDS){my$plugin=$backend_type;$plugin =~ s/^\Q${BACKEND_NAMESPACE}\E:://;push@classes,$backend_type if$ua->isa($plugin)}}else {push@classes,$REGISTERED_BACKENDS{$ua}if$REGISTERED_BACKENDS{$ua};push@classes,"${BACKEND_NAMESPACE}::${ua}"}for my$class (@classes){if (eval {$self->_module_loader->load($class);1}){$self->_debug_log("Found usable backend (${class})");return$class->new($self->ua)}else {$self->_debug_log($@)}}_croak 'Cannot find a usable backend that supports the given user agent'}sub _check_response_is_future {my$self=shift;my$val=shift;if (!$val && $self->{backend}&& $self->backend->response_is_future){_croak 'Cannot disable response_is_future with a non-blocking user agent'}}1; +HTTP_ANYUA + +$fatpacked{"HTTP/AnyUA/Backend.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_BACKEND'; + package HTTP::AnyUA::Backend;use warnings;use strict;our$VERSION='0.904';sub new {my$class=shift;my$ua=shift or die 'User agent is required';bless {ua=>$ua},$class}sub request {die 'Not yet implemented'}sub ua {shift->{ua}}sub response_is_future {0}1; +HTTP_ANYUA_BACKEND + +$fatpacked{"HTTP/AnyUA/Backend/AnyEvent/HTTP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_BACKEND_ANYEVENT_HTTP'; + package HTTP::AnyUA::Backend::AnyEvent::HTTP;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Backend';use Future;use HTTP::AnyUA::Util;my$future_class;BEGIN {$future_class='Future';eval 'use AnyEvent::Future';$future_class='AnyEvent::Future' if!$@}sub options {@_==2 ? $_[0]->{options}=pop : $_[0]->{options}}sub response_is_future {1}sub request {my$self=shift;my ($method,$url,$args)=@_;my%opts=$self->_munge_request($method,$url,$args);my$future=$future_class->new;require AnyEvent::HTTP;AnyEvent::HTTP::http_request($method=>$url,%opts,sub {my$resp=$self->_munge_response(@_,$args->{data_callback});if ($resp->{success}){$future->done($resp)}else {$future->fail($resp)}});return$future}sub _munge_request {my$self=shift;my$method=shift;my$url=shift;my$args=shift || {};my%opts=%{$self->options || {}};if (my$headers=$args->{headers}){my%headers;for my$header (keys %$headers){my$value=$headers->{$header};$value=join(', ',@$value)if ref($value)eq 'ARRAY';$headers{$header}=$value}$opts{headers}=\%headers}my@url_parts=HTTP::AnyUA::Util::split_url($url);if (my$auth=$url_parts[4]and!$opts{headers}{'authorization'}){require MIME::Base64;$opts{headers}{'authorization'}='Basic ' .MIME::Base64::encode_base64($auth,'')}my$content=HTTP::AnyUA::Util::coderef_content_to_string($args->{content});$opts{body}=$content if$content;if (my$data_cb=$args->{data_callback}){$opts{on_body}=sub {my$data=shift;$data_cb->($data,$self->_munge_response(undef,@_));1}}return%opts}sub _munge_response {my$self=shift;my$data=shift;my$headers=shift;my$data_cb=shift;my%headers=%$headers;my$code=delete$headers{Status};my$reason=delete$headers{Reason};my$url=delete$headers{URL};my$resp={success=>200 <= $code && $code <= 299,url=>$url,status=>$code,reason=>$reason,headers=>\%headers,};my$version=delete$headers{HTTPVersion};$resp->{protocol}="HTTP/$version" if$version;$resp->{content}=$data if$data &&!$data_cb;my@redirects;my$redirect=delete$headers{Redirect};while ($redirect){my$next=delete$redirect->[1]{Redirect};unshift@redirects,$self->_munge_response(@$redirect);$redirect=$next}$resp->{redirects}=\@redirects if@redirects;if (590 <= $code && $code <= 599){HTTP::AnyUA::Util::internal_exception($reason,$resp)}return$resp}1; +HTTP_ANYUA_BACKEND_ANYEVENT_HTTP + +$fatpacked{"HTTP/AnyUA/Backend/Furl.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_BACKEND_FURL'; + package HTTP::AnyUA::Backend::Furl;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Backend';use HTTP::AnyUA::Util;sub request {my$self=shift;my ($method,$url,$args)=@_;local$args->{content}=HTTP::AnyUA::Util::coderef_content_to_string($args->{content});my$request=HTTP::AnyUA::Util::native_to_http_request(@_);my$ua_resp=$self->ua->request($request);return$self->_munge_response($ua_resp,$args->{data_callback})}sub _munge_response {my$self=shift;my$ua_resp=shift;my$data_cb=shift;my$resp={success=>!!$ua_resp->is_success,url=>$ua_resp->request->uri->as_string,status=>$ua_resp->code,reason=>$ua_resp->message,headers=>HTTP::AnyUA::Util::http_headers_to_native($ua_resp->headers),};$resp->{protocol}=$ua_resp->protocol if$ua_resp->protocol;if ($resp->{headers}{'x-internal-response'}){HTTP::AnyUA::Util::internal_exception($ua_resp->content,$resp)}elsif ($data_cb){$data_cb->($ua_resp->content,$resp)}else {$resp->{content}=$ua_resp->content}return$resp}1; +HTTP_ANYUA_BACKEND_FURL + +$fatpacked{"HTTP/AnyUA/Backend/HTTP/AnyUA.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_BACKEND_HTTP_ANYUA'; + package HTTP::AnyUA::Backend::HTTP::AnyUA;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Backend';sub response_is_future {my$self=shift;return$self->ua->response_is_future}sub request {my$self=shift;return$self->ua->request(@_)}1; +HTTP_ANYUA_BACKEND_HTTP_ANYUA + +$fatpacked{"HTTP/AnyUA/Backend/HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_BACKEND_HTTP_TINY'; + package HTTP::AnyUA::Backend::HTTP::Tiny;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Backend';sub request {my$self=shift;return$self->ua->request(@_)}1; +HTTP_ANYUA_BACKEND_HTTP_TINY + +$fatpacked{"HTTP/AnyUA/Backend/LWP/UserAgent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_BACKEND_LWP_USERAGENT'; + package HTTP::AnyUA::Backend::LWP::UserAgent;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Backend';use HTTP::AnyUA::Util;sub request {my$self=shift;my ($method,$url,$args)=@_;my$r=HTTP::AnyUA::Util::native_to_http_request(@_);my$ua_resp=$self->ua->request($r);return$self->_munge_response($ua_resp,$args->{data_callback})}sub _munge_response {my$self=shift;my$ua_resp=shift;my$data_cb=shift;my$recurse=shift;my$resp={success=>!!$ua_resp->is_success,url=>$ua_resp->request->uri->as_string,status=>$ua_resp->code,reason=>$ua_resp->message,headers=>HTTP::AnyUA::Util::http_headers_to_native($ua_resp->headers),};$resp->{protocol}=$ua_resp->protocol if$ua_resp->protocol;if (!$recurse){for my$redirect ($ua_resp->redirects){push @{$resp->{redirects}||= []},$self->_munge_response($redirect,undef,1)}}my$content_ref=$ua_resp->content_ref;if (($resp->{headers}{'client-warning'}|| '')eq 'Internal response'){HTTP::AnyUA::Util::internal_exception($$content_ref,$resp)}elsif ($data_cb){$data_cb->($$content_ref,$resp)}else {$resp->{content}=$$content_ref}return$resp}1; +HTTP_ANYUA_BACKEND_LWP_USERAGENT + +$fatpacked{"HTTP/AnyUA/Backend/Mojo/UserAgent.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_BACKEND_MOJO_USERAGENT'; + package HTTP::AnyUA::Backend::Mojo::UserAgent;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Backend';use Future;use Scalar::Util;my$future_class;BEGIN {$future_class='Future';eval 'use Future::Mojo';$future_class='Future::Mojo' if!$@}sub response_is_future {1}sub request {my$self=shift;my ($method,$url,$args)=@_;my$future=$future_class->new;my$tx=$self->_munge_request(@_);$self->ua->start($tx=>sub {my$ua=shift;my$tx=shift;my$resp=$self->_munge_response($tx,$args->{data_callback});if ($resp->{success}){$future->done($resp)}else {$future->fail($resp)}});return$future}sub _munge_request {my$self=shift;my$method=shift;my$url=shift;my$args=shift;my$headers=$args->{headers}|| {};my$content=$args->{content};my@content;my$content_length;if ($content){for my$header (keys %$headers){if (lc($header)eq 'content-length'){$content_length=$headers->{$header};last}}$content=HTTP::AnyUA::Util::coderef_content_to_string($content)if!$content_length;push@content,$content if ref($content)ne 'CODE'}my$tx=$self->ua->build_tx($method=>$url=>$headers=>@content);if (ref($content)eq 'CODE'){$tx->req->headers->content_length($content_length);my$drain;$drain=sub {my$body=shift;my$chunk=$content->()|| '';undef$drain if!$chunk;$body->write($chunk,$drain)};$tx->req->content->$drain}if (my$data_cb=$args->{data_callback}){my$tx_copy=$tx;Scalar::Util::weaken($tx_copy);$tx->res->content->unsubscribe('read')->on(read=>sub {my ($content,$bytes)=@_;my$resp=$self->_munge_response($tx_copy,undef);$data_cb->($bytes,$resp)})}return$tx}sub _munge_response {my$self=shift;my$tx=shift;my$data_cb=shift;my$recurse=shift;my$resp={success=>!!$tx->res->is_success,url=>$tx->req->url->to_string,status=>$tx->res->code,reason=>$tx->res->message,headers=>{},};my$headers=$tx->res->headers->to_hash;for my$header (keys %$headers){$resp->{headers}{lc($header)}=delete$headers->{$header}}my$version=$tx->res->version;$resp->{protocol}="HTTP/$version" if$version;if (!$recurse){for my$redirect (@{$tx->redirects}){push @{$resp->{redirects}||= []},$self->_munge_response($redirect,undef,1)}}my$err=$tx->error;if ($err &&!$err->{code}){return HTTP::AnyUA::Util::internal_exception($err->{message},$resp)}my$body=$tx->res->body;$resp->{content}=$body if$body &&!$data_cb;return$resp}1; +HTTP_ANYUA_BACKEND_MOJO_USERAGENT + +$fatpacked{"HTTP/AnyUA/Backend/Net/Curl/Easy.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_BACKEND_NET_CURL_EASY'; + package HTTP::AnyUA::Backend::Net::Curl::Easy;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Backend';use HTTP::AnyUA::Util;use Scalar::Util;sub request {my$self=shift;my ($method,$url,$args)=@_;my$ua=$self->ua;$ua->setopt(Net::Curl::Easy::CURLOPT_HTTPGET(),0);$ua->setopt(Net::Curl::Easy::CURLOPT_NOBODY(),0);$ua->setopt(Net::Curl::Easy::CURLOPT_READFUNCTION(),undef);$ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDS(),undef);$ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDSIZE(),0);if ($method eq 'GET'){$ua->setopt(Net::Curl::Easy::CURLOPT_HTTPGET(),1)}elsif ($method eq 'HEAD'){$ua->setopt(Net::Curl::Easy::CURLOPT_NOBODY(),1)}if (my$content=$args->{content}){if (ref($content)eq 'CODE'){my$content_length;for my$header (keys %{$args->{headers}|| {}}){if (lc($header)eq 'content-length'){$content_length=$args->{headers}{$header};last}}if ($content_length){my$chunk;$ua->setopt(Net::Curl::Easy::CURLOPT_READFUNCTION(),sub {my$ua=shift;my$maxlen=shift;if (!$chunk){$chunk=$content->();return 0 if!$chunk}my$part=substr($chunk,0,$maxlen,'');return \$part});$ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDSIZE(),$content_length)}else {$content=HTTP::AnyUA::Util::coderef_content_to_string($content)}}if (ref($content)ne 'CODE'){$ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDS(),$content);$ua->setopt(Net::Curl::Easy::CURLOPT_POSTFIELDSIZE(),length$content)}}$ua->setopt(Net::Curl::Easy::CURLOPT_URL(),$url);$ua->setopt(Net::Curl::Easy::CURLOPT_CUSTOMREQUEST(),$method);my@headers;for my$header (keys %{$args->{headers}|| {}}){my$value=$args->{headers}{$header};my@values=ref($value)eq 'ARRAY' ? @$value : $value;for my$v (@values){push@headers,"${header}: $v"}}$ua->setopt(Net::Curl::Easy::CURLOPT_HTTPHEADER(),\@headers)if@headers;my@hdrdata;$ua->setopt(Net::Curl::Easy::CURLOPT_HEADERFUNCTION(),sub {my$ua=shift;my$data=shift;my$size=length$data;my%headers=_parse_header($data);if ($headers{Status}){push@hdrdata,{}}my$resp_headers=$hdrdata[-1];for my$key (keys%headers){if (!$resp_headers->{$key}){$resp_headers->{$key}=$headers{$key}}else {if (ref($resp_headers->{$key})ne 'ARRAY'){$resp_headers->{$key}=[$resp_headers->{$key}]}push @{$resp_headers->{$key}},$headers{$key}}}return$size});my$resp_body='';my$data_cb=$args->{data_callback};my$copy=$self;Scalar::Util::weaken($copy);$ua->setopt(Net::Curl::Easy::CURLOPT_WRITEFUNCTION(),sub {my$ua=shift;my$data=shift;my$fh=shift;my$size=length$data;if ($data_cb){my$resp=$copy->_munge_response(undef,undef,[@hdrdata],$data_cb);$data_cb->($data,$resp)}else {print$fh $data}return$size});open(my$fileb,'>',\$resp_body);$ua->setopt(Net::Curl::Easy::CURLOPT_WRITEDATA(),$fileb);eval {$ua->perform};my$ret=$@;return$self->_munge_response($ret,$resp_body,[@hdrdata],$data_cb)}sub _munge_response {my$self=shift;my$error=shift;my$body=shift;my$hdrdata=shift;my$data_cb=shift;my%headers=%{pop @$hdrdata || {}};my$code=delete$headers{Status}|| $self->ua->getinfo(Net::Curl::Easy::CURLINFO_RESPONSE_CODE())|| 599;my$reason=delete$headers{Reason};my$url=$self->ua->getinfo(Net::Curl::Easy::CURLINFO_EFFECTIVE_URL());my$resp={success=>200 <= $code && $code <= 299,url=>$url,status=>$code,reason=>$reason,headers=>\%headers,};my$version=delete$headers{HTTPVersion}|| _http_version($self->ua->getinfo(Net::Curl::Easy::CURLINFO_HTTP_VERSION()));$resp->{protocol}="HTTP/$version" if$version;if ($error){my$err=$self->ua->strerror($error);return HTTP::AnyUA::Util::internal_exception($err,$resp)}$resp->{content}=$body if$body &&!$data_cb;return$resp}sub _http_version {my$version=shift;return$version==Net::Curl::Easy::CURL_HTTP_VERSION_1_0()? '1.0' : $version==Net::Curl::Easy::CURL_HTTP_VERSION_1_1()? '1.1' : $version==Net::Curl::Easy::CURL_HTTP_VERSION_2_0()? '2.0' : ''}sub _parse_header {my$data=shift;$data =~ s/[\x0A\x0D]*$//;if ($data =~ m!^HTTP/([0-9.]+) [\x09\x20]+ (\d{3}) [\x09\x20]+ ([^\x0A\x0D]*)!x){return (HTTPVersion=>$1,Status=>$2,Reason=>$3,)}my ($key,$val)=split(/:\s*/,$data,2);return if!$key;return (lc($key)=>$val)}1; +HTTP_ANYUA_BACKEND_NET_CURL_EASY + +$fatpacked{"HTTP/AnyUA/Middleware.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_MIDDLEWARE'; + package HTTP::AnyUA::Middleware;use warnings;use strict;our$VERSION='0.904';sub _croak {require Carp;Carp::croak(@_)}sub _usage {_croak("Usage: @_\n")}sub new {my$class=shift;my$backend=shift or die 'Backend is required';my$self=bless {backend=>$backend},$class;$self->init(@_);return$self}sub init {}sub wrap {my$self=shift;my$backend=shift or _usage($self .q{->wrap($backend, %args)});if (ref$self){$self->{backend}=$backend}else {$self=$self->new($backend,@_)}return$self}sub request {shift->backend->request(@_)}sub backend {shift->{backend}}sub ua {shift->backend->ua(@_)}sub response_is_future {shift->backend->response_is_future(@_)}1; +HTTP_ANYUA_MIDDLEWARE + +$fatpacked{"HTTP/AnyUA/Middleware/ContentLength.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_MIDDLEWARE_CONTENTLENGTH'; + package HTTP::AnyUA::Middleware::ContentLength;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Middleware';use HTTP::AnyUA::Util;sub request {my$self=shift;my ($method,$url,$args)=@_;$args->{headers}=HTTP::AnyUA::Util::normalize_headers($args->{headers});if (!defined$args->{headers}{'content-length'}&& $args->{content}&&!ref$args->{content}){$args->{headers}{'content-length'}=length$args->{content}}return$self->backend->request($method,$url,$args)}1; +HTTP_ANYUA_MIDDLEWARE_CONTENTLENGTH + +$fatpacked{"HTTP/AnyUA/Middleware/RequestHeaders.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_MIDDLEWARE_REQUESTHEADERS'; + package HTTP::AnyUA::Middleware::RequestHeaders;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Middleware';use HTTP::AnyUA::Util;sub init {my$self=shift;my%args=@_;$self->{override}=!!$args{override};$self->{headers}=HTTP::AnyUA::Util::normalize_headers($args{headers})}sub request {my$self=shift;my ($method,$url,$args)=@_;if ($self->override){$args->{headers}={%{HTTP::AnyUA::Util::normalize_headers($args->{headers})},%{$self->headers},}}else {$args->{headers}={%{$self->headers},%{HTTP::AnyUA::Util::normalize_headers($args->{headers})},}}return$self->backend->request($method,$url,$args)}sub headers {shift->{headers}}sub override {shift->{override}}1; +HTTP_ANYUA_MIDDLEWARE_REQUESTHEADERS + +$fatpacked{"HTTP/AnyUA/Middleware/Runtime.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_MIDDLEWARE_RUNTIME'; + package HTTP::AnyUA::Middleware::Runtime;use warnings;use strict;our$VERSION='0.904';use parent 'HTTP::AnyUA::Middleware';use Time::HiRes;sub request {my$self=shift;my ($method,$url,$args)=@_;my$start=[Time::HiRes::gettimeofday];my$resp=$self->backend->request($method,$url,$args);my$handle_response=sub {my$resp=shift;$resp->{runtime}=sprintf('%.6f',Time::HiRes::tv_interval($start));return$resp};if ($self->response_is_future){$resp=$resp->transform(done=>$handle_response,fail=>$handle_response,)}else {$resp=$handle_response->($resp)}return$resp}1; +HTTP_ANYUA_MIDDLEWARE_RUNTIME + +$fatpacked{"HTTP/AnyUA/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_ANYUA_UTIL'; + package HTTP::AnyUA::Util;use warnings;use strict;our$VERSION='0.904';use Exporter qw(import);our@EXPORT_OK=qw(http_headers_to_native native_to_http_request coderef_content_to_string normalize_headers internal_exception http_date parse_http_date uri_escape www_form_urlencode);sub _croak {require Carp;Carp::croak(@_)}sub _usage {_croak("Usage: @_\n")}sub coderef_content_to_string {my$content=shift;return$content if!$content;if (ref($content)eq 'CODE'){my$body='';while (my$chunk=$content->()){$body .= $chunk}$content=$body}return$content}sub native_to_http_request {my$method=shift;my$url=shift;my$args=shift || {};my$headers=[];my$content=$args->{content};for my$header (keys %{$args->{headers}|| {}}){my$value=$args->{headers}{$header};my@values=ref($value)eq 'ARRAY' ? @$value : ($value);for my$v (@values){push @$headers,($header=>$v)}}require HTTP::Request;return HTTP::Request->new($method,$url,$headers,$content)}sub http_headers_to_native {my$http_headers=shift;my$native;for my$header ($http_headers->header_field_names){my@values=$http_headers->header($header);$native->{lc($header)}=@values==1 ? $values[0]: [@values]}return$native}sub normalize_headers {my$headers_in=shift;my$headers={};if (defined$headers_in){while (my ($key,$value)=each %{$headers_in || {}}){$headers->{lc($key)}=$value}}return$headers}sub internal_exception {my$e=shift or _usage(q{internal_exception($exception)});my$resp=shift || {};$e="$e";$resp->{headers}{'client-original-status'}=$resp->{status}if$resp->{status};$resp->{headers}{'client-original-reason'}=$resp->{reason}if$resp->{reason};$resp->{success}='';$resp->{status}=599;$resp->{reason}='Internal Exception';$resp->{content}=$e;$resp->{headers}{'content-type'}='text/plain';$resp->{headers}{'content-length'}=length$e;return$resp}sub split_url {my$url=shift or _usage(q{split_url($url)});my ($scheme,$host,$path_query)=$url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> or die(qq/Cannot parse URL: '$url'\n/);$scheme=lc$scheme;$path_query="/$path_query" unless$path_query =~ m<\A/>;my$auth='';if ((my$i=index$host,'@')!=-1){$auth=substr$host,0,$i,'';substr$host,0,1,'';$auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg}my$port=$host =~ s/:(\d*)\z// && length $1 ? $1 : $scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef;return ($scheme,(length$host ? lc$host : "localhost"),$port,$path_query,$auth)}my$DoW='Sun|Mon|Tue|Wed|Thu|Fri|Sat';my$MoY='Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec';sub http_date {my$time=shift or _usage(q{http_date($time)});my ($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime($time);return sprintf('%s, %02d %s %04d %02d:%02d:%02d GMT',substr($DoW,$wday*4,3),$mday,substr($MoY,$mon*4,3),$year+1900,$hour,$min,$sec)}sub parse_http_date {my$str=shift or _usage(q{parse_http_date($str)});my@tl_parts;if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/){@tl_parts=($6,$5,$4,$1,(index($MoY,$2)/4),$3)}elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/){@tl_parts=($6,$5,$4,$1,(index($MoY,$2)/4),$3)}elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/){@tl_parts=($5,$4,$3,$2,(index($MoY,$1)/4),$6)}require Time::Local;return eval {my$t=@tl_parts ? Time::Local::timegm(@tl_parts): -1;$t < 0 ? undef : $t}}my%escapes=map {chr($_)=>sprintf('%%%02X',$_)}0..255;$escapes{' '}='+';my$unsafe_char=qr/[^A-Za-z0-9\-\._~]/;sub uri_escape {my$str=shift or _usage(q{uri_escape($str)});if ($] ge '5.008'){utf8::encode($str)}else {$str=pack('U*',unpack('C*',$str))if (length$str==do {use bytes;length$str});$str=pack('C*',unpack('C*',$str))}$str =~ s/($unsafe_char)/$escapes{$1}/ge;return$str}sub www_form_urlencode {my$data=shift;($data && ref$data)or _usage(q{www_form_urlencode($dataref)});(ref$data eq 'HASH' || ref$data eq 'ARRAY')or _croak("form data must be a hash or array reference\n");my@params=ref$data eq 'HASH' ? %$data : @$data;@params % 2==0 or _croak("form data reference must have an even number of terms\n");my@terms;while (@params){my ($key,$value)=splice(@params,0,2);if (ref$value eq 'ARRAY'){unshift@params,map {$key=>$_}@$value}else {push@terms,join('=',map {uri_escape($_)}$key,$value)}}return join('&',ref($data)eq 'ARRAY' ? @terms : sort@terms)}1; +HTTP_ANYUA_UTIL + +$fatpacked{"HTTP/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'HTTP_TINY'; + package HTTP::Tiny;use strict;use warnings;our$VERSION='0.076';sub _croak {require Carp;Carp::croak(@_)}my@attributes;BEGIN {@attributes=qw(cookie_jar default_headers http_proxy https_proxy keep_alive local_address max_redirect max_size proxy no_proxy SSL_options verify_SSL);my%persist_ok=map {;$_=>1}qw(cookie_jar default_headers max_redirect max_size);no strict 'refs';no warnings 'uninitialized';for my$accessor (@attributes){*{$accessor}=sub {@_ > 1 ? do {delete $_[0]->{handle}if!$persist_ok{$accessor}&& $_[1]ne $_[0]->{$accessor};$_[0]->{$accessor}=$_[1]}: $_[0]->{$accessor}}}}sub agent {my($self,$agent)=@_;if(@_ > 1){$self->{agent}=(defined$agent && $agent =~ / $/)? $agent .$self->_agent : $agent}return$self->{agent}}sub timeout {my ($self,$timeout)=@_;if (@_ > 1){$self->{timeout}=$timeout;if ($self->{handle}){$self->{handle}->timeout($timeout)}}return$self->{timeout}}sub new {my($class,%args)=@_;my$self={max_redirect=>5,timeout=>defined$args{timeout}? $args{timeout}: 60,keep_alive=>1,verify_SSL=>$args{verify_SSL}|| $args{verify_ssl}|| 0,no_proxy=>$ENV{no_proxy},};bless$self,$class;$class->_validate_cookie_jar($args{cookie_jar})if$args{cookie_jar};for my$key (@attributes){$self->{$key}=$args{$key}if exists$args{$key}}$self->agent(exists$args{agent}? $args{agent}: $class->_agent);$self->_set_proxies;return$self}sub _set_proxies {my ($self)=@_;if (!exists$self->{proxy}){$self->{proxy}=$ENV{all_proxy}|| $ENV{ALL_PROXY}}if (defined$self->{proxy}){$self->_split_proxy('generic proxy'=>$self->{proxy})}else {delete$self->{proxy}}if (!exists$self->{http_proxy}){local$ENV{HTTP_PROXY}if$ENV{REQUEST_METHOD};$self->{http_proxy}=$ENV{http_proxy}|| $ENV{HTTP_PROXY}|| $self->{proxy}}if (defined$self->{http_proxy}){$self->_split_proxy(http_proxy=>$self->{http_proxy});$self->{_has_proxy}{http}=1}else {delete$self->{http_proxy}}if (!exists$self->{https_proxy}){$self->{https_proxy}=$ENV{https_proxy}|| $ENV{HTTPS_PROXY}|| $self->{proxy}}if ($self->{https_proxy}){$self->_split_proxy(https_proxy=>$self->{https_proxy});$self->{_has_proxy}{https}=1}else {delete$self->{https_proxy}}unless (ref$self->{no_proxy}eq 'ARRAY'){$self->{no_proxy}=(defined$self->{no_proxy})? [split /\s*,\s*/,$self->{no_proxy}]: []}return}for my$sub_name (qw/get head put post delete/){my$req_method=uc$sub_name;no strict 'refs';eval <<"HERE"}sub post_form {my ($self,$url,$data,$args)=@_;(@_==3 || @_==4 && ref$args eq 'HASH')or _croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ ."\n");my$headers={};while (my ($key,$value)=each %{$args->{headers}|| {}}){$headers->{lc$key}=$value}delete$args->{headers};return$self->request('POST',$url,{%$args,content=>$self->www_form_urlencode($data),headers=>{%$headers,'content-type'=>'application/x-www-form-urlencoded' },})}sub mirror {my ($self,$url,$file,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or _croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ ."\n");if (exists$args->{headers}){my$headers={};while (my ($key,$value)=each %{$args->{headers}|| {}}){$headers->{lc$key}=$value}$args->{headers}=$headers}if (-e $file and my$mtime=(stat($file))[9]){$args->{headers}{'if-modified-since'}||= $self->_http_date($mtime)}my$tempfile=$file .int(rand(2**31));require Fcntl;sysopen my$fh,$tempfile,Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()or _croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);binmode$fh;$args->{data_callback}=sub {print {$fh}$_[0]};my$response=$self->request('GET',$url,$args);close$fh or _croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);if ($response->{success}){rename$tempfile,$file or _croak(qq/Error replacing $file with $tempfile: $!\n/);my$lm=$response->{headers}{'last-modified'};if ($lm and my$mtime=$self->_parse_http_date($lm)){utime$mtime,$mtime,$file}}$response->{success}||= $response->{status}eq '304';unlink$tempfile;return$response}my%idempotent=map {$_=>1}qw/GET HEAD PUT DELETE OPTIONS TRACE/;sub request {my ($self,$method,$url,$args)=@_;@_==3 || (@_==4 && ref$args eq 'HASH')or _croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ ."\n");$args ||= {};my$response;for (0 .. 1){$response=eval {$self->_request($method,$url,$args)};last unless $@ && $idempotent{$method}&& $@ =~ m{^(?:Socket closed|Unexpected end)}}if (my$e=$@){if (ref$e eq 'HASH' && exists$e->{status}){$e->{redirects}=delete$args->{_redirects}if @{$args->{_redirects}|| []};return$e}$e="$e";$response={url=>$url,success=>q{},status=>599,reason=>'Internal Exception',content=>$e,headers=>{'content-type'=>'text/plain','content-length'=>length$e,},(@{$args->{_redirects}|| []}? (redirects=>delete$args->{_redirects}): ()),}}return$response}sub www_form_urlencode {my ($self,$data)=@_;(@_==2 && ref$data)or _croak(q/Usage: $http->www_form_urlencode(DATAREF)/ ."\n");(ref$data eq 'HASH' || ref$data eq 'ARRAY')or _croak("form data must be a hash or array reference\n");my@params=ref$data eq 'HASH' ? %$data : @$data;@params % 2==0 or _croak("form data reference must have an even number of terms\n");my@terms;while(@params){my ($key,$value)=splice(@params,0,2);if (ref$value eq 'ARRAY'){unshift@params,map {$key=>$_}@$value}else {push@terms,join("=",map {$self->_uri_escape($_)}$key,$value)}}return join("&",(ref$data eq 'ARRAY')? (@terms): (sort@terms))}sub can_ssl {my ($self)=@_;my($ok,$reason)=(1,'');local@INC=@INC;pop@INC if$INC[-1]eq '.';unless (eval {require IO::Socket::SSL;IO::Socket::SSL->VERSION(1.42)}){$ok=0;$reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/}unless (eval {require Net::SSLeay;Net::SSLeay->VERSION(1.49)}){$ok=0;$reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/}if (ref($self)&& ($self->{verify_SSL}|| $self->{SSL_options}{SSL_verify_mode})){my$handle=HTTP::Tiny::Handle->new(SSL_options=>$self->{SSL_options},verify_SSL=>$self->{verify_SSL},);unless (eval {$handle->_find_CA_file;1}){$ok=0;$reason .= "$@"}}wantarray ? ($ok,$reason): $ok}sub connected {my ($self)=@_;if ($self->{handle}&& $self->{handle}{fh}){my$socket=$self->{handle}{fh};if ($socket->connected){return wantarray ? ($socket->peerhost,$socket->peerport): join(':',$socket->peerhost,$socket->peerport)}}return}my%DefaultPort=(http=>80,https=>443,);sub _agent {my$class=ref($_[0])|| $_[0];(my$default_agent=$class)=~ s{::}{-}g;return$default_agent ."/" .$class->VERSION}sub _request {my ($self,$method,$url,$args)=@_;my ($scheme,$host,$port,$path_query,$auth)=$self->_split_url($url);my$request={method=>$method,scheme=>$scheme,host=>$host,port=>$port,host_port=>($port==$DefaultPort{$scheme}? $host : "$host:$port"),uri=>$path_query,headers=>{},};my$peer=$args->{peer}|| $host;if ('CODE' eq ref$peer){$peer=$peer->($host)}my$handle=delete$self->{handle};if ($handle){unless ($handle->can_reuse($scheme,$host,$port,$peer)){$handle->close;undef$handle}}$handle ||= $self->_open_handle($request,$scheme,$host,$port,$peer);$self->_prepare_headers_and_cb($request,$args,$url,$auth);$handle->write_request($request);my$response;do {$response=$handle->read_response_header}until (substr($response->{status},0,1)ne '1');$self->_update_cookie_jar($url,$response)if$self->{cookie_jar};my@redir_args=$self->_maybe_redirect($request,$response,$args);my$known_message_length;if ($method eq 'HEAD' || $response->{status}=~ /^[23]04/){$known_message_length=1}else {my$cb_args=@redir_args ? +{}: $args;my$data_cb=$self->_prepare_data_cb($response,$cb_args);$known_message_length=$handle->read_body($data_cb,$response)}if ($self->{keep_alive}&& $known_message_length && $response->{protocol}eq 'HTTP/1.1' && ($response->{headers}{connection}|| '')ne 'close'){$self->{handle}=$handle}else {$handle->close}$response->{success}=substr($response->{status},0,1)eq '2';$response->{url}=$url;if (@redir_args){push @{$args->{_redirects}},$response;return$self->_request(@redir_args,$args)}$response->{redirects}=delete$args->{_redirects}if @{$args->{_redirects}};return$response}sub _open_handle {my ($self,$request,$scheme,$host,$port,$peer)=@_;my$handle=HTTP::Tiny::Handle->new(timeout=>$self->{timeout},SSL_options=>$self->{SSL_options},verify_SSL=>$self->{verify_SSL},local_address=>$self->{local_address},keep_alive=>$self->{keep_alive});if ($self->{_has_proxy}{$scheme}&&!grep {$host =~ /\Q$_\E$/}@{$self->{no_proxy}}){return$self->_proxy_connect($request,$handle)}else {return$handle->connect($scheme,$host,$port,$peer)}}sub _proxy_connect {my ($self,$request,$handle)=@_;my@proxy_vars;if ($request->{scheme}eq 'https'){_croak(qq{No https_proxy defined})unless$self->{https_proxy};@proxy_vars=$self->_split_proxy(https_proxy=>$self->{https_proxy});if ($proxy_vars[0]eq 'https'){_croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}})}}else {_croak(qq{No http_proxy defined})unless$self->{http_proxy};@proxy_vars=$self->_split_proxy(http_proxy=>$self->{http_proxy})}my ($p_scheme,$p_host,$p_port,$p_auth)=@proxy_vars;if (length$p_auth &&!defined$request->{headers}{'proxy-authorization'}){$self->_add_basic_auth_header($request,'proxy-authorization'=>$p_auth)}$handle->connect($p_scheme,$p_host,$p_port,$p_host);if ($request->{scheme}eq 'https'){$self->_create_proxy_tunnel($request,$handle)}else {$request->{uri}="$request->{scheme}://$request->{host_port}$request->{uri}"}return$handle}sub _split_proxy {my ($self,$type,$proxy)=@_;my ($scheme,$host,$port,$path_query,$auth)=eval {$self->_split_url($proxy)};unless(defined($scheme)&& length($scheme)&& length($host)&& length($port)&& $path_query eq '/'){_croak(qq{$type URL must be in format http[s]://[auth@]:/\n})}return ($scheme,$host,$port,$auth)}sub _create_proxy_tunnel {my ($self,$request,$handle)=@_;$handle->_assert_ssl;my$agent=exists($request->{headers}{'user-agent'})? $request->{headers}{'user-agent'}: $self->{agent};my$connect_request={method=>'CONNECT',uri=>"$request->{host}:$request->{port}",headers=>{host=>"$request->{host}:$request->{port}",'user-agent'=>$agent,}};if ($request->{headers}{'proxy-authorization'}){$connect_request->{headers}{'proxy-authorization'}=delete$request->{headers}{'proxy-authorization'}}$handle->write_request($connect_request);my$response;do {$response=$handle->read_response_header}until (substr($response->{status},0,1)ne '1');unless (substr($response->{status},0,1)eq '2'){die$response}$handle->start_ssl($request->{host});return}sub _prepare_headers_and_cb {my ($self,$request,$args,$url,$auth)=@_;for ($self->{default_headers},$args->{headers}){next unless defined;while (my ($k,$v)=each %$_){$request->{headers}{lc$k}=$v;$request->{header_case}{lc$k}=$k}}if (exists$request->{headers}{'host'}){die(qq/The 'Host' header must not be provided as header option\n/)}$request->{headers}{'host'}=$request->{host_port};$request->{headers}{'user-agent'}||= $self->{agent};$request->{headers}{'connection'}="close" unless$self->{keep_alive};if (defined$args->{content}){if (ref$args->{content}eq 'CODE'){$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'transfer-encoding'}='chunked' unless$request->{headers}{'content-length'}|| $request->{headers}{'transfer-encoding'};$request->{cb}=$args->{content}}elsif (length$args->{content}){my$content=$args->{content};if ($] ge '5.008'){utf8::downgrade($content,1)or die(qq/Wide character in request message body\n/)}$request->{headers}{'content-type'}||= "application/octet-stream";$request->{headers}{'content-length'}=length$content unless$request->{headers}{'content-length'}|| $request->{headers}{'transfer-encoding'};$request->{cb}=sub {substr$content,0,length$content,''}}$request->{trailer_cb}=$args->{trailer_callback}if ref$args->{trailer_callback}eq 'CODE'}if ($self->{cookie_jar}){my$cookies=$self->cookie_jar->cookie_header($url);$request->{headers}{cookie}=$cookies if length$cookies}if (length$auth &&!defined$request->{headers}{authorization}){$self->_add_basic_auth_header($request,'authorization'=>$auth)}return}sub _add_basic_auth_header {my ($self,$request,$header,$auth)=@_;require MIME::Base64;$request->{headers}{$header}="Basic " .MIME::Base64::encode_base64($auth,"");return}sub _prepare_data_cb {my ($self,$response,$args)=@_;my$data_cb=$args->{data_callback};$response->{content}='';if (!$data_cb || $response->{status}!~ /^2/){if (defined$self->{max_size}){$data_cb=sub {$_[1]->{content}.= $_[0];die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)if length $_[1]->{content}> $self->{max_size}}}else {$data_cb=sub {$_[1]->{content}.= $_[0]}}}return$data_cb}sub _update_cookie_jar {my ($self,$url,$response)=@_;my$cookies=$response->{headers}->{'set-cookie'};return unless defined$cookies;my@cookies=ref$cookies ? @$cookies : $cookies;$self->cookie_jar->add($url,$_)for@cookies;return}sub _validate_cookie_jar {my ($class,$jar)=@_;for my$method (qw/add cookie_header/){_croak(qq/Cookie jar must provide the '$method' method\n/)unless ref($jar)&& ref($jar)->can($method)}return}sub _maybe_redirect {my ($self,$request,$response,$args)=@_;my$headers=$response->{headers};my ($status,$method)=($response->{status},$request->{method});$args->{_redirects}||= [];if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))and $headers->{location}and @{$args->{_redirects}}< $self->{max_redirect}){my$location=($headers->{location}=~ /^\//)? "$request->{scheme}://$request->{host_port}$headers->{location}" : $headers->{location};return (($status eq '303' ? 'GET' : $method),$location)}return}sub _split_url {my$url=pop;my ($scheme,$host,$path_query)=$url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)> or die(qq/Cannot parse URL: '$url'\n/);$scheme=lc$scheme;$path_query="/$path_query" unless$path_query =~ m<\A/>;my$auth='';if ((my$i=index$host,'@')!=-1){$auth=substr$host,0,$i,'';substr$host,0,1,'';$auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg}my$port=$host =~ s/:(\d*)\z// && length $1 ? $1 : $scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef;return ($scheme,(length$host ? lc$host : "localhost"),$port,$path_query,$auth)}my$DoW="Sun|Mon|Tue|Wed|Thu|Fri|Sat";my$MoY="Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";sub _http_date {my ($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime($_[1]);return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",substr($DoW,$wday*4,3),$mday,substr($MoY,$mon*4,3),$year+1900,$hour,$min,$sec)}sub _parse_http_date {my ($self,$str)=@_;require Time::Local;my@tl_parts;if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/){@tl_parts=($6,$5,$4,$1,(index($MoY,$2)/4),$3)}elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/){@tl_parts=($6,$5,$4,$1,(index($MoY,$2)/4),$3)}elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/){@tl_parts=($5,$4,$3,$2,(index($MoY,$1)/4),$6)}return eval {my$t=@tl_parts ? Time::Local::timegm(@tl_parts): -1;$t < 0 ? undef : $t}}my%escapes=map {chr($_)=>sprintf("%%%02X",$_)}0..255;$escapes{' '}="+";my$unsafe_char=qr/[^A-Za-z0-9\-\._~]/;sub _uri_escape {my ($self,$str)=@_;if ($] ge '5.008'){utf8::encode($str)}else {$str=pack("U*",unpack("C*",$str))if (length$str==do {use bytes;length$str});$str=pack("C*",unpack("C*",$str))}$str =~ s/($unsafe_char)/$escapes{$1}/g;return$str}package HTTP::Tiny::Handle;use strict;use warnings;use Errno qw[EINTR EPIPE];use IO::Socket qw[SOCK_STREAM];use Socket qw[SOL_SOCKET SO_KEEPALIVE];my$SOCKET_CLASS=$ENV{PERL_HTTP_TINY_IPV4_ONLY}? 'IO::Socket::INET' : eval {require IO::Socket::IP;IO::Socket::IP->VERSION(0.25)}? 'IO::Socket::IP' : 'IO::Socket::INET';sub BUFSIZE () {32768}my$Printable=sub {local $_=shift;s/\r/\\r/g;s/\n/\\n/g;s/\t/\\t/g;s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;$_};my$Token=qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;my$Field_Content=qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x;sub new {my ($class,%args)=@_;return bless {rbuf=>'',timeout=>60,max_line_size=>16384,max_header_lines=>64,verify_SSL=>0,SSL_options=>{},%args },$class}sub timeout {my ($self,$timeout)=@_;if (@_ > 1){$self->{timeout}=$timeout;if ($self->{fh}&& $self->{fh}->can('timeout')){$self->{fh}->timeout($timeout)}}return$self->{timeout}}sub connect {@_==5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ ."\n");my ($self,$scheme,$host,$port,$peer)=@_;if ($scheme eq 'https'){$self->_assert_ssl}elsif ($scheme ne 'http'){die(qq/Unsupported URL scheme '$scheme'\n/)}$self->{fh}=$SOCKET_CLASS->new(PeerHost=>$peer,PeerPort=>$port,$self->{local_address}? (LocalAddr=>$self->{local_address}): (),Proto=>'tcp',Type=>SOCK_STREAM,Timeout=>$self->{timeout},)or die(qq/Could not connect to '$host:$port': $@\n/);binmode($self->{fh})or die(qq/Could not binmode() socket: '$!'\n/);if ($self->{keep_alive}){unless (defined($self->{fh}->setsockopt(SOL_SOCKET,SO_KEEPALIVE,1))){CORE::close($self->{fh});die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/)}}$self->start_ssl($host)if$scheme eq 'https';$self->{scheme}=$scheme;$self->{host}=$host;$self->{peer}=$peer;$self->{port}=$port;$self->{pid}=$$;$self->{tid}=_get_tid();return$self}sub start_ssl {my ($self,$host)=@_;if (ref($self->{fh})eq 'IO::Socket::SSL'){unless ($self->{fh}->stop_SSL){my$ssl_err=IO::Socket::SSL->errstr;die(qq/Error halting prior SSL connection: $ssl_err/)}}my$ssl_args=$self->_ssl_args($host);IO::Socket::SSL->start_SSL($self->{fh},%$ssl_args,SSL_create_ctx_callback=>sub {my$ctx=shift;Net::SSLeay::CTX_set_mode($ctx,Net::SSLeay::MODE_AUTO_RETRY())},);unless (ref($self->{fh})eq 'IO::Socket::SSL'){my$ssl_err=IO::Socket::SSL->errstr;die(qq/SSL connection failed for $host: $ssl_err\n/)}}sub close {@_==1 || die(q/Usage: $handle->close()/ ."\n");my ($self)=@_;CORE::close($self->{fh})or die(qq/Could not close socket: '$!'\n/)}sub write {@_==2 || die(q/Usage: $handle->write(buf)/ ."\n");my ($self,$buf)=@_;if ($] ge '5.008'){utf8::downgrade($buf,1)or die(qq/Wide character in write()\n/)}my$len=length$buf;my$off=0;local$SIG{PIPE}='IGNORE';while (){$self->can_write or die(qq/Timed out while waiting for socket to become ready for writing\n/);my$r=syswrite($self->{fh},$buf,$len,$off);if (defined$r){$len -= $r;$off += $r;last unless$len > 0}elsif ($!==EPIPE){die(qq/Socket closed by remote server: $!\n/)}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not write to SSL socket: '$err'\n /)}else {die(qq/Could not write to socket: '$!'\n/)}}}return$off}sub read {@_==2 || @_==3 || die(q/Usage: $handle->read(len [, allow_partial])/ ."\n");my ($self,$len,$allow_partial)=@_;my$buf='';my$got=length$self->{rbuf};if ($got){my$take=($got < $len)? $got : $len;$buf=substr($self->{rbuf},0,$take,'');$len -= $take}while ($len > 0){$self->can_read or die(q/Timed out while waiting for socket to become ready for reading/ ."\n");my$r=sysread($self->{fh},$buf,$len,length$buf);if (defined$r){last unless$r;$len -= $r}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not read from SSL socket: '$err'\n /)}else {die(qq/Could not read from socket: '$!'\n/)}}}if ($len &&!$allow_partial){die(qq/Unexpected end of stream\n/)}return$buf}sub readline {@_==1 || die(q/Usage: $handle->readline()/ ."\n");my ($self)=@_;while (){if ($self->{rbuf}=~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x){return $1}if (length$self->{rbuf}>= $self->{max_line_size}){die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/)}$self->can_read or die(qq/Timed out while waiting for socket to become ready for reading\n/);my$r=sysread($self->{fh},$self->{rbuf},BUFSIZE,length$self->{rbuf});if (defined$r){last unless$r}elsif ($!!=EINTR){if ($self->{fh}->can('errstr')){my$err=$self->{fh}->errstr();die (qq/Could not read from SSL socket: '$err'\n /)}else {die(qq/Could not read from socket: '$!'\n/)}}}die(qq/Unexpected end of stream while looking for line\n/)}sub read_header_lines {@_==1 || @_==2 || die(q/Usage: $handle->read_header_lines([headers])/ ."\n");my ($self,$headers)=@_;$headers ||= {};my$lines=0;my$val;while (){my$line=$self->readline;if (++$lines >= $self->{max_header_lines}){die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/)}elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x){my ($field_name)=lc $1;if (exists$headers->{$field_name}){for ($headers->{$field_name}){$_=[$_]unless ref $_ eq "ARRAY";push @$_,$2;$val=\$_->[-1]}}else {$val=\($headers->{$field_name}=$2)}}elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x){$val or die(qq/Unexpected header continuation line\n/);next unless length $1;$$val .= ' ' if length $$val;$$val .= $1}elsif ($line =~ /\A \x0D?\x0A \z/x){last}else {die(q/Malformed header line: / .$Printable->($line)."\n")}}return$headers}sub write_request {@_==2 || die(q/Usage: $handle->write_request(request)/ ."\n");my($self,$request)=@_;$self->write_request_header(@{$request}{qw/method uri headers header_case/});$self->write_body($request)if$request->{cb};return}my@rfc_request_headers=qw(Accept Accept-Charset Accept-Encoding Accept-Language Authorization Cache-Control Connection Content-Length Expect From Host If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer Transfer-Encoding Upgrade User-Agent Via);my@other_request_headers=qw(Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin X-XSS-Protection);my%HeaderCase=map {lc($_)=>$_}@rfc_request_headers,@other_request_headers;sub write_header_lines {(@_ >= 2 && @_ <= 4 && ref $_[1]eq 'HASH')|| die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ ."\n");my($self,$headers,$header_case,$prefix_data)=@_;$header_case ||= {};my$buf=(defined$prefix_data ? $prefix_data : '');my%seen;for my$k (qw/host cache-control expect max-forwards pragma range te/){next unless exists$headers->{$k};$seen{$k}++;my$field_name=$HeaderCase{$k};my$v=$headers->{$k};for (ref$v eq 'ARRAY' ? @$v : $v){$_='' unless defined $_;$buf .= "$field_name: $_\x0D\x0A"}}while (my ($k,$v)=each %$headers){my$field_name=lc$k;next if$seen{$field_name};if (exists$HeaderCase{$field_name}){$field_name=$HeaderCase{$field_name}}else {if (exists$header_case->{$field_name}){$field_name=$header_case->{$field_name}}else {$field_name =~ s/\b(\w)/\u$1/g}$field_name =~ /\A $Token+ \z/xo or die(q/Invalid HTTP header field name: / .$Printable->($field_name)."\n");$HeaderCase{lc$field_name}=$field_name}for (ref$v eq 'ARRAY' ? @$v : $v){s/\x0D?\x0A\s+/ /g;die(qq/Invalid HTTP header field value ($field_name): / .$Printable->($_)."\n")unless $_ eq '' || /\A $Field_Content \z/xo;$_='' unless defined $_;$buf .= "$field_name: $_\x0D\x0A"}}$buf .= "\x0D\x0A";return$self->write($buf)}sub read_body {@_==3 || die(q/Usage: $handle->read_body(callback, response)/ ."\n");my ($self,$cb,$response)=@_;my$te=$response->{headers}{'transfer-encoding'}|| '';my$chunked=grep {/chunked/i}(ref$te eq 'ARRAY' ? @$te : $te);return$chunked ? $self->read_chunked_body($cb,$response): $self->read_content_body($cb,$response)}sub write_body {@_==2 || die(q/Usage: $handle->write_body(request)/ ."\n");my ($self,$request)=@_;if ($request->{headers}{'content-length'}){return$self->write_content_body($request)}else {return$self->write_chunked_body($request)}}sub read_content_body {@_==3 || @_==4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ ."\n");my ($self,$cb,$response,$content_length)=@_;$content_length ||= $response->{headers}{'content-length'};if (defined$content_length){my$len=$content_length;while ($len > 0){my$read=($len > BUFSIZE)? BUFSIZE : $len;$cb->($self->read($read,0),$response);$len -= $read}return length($self->{rbuf})==0}my$chunk;$cb->($chunk,$response)while length($chunk=$self->read(BUFSIZE,1));return}sub write_content_body {@_==2 || die(q/Usage: $handle->write_content_body(request)/ ."\n");my ($self,$request)=@_;my ($len,$content_length)=(0,$request->{headers}{'content-length'});while (){my$data=$request->{cb}->();defined$data && length$data or last;if ($] ge '5.008'){utf8::downgrade($data,1)or die(qq/Wide character in write_content()\n/)}$len += $self->write($data)}$len==$content_length or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);return$len}sub read_chunked_body {@_==3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ ."\n");my ($self,$cb,$response)=@_;while (){my$head=$self->readline;$head =~ /\A ([A-Fa-f0-9]+)/x or die(q/Malformed chunk head: / .$Printable->($head)."\n");my$len=hex($1)or last;$self->read_content_body($cb,$response,$len);$self->read(2)eq "\x0D\x0A" or die(qq/Malformed chunk: missing CRLF after chunk data\n/)}$self->read_header_lines($response->{headers});return 1}sub write_chunked_body {@_==2 || die(q/Usage: $handle->write_chunked_body(request)/ ."\n");my ($self,$request)=@_;my$len=0;while (){my$data=$request->{cb}->();defined$data && length$data or last;if ($] ge '5.008'){utf8::downgrade($data,1)or die(qq/Wide character in write_chunked_body()\n/)}$len += length$data;my$chunk=sprintf '%X',length$data;$chunk .= "\x0D\x0A";$chunk .= $data;$chunk .= "\x0D\x0A";$self->write($chunk)}$self->write("0\x0D\x0A");if (ref$request->{trailer_cb}eq 'CODE'){$self->write_header_lines($request->{trailer_cb}->())}else {$self->write("\x0D\x0A")}return$len}sub read_response_header {@_==1 || die(q/Usage: $handle->read_response_header()/ ."\n");my ($self)=@_;my$line=$self->readline;$line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) [\x09\x20]+ ([^\x0D\x0A]*) \x0D?\x0A/x or die(q/Malformed Status-Line: / .$Printable->($line)."\n");my ($protocol,$version,$status,$reason)=($1,$2,$3,$4);die (qq/Unsupported HTTP protocol: $protocol\n/)unless$version =~ /0*1\.0*[01]/;return {status=>$status,reason=>$reason,headers=>$self->read_header_lines,protocol=>$protocol,}}sub write_request_header {@_==5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ ."\n");my ($self,$method,$request_uri,$headers,$header_case)=@_;return$self->write_header_lines($headers,$header_case,"$method $request_uri HTTP/1.1\x0D\x0A")}sub _do_timeout {my ($self,$type,$timeout)=@_;$timeout=$self->{timeout}unless defined$timeout && $timeout >= 0;my$fd=fileno$self->{fh};defined$fd && $fd >= 0 or die(qq/select(2): 'Bad file descriptor'\n/);my$initial=time;my$pending=$timeout;my$nfound;vec(my$fdset='',$fd,1)=1;while (){$nfound=($type eq 'read')? select($fdset,undef,undef,$pending): select(undef,$fdset,undef,$pending);if ($nfound==-1){$!==EINTR or die(qq/select(2): '$!'\n/);redo if!$timeout || ($pending=$timeout - (time - $initial))> 0;$nfound=0}last}$!=0;return$nfound}sub can_read {@_==1 || @_==2 || die(q/Usage: $handle->can_read([timeout])/ ."\n");my$self=shift;if (ref($self->{fh})eq 'IO::Socket::SSL'){return 1 if$self->{fh}->pending}return$self->_do_timeout('read',@_)}sub can_write {@_==1 || @_==2 || die(q/Usage: $handle->can_write([timeout])/ ."\n");my$self=shift;return$self->_do_timeout('write',@_)}sub _assert_ssl {my($ok,$reason)=HTTP::Tiny->can_ssl();die$reason unless$ok}sub can_reuse {my ($self,$scheme,$host,$port,$peer)=@_;return 0 if $self->{pid}!=$$ || $self->{tid}!=_get_tid()|| length($self->{rbuf})|| $scheme ne $self->{scheme}|| $host ne $self->{host}|| $port ne $self->{port}|| $peer ne $self->{peer}|| eval {$self->can_read(0)}|| $@ ;return 1}sub _find_CA_file {my$self=shift();my$ca_file=defined($self->{SSL_options}->{SSL_ca_file})? $self->{SSL_options}->{SSL_ca_file}: $ENV{SSL_CERT_FILE};if (defined$ca_file){unless (-r $ca_file){die qq/SSL_ca_file '$ca_file' not found or not readable\n/}return$ca_file}local@INC=@INC;pop@INC if$INC[-1]eq '.';return Mozilla::CA::SSL_ca_file()if eval {require Mozilla::CA;1};for my$ca_bundle ("/etc/ssl/certs/ca-certificates.crt","/etc/pki/tls/certs/ca-bundle.crt","/etc/ssl/ca-bundle.pem","/etc/openssl/certs/ca-certificates.crt","/etc/ssl/cert.pem","/usr/local/share/certs/ca-root-nss.crt","/etc/pki/tls/cacert.pem","/etc/certs/ca-certificates.crt",){return$ca_bundle if -e $ca_bundle}die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/ .qq/Try installing Mozilla::CA from CPAN\n/}sub _get_tid {no warnings 'reserved';return threads->can("tid")? threads->tid : 0}sub _ssl_args {my ($self,$host)=@_;my%ssl_args;if (Net::SSLeay::OPENSSL_VERSION_NUMBER()>= 0x01000000){$ssl_args{SSL_hostname}=$host,}if ($self->{verify_SSL}){$ssl_args{SSL_verifycn_scheme}='http';$ssl_args{SSL_verifycn_name}=$host;$ssl_args{SSL_verify_mode}=0x01;$ssl_args{SSL_ca_file}=$self->_find_CA_file}else {$ssl_args{SSL_verifycn_scheme}='none';$ssl_args{SSL_verify_mode}=0x00}for my$k (keys %{$self->{SSL_options}}){$ssl_args{$k}=$self->{SSL_options}{$k}if$k =~ m/^SSL_/}return \%ssl_args}1; + sub $sub_name { + my (\$self, \$url, \$args) = \@_; + \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH') + or _croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n"); + return \$self->request('$req_method', \$url, \$args || {}); + } + HERE +HTTP_TINY + +$fatpacked{"JSON/MaybeXS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_MAYBEXS'; + package JSON::MaybeXS;use strict;use warnings FATAL=>'all';use base qw(Exporter);our$VERSION='1.004000';$VERSION=eval$VERSION;sub _choose_json_module {return 'Cpanel::JSON::XS' if$INC{'Cpanel/JSON/XS.pm'};return 'JSON::XS' if$INC{'JSON/XS.pm'};my@err;return 'Cpanel::JSON::XS' if eval {require Cpanel::JSON::XS;1};push@err,"Error loading Cpanel::JSON::XS: $@";return 'JSON::XS' if eval {require JSON::XS;1};push@err,"Error loading JSON::XS: $@";return 'JSON::PP' if eval {require JSON::PP;1};push@err,"Error loading JSON::PP: $@";die join("\n","Couldn't load a JSON module:",@err)}BEGIN {our$JSON_Class=_choose_json_module();$JSON_Class->import(qw(encode_json decode_json));no strict 'refs';*$_=$JSON_Class->can($_)for qw(true false)}our@EXPORT=qw(encode_json decode_json JSON);my@EXPORT_ALL=qw(is_bool);our@EXPORT_OK=qw(is_bool to_json from_json);our%EXPORT_TAGS=(all=>[@EXPORT,@EXPORT_ALL ],legacy=>[@EXPORT,@EXPORT_OK ],);sub JSON () {our$JSON_Class}sub new {shift;my%args=@_==1 ? %{$_[0]}: @_;my$new=(our$JSON_Class)->new;$new->$_($args{$_})for keys%args;return$new}use Scalar::Util ();sub is_bool {die 'is_bool is not a method' if $_[1];Scalar::Util::blessed($_[0])and ($_[0]->isa('JSON::XS::Boolean')or $_[0]->isa('Cpanel::JSON::XS::Boolean')or $_[0]->isa('JSON::PP::Boolean'))}use Carp ();sub from_json ($@) {if (ref($_[0])=~ /^JSON/ or $_[0]=~ /^JSON/){Carp::croak "from_json should not be called as a method."}my$json=JSON()->new;if (@_==2 and ref $_[1]eq 'HASH'){my$opt=$_[1];for my$method (keys %$opt){$json->$method($opt->{$method})}}return$json->decode($_[0])}sub to_json ($@) {if (ref($_[0])=~ /^JSON/ or (@_ > 2 and $_[0]=~ /^JSON/)){Carp::croak "to_json should not be called as a method."}my$json=JSON()->new;if (@_==2 and ref $_[1]eq 'HASH'){my$opt=$_[1];for my$method (keys %$opt){$json->$method($opt->{$method})}}$json->encode($_[0])}1; +JSON_MAYBEXS + +$fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP'; + package JSON::PP;use 5.005;use strict;use Exporter ();BEGIN {@JSON::PP::ISA=('Exporter')}use overload ();use JSON::PP::Boolean;use Carp ();$JSON::PP::VERSION='4.04';@JSON::PP::EXPORT=qw(encode_json decode_json from_json to_json);use constant P_ASCII=>0;use constant P_LATIN1=>1;use constant P_UTF8=>2;use constant P_INDENT=>3;use constant P_CANONICAL=>4;use constant P_SPACE_BEFORE=>5;use constant P_SPACE_AFTER=>6;use constant P_ALLOW_NONREF=>7;use constant P_SHRINK=>8;use constant P_ALLOW_BLESSED=>9;use constant P_CONVERT_BLESSED=>10;use constant P_RELAXED=>11;use constant P_LOOSE=>12;use constant P_ALLOW_BIGNUM=>13;use constant P_ALLOW_BAREKEY=>14;use constant P_ALLOW_SINGLEQUOTE=>15;use constant P_ESCAPE_SLASH=>16;use constant P_AS_NONBLESSED=>17;use constant P_ALLOW_UNKNOWN=>18;use constant P_ALLOW_TAGS=>19;use constant OLD_PERL=>$] < 5.008 ? 1 : 0;use constant USE_B=>$ENV{PERL_JSON_PP_USE_B}|| 0;BEGIN {if (USE_B){require B}}BEGIN {my@xs_compati_bit_properties=qw(latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink allow_blessed convert_blessed relaxed allow_unknown allow_tags);my@pp_bit_properties=qw(allow_singlequote allow_bignum loose allow_barekey escape_slash as_nonblessed);if (OLD_PERL){my$helper=$] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';eval qq| require $helper |;if ($@){Carp::croak $@}}for my$name (@xs_compati_bit_properties,@pp_bit_properties){my$property_id='P_' .uc($name);eval qq/ + sub $name { + my \$enable = defined \$_[1] ? \$_[1] : 1; + + if (\$enable) { + \$_[0]->{PROPS}->[$property_id] = 1; + } + else { + \$_[0]->{PROPS}->[$property_id] = 0; + } + + \$_[0]; + } + + sub get_$name { + \$_[0]->{PROPS}->[$property_id] ? 1 : ''; + } + /}}my$JSON;sub encode_json ($) {($JSON ||= __PACKAGE__->new->utf8)->encode(@_)}sub decode_json {($JSON ||= __PACKAGE__->new->utf8)->decode(@_)}sub to_json($) {Carp::croak ("JSON::PP::to_json has been renamed to encode_json.")}sub from_json($) {Carp::croak ("JSON::PP::from_json has been renamed to decode_json.")}sub new {my$class=shift;my$self={max_depth=>512,max_size=>0,indent_length=>3,};$self->{PROPS}[P_ALLOW_NONREF]=1;bless$self,$class}sub encode {return $_[0]->PP_encode_json($_[1])}sub decode {return $_[0]->PP_decode_json($_[1],0x00000000)}sub decode_prefix {return $_[0]->PP_decode_json($_[1],0x00000001)}sub pretty {my ($self,$v)=@_;my$enable=defined$v ? $v : 1;if ($enable){$self->indent(1)->space_before(1)->space_after(1)}else {$self->indent(0)->space_before(0)->space_after(0)}$self}sub max_depth {my$max=defined $_[1]? $_[1]: 0x80000000;$_[0]->{max_depth}=$max;$_[0]}sub get_max_depth {$_[0]->{max_depth}}sub max_size {my$max=defined $_[1]? $_[1]: 0;$_[0]->{max_size}=$max;$_[0]}sub get_max_size {$_[0]->{max_size}}sub boolean_values {my$self=shift;if (@_){my ($false,$true)=@_;$self->{false}=$false;$self->{true}=$true;return ($false,$true)}else {delete$self->{false};delete$self->{true};return}}sub get_boolean_values {my$self=shift;if (exists$self->{true}and exists$self->{false}){return @$self{qw/false true/}}return}sub filter_json_object {if (defined $_[1]and ref $_[1]eq 'CODE'){$_[0]->{cb_object}=$_[1]}else {delete $_[0]->{cb_object}}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub filter_json_single_key_object {if (@_==1 or @_ > 3){Carp::croak("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)")}if (defined $_[2]and ref $_[2]eq 'CODE'){$_[0]->{cb_sk_object}->{$_[1]}=$_[2]}else {delete $_[0]->{cb_sk_object}->{$_[1]};delete $_[0]->{cb_sk_object}unless %{$_[0]->{cb_sk_object}|| {}}}$_[0]->{F_HOOK}=($_[0]->{cb_object}or $_[0]->{cb_sk_object})? 1 : 0;$_[0]}sub indent_length {if (!defined $_[1]or $_[1]> 15 or $_[1]< 0){Carp::carp "The acceptable range of indent_length() is 0 to 15."}else {$_[0]->{indent_length}=$_[1]}$_[0]}sub get_indent_length {$_[0]->{indent_length}}sub sort_by {$_[0]->{sort_by}=defined $_[1]? $_[1]: 1;$_[0]}sub allow_bigint {Carp::carp("allow_bigint() is obsoleted. use allow_bignum() instead.");$_[0]->allow_bignum}{my$max_depth;my$indent;my$ascii;my$latin1;my$utf8;my$space_before;my$space_after;my$canonical;my$allow_blessed;my$convert_blessed;my$indent_length;my$escape_slash;my$bignum;my$as_nonblessed;my$allow_tags;my$depth;my$indent_count;my$keysort;sub PP_encode_json {my$self=shift;my$obj=shift;$indent_count=0;$depth=0;my$props=$self->{PROPS};($ascii,$latin1,$utf8,$indent,$canonical,$space_before,$space_after,$allow_blessed,$convert_blessed,$escape_slash,$bignum,$as_nonblessed,$allow_tags)=@{$props}[P_ASCII .. P_SPACE_AFTER,P_ALLOW_BLESSED,P_CONVERT_BLESSED,P_ESCAPE_SLASH,P_ALLOW_BIGNUM,P_AS_NONBLESSED,P_ALLOW_TAGS];($max_depth,$indent_length)=@{$self}{qw/max_depth indent_length/};$keysort=$canonical ? sub {$a cmp $b}: undef;if ($self->{sort_by}){$keysort=ref($self->{sort_by})eq 'CODE' ? $self->{sort_by}: $self->{sort_by}=~ /\D+/ ? $self->{sort_by}: sub {$a cmp $b}}encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")if(!ref$obj and!$props->[P_ALLOW_NONREF ]);my$str=$self->object_to_json($obj);$str .= "\n" if ($indent);unless ($ascii or $latin1 or $utf8){utf8::upgrade($str)}if ($props->[P_SHRINK ]){utf8::downgrade($str,1)}return$str}sub object_to_json {my ($self,$obj)=@_;my$type=ref($obj);if($type eq 'HASH'){return$self->hash_to_json($obj)}elsif($type eq 'ARRAY'){return$self->array_to_json($obj)}elsif ($type){if (blessed($obj)){return$self->value_to_json($obj)if ($obj->isa('JSON::PP::Boolean'));if ($allow_tags and $obj->can('FREEZE')){my$obj_class=ref$obj || $obj;$obj=bless$obj,$obj_class;my@results=$obj->FREEZE('JSON');if (@results and ref$results[0]){if (refaddr($obj)eq refaddr($results[0])){encode_error(sprintf("%s::FREEZE method returned same object as was passed instead of a new one",ref$obj))}}return '("'.$obj_class.'")['.join(',',@results).']'}if ($convert_blessed and $obj->can('TO_JSON')){my$result=$obj->TO_JSON();if (defined$result and ref($result)){if (refaddr($obj)eq refaddr($result)){encode_error(sprintf("%s::TO_JSON method returned same object as was passed instead of a new one",ref$obj))}}return$self->object_to_json($result)}return "$obj" if ($bignum and _is_bignum($obj));if ($allow_blessed){return$self->blessed_to_json($obj)if ($as_nonblessed);return 'null'}encode_error(sprintf("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)",$obj))}else {return$self->value_to_json($obj)}}else{return$self->value_to_json($obj)}}sub hash_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');my$del=($space_before ? ' ' : '').':' .($space_after ? ' ' : '');for my$k (_sort($obj)){if (OLD_PERL){utf8::decode($k)}push@res,$self->string_to_json($k).$del .(ref$obj->{$k}? $self->object_to_json($obj->{$k}): $self->value_to_json($obj->{$k}))}--$depth;$self->_down_indent()if ($indent);return '{}' unless@res;return '{' .$pre .join(",$pre",@res).$post .'}'}sub array_to_json {my ($self,$obj)=@_;my@res;encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")if (++$depth > $max_depth);my ($pre,$post)=$indent ? $self->_up_indent(): ('','');for my$v (@$obj){push@res,ref($v)? $self->object_to_json($v): $self->value_to_json($v)}--$depth;$self->_down_indent()if ($indent);return '[]' unless@res;return '[' .$pre .join(",$pre",@res).$post .']'}sub _looks_like_number {my$value=shift;if (USE_B){my$b_obj=B::svref_2object(\$value);my$flags=$b_obj->FLAGS;return 1 if$flags & (B::SVp_IOK()| B::SVp_NOK())and!($flags & B::SVp_POK());return}else {no warnings 'numeric';return if utf8::is_utf8($value);return unless length((my$dummy="")& $value);return unless 0 + $value eq $value;return 1 if$value * 0==0;return -1}}sub value_to_json {my ($self,$value)=@_;return 'null' if(!defined$value);my$type=ref($value);if (!$type){if (_looks_like_number($value)){return$value}return$self->string_to_json($value)}elsif(blessed($value)and $value->isa('JSON::PP::Boolean')){return $$value==1 ? 'true' : 'false'}else {if ((overload::StrVal($value)=~ /=(\w+)/)[0]){return$self->value_to_json("$value")}if ($type eq 'SCALAR' and defined $$value){return $$value eq '1' ? 'true' : $$value eq '0' ? 'false' : $self->{PROPS}->[P_ALLOW_UNKNOWN ]? 'null' : encode_error("cannot encode reference to scalar")}if ($self->{PROPS}->[P_ALLOW_UNKNOWN ]){return 'null'}else {if ($type eq 'SCALAR' or $type eq 'REF'){encode_error("cannot encode reference to scalar")}else {encode_error("encountered $value, but JSON can only represent references to arrays or hashes")}}}}my%esc=("\n"=>'\n',"\r"=>'\r',"\t"=>'\t',"\f"=>'\f',"\b"=>'\b',"\""=>'\"',"\\"=>'\\\\',"\'"=>'\\\'',);sub string_to_json {my ($self,$arg)=@_;$arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;$arg =~ s/\//\\\//g if ($escape_slash);$arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;if ($ascii){$arg=JSON_PP_encode_ascii($arg)}if ($latin1){$arg=JSON_PP_encode_latin1($arg)}if ($utf8){utf8::encode($arg)}return '"' .$arg .'"'}sub blessed_to_json {my$reftype=reftype($_[1])|| '';if ($reftype eq 'HASH'){return $_[0]->hash_to_json($_[1])}elsif ($reftype eq 'ARRAY'){return $_[0]->array_to_json($_[1])}else {return 'null'}}sub encode_error {my$error=shift;Carp::croak "$error"}sub _sort {defined$keysort ? (sort$keysort (keys %{$_[0]})): keys %{$_[0]}}sub _up_indent {my$self=shift;my$space=' ' x $indent_length;my ($pre,$post)=('','');$post="\n" .$space x $indent_count;$indent_count++;$pre="\n" .$space x $indent_count;return ($pre,$post)}sub _down_indent {$indent_count--}sub PP_encode_box {{depth=>$depth,indent_count=>$indent_count,}}}sub _encode_ascii {join('',map {$_ <= 127 ? chr($_): $_ <= 65535 ? sprintf('\u%04x',$_): sprintf('\u%x\u%x',_encode_surrogates($_))}unpack('U*',$_[0]))}sub _encode_latin1 {join('',map {$_ <= 255 ? chr($_): $_ <= 65535 ? sprintf('\u%04x',$_): sprintf('\u%x\u%x',_encode_surrogates($_))}unpack('U*',$_[0]))}sub _encode_surrogates {my$uni=$_[0]- 0x10000;return ($uni / 0x400 + 0xD800,$uni % 0x400 + 0xDC00)}sub _is_bignum {$_[0]->isa('Math::BigInt')or $_[0]->isa('Math::BigFloat')}my$max_intsize;BEGIN {my$checkint=1111;for my$d (5..64){$checkint .= 1;my$int=eval qq| $checkint |;if ($int =~ /[eE]/){$max_intsize=$d - 1;last}}}{my%escapes=(b=>"\x8",t=>"\x9",n=>"\xA",f=>"\xC",r=>"\xD",'\\'=>'\\','"'=>'"','/'=>'/',);my$text;my$at;my$ch;my$len;my$depth;my$encoding;my$is_valid_utf8;my$utf8_len;my$utf8;my$max_depth;my$max_size;my$relaxed;my$cb_object;my$cb_sk_object;my$F_HOOK;my$allow_bignum;my$singlequote;my$loose;my$allow_barekey;my$allow_tags;my$alt_true;my$alt_false;sub _detect_utf_encoding {my$text=shift;my@octets=unpack('C4',$text);return 'unknown' unless defined$octets[3];return ($octets[0]and $octets[1])? 'UTF-8' : (!$octets[0]and $octets[1])? 'UTF-16BE' : (!$octets[0]and!$octets[1])? 'UTF-32BE' : ($octets[2])? 'UTF-16LE' : (!$octets[2])? 'UTF-32LE' : 'unknown'}sub PP_decode_json {my ($self,$want_offset);($self,$text,$want_offset)=@_;($at,$ch,$depth)=(0,'',0);if (!defined$text or ref$text){decode_error("malformed JSON string, neither array, object, number, string or atom")}my$props=$self->{PROPS};($utf8,$relaxed,$loose,$allow_bignum,$allow_barekey,$singlequote,$allow_tags)=@{$props}[P_UTF8,P_RELAXED,P_LOOSE .. P_ALLOW_SINGLEQUOTE,P_ALLOW_TAGS];($alt_true,$alt_false)=@$self{qw/true false/};if ($utf8){$encoding=_detect_utf_encoding($text);if ($encoding ne 'UTF-8' and $encoding ne 'unknown'){require Encode;Encode::from_to($text,$encoding,'utf-8')}else {utf8::downgrade($text,1)or Carp::croak("Wide character in subroutine entry")}}else {utf8::upgrade($text);utf8::encode($text)}$len=length$text;($max_depth,$max_size,$cb_object,$cb_sk_object,$F_HOOK)=@{$self}{qw/max_depth max_size cb_object cb_sk_object F_HOOK/};if ($max_size > 1){use bytes;my$bytes=length$text;decode_error(sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s" ,$bytes,$max_size),1)if ($bytes > $max_size)}white();decode_error("malformed JSON string, neither array, object, number, string or atom")unless defined$ch;my$result=value();if (!$props->[P_ALLOW_NONREF ]and!ref$result){decode_error('JSON text must be an object or array (but found number, string, true, false or null,' .' use allow_nonref to allow this)',1)}Carp::croak('something wrong.')if$len < $at;my$consumed=defined$ch ? $at - 1 : $at;white();return ($result,$consumed)if$want_offset;decode_error("garbage after JSON object")if defined$ch;$result}sub next_chr {return$ch=undef if($at >= $len);$ch=substr($text,$at++,1)}sub value {white();return if(!defined$ch);return object()if($ch eq '{');return array()if($ch eq '[');return tag()if($ch eq '(');return string()if($ch eq '"' or ($singlequote and $ch eq "'"));return number()if($ch =~ /[0-9]/ or $ch eq '-');return word()}sub string {my$utf16;my$is_utf8;($is_valid_utf8,$utf8_len)=('',0);my$s='';if($ch eq '"' or ($singlequote and $ch eq "'")){my$boundChar=$ch;OUTER: while(defined(next_chr())){if($ch eq $boundChar){next_chr();if ($utf16){decode_error("missing low surrogate character in surrogate pair")}utf8::decode($s)if($is_utf8);return$s}elsif($ch eq '\\'){next_chr();if(exists$escapes{$ch}){$s .= $escapes{$ch}}elsif($ch eq 'u'){my$u='';for(1..4){$ch=next_chr();last OUTER if($ch !~ /[0-9a-fA-F]/);$u .= $ch}if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/){$utf16=$u}elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/){unless (defined$utf16){decode_error("missing high surrogate character in surrogate pair")}$is_utf8=1;$s .= JSON_PP_decode_surrogates($utf16,$u)|| next;$utf16=undef}else {if (defined$utf16){decode_error("surrogate pair expected")}if ((my$hex=hex($u))> 127){$is_utf8=1;$s .= JSON_PP_decode_unicode($u)|| next}else {$s .= chr$hex}}}else{unless ($loose){$at -= 2;decode_error('illegal backslash escape sequence in string')}$s .= $ch}}else{if (ord$ch > 127){unless($ch=is_valid_utf8($ch)){$at -= 1;decode_error("malformed UTF-8 character in JSON string")}else {$at += $utf8_len - 1}$is_utf8=1}if (!$loose){if ($ch =~ /[\x00-\x1f\x22\x5c]/){if (!$relaxed or $ch ne "\t"){$at--;decode_error('invalid character encountered while parsing JSON string')}}}$s .= $ch}}}decode_error("unexpected end of string while parsing JSON string")}sub white {while(defined$ch){if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){next_chr()}elsif($relaxed and $ch eq '/'){next_chr();if(defined$ch and $ch eq '/'){1 while(defined(next_chr())and $ch ne "\n" and $ch ne "\r")}elsif(defined$ch and $ch eq '*'){next_chr();while(1){if(defined$ch){if($ch eq '*'){if(defined(next_chr())and $ch eq '/'){next_chr();last}}else{next_chr()}}else{decode_error("Unterminated comment")}}next}else{$at--;decode_error("malformed JSON string, neither array, object, number, string or atom")}}else{if ($relaxed and $ch eq '#'){pos($text)=$at;$text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;$at=pos($text);next_chr;next}last}}}sub array {my$a=$_[0]|| [];decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')if (++$depth > $max_depth);next_chr();white();if(defined$ch and $ch eq ']'){--$depth;next_chr();return$a}else {while(defined($ch)){push @$a,value();white();if (!defined$ch){last}if($ch eq ']'){--$depth;next_chr();return$a}if($ch ne ','){last}next_chr();white();if ($relaxed and $ch eq ']'){--$depth;next_chr();return$a}}}$at-- if defined$ch and $ch ne '';decode_error(", or ] expected while parsing array")}sub tag {decode_error('malformed JSON string, neither array, object, number, string or atom')unless$allow_tags;next_chr();white();my$tag=value();return unless defined$tag;decode_error('malformed JSON string, (tag) must be a string')if ref$tag;white();if (!defined$ch or $ch ne ')'){decode_error(') expected after tag')}next_chr();white();my$val=value();return unless defined$val;decode_error('malformed JSON string, tag value must be an array')unless ref$val eq 'ARRAY';if (!eval {$tag->can('THAW')}){decode_error('cannot decode perl-object (package does not exist)')if $@;decode_error('cannot decode perl-object (package does not have a THAW method)')}$tag->THAW('JSON',@$val)}sub object {my$o=$_[0]|| {};my$k;decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')if (++$depth > $max_depth);next_chr();white();if(defined$ch and $ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}else {while (defined$ch){$k=($allow_barekey and $ch ne '"' and $ch ne "'")? bareKey(): string();white();if(!defined$ch or $ch ne ':'){$at--;decode_error("':' expected")}next_chr();$o->{$k}=value();white();last if (!defined$ch);if($ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}if($ch ne ','){last}next_chr();white();if ($relaxed and $ch eq '}'){--$depth;next_chr();if ($F_HOOK){return _json_object_hook($o)}return$o}}}$at-- if defined$ch and $ch ne '';decode_error(", or } expected while parsing object/hash")}sub bareKey {my$key;while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){$key .= $ch;next_chr()}return$key}sub word {my$word=substr($text,$at-1,4);if($word eq 'true'){$at += 3;next_chr;return defined$alt_true ? $alt_true : $JSON::PP::true}elsif($word eq 'null'){$at += 3;next_chr;return undef}elsif($word eq 'fals'){$at += 3;if(substr($text,$at,1)eq 'e'){$at++;next_chr;return defined$alt_false ? $alt_false : $JSON::PP::false}}$at--;decode_error("'null' expected")if ($word =~ /^n/);decode_error("'true' expected")if ($word =~ /^t/);decode_error("'false' expected")if ($word =~ /^f/);decode_error("malformed JSON string, neither array, object, number, string or atom")}sub number {my$n='';my$v;my$is_dec;my$is_exp;if($ch eq '-'){$n='-';next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after initial minus)")}}if($ch eq '0'){my$peek=substr($text,$at,1);if($peek =~ /^[0-9a-dfA-DF]/){decode_error("malformed number (leading zero must not be followed by another digit)")}$n .= $ch;next_chr}while(defined$ch and $ch =~ /\d/){$n .= $ch;next_chr}if(defined$ch and $ch eq '.'){$n .= '.';$is_dec=1;next_chr;if (!defined$ch or $ch !~ /\d/){decode_error("malformed number (no digits after decimal point)")}else {$n .= $ch}while(defined(next_chr)and $ch =~ /\d/){$n .= $ch}}if(defined$ch and ($ch eq 'e' or $ch eq 'E')){$n .= $ch;$is_exp=1;next_chr;if(defined($ch)and ($ch eq '+' or $ch eq '-')){$n .= $ch;next_chr;if (!defined$ch or $ch =~ /\D/){decode_error("malformed number (no digits after exp sign)")}$n .= $ch}elsif(defined($ch)and $ch =~ /\d/){$n .= $ch}else {decode_error("malformed number (no digits after exp sign)")}while(defined(next_chr)and $ch =~ /\d/){$n .= $ch}}$v .= $n;if ($is_dec or $is_exp){if ($allow_bignum){require Math::BigFloat;return Math::BigFloat->new($v)}}else {if (length$v > $max_intsize){if ($allow_bignum){require Math::BigInt;return Math::BigInt->new($v)}else {return "$v"}}}return$is_dec ? $v/1.0 : 0+$v}sub is_valid_utf8 {$utf8_len=$_[0]=~ /[\x00-\x7F]/ ? 1 : $_[0]=~ /[\xC2-\xDF]/ ? 2 : $_[0]=~ /[\xE0-\xEF]/ ? 3 : $_[0]=~ /[\xF0-\xF4]/ ? 4 : 0 ;return unless$utf8_len;my$is_valid_utf8=substr($text,$at - 1,$utf8_len);return ($is_valid_utf8 =~ /^(?: + [\x00-\x7F] + |[\xC2-\xDF][\x80-\xBF] + |[\xE0][\xA0-\xBF][\x80-\xBF] + |[\xE1-\xEC][\x80-\xBF][\x80-\xBF] + |[\xED][\x80-\x9F][\x80-\xBF] + |[\xEE-\xEF][\x80-\xBF][\x80-\xBF] + |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] + |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] + |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] + )$/x)? $is_valid_utf8 : ''}sub decode_error {my$error=shift;my$no_rep=shift;my$str=defined$text ? substr($text,$at): '';my$mess='';my$type='U*';if (OLD_PERL){my$type=$] < 5.006 ? 'C*' : utf8::is_utf8($str)? 'U*' : 'C*' }for my$c (unpack($type,$str)){$mess .= $c==0x07 ? '\a' : $c==0x09 ? '\t' : $c==0x0a ? '\n' : $c==0x0d ? '\r' : $c==0x0c ? '\f' : $c < 0x20 ? sprintf('\x{%x}',$c): $c==0x5c ? '\\\\' : $c < 0x80 ? chr($c): sprintf('\x{%x}',$c);if (length$mess >= 20){$mess .= '...';last}}unless (length$mess){$mess='(end of string)'}Carp::croak ($no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")")}sub _json_object_hook {my$o=$_[0];my@ks=keys %{$o};if ($cb_sk_object and @ks==1 and exists$cb_sk_object->{$ks[0]}and ref$cb_sk_object->{$ks[0]}){my@val=$cb_sk_object->{$ks[0]}->($o->{$ks[0]});if (@val==0){return$o}elsif (@val==1){return$val[0]}else {Carp::croak("filter_json_single_key_object callbacks must not return more than one scalar")}}my@val=$cb_object->($o)if ($cb_object);if (@val==0){return$o}elsif (@val==1){return$val[0]}else {Carp::croak("filter_json_object callbacks must not return more than one scalar")}}sub PP_decode_box {{text=>$text,at=>$at,ch=>$ch,len=>$len,depth=>$depth,encoding=>$encoding,is_valid_utf8=>$is_valid_utf8,}}}sub _decode_surrogates {my$uni=0x10000 + (hex($_[0])- 0xD800)* 0x400 + (hex($_[1])- 0xDC00);my$un=pack('U*',$uni);utf8::encode($un);return$un}sub _decode_unicode {my$un=pack('U',hex shift);utf8::encode($un);return$un}BEGIN {unless (defined&utf8::is_utf8){require Encode;*utf8::is_utf8=*Encode::is_utf8}if (!OLD_PERL){*JSON::PP::JSON_PP_encode_ascii=\&_encode_ascii;*JSON::PP::JSON_PP_encode_latin1=\&_encode_latin1;*JSON::PP::JSON_PP_decode_surrogates=\&_decode_surrogates;*JSON::PP::JSON_PP_decode_unicode=\&_decode_unicode;if ($] < 5.008003){package JSON::PP;require subs;subs->import('join');eval q| + sub join { + return '' if (@_ < 2); + my $j = shift; + my $str = shift; + for (@_) { $str .= $j . $_; } + return $str; + } + |}}sub JSON::PP::incr_parse {local$Carp::CarpLevel=1;($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_parse(@_)}sub JSON::PP::incr_skip {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_skip}sub JSON::PP::incr_reset {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_reset}eval q{ + sub JSON::PP::incr_text : lvalue { + $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new; + + if ( $_[0]->{_incr_parser}->{incr_pos} ) { + Carp::croak("incr_text cannot be called when the incremental parser already started parsing"); + } + $_[0]->{_incr_parser}->{incr_text}; + } + } if ($] >= 5.006)}BEGIN {eval 'require Scalar::Util';unless($@){*JSON::PP::blessed=\&Scalar::Util::blessed;*JSON::PP::reftype=\&Scalar::Util::reftype;*JSON::PP::refaddr=\&Scalar::Util::refaddr}else{eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';*JSON::PP::blessed=sub {local($@,$SIG{__DIE__},$SIG{__WARN__});ref($_[0])? eval {$_[0]->a_sub_not_likely_to_be_here}: undef};require B;my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP);*JSON::PP::reftype=sub {my$r=shift;return undef unless length(ref($r));my$t=ref(B::svref_2object($r));return exists$tmap{$t}? $tmap{$t}: length(ref($$r))? 'REF' : 'SCALAR'};*JSON::PP::refaddr=sub {return undef unless length(ref($_[0]));my$addr;if(defined(my$pkg=blessed($_[0]))){$addr .= bless $_[0],'Scalar::Util::Fake';bless $_[0],$pkg}else {$addr .= $_[0]}$addr =~ /0x(\w+)/;local $^W;hex($1)}}}$JSON::PP::true=do {bless \(my$dummy=1),"JSON::PP::Boolean"};$JSON::PP::false=do {bless \(my$dummy=0),"JSON::PP::Boolean"};sub is_bool {blessed $_[0]and ($_[0]->isa("JSON::PP::Boolean")or $_[0]->isa("Types::Serialiser::BooleanBase")or $_[0]->isa("JSON::XS::Boolean"))}sub true {$JSON::PP::true}sub false {$JSON::PP::false}sub null {undef}package JSON::PP::IncrParser;use strict;use constant INCR_M_WS=>0;use constant INCR_M_STR=>1;use constant INCR_M_BS=>2;use constant INCR_M_JSON=>3;use constant INCR_M_C0=>4;use constant INCR_M_C1=>5;use constant INCR_M_TFN=>6;use constant INCR_M_NUM=>7;$JSON::PP::IncrParser::VERSION='1.01';sub new {my ($class)=@_;bless {incr_nest=>0,incr_text=>undef,incr_pos=>0,incr_mode=>0,},$class}sub incr_parse {my ($self,$coder,$text)=@_;$self->{incr_text}='' unless (defined$self->{incr_text});if (defined$text){if (utf8::is_utf8($text)and!utf8::is_utf8($self->{incr_text})){utf8::upgrade($self->{incr_text});utf8::decode($self->{incr_text})}$self->{incr_text}.= $text}if (defined wantarray){my$max_size=$coder->get_max_size;my$p=$self->{incr_pos};my@ret;{do {unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){$self->_incr_parse($coder);if ($max_size and $self->{incr_pos}> $max_size){Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size")}unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){if ($self->{incr_mode}==INCR_M_WS and $self->{incr_pos}){$self->{incr_pos}=0;$self->{incr_text}=''}last}}my ($obj,$offset)=$coder->PP_decode_json($self->{incr_text},0x00000001);push@ret,$obj;use bytes;$self->{incr_text}=substr($self->{incr_text},$offset || 0);$self->{incr_pos}=0;$self->{incr_nest}=0;$self->{incr_mode}=0;last unless wantarray}while (wantarray)}if (wantarray){return@ret}else {return defined$ret[0]? $ret[0]: undef}}}sub _incr_parse {my ($self,$coder)=@_;my$text=$self->{incr_text};my$len=length$text;my$p=$self->{incr_pos};INCR_PARSE: while ($len > $p){my$s=substr($text,$p,1);last INCR_PARSE unless defined$s;my$mode=$self->{incr_mode};if ($mode==INCR_M_WS){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if (ord($s)> 0x20){if ($s eq '#'){$self->{incr_mode}=INCR_M_C0;redo INCR_PARSE}else {$self->{incr_mode}=INCR_M_JSON;redo INCR_PARSE}}$p++}}elsif ($mode==INCR_M_BS){$p++;$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($mode==INCR_M_C0 or $mode==INCR_M_C1){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq "\n"){$self->{incr_mode}=$self->{incr_mode}==INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;last}$p++}next}elsif ($mode==INCR_M_TFN){while ($len > $p){$s=substr($text,$p++,1);next if defined$s and $s =~ /[rueals]/;last}$p--;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($mode==INCR_M_NUM){while ($len > $p){$s=substr($text,$p++,1);next if defined$s and $s =~ /[0-9eE.+\-]/;last}$p--;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($mode==INCR_M_STR){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq '"'){$p++;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($s eq '\\'){$p++;if (!defined substr($text,$p,1)){$self->{incr_mode}=INCR_M_BS;last INCR_PARSE}}$p++}}elsif ($mode==INCR_M_JSON){while ($len > $p){$s=substr($text,$p++,1);if ($s eq "\x00"){$p--;last INCR_PARSE}elsif ($s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20"){if (!$self->{incr_nest}){$p--;last INCR_PARSE}next}elsif ($s eq 't' or $s eq 'f' or $s eq 'n'){$self->{incr_mode}=INCR_M_TFN;redo INCR_PARSE}elsif ($s =~ /^[0-9\-]$/){$self->{incr_mode}=INCR_M_NUM;redo INCR_PARSE}elsif ($s eq '"'){$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($s eq '[' or $s eq '{'){if (++$self->{incr_nest}> $coder->get_max_depth){Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')}next}elsif ($s eq ']' or $s eq '}'){if (--$self->{incr_nest}<= 0){last INCR_PARSE}}elsif ($s eq '#'){$self->{incr_mode}=INCR_M_C1;redo INCR_PARSE}}}}$self->{incr_pos}=$p;$self->{incr_parsing}=$p ? 1 : 0}sub incr_text {if ($_[0]->{incr_pos}){Carp::croak("incr_text cannot be called when the incremental parser already started parsing")}$_[0]->{incr_text}}sub incr_skip {my$self=shift;$self->{incr_text}=substr($self->{incr_text},$self->{incr_pos});$self->{incr_pos}=0;$self->{incr_mode}=0;$self->{incr_nest}=0}sub incr_reset {my$self=shift;$self->{incr_text}=undef;$self->{incr_pos}=0;$self->{incr_mode}=0;$self->{incr_nest}=0}1; +JSON_PP + +$fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN'; + package JSON::PP::Boolean;use strict;require overload;local $^W;overload::import('overload',"0+"=>sub {${$_[0]}},"++"=>sub {$_[0]=${$_[0]}+ 1},"--"=>sub {$_[0]=${$_[0]}- 1},fallback=>1,);$JSON::PP::Boolean::VERSION='4.04';1; +JSON_PP_BOOLEAN + +$fatpacked{"Module/Implementation.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_IMPLEMENTATION'; + package Module::Implementation;$Module::Implementation::VERSION='0.09';use strict;use warnings;use Module::Runtime 0.012 qw(require_module);use Try::Tiny;unless (exists$Module::Implementation::{VERSION}&& ${$Module::Implementation::{VERSION}}){$Module::Implementation::{VERSION}=\42}my%Implementation;sub build_loader_sub {my$caller=caller();return _build_loader($caller,@_)}sub _build_loader {my$package=shift;my%args=@_;my@implementations=@{$args{implementations}};my@symbols=@{$args{symbols}|| []};my$implementation;my$env_var=uc$package;$env_var =~ s/::/_/g;$env_var .= '_IMPLEMENTATION';return sub {my ($implementation,$loaded)=_load_implementation($package,$ENV{$env_var},\@implementations,);$Implementation{$package}=$implementation;_copy_symbols($loaded,$package,\@symbols);return$loaded}}sub implementation_for {my$package=shift;return$Implementation{$package}}sub _load_implementation {my$package=shift;my$env_value=shift;my$implementations=shift;if ($env_value){die "$env_value is not a valid implementation for $package" unless grep {$_ eq $env_value}@{$implementations};my$requested="${package}::$env_value";($requested)=$requested =~ /^(.+)$/;try {require_module($requested)}catch {require Carp;Carp::croak("Could not load $requested: $_")};return ($env_value,$requested)}else {my$err;for my$possible (@{$implementations}){my$try="${package}::$possible";my$ok;try {require_module($try);$ok=1}catch {$err .= $_ if defined $_};return ($possible,$try)if$ok}require Carp;if (defined$err && length$err){Carp::croak("Could not find a suitable $package implementation: $err")}else {Carp::croak('Module::Runtime failed to load a module but did not throw a real error. This should never happen. Something is very broken')}}}sub _copy_symbols {my$from_package=shift;my$to_package=shift;my$symbols=shift;for my$sym (@{$symbols}){my$type=$sym =~ s/^([\$\@\%\&\*])// ? $1 : '&';my$from="${from_package}::$sym";my$to="${to_package}::$sym";{no strict 'refs';no warnings 'once';*{$to}=$type eq '&' ? \&{$from}: $type eq '$' ? \${$from}: $type eq '@' ? \@{$from}: $type eq '%' ? \%{$from}: $type eq '*' ? *{$from}: die "Can't copy symbol from $from_package to $to_package: $type$sym"}}}1; +MODULE_IMPLEMENTATION + +$fatpacked{"Module/Loader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_LOADER'; + package Module::Loader;$Module::Loader::VERSION='0.03';use 5.006;use strict;use warnings;use Path::Iterator::Rule;use File::Spec::Functions qw/catfile splitdir/;use Carp qw/croak/;sub new {my ($class,%attributes)=@_;bless {%attributes},$class}sub max_depth {my$self=shift;croak 'max_depth is immutable' if @_ > 0;return$self->{max_depth}if exists($self->{max_depth});return}sub find_modules {my$self=shift;my$base=shift;my$argref=@_ > 0 ? shift : {};my$max_depth=$argref->{max_depth}|| $self->{max_depth}|| 0;my@baseparts=split(/::/,$base);my%modules;for my$directory (@INC){my$path=catfile($directory,@baseparts);next unless -d $path;my$rule=Path::Iterator::Rule->new->perl_module;$rule->max_depth($max_depth)if$max_depth;for my$file ($rule->all($path)){(my$modpath=$file)=~ s!^\Q$directory\E.|\.pm$!!g;my$module=join('::',splitdir($modpath));$modules{$module }++}}return keys(%modules)}sub search {my ($self,$base)=@_;return$self->find_modules($base,{max_depth=>1 })}sub load {my ($self,@modules)=@_;require Module::Runtime;for my$module (@modules){Module::Runtime::require_module($module)}}1; +MODULE_LOADER + +$fatpacked{"Module/Runtime.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_RUNTIME'; + package Module::Runtime;BEGIN {require 5.006}BEGIN {${^WARNING_BITS}=""}our$VERSION="0.016";our@EXPORT_OK=qw($module_name_rx is_module_name is_valid_module_name check_module_name module_notional_filename require_module use_module use_package_optimistically $top_module_spec_rx $sub_module_spec_rx is_module_spec is_valid_module_spec check_module_spec compose_module_name);my%export_ok=map {($_=>undef)}@EXPORT_OK;sub import {my$me=shift;my$callpkg=caller(0);my$errs="";for(@_){if(exists$export_ok{$_}){if(/\A\$(.*)\z/s){*{$callpkg."::".$1}=\$$1}else {*{$callpkg."::".$_}=\&$_}}else {$errs .= "\"$_\" is not exported by the $me module\n"}}if($errs ne ""){die "${errs}Can't continue after import errors "."at @{[(caller(0))[1]]} line @{[(caller(0))[2]]}.\n"}}sub _is_string($) {my($arg)=@_;return defined($arg)&& ref(\$arg)eq "SCALAR"}our$module_name_rx=qr/[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/;my$qual_module_spec_rx=qr#(?:/|::)[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#;my$unqual_top_module_spec_rx=qr#[A-Z_a-z][0-9A-Z_a-z]*(?:(?:/|::)[0-9A-Z_a-z]+)*#;our$top_module_spec_rx=qr/$qual_module_spec_rx|$unqual_top_module_spec_rx/o;my$unqual_sub_module_spec_rx=qr#[0-9A-Z_a-z]+(?:(?:/|::)[0-9A-Z_a-z]+)*#;our$sub_module_spec_rx=qr/$qual_module_spec_rx|$unqual_sub_module_spec_rx/o;sub is_module_name($) {_is_string($_[0])&& $_[0]=~ /\A$module_name_rx\z/o}*is_valid_module_name=\&is_module_name;sub check_module_name($) {unless(&is_module_name){die +(_is_string($_[0])? "`$_[0]'" : "argument")." is not a module name\n"}}sub module_notional_filename($) {&check_module_name;my($name)=@_;$name =~ s!::!/!g;return$name.".pm"}BEGIN {*_WORK_AROUND_HINT_LEAKAGE="$]" < 5.011 &&!("$]" >= 5.009004 && "$]" < 5.010001)? sub(){1}: sub(){0};*_WORK_AROUND_BROKEN_MODULE_STATE="$]" < 5.009 ? sub(){1}: sub(){0}}BEGIN {if(_WORK_AROUND_BROKEN_MODULE_STATE){eval q{ + sub Module::Runtime::__GUARD__::DESTROY { + delete $INC{$_[0]->[0]} if @{$_[0]}; + } + 1; + };die $@ if $@ ne ""}}sub require_module($) {local %^H if _WORK_AROUND_HINT_LEAKAGE;if(_WORK_AROUND_BROKEN_MODULE_STATE){my$notional_filename=&module_notional_filename;my$guard=bless([$notional_filename ],"Module::Runtime::__GUARD__");my$result=CORE::require($notional_filename);pop @$guard;return$result}else {return scalar(CORE::require(&module_notional_filename))}}sub use_module($;$) {my($name,$version)=@_;require_module($name);$name->VERSION($version)if @_ >= 2;return$name}sub use_package_optimistically($;$) {my($name,$version)=@_;my$fn=module_notional_filename($name);eval {local$SIG{__DIE__};require_module($name)};die $@ if $@ ne "" && ($@ !~ /\ACan't locate \Q$fn\E .+ at \Q@{[__FILE__]}\E line/s || $@ =~ /^Compilation\ failed\ in\ require + \ at\ \Q@{[__FILE__]}\E\ line/xm);$name->VERSION($version)if @_ >= 2;return$name}sub is_module_spec($$) {my($prefix,$spec)=@_;return _is_string($spec)&& $spec =~ ($prefix ? qr/\A$sub_module_spec_rx\z/o : qr/\A$top_module_spec_rx\z/o)}*is_valid_module_spec=\&is_module_spec;sub check_module_spec($$) {unless(&is_module_spec){die +(_is_string($_[1])? "`$_[1]'" : "argument")." is not a module specification\n"}}sub compose_module_name($$) {my($prefix,$spec)=@_;check_module_name($prefix)if defined$prefix;&check_module_spec;if($spec =~ s#\A(?:/|::)##){}else {$spec=$prefix."::".$spec if defined$prefix}$spec =~ s#/#::#g;return$spec}1; +MODULE_RUNTIME + +$fatpacked{"Number/Compare.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NUMBER_COMPARE'; + package Number::Compare;use strict;use Carp qw(croak);use vars qw/$VERSION/;$VERSION='0.03';sub new {my$referent=shift;my$class=ref$referent || $referent;my$expr=$class->parse_to_perl(shift);bless eval "sub { \$_[0] $expr }",$class}sub parse_to_perl {shift;my$test=shift;$test =~ m{^ + ([<>]=?)? # comparison + (.*?) # value + ([kmg]i?)? # magnitude + $}ix or croak "don't understand '$test' as a test";my$comparison=$1 || '==';my$target=$2;my$magnitude=$3 || '';$target *= 1000 if lc$magnitude eq 'k';$target *= 1024 if lc$magnitude eq 'ki';$target *= 1000000 if lc$magnitude eq 'm';$target *= 1024*1024 if lc$magnitude eq 'mi';$target *= 1000000000 if lc$magnitude eq 'g';$target *= 1024*1024*1024 if lc$magnitude eq 'gi';return "$comparison $target"}sub test {$_[0]->($_[1])}1; +NUMBER_COMPARE + +$fatpacked{"PIR.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PIR'; + use 5.008001;use strict;use warnings;package PIR;our$VERSION='1.014';use Path::Iterator::Rule;our@ISA=qw/Path::Iterator::Rule/;1; +PIR + +$fatpacked{"Package/Stash.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PACKAGE_STASH'; + package Package::Stash;use strict;use warnings;use 5.008001;our$VERSION='0.38';our$IMPLEMENTATION;use Module::Implementation 0.06;BEGIN {local$ENV{PACKAGE_STASH_IMPLEMENTATION}=$IMPLEMENTATION if ($IMPLEMENTATION and not $ENV{PACKAGE_STASH_IMPLEMENTATION});Module::Implementation::build_loader_sub(implementations=>['XS','PP' ],symbols=>[qw(new name namespace add_symbol remove_glob has_symbol get_symbol get_or_add_symbol remove_symbol list_all_symbols get_all_symbols)],)->();$IMPLEMENTATION=Module::Implementation::implementation_for(__PACKAGE__)}1; +PACKAGE_STASH + +$fatpacked{"Package/Stash/Conflicts.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PACKAGE_STASH_CONFLICTS'; + package Package::Stash::Conflicts;use strict;use warnings;use Dist::CheckConflicts -dist=>'Package::Stash',-conflicts=>{'Class::MOP'=>'1.08','MooseX::Method::Signatures'=>'0.36','MooseX::Role::WithOverloading'=>'0.08','namespace::clean'=>'0.18',},-also=>[qw(B Carp Dist::CheckConflicts Getopt::Long Module::Implementation Scalar::Util Symbol constant strict warnings) ],;1; +PACKAGE_STASH_CONFLICTS + +$fatpacked{"Package/Stash/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PACKAGE_STASH_PP'; + package Package::Stash::PP;use strict;use warnings;our$VERSION='0.38';use B;use Carp qw(confess);use Scalar::Util qw(blessed reftype weaken);use Symbol;use constant BROKEN_ISA_ASSIGNMENT=>($] < 5.012);use constant BROKEN_WEAK_STASH=>($] < 5.010);use constant BROKEN_SCALAR_INITIALIZATION=>($] < 5.010);use constant BROKEN_GLOB_ASSIGNMENT=>($] < 5.013004);use constant HAS_ISA_CACHE=>($] < 5.010);sub new {my$class=shift;my ($package)=@_;if (!defined($package)|| (ref($package)&& reftype($package)ne 'HASH')){confess "Package::Stash->new must be passed the name of the " ."package to access"}elsif (ref($package)&& reftype($package)eq 'HASH'){confess "The PP implementation of Package::Stash does not support " ."anonymous stashes before perl 5.14" if BROKEN_GLOB_ASSIGNMENT;return bless {'namespace'=>$package,},$class}elsif ($package =~ /\A[0-9A-Z_a-z]+(?:::[0-9A-Z_a-z]+)*\z/){return bless {'package'=>$package,},$class}else {confess "$package is not a module name"}}sub name {confess "Can't call name as a class method" unless blessed($_[0]);confess "Can't get the name of an anonymous package" unless defined($_[0]->{package});return $_[0]->{package}}sub namespace {confess "Can't call namespace as a class method" unless blessed($_[0]);if (BROKEN_WEAK_STASH){no strict 'refs';return \%{$_[0]->name .'::'}}else {return $_[0]->{namespace}if defined $_[0]->{namespace};{no strict 'refs';$_[0]->{namespace}=\%{$_[0]->name .'::'}}weaken($_[0]->{namespace});return $_[0]->{namespace}}}{my%SIGIL_MAP=('$'=>'SCALAR','@'=>'ARRAY','%'=>'HASH','&'=>'CODE',''=>'IO',);sub _deconstruct_variable_name {my ($variable)=@_;my@ret;if (ref($variable)eq 'HASH'){@ret=@{$variable}{qw[name sigil type]}}else {(defined$variable && length$variable)|| confess "You must pass a variable name";my$sigil=substr($variable,0,1,'');if (exists$SIGIL_MAP{$sigil}){@ret=($variable,$sigil,$SIGIL_MAP{$sigil})}else {@ret=("${sigil}${variable}",'',$SIGIL_MAP{''})}}($ret[0]!~ /::/)|| confess "Variable names may not contain ::";return@ret}}sub _valid_for_type {my ($value,$type)=@_;if ($type eq 'HASH' || $type eq 'ARRAY' || $type eq 'IO' || $type eq 'CODE'){return reftype($value)eq $type}else {my$ref=reftype($value);return!defined($ref)|| $ref eq 'SCALAR' || $ref eq 'REF' || $ref eq 'LVALUE' || $ref eq 'REGEXP' || $ref eq 'VSTRING'}}sub add_symbol {my ($self,$variable,$initial_value,%opts)=@_;my ($name,$sigil,$type)=_deconstruct_variable_name($variable);if (@_ > 2){_valid_for_type($initial_value,$type)|| confess "$initial_value is not of type $type";if ($^P and $^P & 0x10 && $sigil eq '&'){my$filename=$opts{filename};my$first_line_num=$opts{first_line_num};(undef,$filename,$first_line_num)=caller if not defined$filename;my$last_line_num=$opts{last_line_num}|| ($first_line_num ||= 0);$DB::sub{$self->name .'::' .$name}="$filename:$first_line_num-$last_line_num"}}if (BROKEN_GLOB_ASSIGNMENT){if (@_ > 2){no strict 'refs';no warnings 'redefine';*{$self->name .'::' .$name}=ref$initial_value ? $initial_value : \$initial_value}else {no strict 'refs';if (BROKEN_ISA_ASSIGNMENT && $name eq 'ISA'){*{$self->name .'::' .$name}}else {my$undef=_undef_ref_for_type($type);*{$self->name .'::' .$name}=$undef}}}else {my$namespace=$self->namespace;{local*__ANON__::=$namespace;no strict 'refs';no warnings 'void';no warnings 'once';*{"__ANON__::$name"}}if (@_ > 2){no warnings 'redefine';*{$namespace->{$name}}=ref$initial_value ? $initial_value : \$initial_value}else {return if BROKEN_ISA_ASSIGNMENT && $name eq 'ISA';*{$namespace->{$name}}=_undef_ref_for_type($type)}}}sub _undef_ref_for_type {my ($type)=@_;if ($type eq 'ARRAY'){return []}elsif ($type eq 'HASH'){return {}}elsif ($type eq 'SCALAR'){return \undef}elsif ($type eq 'IO'){return Symbol::geniosym}elsif ($type eq 'CODE'){confess "Don't know how to vivify CODE variables"}else {confess "Unknown type $type in vivication"}}sub remove_glob {my ($self,$name)=@_;delete$self->namespace->{$name}}sub has_symbol {my ($self,$variable)=@_;my ($name,$sigil,$type)=_deconstruct_variable_name($variable);my$namespace=$self->namespace;return unless exists$namespace->{$name};my$entry_ref=\$namespace->{$name};if (reftype($entry_ref)eq 'GLOB'){if ($type eq 'SCALAR'){if (BROKEN_SCALAR_INITIALIZATION){return defined ${*{$entry_ref}{$type}}}else {my$sv=B::svref_2object($entry_ref)->SV;return$sv->isa('B::SV')|| ($sv->isa('B::SPECIAL')&& $B::specialsv_name[$$sv]ne 'Nullsv')}}else {return defined *{$entry_ref}{$type}}}else {return$type eq 'CODE'}}sub get_symbol {my ($self,$variable,%opts)=@_;my ($name,$sigil,$type)=_deconstruct_variable_name($variable);my$namespace=$self->namespace;if (!exists$namespace->{$name}){if ($opts{vivify}){$self->add_symbol($variable)}else {return undef}}my$entry_ref=\$namespace->{$name};if (ref($entry_ref)eq 'GLOB'){return *{$entry_ref}{$type}}else {if ($type eq 'CODE'){if (BROKEN_GLOB_ASSIGNMENT || defined($self->{package})){no strict 'refs';return \&{$self->name .'::' .$name}}if (blessed($namespace)&& $namespace->isa('Package::Anon')){$namespace->bless(\(my$foo))->can($name)}else {confess "Don't know how to inflate a " .ref($entry_ref)." into a full coderef (perhaps you could use" ." Package::Anon instead of a bare stash?)"}return *{$namespace->{$name}}{CODE}}else {return undef}}}sub get_or_add_symbol {my$self=shift;$self->get_symbol(@_,vivify=>1)}sub remove_symbol {my ($self,$variable)=@_;my ($name,$sigil,$type)=_deconstruct_variable_name($variable);my%desc=(SCALAR=>{sigil=>'$',type=>'SCALAR',name=>$name },ARRAY=>{sigil=>'@',type=>'ARRAY',name=>$name },HASH=>{sigil=>'%',type=>'HASH',name=>$name },CODE=>{sigil=>'&',type=>'CODE',name=>$name },IO=>{sigil=>'',type=>'IO',name=>$name },);confess "This should never ever ever happen" if!$desc{$type};my@types_to_store=grep {$type ne $_ && $self->has_symbol($desc{$_})}keys%desc;my%values=map {$_,$self->get_symbol($desc{$_})}@types_to_store;$values{SCALAR}=$self->get_symbol($desc{SCALAR})if!defined$values{SCALAR}&& $type ne 'SCALAR' && BROKEN_SCALAR_INITIALIZATION;$self->remove_glob($name);$self->add_symbol($desc{$_}=>$values{$_})for grep {defined$values{$_}}keys%values}sub list_all_symbols {my ($self,$type_filter)=@_;my$namespace=$self->namespace;if (HAS_ISA_CACHE){return grep {$_ ne '::ISA::CACHE::'}keys %{$namespace}unless defined$type_filter}else {return keys %{$namespace}unless defined$type_filter}if ($type_filter eq 'CODE'){return grep {ref(\$namespace->{$_})ne 'GLOB' || defined(*{$namespace->{$_}}{CODE})}keys %{$namespace}}elsif ($type_filter eq 'SCALAR'){return grep {!(HAS_ISA_CACHE && $_ eq '::ISA::CACHE::')&& (BROKEN_SCALAR_INITIALIZATION ? (ref(\$namespace->{$_})eq 'GLOB' && defined(${*{$namespace->{$_}}{'SCALAR'}})): (do {my$entry=\$namespace->{$_};ref($entry)eq 'GLOB' && B::svref_2object($entry)->SV->isa('B::SV')}))}keys %{$namespace}}else {return grep {ref(\$namespace->{$_})eq 'GLOB' && defined(*{$namespace->{$_}}{$type_filter})}keys %{$namespace}}}sub get_all_symbols {my ($self,$type_filter)=@_;my$namespace=$self->namespace;return {%{$namespace}}unless defined$type_filter;return {map {$_=>$self->get_symbol({name=>$_,type=>$type_filter})}$self->list_all_symbols($type_filter)}}1; +PACKAGE_STASH_PP + +$fatpacked{"Path/Iterator/Rule.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_ITERATOR_RULE'; + use 5.008001;use strict;use warnings;package Path::Iterator::Rule;our$VERSION='1.014';use warnings::register;use if $] ge '5.010000','re','regexp_pattern';use Carp ();use File::Basename ();use File::Spec ();use List::Util ();use Number::Compare 0.02;use Scalar::Util ();use Text::Glob ();use Try::Tiny;sub new {my$class=shift;$class=ref$class if ref$class;return bless {rules=>[]},$class}sub clone {my$self=shift;return bless _my_clone({%$self}),ref$self}sub _my_clone {my$d=shift;if (ref$d eq 'HASH'){return {map {;my$v=$d->{$_};$_=>(ref($v)? _my_clone($v): $v)}keys %$d }}elsif (ref$d eq 'ARRAY'){return [map {ref($_)? _my_clone($_): $_}@$d ]}else {return$d}}sub add_helper {my ($class,$name,$coderef,$skip_negation)=@_;$class=ref$class if ref$class;if (!$class->can($name)){no strict 'refs';*$name=sub {my$self=shift;my$rule=$coderef->(@_);$self->and($rule)};if (!$skip_negation){*{"not_$name"}=sub {my$self=shift;my$rule=$coderef->(@_);$self->not($rule)}}}else {Carp::croak("Can't add rule '$name' because it conflicts with an existing method")}}sub _objectify {my ($self,$path)=@_;return "$path"}sub _defaults {return (_stringify=>1,follow_symlinks=>1,depthfirst=>0,sorted=>1,loop_safe=>($^O eq 'MSWin32' ? 0 : 1),error_handler=>sub {die sprintf("%s: %s",@_)},visitor=>undef,)}sub _fast_defaults {return (_stringify=>1,follow_symlinks=>1,depthfirst=>-1,sorted=>0,loop_safe=>0,error_handler=>undef,visitor=>undef,)}sub iter {my$self=shift;$self->_iter({$self->_defaults },@_)}sub iter_fast {my$self=shift;$self->_iter({$self->_fast_defaults },@_)}sub _iter {my$self=shift;my$defaults=shift;my$args=ref($_[0])&&!Scalar::Util::blessed($_[0])? shift : ref($_[-1])&&!Scalar::Util::blessed($_[-1])? pop : {};my%opts=(%$defaults,%$args);my$opt_stringify=$opts{_stringify};my$opt_depthfirst=$opts{depthfirst};my$opt_follow_symlinks=$opts{follow_symlinks};my$opt_sorted=$opts{sorted};my$opt_loop_safe=$opts{loop_safe};my$opt_error_handler=$opts{error_handler};my$opt_relative=$opts{relative};my$opt_visitor=$opts{visitor};my$has_rules=@{$self->{rules}};my$stash={};my$opt_report_symlinks=defined($opts{report_symlinks})? $opts{report_symlinks}: $opts{follow_symlinks};my$can_children=$self->can("_children");my@queue=map {my$i=$self->_objectify($_);($i,File::Basename::basename("$_"),0,$i)}@_ ? @_ : '.';return sub {LOOP: {my ($item,$base,$depth,$origin)=splice(@queue,0,4);return unless$item;if (ref$item eq 'CODE'){unshift@queue,$item->();redo LOOP}return$item->[0]if ref$item eq 'ARRAY';my$string_item=$opt_stringify ? "$item" : $item;my ($interest,$prune)=(1,0);if (-l $string_item){$prune=1 if!$opt_follow_symlinks;redo LOOP if!$opt_report_symlinks}if ($has_rules){local $_=$item;$stash->{_depth}=$depth;if ($opt_error_handler){$interest=try {$self->test($item,$base,$stash)}catch {$opt_error_handler->($item,$_)}}else {$interest=$self->test($item,$base,$stash)}if (ref$interest eq 'SCALAR'){$prune=1;$interest=$$interest}}if ($opt_visitor && $interest){local $_=$item;$stash->{_depth}=$depth;$opt_visitor->($item,$base,$stash)}if ((-d $string_item)&& (!$prune)&& (!$opt_loop_safe || $self->_is_unique($string_item,$stash))){if (!-r $string_item){warnings::warnif("Directory '$string_item' is not readable. Skipping it")}else {my$depth_p1=$depth + 1;my$next;if ($can_children){$next=sub {my@paths=$can_children->($self,$item);if ($opt_sorted){@paths=sort {"$a->[0]" cmp "$b->[0]"}@paths}map {($_->[1],$_->[0],$depth_p1,$origin)}@paths}}else {$next=sub {opendir(my$dh,$string_item);if ($opt_sorted){map {("$string_item/$_",$_,$depth_p1,$origin)}sort {$a cmp $b}grep {$_ ne "." && $_ ne ".."}readdir$dh}else {map {("$string_item/$_",$_,$depth_p1,$origin)}grep {$_ ne "." && $_ ne ".."}readdir$dh}}}if ($opt_depthfirst){unshift@queue,[($opt_relative ? $self->_objectify(File::Spec->abs2rel($string_item,$origin)): $item)],undef,undef,undef if$interest && $opt_depthfirst > 0;unshift@queue,$next,undef,undef,undef;redo LOOP if$opt_depthfirst > 0}else {push@queue,$next,undef,undef,undef}}}return ($opt_relative ? $self->_objectify(File::Spec->abs2rel($string_item,$origin)): $item)if$interest;redo LOOP}}}sub all {my$self=shift;return$self->_all($self->iter(@_))}sub all_fast {my$self=shift;return$self->_all($self->iter_fast(@_))}sub _all {my$self=shift;my$iter=shift;if (wantarray){my@results;while (defined(my$item=$iter->())){push@results,$item}return@results}elsif (defined wantarray){my$count=0;$count++ while defined$iter->();return$count}else {1 while defined$iter->()}}sub and {my$self=shift;push @{$self->{rules}},$self->_rulify(@_);return$self}sub or {my$self=shift;my@rules=$self->_rulify(@_);my$coderef=sub {my ($result,$prune);for my$rule (@rules){$result=$rule->(@_);$prune ||= ref($result)eq 'SCALAR';$result=$$result if ref($result)eq 'SCALAR';return ($prune ? \1 : 1)if$result}return ($prune ? \$result : $result)};return$self->and($coderef)}sub not {my$self=shift;my$obj=$self->new->and(@_);my$coderef=sub {my$result=$obj->test(@_);return ref($result)? \!$$result :!$result};return$self->and($coderef)}sub skip {my$self=shift;my@rules=@_;my$obj=$self->new->or(@rules);my$coderef=sub {my$result=$obj->test(@_);my ($prune,$interest);if (ref($result)eq 'SCALAR'){$prune=1;$interest=0}else {$prune=$result;$interest=!$result}return$prune ? \$interest : $interest};return$self->and($coderef)}sub test {my ($self,$item,$base,$stash)=@_;my ($result,$prune);for my$rule (@{$self->{rules}}){$result=$rule->($item,$base,$stash)|| 0;if (!ref($result)&& $result eq '0 but true'){Carp::croak("0 but true no longer supported by custom rules")}$prune ||= ref($result)eq 'SCALAR';$result=$$result if ref($result)eq 'SCALAR';return ($prune ? \0 : 0)if!$result}return ($prune ? \1 : 1)}sub _rulify {my ($self,@args)=@_;my@rules;for my$arg (@args){my$rule;if (Scalar::Util::blessed($arg)&& $arg->isa("Path::Iterator::Rule")){$rule=sub {$arg->test(@_)}}elsif (ref($arg)eq 'CODE'){$rule=$arg}else {Carp::croak("Rules must be coderef or Path::Iterator::Rule")}push@rules,$rule}return@rules}sub _is_unique {my ($self,$string_item,$stash)=@_;my$unique_id;my@st=eval {stat$string_item};@st=eval {lstat$string_item}unless@st;if (@st){$unique_id=join(",",$st[0],$st[1])}else {my$type=-d $string_item ? 'directory' : 'file';warnings::warnif("Could not stat $type '$string_item'");$unique_id=$string_item}return!$stash->{_seen}{$unique_id}++}sub _regexify {my ($re,$add)=@_;$add ||= '';my$new=ref($re)eq 'Regexp' ? $re : Text::Glob::glob_to_regex($re);return$new unless$add;my ($pattern,$flags)=_split_re($new);my$new_flags=$add ? _reflag($flags,$add): "";return qr/$new_flags$pattern/}sub _split_re {my$value=shift;if ($] ge 5.010){return re::regexp_pattern($value)}else {$value =~ s/^\(\?\^?//;$value =~ s/\)$//;my ($opt,$re)=split(/:/,$value,2);$opt =~ s/\-\w+$//;return ($re,$opt)}}sub _reflag {my ($orig,$add)=@_;$orig ||= "";if ($] >= 5.014){return "(?^$orig$add)"}else {my ($pos,$neg)=split /-/,$orig;$pos ||= "";$neg ||= "";$neg =~ s/i//;$neg="-$neg" if length$neg;return "(?$add$pos$neg)"}}my%simple_helpers=(directory=>sub {-d $_},dangling=>sub {-l $_ &&!stat $_},);while (my ($k,$v)=each%simple_helpers){__PACKAGE__->add_helper($k,sub {return$v})}sub _generate_name_matcher {my (@patterns)=@_;if (@patterns > 1){return sub {my$name="$_[1]";return (List::Util::first {$name =~ $_}@patterns)? 1 : 0}}else {my$pattern=$patterns[0];return sub {my$name="$_[1]";return$name =~ $pattern ? 1 : 0}}}my%complex_helpers=(name=>sub {Carp::croak("No patterns provided to 'name'")unless @_;_generate_name_matcher(map {_regexify($_)}@_)},iname=>sub {Carp::croak("No patterns provided to 'iname'")unless @_;_generate_name_matcher(map {_regexify($_,"i")}@_)},min_depth=>sub {Carp::croak("No depth argument given to 'min_depth'")unless @_;my$min_depth=0+ shift;return sub {my ($f,$b,$stash)=@_;return$stash->{_depth}>= $min_depth}},max_depth=>sub {Carp::croak("No depth argument given to 'max_depth'")unless @_;my$max_depth=0+ shift;return sub {my ($f,$b,$stash)=@_;return 1 if$stash->{_depth}< $max_depth;return \1 if$stash->{_depth}==$max_depth;return \0}},shebang=>sub {Carp::croak("No patterns provided to 'shebang'")unless @_;my@patterns=map {_regexify($_)}@_;return sub {my$f=shift;return unless!-d $f;open my$fh,"<",$f;my$shebang=<$fh>;return unless defined$shebang;return (List::Util::first {$shebang =~ $_}@patterns)? 1 : 0}},contents_match=>sub {my@regexp=@_;my$filter=':encoding(UTF-8)';$filter=shift@regexp unless ref$regexp[0];return sub {my$f=shift;return unless!-d $f;my$contents=do {local $/=undef;open my$fh,"<$filter",$f;<$fh>};for my$re (@regexp){return 1 if$contents =~ $re}return 0}},line_match=>sub {my@regexp=@_;my$filter=':encoding(UTF-8)';$filter=shift@regexp unless ref$regexp[0];return sub {my$f=shift;return unless!-d $f;open my$fh,"<$filter",$f;while (my$line=<$fh>){for my$re (@regexp){return 1 if$line =~ $re}}return 0}},);while (my ($k,$v)=each%complex_helpers){__PACKAGE__->add_helper($k,$v)}__PACKAGE__->add_helper(skip_dirs=>sub {Carp::croak("No patterns provided to 'skip_dirs'")unless @_;my$name_check=Path::Iterator::Rule->new->name(@_);return sub {return \0 if -d $_[0]&& $name_check->test(@_);return 1}}=>1);__PACKAGE__->add_helper(skip_subdirs=>sub {Carp::croak("No patterns provided to 'skip_subdirs'")unless @_;my$name_check=Path::Iterator::Rule->new->name(@_);return sub {my ($f,$b,$stash)=@_;return \0 if -d $f && $stash->{_depth}&& $name_check->test(@_);return 1}}=>1);my%X_tests=(-r=>readable=>-R=>r_readable=>-w=>writeable=>-W=>r_writeable=>-w=>writable=>-W=>r_writable=>-x=>executable=>-X=>r_executable=>-o=>owned=>-O=>r_owned=>-e=>exists=>-f=>file=>-z=>empty=>-d=>dir=>-s=>nonempty=>-l=>symlink=>=>-p=>fifo=>-u=>setuid=>-S=>socket=>-g=>setgid=>-b=>block=>-k=>sticky=>-c=>character=>=>-t=>tty=>-T=>ascii=>-B=>binary=>);while (my ($op,$name)=each%X_tests){my$coderef=eval "sub { $op \$_ }";__PACKAGE__->add_helper($name,sub {return$coderef})}my%time_tests=(-A=>accessed=>-M=>modified=>-C=>changed=>);while (my ($op,$name)=each%time_tests){my$filetest=eval "sub { $op \$_ }";my$coderef=sub {Carp::croak("The '$name' test requires a single argument")unless @_==1;my$comparator=Number::Compare->new(shift);return sub {return$comparator->($filetest->())}};__PACKAGE__->add_helper($name,$coderef)}my@stat_tests=qw(dev ino mode nlink uid gid rdev size atime mtime ctime blksize blocks);for my$i (0 .. $#stat_tests){my$name=$stat_tests[$i];my$coderef=sub {Carp::croak("The '$name' test requires a single argument")unless @_==1;my$comparator=Number::Compare->new(shift);return sub {return$comparator->((stat($_))[$i])}};__PACKAGE__->add_helper($name,$coderef)}my%vcs_rules=(skip_cvs=>sub {return Path::Iterator::Rule->new->skip_dirs('CVS')->not_name(qr/\.\#$/)},skip_rcs=>sub {return Path::Iterator::Rule->new->skip_dirs('RCS')->not_name(qr/,v$/)},skip_git=>sub {return Path::Iterator::Rule->new->skip_dirs('.git')},skip_svn=>sub {return Path::Iterator::Rule->new->skip_dirs(($^O eq 'MSWin32')? ('.svn','_svn'): ('.svn'))},skip_bzr=>sub {return Path::Iterator::Rule->new->skip_dirs('.bzr')},skip_hg=>sub {return Path::Iterator::Rule->new->skip_dirs('.hg')},skip_darcs=>sub {return Path::Iterator::Rule->new->skip_dirs('_darcs')},skip_vcs=>sub {return Path::Iterator::Rule->new->skip_dirs(qw/.git .bzr .hg _darcs CVS RCS/)->skip_svn->not_name(qr/\.\#$/,qr/,v$/)},);while (my ($name,$coderef)=each%vcs_rules){__PACKAGE__->add_helper($name,$coderef,1)}my%perl_rules=(perl_module=>sub {return Path::Iterator::Rule->new->file->name('*.pm')},perl_pod=>sub {return Path::Iterator::Rule->new->file->name('*.pod')},perl_test=>sub {return Path::Iterator::Rule->new->file->name('*.t')},perl_installer=>sub {return Path::Iterator::Rule->new->file->name('Makefile.PL','Build.PL')},perl_script=>sub {return Path::Iterator::Rule->new->file->or(Path::Iterator::Rule->new->name('*.pl'),Path::Iterator::Rule->new->shebang(qr/#!.*\bperl\b/),)},perl_file=>sub {return Path::Iterator::Rule->new->or(Path::Iterator::Rule->new->perl_module,Path::Iterator::Rule->new->perl_pod,Path::Iterator::Rule->new->perl_test,Path::Iterator::Rule->new->perl_installer,Path::Iterator::Rule->new->perl_script,)},);while (my ($name,$coderef)=each%perl_rules){__PACKAGE__->add_helper($name,$coderef)}1; +PATH_ITERATOR_RULE + +$fatpacked{"Proc/Find/Parents.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PROC_FIND_PARENTS'; + package Proc::Find::Parents;our$DATE='2018-01-17';our$VERSION='0.631';use 5.010001;use strict;use warnings;require Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(get_parent_processes);sub get_parent_processes {my ($pid,$opts)=@_;$pid //= $$;$opts //= {};my%proc;if (($opts->{method}// 'proctable')eq 'pstree'){my@lines=`pstree -pAl`;return undef unless@lines;my@p;for (@lines){my$i=0;while (/(?: (\s*(?:\|-?|`-)) | (.+?)\((\d+)\) ) + (?: -[+-]- )?/gx){unless ($1){my$p={name=>$2,pid=>$3};$p[$i]=$p;$p->{ppid}=$p[$i-1]{pid}if$i > 0;$proc{$3}=$p}$i++}}}else {eval {require Proc::ProcessTable};return undef if $@;state$pt=Proc::ProcessTable->new;for my$p (@{$pt->table}){$proc{$p->{pid}}={name=>$p->{fname},cmdline=>$p->{cmndline},pid=>$p->{pid},ppid=>$p->{ppid},uid=>$p->{uid},gid=>$p->{gid},pgrp=>$p->{pgrp},sess=>$p->{sess},sgid=>$p->{sgid},euid=>$p->{euid},egid=>$p->{egid},ttydev=>$p->{ttydev},ttynum=>$p->{ttynum},}}}my@p=();my$cur_pid=$pid;while (1){return if!$proc{$cur_pid};$proc{$cur_pid}{name}=$1 if$proc{$cur_pid}{name}=~ /\A\{(.+)\}\z/;push@p,$proc{$cur_pid};$cur_pid=$proc{$cur_pid}{ppid};last unless$cur_pid}shift@p;\@p}1; +PROC_FIND_PARENTS + +$fatpacked{"Sub/Exporter/Progressive.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SUB_EXPORTER_PROGRESSIVE'; + package Sub::Exporter::Progressive;$Sub::Exporter::Progressive::VERSION='0.001013';use strict;use warnings;sub _croak {require Carp;&Carp::croak}sub import {my ($self,@args)=@_;my$inner_target=caller;my$export_data=sub_export_options($inner_target,@args);my$full_exporter;no strict 'refs';no warnings 'once';@{"${inner_target}::EXPORT_OK"}=@{$export_data->{exports}};@{"${inner_target}::EXPORT"}=@{$export_data->{defaults}};%{"${inner_target}::EXPORT_TAGS"}=%{$export_data->{tags}};*{"${inner_target}::import"}=sub {use strict;my ($self,@args)=@_;if (grep {length ref $_ or $_ !~ / \A [:-]? \w+ \z /xm}@args){_croak 'your usage of Sub::Exporter::Progressive requires Sub::Exporter to be installed' unless eval {require Sub::Exporter};$full_exporter ||= Sub::Exporter::build_exporter($export_data->{original});goto$full_exporter}elsif (defined((my ($num)=grep {m/^\d/}@args)[0])){_croak "cannot export symbols with a leading digit: '$num'"}else {require Exporter;s/ \A - /:/xm for@args;@_=($self,@args);goto \&Exporter::import}};return}my$too_complicated=<<'DEATH';sub sub_export_options {my ($inner_target,$setup,$options)=@_;my@exports;my@defaults;my%tags;if (($setup||'')eq '-setup'){my%options=%$options;OPTIONS: for my$opt (keys%options){if ($opt eq 'exports'){_croak$too_complicated if ref$options{exports}ne 'ARRAY';@exports=@{$options{exports}};_croak$too_complicated if grep {length ref $_}@exports}elsif ($opt eq 'groups'){%tags=%{$options{groups}};for my$tagset (values%tags){_croak$too_complicated if grep {length ref $_ or $_ =~ / \A - (?! all \b ) /x}@{$tagset}}@defaults=@{$tags{default}|| []}}else {_croak$too_complicated}}@{$_}=map {/ \A [:-] all \z /x ? @exports : $_}@{$_}for \@defaults,values%tags;$tags{all}||= [@exports ];my%exports=map {$_=>1}@exports;my@errors=grep {not $exports{$_}}@defaults;_croak join(', ',@errors)." is not exported by the $inner_target module\n" if@errors}return {exports=>\@exports,defaults=>\@defaults,original=>$options,tags=>\%tags,}}1; + You are using Sub::Exporter::Progressive, but the features your program uses from + Sub::Exporter cannot be implemented without Sub::Exporter, so you might as well + just use vanilla Sub::Exporter + DEATH +SUB_EXPORTER_PROGRESSIVE + +$fatpacked{"Text/CSV.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_CSV'; + package Text::CSV;use strict;use Exporter;use Carp ();use vars qw($VERSION $DEBUG @ISA @EXPORT_OK);@ISA=qw(Exporter);@EXPORT_OK=qw(csv);BEGIN {$VERSION='2.00';$DEBUG=0}my$Module_XS='Text::CSV_XS';my$Module_PP='Text::CSV_PP';my$XS_Version='1.02';my$Is_Dynamic=0;my@PublicMethods=qw/version error_diag error_input known_attributes csv PV IV NV/;unless ($Text::CSV::Worker){$Text::CSV::DEBUG and Carp::carp("Check used worker module...");if (exists$ENV{PERL_TEXT_CSV}){if ($ENV{PERL_TEXT_CSV}eq '0' or $ENV{PERL_TEXT_CSV}eq 'Text::CSV_PP'){_load_pp()or Carp::croak $@}elsif ($ENV{PERL_TEXT_CSV}eq '1' or $ENV{PERL_TEXT_CSV}=~ /Text::CSV_XS\s*,\s*Text::CSV_PP/){_load_xs()or _load_pp()or Carp::croak $@}elsif ($ENV{PERL_TEXT_CSV}eq '2' or $ENV{PERL_TEXT_CSV}eq 'Text::CSV_XS'){_load_xs()or Carp::croak $@}else {Carp::croak "The value of environmental variable 'PERL_TEXT_CSV' is invalid."}}else {_load_xs()or _load_pp()or Carp::croak $@}}sub new {my$proto=shift;my$class=ref($proto)|| $proto;unless ($proto){return eval qq| $Text::CSV::Worker\::new( \$proto ) |}if (my$obj=$Text::CSV::Worker->new(@_)){$obj->{_MODULE}=$Text::CSV::Worker;bless$obj,$class;return$obj}else {return}}sub require_xs_version {$XS_Version}sub module {my$proto=shift;return!ref($proto)? $Text::CSV::Worker : ref($proto->{_MODULE})? ref($proto->{_MODULE}): $proto->{_MODULE}}*backend=*module;sub is_xs {return $_[0]->module eq $Module_XS}sub is_pp {return $_[0]->module eq $Module_PP}sub is_dynamic {$Is_Dynamic}sub _load_xs {_load($Module_XS,$XS_Version)}sub _load_pp {_load($Module_PP)}sub _load {my ($module,$version)=@_;$version ||= '';$Text::CSV::DEBUG and Carp::carp "Load $module.";eval qq| use $module $version |;return if $@;push@Text::CSV::ISA,$module;$Text::CSV::Worker=$module;local $^W;no strict qw(refs);for my$method (@PublicMethods){*{"Text::CSV::$method"}=\&{"$module\::$method"}}return 1}1; +TEXT_CSV + +$fatpacked{"Text/CSV_PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_CSV_PP'; + package Text::CSV_PP;require 5.006001;use strict;use Exporter ();use vars qw($VERSION @ISA @EXPORT_OK);use Carp;$VERSION='2.00';@ISA=qw(Exporter);@EXPORT_OK=qw(csv);sub PV {0}sub IV {1}sub NV {2}sub IS_QUOTED () {0x0001}sub IS_BINARY () {0x0002}sub IS_ERROR () {0x0004}sub IS_MISSING () {0x0010}sub HOOK_ERROR () {0x0001}sub HOOK_AFTER_PARSE () {0x0002}sub HOOK_BEFORE_PRINT () {0x0004}sub useIO_EOF () {0x0010}my$ERRORS={1000=>"INI - constructor failed",1001=>"INI - sep_char is equal to quote_char or escape_char",1002=>"INI - allow_whitespace with escape_char or quote_char SP or TAB",1003=>"INI - \\r or \\n in main attr not allowed",1004=>"INI - callbacks should be undef or a hashref",1005=>"INI - EOL too long",1006=>"INI - SEP too long",1007=>"INI - QUOTE too long",1008=>"INI - SEP undefined",1010=>"INI - the header is empty",1011=>"INI - the header contains more than one valid separator",1012=>"INI - the header contains an empty field",1013=>"INI - the header contains nun-unique fields",1014=>"INI - header called on undefined stream",1500=>"PRM - Invalid/unsupported arguments(s)",1501=>"PRM - The key attribute is passed as an unsupported type",1502=>"PRM - The value attribute is passed without the key attribute",1503=>"PRM - The value attribute is passed as an unsupported type",2010=>"ECR - QUO char inside quotes followed by CR not part of EOL",2011=>"ECR - Characters after end of quoted field",2012=>"EOF - End of data in parsing input stream",2013=>"ESP - Specification error for fragments RFC7111",2014=>"ENF - Inconsistent number of fields",2021=>"EIQ - NL char inside quotes, binary off",2022=>"EIQ - CR char inside quotes, binary off",2023=>"EIQ - QUO character not allowed",2024=>"EIQ - EOF cannot be escaped, not even inside quotes",2025=>"EIQ - Loose unescaped escape",2026=>"EIQ - Binary character inside quoted field, binary off",2027=>"EIQ - Quoted field not terminated",2030=>"EIF - NL char inside unquoted verbatim, binary off",2031=>"EIF - CR char is first char of field, not part of EOL",2032=>"EIF - CR char inside unquoted, not part of EOL",2034=>"EIF - Loose unescaped quote",2035=>"EIF - Escaped EOF in unquoted field",2036=>"EIF - ESC error",2037=>"EIF - Binary character in unquoted field, binary off",2110=>"ECB - Binary character in Combine, binary off",2200=>"EIO - print to IO failed. See errno",3001=>"EHR - Unsupported syntax for column_names ()",3002=>"EHR - getline_hr () called before column_names ()",3003=>"EHR - bind_columns () and column_names () fields count mismatch",3004=>"EHR - bind_columns () only accepts refs to scalars",3006=>"EHR - bind_columns () did not pass enough refs for parsed fields",3007=>"EHR - bind_columns needs refs to writable scalars",3008=>"EHR - unexpected error in bound fields",3009=>"EHR - print_hr () called before column_names ()",3010=>"EHR - print_hr () called with invalid arguments",4001=>"PRM - The key does not exist as field in the data",0=>"",};BEGIN {if ($] < 5.006){$INC{'bytes.pm'}=1 unless$INC{'bytes.pm'};no strict 'refs';*{"utf8::is_utf8"}=sub {0};*{"utf8::decode"}=sub {}}elsif ($] < 5.008){no strict 'refs';*{"utf8::is_utf8"}=sub {0};*{"utf8::decode"}=sub {};*{"utf8::encode"}=sub {}}elsif (!defined&utf8::is_utf8){require Encode;*utf8::is_utf8=*Encode::is_utf8}eval q| require Scalar::Util |;if ($@){eval q| require B |;if ($@){Carp::croak $@}else {my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP);*Scalar::Util::reftype=sub (\$) {my$r=shift;return undef unless length(ref($r));my$t=ref(B::svref_2object($r));return exists$tmap{$t}? $tmap{$t}: length(ref($$r))? 'REF' : 'SCALAR'};*Scalar::Util::readonly=sub (\$) {my$b=B::svref_2object($_[0]);$b->FLAGS & 0x00800000}}}}sub version {return$VERSION}my%def_attr=(eol=>'',sep_char=>',',quote_char=>'"',escape_char=>'"',binary=>0,decode_utf8=>1,auto_diag=>0,diag_verbose=>0,strict=>0,blank_is_undef=>0,empty_is_undef=>0,allow_whitespace=>0,allow_loose_quotes=>0,allow_loose_escapes=>0,allow_unquoted_escape=>0,always_quote=>0,quote_empty=>0,quote_space=>1,quote_binary=>1,escape_null=>1,keep_meta_info=>0,verbatim=>0,formula=>0,undef_str=>undef,types=>undef,callbacks=>undef,_EOF=>0,_RECNO=>0,_STATUS=>undef,_FIELDS=>undef,_FFLAGS=>undef,_STRING=>undef,_ERROR_INPUT=>undef,_COLUMN_NAMES=>undef,_BOUND_COLUMNS=>undef,_AHEAD=>undef,ENCODING=>undef,);my%attr_alias=(quote_always=>"always_quote",verbose_diag=>"diag_verbose",quote_null=>"escape_null",escape=>"escape_char",);my$last_new_error=Text::CSV_PP->SetDiag(0);my$last_error;sub _unhealthy_whitespace {my ($self,$aw)=@_;$aw or return 0;my$quo=$self->{quote};defined$quo && length ($quo)or $quo=$self->{quote_char};my$esc=$self->{escape_char};defined$quo && $quo =~ m/^[ \t]/ and return 1002;defined$esc && $esc =~ m/^[ \t]/ and return 1002;return 0}sub _check_sanity {my$self=shift;my$eol=$self->{eol};my$sep=$self->{sep};defined$sep && length ($sep)or $sep=$self->{sep_char};my$quo=$self->{quote};defined$quo && length ($quo)or $quo=$self->{quote_char};my$esc=$self->{escape_char};$sep ne "" or return 1008;length ($sep)> 16 and return 1006;$sep =~ m/[\r\n]/ and return 1003;if (defined$quo){$quo eq $sep and return 1001;length ($quo)> 16 and return 1007;$quo =~ m/[\r\n]/ and return 1003}if (defined$esc){$esc eq $sep and return 1001;$esc =~ m/[\r\n]/ and return 1003}if (defined$eol){length ($eol)> 16 and return 1005}return _unhealthy_whitespace ($self,$self->{allow_whitespace})}sub known_attributes {sort grep!m/^_/=>"sep","quote",keys%def_attr}sub new {$last_new_error=Text::CSV_PP->SetDiag(1000,'usage: my $csv = Text::CSV_PP->new ([{ option => value, ... }]);');my$proto=shift;my$class=ref ($proto)|| $proto or return;@_ > 0 && ref $_[0]ne "HASH" and return;my$attr=shift || {};my%attr=map {my$k=m/^[a-zA-Z]\w+$/ ? lc $_ : $_;exists$attr_alias{$k}and $k=$attr_alias{$k};$k=>$attr->{$_}}keys %$attr;my$sep_aliased=0;if (exists$attr{sep}){$attr{sep_char}=delete$attr{sep};$sep_aliased=1}my$quote_aliased=0;if (exists$attr{quote}){$attr{quote_char}=delete$attr{quote};$quote_aliased=1}exists$attr{formula_handling}and $attr{formula}=delete$attr{formula_handling};exists$attr{formula}and $attr{formula}=_supported_formula (undef,$attr{formula});for (keys%attr){if (m/^[a-z]/ && exists$def_attr{$_}){defined$attr{$_}&& m/_char$/ and utf8::decode ($attr{$_});next}$last_new_error=Text::CSV_PP->SetDiag(1000,"INI - Unknown attribute '$_'");$attr{auto_diag}and error_diag ();return}if ($sep_aliased){my@b=unpack "U0C*",$attr{sep_char};if (@b > 1){$attr{sep}=$attr{sep_char};$attr{sep_char}="\0"}else {$attr{sep}=undef}}if ($quote_aliased and defined$attr{quote_char}){my@b=unpack "U0C*",$attr{quote_char};if (@b > 1){$attr{quote}=$attr{quote_char};$attr{quote_char}="\0"}else {$attr{quote}=undef}}my$self={%def_attr,%attr };if (my$ec=_check_sanity ($self)){$last_new_error=Text::CSV_PP->SetDiag($ec);$attr{auto_diag}and error_diag ();return}if (defined$self->{callbacks}&& ref$self->{callbacks}ne "HASH"){Carp::carp "The 'callbacks' attribute is set but is not a hash: ignored\n";$self->{callbacks}=undef}$last_new_error=Text::CSV_PP->SetDiag(0);defined $\ &&!exists$attr{eol}and $self->{eol}=$\;bless$self,$class;defined$self->{types}and $self->types ($self->{types});$self}my%_cache_id=(quote_char=>0,escape_char=>1,sep_char=>2,sep=>39,binary=>3,keep_meta_info=>4,always_quote=>5,allow_loose_quotes=>6,allow_loose_escapes=>7,allow_unquoted_escape=>8,allow_whitespace=>9,blank_is_undef=>10,eol=>11,quote=>15,verbatim=>22,empty_is_undef=>23,auto_diag=>24,diag_verbose=>33,quote_space=>25,quote_empty=>37,quote_binary=>32,escape_null=>31,decode_utf8=>35,_has_ahead=>30,_has_hooks=>36,_is_bound=>26,formula=>38,strict=>42,undef_str=>46,);my%_hidden_cache_id=qw(sep_len 38 eol_len 12 eol_is_cr 13 quo_len 16 has_error_input 34);my%_reverse_cache_id=(map({$_cache_id{$_}=>$_}keys%_cache_id),map({$_hidden_cache_id{$_}=>$_}keys%_hidden_cache_id),);sub _set_attr_C {my ($self,$name,$val,$ec)=@_;defined$val or $val=0;utf8::decode ($val);$self->{$name}=$val;$ec=_check_sanity ($self)and croak ($self->SetDiag ($ec));$self->_cache_set ($_cache_id{$name},$val)}sub _set_attr_X {my ($self,$name,$val)=@_;defined$val or $val=0;$self->{$name}=$val;$self->_cache_set ($_cache_id{$name},0 + $val)}sub _set_attr_N {my ($self,$name,$val)=@_;$self->{$name}=$val;$self->_cache_set ($_cache_id{$name},0 + $val)}sub quote_char {my$self=shift;if (@_){$self->_set_attr_C ("quote_char",shift);$self->_cache_set ($_cache_id{quote},"")}$self->{quote_char}}sub quote {my$self=shift;if (@_){my$quote=shift;defined$quote or $quote="";utf8::decode ($quote);my@b=unpack "U0C*",$quote;if (@b > 1){@b > 16 and croak ($self->SetDiag (1007));$self->quote_char ("\0")}else {$self->quote_char ($quote);$quote=""}$self->{quote}=$quote;my$ec=_check_sanity ($self);$ec and croak ($self->SetDiag ($ec));$self->_cache_set ($_cache_id{quote},$quote)}my$quote=$self->{quote};defined$quote && length ($quote)? $quote : $self->{quote_char}}sub escape_char {my$self=shift;if (@_){my$ec=shift;$self->_set_attr_C ("escape_char",$ec);$ec or $self->_set_attr_X ("escape_null",0)}$self->{escape_char}}sub sep_char {my$self=shift;if (@_){$self->_set_attr_C ("sep_char",shift);$self->_cache_set ($_cache_id{sep},"")}$self->{sep_char}}sub sep {my$self=shift;if (@_){my$sep=shift;defined$sep or $sep="";utf8::decode ($sep);my@b=unpack "U0C*",$sep;if (@b > 1){@b > 16 and croak ($self->SetDiag (1006));$self->sep_char ("\0")}else {$self->sep_char ($sep);$sep=""}$self->{sep}=$sep;my$ec=_check_sanity ($self);$ec and croak ($self->SetDiag ($ec));$self->_cache_set ($_cache_id{sep},$sep)}my$sep=$self->{sep};defined$sep && length ($sep)? $sep : $self->{sep_char}}sub eol {my$self=shift;if (@_){my$eol=shift;defined$eol or $eol="";length ($eol)> 16 and croak ($self->SetDiag (1005));$self->{eol}=$eol;$self->_cache_set ($_cache_id{eol},$eol)}$self->{eol}}sub always_quote {my$self=shift;@_ and $self->_set_attr_X ("always_quote",shift);$self->{always_quote}}sub quote_space {my$self=shift;@_ and $self->_set_attr_X ("quote_space",shift);$self->{quote_space}}sub quote_empty {my$self=shift;@_ and $self->_set_attr_X ("quote_empty",shift);$self->{quote_empty}}sub escape_null {my$self=shift;@_ and $self->_set_attr_X ("escape_null",shift);$self->{escape_null}}sub quote_null {goto&escape_null}sub quote_binary {my$self=shift;@_ and $self->_set_attr_X ("quote_binary",shift);$self->{quote_binary}}sub binary {my$self=shift;@_ and $self->_set_attr_X ("binary",shift);$self->{binary}}sub strict {my$self=shift;@_ and $self->_set_attr_X ("strict",shift);$self->{strict}}sub _SetDiagInfo {my ($self,$err,$msg)=@_;$self->SetDiag ($err);my$em=$self->error_diag;$em =~ s/^\d+$// and $msg =~ s/^/# /;my$sep=$em =~ m/[;\n]$/ ? "\n\t" : ": ";join$sep=>grep m/\S\S\S/=>$em,$msg}sub _supported_formula {my ($self,$f)=@_;defined$f or return 5;$f =~ m/^(?: 0 | none )$/xi ? 0 : $f =~ m/^(?: 1 | die )$/xi ? 1 : $f =~ m/^(?: 2 | croak )$/xi ? 2 : $f =~ m/^(?: 3 | diag )$/xi ? 3 : $f =~ m/^(?: 4 | empty | )$/xi ? 4 : $f =~ m/^(?: 5 | undef )$/xi ? 5 : do {$self ||= "Text::CSV_PP";croak ($self->_SetDiagInfo (1500,"formula-handling '$f' is not supported"))}}sub formula {my$self=shift;@_ and $self->_set_attr_N ("formula",_supported_formula ($self,shift));[qw(none die croak diag empty undef)]->[_supported_formula ($self,$self->{formula})]}sub formula_handling {my$self=shift;$self->formula (@_)}sub decode_utf8 {my$self=shift;@_ and $self->_set_attr_X ("decode_utf8",shift);$self->{decode_utf8}}sub keep_meta_info {my$self=shift;if (@_){my$v=shift;!defined$v || $v eq "" and $v=0;$v =~ m/^[0-9]/ or $v=lc$v eq "false" ? 0 : 1;$self->_set_attr_X ("keep_meta_info",$v)}$self->{keep_meta_info}}sub allow_loose_quotes {my$self=shift;@_ and $self->_set_attr_X ("allow_loose_quotes",shift);$self->{allow_loose_quotes}}sub allow_loose_escapes {my$self=shift;@_ and $self->_set_attr_X ("allow_loose_escapes",shift);$self->{allow_loose_escapes}}sub allow_whitespace {my$self=shift;if (@_){my$aw=shift;_unhealthy_whitespace ($self,$aw)and croak ($self->SetDiag (1002));$self->_set_attr_X ("allow_whitespace",$aw)}$self->{allow_whitespace}}sub allow_unquoted_escape {my$self=shift;@_ and $self->_set_attr_X ("allow_unquoted_escape",shift);$self->{allow_unquoted_escape}}sub blank_is_undef {my$self=shift;@_ and $self->_set_attr_X ("blank_is_undef",shift);$self->{blank_is_undef}}sub empty_is_undef {my$self=shift;@_ and $self->_set_attr_X ("empty_is_undef",shift);$self->{empty_is_undef}}sub verbatim {my$self=shift;@_ and $self->_set_attr_X ("verbatim",shift);$self->{verbatim}}sub undef_str {my$self=shift;if (@_){my$v=shift;$self->{undef_str}=defined$v ? "$v" : undef;$self->_cache_set ($_cache_id{undef_str},$self->{undef_str})}$self->{undef_str}}sub auto_diag {my$self=shift;if (@_){my$v=shift;!defined$v || $v eq "" and $v=0;$v =~ m/^[0-9]/ or $v=lc$v eq "false" ? 0 : 1;$self->_set_attr_X ("auto_diag",$v)}$self->{auto_diag}}sub diag_verbose {my$self=shift;if (@_){my$v=shift;!defined$v || $v eq "" and $v=0;$v =~ m/^[0-9]/ or $v=lc$v eq "false" ? 0 : 1;$self->_set_attr_X ("diag_verbose",$v)}$self->{diag_verbose}}sub status {$_[0]->{_STATUS}}sub eof {$_[0]->{_EOF}}sub types {my$self=shift;if (@_){if (my$types=shift){$self->{'_types'}=join("",map{chr($_)}@$types);$self->{'types'}=$types}else {delete$self->{'types'};delete$self->{'_types'};undef}}else {$self->{'types'}}}sub callbacks {my$self=shift;if (@_){my$cb;my$hf=0x00;if (defined $_[0]){grep {!defined}@_ and croak ($self->SetDiag (1004));$cb=@_==1 && ref $_[0]eq "HASH" ? shift : @_ % 2==0 ? {@_ }: croak ($self->SetDiag (1004));for my$cbk (keys %$cb){$cbk =~ m/^[\w.]+$/ && ref$cb->{$cbk}eq "CODE" or croak ($self->SetDiag (1004))}exists$cb->{error}and $hf |= 0x01;exists$cb->{after_parse}and $hf |= 0x02;exists$cb->{before_print}and $hf |= 0x04}elsif (@_ > 1){croak ($self->SetDiag (1004))}$self->_set_attr_X ("_has_hooks",$hf);$self->{callbacks}=$cb}$self->{callbacks}}sub error_diag {my$self=shift;my@diag=(0 + $last_new_error,$last_new_error,0,0,0);if ($self && ref$self && UNIVERSAL::isa ($self,__PACKAGE__)&& exists$self->{_ERROR_DIAG}){$diag[0]=0 + $self->{_ERROR_DIAG};$diag[1]=$self->{_ERROR_DIAG};$diag[2]=1 + $self->{_ERROR_POS}if exists$self->{_ERROR_POS};$diag[3]=$self->{_RECNO};$diag[4]=$self->{_ERROR_FLD}if exists$self->{_ERROR_FLD};$diag[0]&& $self->{callbacks}&& $self->{callbacks}{error}and return$self->{callbacks}{error}->(@diag)}my$context=wantarray;unless (defined$context){if ($diag[0]&& $diag[0]!=2012){my$msg="# CSV_PP ERROR: $diag[0] - $diag[1] \@ rec $diag[3] pos $diag[2]\n";$diag[4]and $msg =~ s/$/ field $diag[4]/;unless ($self && ref$self){warn$msg;return}if ($self->{diag_verbose}and $self->{_ERROR_INPUT}){$msg .= "$self->{_ERROR_INPUT}'\n";$msg .= " " x ($diag[2]- 1);$msg .= "^\n"}my$lvl=$self->{auto_diag};if ($lvl < 2){my@c=caller (2);if (@c >= 11 && $c[10]&& ref$c[10]eq "HASH"){my$hints=$c[10];(exists$hints->{autodie}&& $hints->{autodie}or exists$hints->{"guard Fatal"}&& !exists$hints->{"no Fatal"})and $lvl++}}$lvl > 1 ? die$msg : warn$msg}return}return$context ? @diag : $diag[1]}sub record_number {return shift->{_RECNO}}*string=\&_string;sub _string {defined $_[0]->{_STRING}? ${$_[0]->{_STRING}}: undef}*fields=\&_fields;sub _fields {ref($_[0]->{_FIELDS})? @{$_[0]->{_FIELDS}}: undef}sub meta_info {$_[0]->{_FFLAGS}? @{$_[0]->{_FFLAGS}}: undef}sub is_quoted {return unless (defined $_[0]->{_FFLAGS});return if($_[1]=~ /\D/ or $_[1]< 0 or $_[1]> $#{$_[0]->{_FFLAGS}});$_[0]->{_FFLAGS}->[$_[1]]& IS_QUOTED ? 1 : 0}sub is_binary {return unless (defined $_[0]->{_FFLAGS});return if($_[1]=~ /\D/ or $_[1]< 0 or $_[1]> $#{$_[0]->{_FFLAGS}});$_[0]->{_FFLAGS}->[$_[1]]& IS_BINARY ? 1 : 0}sub is_missing {my ($self,$idx,$val)=@_;return unless$self->{keep_meta_info};$idx < 0 ||!ref$self->{_FFLAGS}and return;$idx >= @{$self->{_FFLAGS}}and return 1;$self->{_FFLAGS}[$idx]& IS_MISSING ? 1 : 0}*combine=\&_combine;sub _combine {my ($self,@fields)=@_;my$str="";$self->{_FIELDS}=\@fields;$self->{_STATUS}=(@fields > 0)&& $self->__combine(\$str,\@fields,0);$self->{_STRING}=\$str;$self->{_STATUS}}*parse=\&_parse;sub _parse {my ($self,$str)=@_;ref$str and croak ($self->SetDiag (1500));my$fields=[];my$fflags=[];$self->{_STRING}=\$str;if (defined$str && $self->__parse ($fields,$fflags,$str,0)){$self->{_FIELDS}=$fields;$self->{_FFLAGS}=$fflags;$self->{_STATUS}=1}else {$self->{_FIELDS}=undef;$self->{_FFLAGS}=undef;$self->{_STATUS}=0}$self->{_STATUS}}sub column_names {my ($self,@columns)=@_;@columns or return defined$self->{_COLUMN_NAMES}? @{$self->{_COLUMN_NAMES}}: ();@columns==1 &&!defined$columns[0]and return$self->{_COLUMN_NAMES}=undef;if (@columns==1 && ref$columns[0]eq "ARRAY"){@columns=@{$columns[0]}}elsif (join "",map {defined $_ ? ref $_ : ""}@columns){croak$self->SetDiag(3001)}if ($self->{_BOUND_COLUMNS}&& @columns!=@{$self->{_BOUND_COLUMNS}}){croak$self->SetDiag(3003)}$self->{_COLUMN_NAMES}=[map {defined $_ ? $_ : "\cAUNDEF\cA"}@columns ];@{$self->{_COLUMN_NAMES}}}sub header {my ($self,$fh,@args)=@_;$fh or croak ($self->SetDiag (1014));my (@seps,%args);for (@args){if (ref $_ eq "ARRAY"){push@seps,@$_;next}if (ref $_ eq "HASH"){%args=%$_;next}croak (q{usage: $csv->header ($fh, [ seps ], { options })})}defined$args{munge}&&!defined$args{munge_column_names}and $args{munge_column_names}=$args{munge};defined$args{detect_bom}or $args{detect_bom}=1;defined$args{set_column_names}or $args{set_column_names}=1;defined$args{munge_column_names}or $args{munge_column_names}="lc";$self->{_RECNO}=0;$self->{_AHEAD}=undef;$self->{_COLUMN_NAMES}=undef if$args{set_column_names};$self->{_BOUND_COLUMNS}=undef if$args{set_column_names};$self->_cache_set($_cache_id{'_has_ahead'},0);if (defined$args{sep_set}){ref$args{sep_set}eq "ARRAY" or croak ($self->_SetDiagInfo (1500,"sep_set should be an array ref"));@seps=@{$args{sep_set}}}$^O eq "MSWin32" and binmode$fh;my$hdr=<$fh>;defined$hdr && $hdr ne "" or croak ($self->SetDiag (1010));my%sep;@seps or @seps=(",",";");for my$sep (@seps){index ($hdr,$sep)>= 0 and $sep{$sep}++}keys%sep >= 2 and croak ($self->SetDiag (1011));$self->sep (keys%sep);my$enc="";if ($args{detect_bom}){if ($hdr =~ s/^\x00\x00\xfe\xff//){$enc="utf-32be"}elsif ($hdr =~ s/^\xff\xfe\x00\x00//){$enc="utf-32le"}elsif ($hdr =~ s/^\xfe\xff//){$enc="utf-16be"}elsif ($hdr =~ s/^\xff\xfe//){$enc="utf-16le"}elsif ($hdr =~ s/^\xef\xbb\xbf//){$enc="utf-8"}elsif ($hdr =~ s/^\xf7\x64\x4c//){$enc="utf-1"}elsif ($hdr =~ s/^\xdd\x73\x66\x73//){$enc="utf-ebcdic"}elsif ($hdr =~ s/^\x0e\xfe\xff//){$enc="scsu"}elsif ($hdr =~ s/^\xfb\xee\x28//){$enc="bocu-1"}elsif ($hdr =~ s/^\x84\x31\x95\x33//){$enc="gb-18030"}elsif ($hdr =~ s/^\x{feff}//){$enc=""}$self->{ENCODING}=uc$enc;$hdr eq "" and croak ($self->SetDiag (1010));if ($enc){if ($enc =~ m/([13]).le$/){my$l=0 + $1;my$x;$hdr .= "\0" x $l;read$fh,$x,$l}if ($enc ne "utf-8"){require Encode;$hdr=Encode::decode ($enc,$hdr)}binmode$fh,":encoding($enc)"}}my ($ahead,$eol);if ($hdr =~ s/^([^\r\n]+)([\r\n]+)([^\r\n].+)\z/$1/s){$eol=$2;$ahead=$3}$args{munge_column_names}eq "lc" and $hdr=lc$hdr;$args{munge_column_names}eq "uc" and $hdr=uc$hdr;my$hr=\$hdr;open my$h,"<",$hr or croak ($self->SetDiag (1010));my$row=$self->getline ($h)or croak;close$h;if ($ahead){$self->_cache_set ($_cache_id{_has_ahead},1);$self->{_AHEAD}=$ahead;$eol =~ m/^\r([^\n]|\z)/ and $self->eol ($eol)}my@hdr=@$row;ref$args{munge_column_names}eq "CODE" and @hdr=map {$args{munge_column_names}->($_)}@hdr;ref$args{munge_column_names}eq "HASH" and @hdr=map {$args{munge_column_names}->{$_}|| $_}@hdr;my%hdr;$hdr{$_}++ for@hdr;exists$hdr{""}and croak ($self->SetDiag (1012));unless (keys%hdr==@hdr){croak ($self->_SetDiagInfo (1013,join ", "=>map {"$_ ($hdr{$_})"}grep {$hdr{$_}> 1}keys%hdr))}$args{set_column_names}and $self->column_names (@hdr);wantarray ? @hdr : $self}sub bind_columns {my ($self,@refs)=@_;@refs or return defined$self->{_BOUND_COLUMNS}? @{$self->{_BOUND_COLUMNS}}: undef;@refs==1 &&!defined$refs[0]and return$self->{_BOUND_COLUMNS}=undef;if ($self->{_COLUMN_NAMES}&& @refs!=@{$self->{_COLUMN_NAMES}}){croak$self->SetDiag(3003)}if (grep {ref $_ ne "SCALAR"}@refs){croak$self->SetDiag(3004)}$self->_set_attr_N("_is_bound",scalar@refs);$self->{_BOUND_COLUMNS}=[@refs ];@refs}sub getline_hr {my ($self,@args,%hr)=@_;$self->{_COLUMN_NAMES}or croak ($self->SetDiag (3002));my$fr=$self->getline (@args)or return;if (ref$self->{_FFLAGS}){$self->{_FFLAGS}[$_]=IS_MISSING for (@$fr ? $#{$fr}+ 1 : 0).. $#{$self->{_COLUMN_NAMES}};@$fr==1 && (!defined$fr->[0]|| $fr->[0]eq "")and $self->{_FFLAGS}[0]||= IS_MISSING}@hr{@{$self->{_COLUMN_NAMES}}}=@$fr;\%hr}sub getline_hr_all {my ($self,$io,@args)=@_;unless ($self->{_COLUMN_NAMES}){croak$self->SetDiag(3002)}my@cn=@{$self->{_COLUMN_NAMES}};return [map {my%h;@h{@cn }=@$_;\%h}@{$self->getline_all($io,@args)}]}sub say {my ($self,$io,@f)=@_;my$eol=$self->eol;$eol eq "" and $self->eol ($\ || $/);my$state=$self->print ($io,@f==1 &&!defined$f[0]? undef : @f);$self->eol ($eol);return$state}sub print_hr {my ($self,$io,$hr)=@_;$self->{_COLUMN_NAMES}or croak($self->SetDiag(3009));ref$hr eq "HASH" or croak($self->SetDiag(3010));$self->print ($io,[map {$hr->{$_}}$self->column_names ])}sub fragment {my ($self,$io,$spec)=@_;my$qd=qr{\s* [0-9]+ \s* }x;my$qs=qr{\s* (?: [0-9]+ | \* ) \s*}x;my$qr=qr{$qd (?: - $qs )?}x;my$qc=qr{$qr (?: ; $qr )*}x;defined$spec && $spec =~ m{^ \s* + \x23 ? \s* # optional leading # + ( row | col | cell ) \s* = + ( $qc # for row and col + | $qd , $qd (?: - $qs , $qs)? # for cell (ranges) + (?: ; $qd , $qd (?: - $qs , $qs)? )* # and cell (range) lists + ) \s* $}xi or croak ($self->SetDiag (2013));my ($type,$range)=(lc $1,$2);my@h=$self->column_names ();my@c;if ($type eq "cell"){my@spec;my$min_row;my$max_row=0;for (split m/\s*;\s*/=>$range){my ($tlr,$tlc,$brr,$brc)=(m{ + ^ \s* ([0-9]+ ) \s* , \s* ([0-9]+ ) \s* + (?: - \s* ([0-9]+ | \*) \s* , \s* ([0-9]+ | \*) \s* )? + $}x)or croak ($self->SetDiag (2013));defined$brr or ($brr,$brc)=($tlr,$tlc);$tlr==0 || $tlc==0 || ($brr ne "*" && ($brr==0 || $brr < $tlr))|| ($brc ne "*" && ($brc==0 || $brc < $tlc))and croak ($self->SetDiag (2013));$tlc--;$brc-- unless$brc eq "*";defined$min_row or $min_row=$tlr;$tlr < $min_row and $min_row=$tlr;$brr eq "*" || $brr > $max_row and $max_row=$brr;push@spec,[$tlr,$tlc,$brr,$brc ]}my$r=0;while (my$row=$self->getline ($io)){++$r < $min_row and next;my%row;my$lc;for my$s (@spec){my ($tlr,$tlc,$brr,$brc)=@$s;$r < $tlr || ($brr ne "*" && $r > $brr)and next;!defined$lc || $tlc < $lc and $lc=$tlc;my$rr=$brc eq "*" ? $#$row : $brc;$row{$_}=$row->[$_]for$tlc .. $rr}push@c,[@row{sort {$a <=> $b}keys%row }];if (@h){my%h;@h{@h}=@{$c[-1]};$c[-1]=\%h}$max_row ne "*" && $r==$max_row and last}return \@c}my@r;my$eod=0;for (split m/\s*;\s*/=>$range){my ($from,$to)=m/^\s* ([0-9]+) (?: \s* - \s* ([0-9]+ | \* ))? \s* $/x or croak ($self->SetDiag (2013));$to ||= $from;$to eq "*" and ($to,$eod)=($from,1);$from <= 0 || $to < $from and croak ($self->SetDiag (2013));$r[$_]=1 for$from .. $to}my$r=0;$type eq "col" and shift@r;$_ ||= 0 for@r;while (my$row=$self->getline ($io)){$r++;if ($type eq "row"){if (($r > $#r && $eod)|| $r[$r]){push@c,$row;if (@h){my%h;@h{@h}=@{$c[-1]};$c[-1]=\%h}}next}push@c,[map {($_ > $#r && $eod)|| $r[$_]? $row->[$_]: ()}0..$#$row ];if (@h){my%h;@h{@h}=@{$c[-1]};$c[-1]=\%h}}return \@c}my$csv_usage=q{usage: my $aoa = csv (in => $file);};sub _csv_attr {my%attr=(@_==1 && ref $_[0]eq "HASH" ? %{$_[0]}: @_)or croak;$attr{binary}=1;my$enc=delete$attr{enc}|| delete$attr{encoding}|| "";$enc eq "auto" and ($attr{detect_bom},$enc)=(1,"");$enc =~ m/^[-\w.]+$/ and $enc=":encoding($enc)";my$fh;my$sink=0;my$cls=0;my$in=delete$attr{in}|| delete$attr{file}or croak$csv_usage;my$out=exists$attr{out}&&!$attr{out}? \"skip" : delete$attr{out}|| delete$attr{file};ref$in eq "CODE" || ref$in eq "ARRAY" and $out ||= \*STDOUT;$in && $out &&!ref$in &&!ref$out and croak join "\n"=>qq{Cannot use a string for both in and out. Instead use:},qq{ csv (in => csv (in => "$in"), out => "$out");\n};if ($out){if ((ref$out and "SCALAR" ne ref$out)or "GLOB" eq ref \$out){$fh=$out}elsif (ref$out and "SCALAR" eq ref$out and defined $$out and $$out eq "skip"){delete$attr{out};$sink=1}else {open$fh,">",$out or croak "$out: $!";$cls=1}if ($fh){$enc and binmode$fh,$enc;unless (defined$attr{eol}){my@layers=eval {PerlIO::get_layers ($fh)};$attr{eol}=(grep m/crlf/=>@layers)? "\n" : "\r\n"}}}if (ref$in eq "CODE" or ref$in eq "ARRAY"){}elsif (ref$in eq "SCALAR"){open$fh,"<",$in or croak "Cannot open from SCALAR using PerlIO";$cls=1}elsif (ref$in or "GLOB" eq ref \$in){if (!ref$in && $] < 5.008005){$fh=\*$in}else {$fh=$in}}else {open$fh,"<$enc",$in or croak "$in: $!";$cls=1}$fh || $sink or croak qq{No valid source passed. "in" is required};my$hdrs=delete$attr{headers};my$frag=delete$attr{fragment};my$key=delete$attr{key};my$val=delete$attr{value};my$kh=delete$attr{keep_headers}|| delete$attr{keep_column_names}|| delete$attr{kh};my$cbai=delete$attr{callbacks}{after_in}|| delete$attr{after_in}|| delete$attr{callbacks}{after_parse}|| delete$attr{after_parse};my$cbbo=delete$attr{callbacks}{before_out}|| delete$attr{before_out};my$cboi=delete$attr{callbacks}{on_in}|| delete$attr{on_in};my$hd_s=delete$attr{sep_set}|| delete$attr{seps};my$hd_b=delete$attr{detect_bom}|| delete$attr{bom};my$hd_m=delete$attr{munge}|| delete$attr{munge_column_names};my$hd_c=delete$attr{set_column_names};for ([quo=>"quote" ],[esc=>"escape" ],[escape=>"escape_char" ],){my ($f,$t)=@$_;exists$attr{$f}and!exists$attr{$t}and $attr{$t}=delete$attr{$f}}my$fltr=delete$attr{filter};my%fltr=(not_blank=>sub {@{$_[1]}> 1 or defined $_[1][0]&& $_[1][0]ne ""},not_empty=>sub {grep {defined && $_ ne ""}@{$_[1]}},filled=>sub {grep {defined && m/\S/}@{$_[1]}},);defined$fltr &&!ref$fltr && exists$fltr{$fltr}and $fltr={0=>$fltr{$fltr}};ref$fltr eq "CODE" and $fltr={0=>$fltr };ref$fltr eq "HASH" or $fltr=undef;exists$attr{formula}and $attr{formula}=_supported_formula (undef,$attr{formula});defined$attr{auto_diag}or $attr{auto_diag}=1;defined$attr{escape_null}or $attr{escape_null}=0;my$csv=delete$attr{csv}|| Text::CSV_PP->new (\%attr)or croak$last_new_error;return {csv=>$csv,attr=>{%attr },fh=>$fh,cls=>$cls,in=>$in,sink=>$sink,out=>$out,enc=>$enc,hdrs=>$hdrs,key=>$key,val=>$val,kh=>$kh,frag=>$frag,fltr=>$fltr,cbai=>$cbai,cbbo=>$cbbo,cboi=>$cboi,hd_s=>$hd_s,hd_b=>$hd_b,hd_m=>$hd_m,hd_c=>$hd_c,}}sub csv {@_ && (ref $_[0]eq __PACKAGE__ or ref $_[0]eq 'Text::CSV')and splice @_,0,0,"csv";@_ or croak$csv_usage;my$c=_csv_attr (@_);my ($csv,$in,$fh,$hdrs)=@{$c}{"csv","in","fh","hdrs"};my%hdr;if (ref$hdrs eq "HASH"){%hdr=%$hdrs;$hdrs="auto"}if ($c->{out}&&!$c->{sink}){if (ref$in eq "CODE"){my$hdr=1;while (my$row=$in->($csv)){if (ref$row eq "ARRAY"){$csv->print ($fh,$row);next}if (ref$row eq "HASH"){if ($hdr){$hdrs ||= [map {$hdr{$_}|| $_}keys %$row ];$csv->print ($fh,$hdrs);$hdr=0}$csv->print ($fh,[@{$row}{@$hdrs}])}}}elsif (ref$in->[0]eq "ARRAY"){ref$hdrs and $csv->print ($fh,$hdrs);for (@{$in}){$c->{cboi}and $c->{cboi}->($csv,$_);$c->{cbbo}and $c->{cbbo}->($csv,$_);$csv->print ($fh,$_)}}else {my@hdrs=ref$hdrs ? @{$hdrs}: keys %{$in->[0]};defined$hdrs or $hdrs="auto";ref$hdrs || $hdrs eq "auto" and $csv->print ($fh,[map {$hdr{$_}|| $_}@hdrs ]);for (@{$in}){local%_;*_=$_;$c->{cboi}and $c->{cboi}->($csv,$_);$c->{cbbo}and $c->{cbbo}->($csv,$_);$csv->print ($fh,[@{$_}{@hdrs}])}}$c->{cls}and close$fh;return 1}my@row1;if (defined$c->{hd_s}|| defined$c->{hd_b}|| defined$c->{hd_m}|| defined$c->{hd_c}){my%harg;defined$c->{hd_s}and $harg{set_set}=$c->{hd_s};defined$c->{hd_d}and $harg{detect_bom}=$c->{hd_b};defined$c->{hd_m}and $harg{munge_column_names}=$hdrs ? "none" : $c->{hd_m};defined$c->{hd_c}and $harg{set_column_names}=$hdrs ? 0 : $c->{hd_c};@row1=$csv->header ($fh,\%harg);my@hdr=$csv->column_names;@hdr and $hdrs ||= \@hdr}if ($c->{kh}){ref$c->{kh}eq "ARRAY" or croak ($csv->SetDiag (1501));$hdrs ||= "auto"}my$key=$c->{key};if ($key){!ref$key or ref$key eq "ARRAY" && @$key > 1 or croak ($csv->SetDiag (1501));$hdrs ||= "auto"}my$val=$c->{val};if ($val){$key or croak ($csv->SetDiag (1502));!ref$val or ref$val eq "ARRAY" && @$val > 0 or croak ($csv->SetDiag (1503))}$c->{fltr}&& grep m/\D/=>keys %{$c->{fltr}}and $hdrs ||= "auto";if (defined$hdrs){if (!ref$hdrs){if ($hdrs eq "skip"){$csv->getline ($fh)}elsif ($hdrs eq "auto"){my$h=$csv->getline ($fh)or return;$hdrs=[map {$hdr{$_}|| $_}@$h ]}elsif ($hdrs eq "lc"){my$h=$csv->getline ($fh)or return;$hdrs=[map {lc ($hdr{$_}|| $_)}@$h ]}elsif ($hdrs eq "uc"){my$h=$csv->getline ($fh)or return;$hdrs=[map {uc ($hdr{$_}|| $_)}@$h ]}}elsif (ref$hdrs eq "CODE"){my$h=$csv->getline ($fh)or return;my$cr=$hdrs;$hdrs=[map {$cr->($hdr{$_}|| $_)}@$h ]}$c->{kh}and $hdrs and @{$c->{kh}}=@$hdrs}if ($c->{fltr}){my%f=%{$c->{fltr}};my@hdr;if (ref$hdrs){@hdr=@{$hdrs};for (0 .. $#hdr){exists$f{$hdr[$_]}and $f{$_ + 1}=delete$f{$hdr[$_]}}}$csv->callbacks (after_parse=>sub {my ($CSV,$ROW)=@_;for my$FLD (sort keys%f){local $_=$ROW->[$FLD - 1];local%_;@hdr and @_{@hdr}=@$ROW;$f{$FLD}->($CSV,$ROW)or return \"skip";$ROW->[$FLD - 1]=$_}})}my$frag=$c->{frag};my$ref=ref$hdrs ? do {my@h=$csv->column_names ($hdrs);my%h;$h{$_}++ for@h;exists$h{""}and croak ($csv->SetDiag (1012));unless (keys%h==@h){croak ($csv->_SetDiagInfo (1013,join ", "=>map {"$_ ($h{$_})"}grep {$h{$_}> 1}keys%h))}$frag ? $csv->fragment ($fh,$frag): $key ? do {my ($k,$j,@f)=ref$key ? (undef,@$key): ($key);if (my@mk=grep {!exists$h{$_}}grep {defined}$k,@f){croak ($csv->_SetDiagInfo (4001,join ", "=>@mk))}+{map {my$r=$_;my$K=defined$k ? $r->{$k}: join$j=>@{$r}{@f};($K=>($val ? ref$val ? {map {$_=>$r->{$_}}@$val }: $r->{$val}: $r))}@{$csv->getline_hr_all ($fh)}}}: $csv->getline_hr_all ($fh)}: $frag ? $csv->fragment ($fh,$frag): $csv->getline_all ($fh);if ($ref){@row1 &&!$c->{hd_c}&&!ref$hdrs and unshift @$ref,\@row1}else {Text::CSV_PP->auto_diag}$c->{cls}and close$fh;if ($ref and $c->{cbai}|| $c->{cboi}){for my$r (ref$ref eq "ARRAY" ? @{$ref}: values %{$ref}){local%_;ref$r eq "HASH" and *_=$r;$c->{cbai}and $c->{cbai}->($csv,$r);$c->{cboi}and $c->{cboi}->($csv,$r)}}$c->{sink}and return;defined wantarray or return csv (%{$c->{attr}},in=>$ref,headers=>$hdrs,%{$c->{attr}});return$ref}sub _setup_ctx {my$self=shift;$last_error=undef;my$ctx;if ($self->{_CACHE}){%$ctx=%{$self->{_CACHE}}}else {$ctx->{sep}=',';if (defined$self->{sep_char}){$ctx->{sep}=$self->{sep_char}}if (defined$self->{sep}and $self->{sep}ne ''){use bytes;$ctx->{sep}=$self->{sep};my$sep_len=length($ctx->{sep});$ctx->{sep_len}=$sep_len if$sep_len > 1}$ctx->{quo}='"';if (exists$self->{quote_char}){my$quote_char=$self->{quote_char};if (defined$quote_char and length$quote_char){$ctx->{quo}=$quote_char}else {$ctx->{quo}="\0"}}if (defined$self->{quote}and $self->{quote}ne ''){use bytes;$ctx->{quo}=$self->{quote};my$quote_len=length($ctx->{quo});$ctx->{quo_len}=$quote_len if$quote_len > 1}$ctx->{escape_char}='"';if (exists$self->{escape_char}){my$escape_char=$self->{escape_char};if (defined$escape_char and length$escape_char){$ctx->{escape_char}=$escape_char}else {$ctx->{escape_char}="\0"}}if (defined$self->{eol}){my$eol=$self->{eol};my$eol_len=length($eol);$ctx->{eol}=$eol;$ctx->{eol_len}=$eol_len;if ($eol_len==1 and $eol eq "\015"){$ctx->{eol_is_cr}=1}}$ctx->{undef_flg}=0;if (defined$self->{undef_str}){$ctx->{undef_str}=$self->{undef_str};$ctx->{undef_flg}=3 if utf8::is_utf8($self->{undef_str})}else {$ctx->{undef_str}=undef}if (defined$self->{_types}){$ctx->{types}=$self->{_types};$ctx->{types_len}=length($ctx->{types})}if (defined$self->{_is_bound}){$ctx->{is_bound}=$self->{_is_bound}}if (defined$self->{callbacks}){my$cb=$self->{callbacks};$ctx->{has_hooks}=0;if (defined$cb->{after_parse}and ref$cb->{after_parse}eq 'CODE'){$ctx->{has_hooks}|= HOOK_AFTER_PARSE}if (defined$cb->{before_print}and ref$cb->{before_print}eq 'CODE'){$ctx->{has_hooks}|= HOOK_BEFORE_PRINT}}for (qw/binary decode_utf8 always_quote strict quote_empty allow_loose_quotes allow_loose_escapes allow_unquoted_escape allow_whitespace blank_is_undef empty_is_undef verbatim auto_diag diag_verbose keep_meta_info formula/){$ctx->{$_}=defined$self->{$_}? $self->{$_}: 0}for (qw/quote_space escape_null quote_binary/){$ctx->{$_}=defined$self->{$_}? $self->{$_}: 1}if ($ctx->{escape_char}eq "\0"){$ctx->{escape_null}=0}%{$self->{_CACHE}}=%$ctx}$ctx->{utf8}=0;$ctx->{size}=0;$ctx->{used}=0;if ($ctx->{is_bound}){my$bound=$self->{_BOUND_COLUMNS};if ($bound and ref$bound eq 'ARRAY'){$ctx->{bound}=$bound}else {$ctx->{is_bound}=0}}$ctx->{eol_pos}=-1;$ctx->{eolx}=$ctx->{eol_len}? $ctx->{verbatim}|| $ctx->{eol_len}>= 2 ? 1 : $ctx->{eol}=~ /\A[\015\012]/ ? 0 : 1 : 0;if ($ctx->{sep_len}and $ctx->{sep_len}> 1 and _is_valid_utf8($ctx->{sep})){$ctx->{utf8}=1}if ($ctx->{quo_len}and $ctx->{quo_len}> 1 and _is_valid_utf8($ctx->{quo})){$ctx->{utf8}=1}$ctx}sub _cache_set {my ($self,$idx,$value)=@_;return unless exists$self->{_CACHE};my$cache=$self->{_CACHE};my$key=$_reverse_cache_id{$idx};if (!defined$key){warn (sprintf "Unknown cache index %d ignored\n",$idx)}elsif ($key eq 'sep_char'){$cache->{sep}=$value;$cache->{sep_len}=0}elsif ($key eq 'quote_char'){$cache->{quo}=$value;$cache->{quo_len}=0}elsif ($key eq '_has_ahead'){$cache->{has_ahead}=$value}elsif ($key eq '_has_hooks'){$cache->{has_hooks}=$value}elsif ($key eq '_is_bound'){$cache->{is_bound}=$value}elsif ($key eq 'sep'){use bytes;my$len=bytes::length($value);$cache->{sep}=$value if$len;$cache->{sep_len}=$len==1 ? 0 : $len}elsif ($key eq 'quote'){use bytes;my$len=bytes::length($value);$cache->{quo}=$value if$len;$cache->{quo_len}=$len==1 ? 0 : $len}elsif ($key eq 'eol'){if (defined($value)){$cache->{eol}=$value;$cache->{eol_len}=length($value)}$cache->{eol_is_cr}=$value eq "\015" ? 1 : 0}elsif ($key eq 'undef_str'){if (defined$value){$cache->{undef_str}=$value;$cache->{undef_flg}=3 if utf8::is_utf8($value)}else {$cache->{undef_str}=undef;$cache->{undef_flg}=0}}else {$cache->{$key}=$value}return 1}sub _cache_diag {my$self=shift;unless (exists$self->{_CACHE}){warn ("CACHE: invalid\n");return}my$cache=$self->{_CACHE};warn ("CACHE:\n");$self->__cache_show_char(quote_char=>$cache->{quo});$self->__cache_show_char(escape_char=>$cache->{escape_char});$self->__cache_show_char(sep_char=>$cache->{sep});for (qw/binary decode_utf8 allow_loose_escapes allow_loose_quotes allow_unquoted_escape allow_whitespace always_quote quote_empty quote_space escape_null quote_binary auto_diag diag_verbose formula strict has_error_input blank_is_undef empty_is_undef has_ahead keep_meta_info verbatim has_hooks eol_is_cr eol_len/){$self->__cache_show_byte($_=>$cache->{$_})}$self->__cache_show_str(eol=>$cache->{eol_len},$cache->{eol});$self->__cache_show_byte(sep_len=>$cache->{sep_len});if ($cache->{sep_len}and $cache->{sep_len}> 1){$self->__cache_show_str(sep=>$cache->{sep_len},$cache->{sep})}$self->__cache_show_byte(quo_len=>$cache->{quo_len});if ($cache->{quo_len}and $cache->{quo_len}> 1){$self->__cache_show_str(quote=>$cache->{quo_len},$cache->{quo})}}sub __cache_show_byte {my ($self,$key,$value)=@_;warn (sprintf " %-21s %02x:%3d\n",$key,defined$value ? ord($value): 0,defined$value ? $value : 0)}sub __cache_show_char {my ($self,$key,$value)=@_;my$v=$value;if (defined$value){my@b=unpack "U0C*",$value;$v=pack "U*",$b[0]}warn (sprintf " %-21s %02x:%s\n",$key,defined$v ? ord($v): 0,$self->__pretty_str($v,1))}sub __cache_show_str {my ($self,$key,$len,$value)=@_;warn (sprintf " %-21s %02d:%s\n",$key,$len,$self->__pretty_str($value,$len))}sub __pretty_str {my ($self,$str,$len)=@_;return '' unless defined$str;$str=substr($str,0,$len);$str =~ s/"/\\"/g;$str =~ s/([^\x09\x20-\x7e])/sprintf '\\x{%x}', ord($1)/eg;qq{"$str"}}sub _hook {my ($self,$name,$fields)=@_;return 0 unless$self->{callbacks};my$cb=$self->{callbacks}{$name};return 0 unless$cb && ref$cb eq 'CODE';my (@res)=$cb->($self,$fields);if (@res){return 0 if ref$res[0]eq 'SCALAR' and ${$res[0]}eq "skip"}scalar@res}sub __combine {my ($self,$dst,$fields,$useIO)=@_;my$ctx=$self->_setup_ctx;my ($binary,$quot,$sep,$esc,$quote_space)=@{$ctx}{qw/binary quo sep escape_char quote_space/};if(!defined$quot or $quot eq "\0"){$quot=''}my$re_esc;if ($esc ne '' and $esc ne "\0"){if ($quot ne ''){$re_esc=$self->{_re_comb_escape}->{$quot}->{$esc}||= qr/(\Q$quot\E|\Q$esc\E)/}else {$re_esc=$self->{_re_comb_escape}->{$quot}->{$esc}||= qr/(\Q$esc\E)/}}my$bound=0;my$n=@$fields - 1;if ($n < 0 and $ctx->{is_bound}){$n=$ctx->{is_bound}- 1;$bound=1}my$check_meta=($ctx->{keep_meta_info}>= 10 and @{$self->{_FFLAGS}|| []}>= $n)? 1 : 0;my$must_be_quoted;my@results;for(my$i=0;$i <= $n;$i++){my$v_ref;if ($bound){$v_ref=$self->__bound_field($ctx,$i,1)}else {if (@$fields > $i){$v_ref=\($fields->[$i])}}next unless$v_ref;my$value=$$v_ref;if (!defined$value){if ($ctx->{undef_str}){if ($ctx->{undef_flg}){$ctx->{utf8}=1;$ctx->{binary}=1}push@results,$ctx->{undef_str}}else {push@results,''}next}if (substr($value,0,1)eq '=' && $ctx->{formula}){$value=$self->_formula($ctx,$value,$i);if (!defined$value){push@results,'';next}}$must_be_quoted=$ctx->{always_quote}? 1 : 0;if ($value eq ''){$must_be_quoted++ if$ctx->{quote_empty}or ($check_meta && $self->is_quoted($i))}else {if (utf8::is_utf8$value){$ctx->{utf8}=1;$ctx->{binary}=1}$must_be_quoted++ if$check_meta && $self->is_quoted($i);if (!$must_be_quoted and $quot ne ''){use bytes;$must_be_quoted++ if ($value =~ /\Q$quot\E/)|| ($sep ne '' and $sep ne "\0" and $value =~ /\Q$sep\E/)|| ($esc ne '' and $esc ne "\0" and $value =~ /\Q$esc\E/)|| ($ctx->{quote_binary}&& $value =~ /[\x00-\x1f\x7f-\xa0]/)|| ($ctx->{quote_space}&& $value =~ /[\x09\x20]/)}if (!$ctx->{binary}and $value =~ /[^\x09\x20-\x7E]/){$self->{_ERROR_INPUT}=$value;$self->SetDiag(2110);return 0}if ($re_esc){$value =~ s/($re_esc)/$esc$1/g}if ($ctx->{escape_null}){$value =~ s/\0/${esc}0/g}}if ($must_be_quoted){$value=$quot .$value .$quot}push@results,$value}$$dst=join($sep,@results).(defined$ctx->{eol}? $ctx->{eol}: '');return 1}sub _formula {my ($self,$ctx,$value,$i)=@_;my$fa=$ctx->{formula}or return;if ($fa==1){die "Formulas are forbidden\n"}if ($fa==2){die "Formulas are forbidden\n"}if ($fa==3){my$rec='';if ($ctx->{recno}){$rec=sprintf " in record %lu",$ctx->{recno}+ 1}my$field='';my$column_names=$self->{_COLUMN_NAMES};if (ref$column_names eq 'ARRAY' and @$column_names >= $i - 1){my$column_name=$column_names->[$i - 1];$field=sprintf " (column: '%.100s')",$column_name if defined$column_name}warn sprintf("Field %d%s%s contains formula '%s'\n",$i,$field,$rec,$value);return$value}if ($fa==4){return ''}if ($fa==5){return undef}return}sub print {my ($self,$io,$fields)=@_;require IO::Handle;if (!defined$fields){$fields=[]}elsif(ref($fields)ne 'ARRAY'){Carp::croak("Expected fields to be an array ref")}$self->_hook(before_print=>$fields);my$str="";$self->__combine(\$str,$fields,1)or return '';local $\='';$io->print($str)or $self->_set_error_diag(2200)}sub __parse {my ($self,$fields,$fflags,$src,$useIO)=@_;my$ctx=$self->_setup_ctx;my$state=$self->___parse($ctx,$fields,$fflags,$src,$useIO);if ($state and ($ctx->{has_hooks}|| 0)& HOOK_AFTER_PARSE){$self->_hook(after_parse=>$fields)}return$state ||!$last_error}sub ___parse {my ($self,$ctx,$fields,$fflags,$src,$useIO)=@_;local $/=$ctx->{eol}if$ctx->{eolx}or $ctx->{eol_is_cr};if ($ctx->{useIO}=$useIO){require IO::Handle;$ctx->{tmp}=undef;if ($ctx->{has_ahead}and defined$self->{_AHEAD}){$ctx->{tmp}=$self->{_AHEAD};$ctx->{size}=length$ctx->{tmp};$ctx->{used}=0}}else {$ctx->{tmp}=$src;$ctx->{size}=length$src;$ctx->{used}=0;$ctx->{utf8}=utf8::is_utf8($src)}if ($ctx->{has_error_input}){$self->{_ERROR_INPUT}=undef;$ctx->{has_error_input}=0}my$result=$self->____parse($ctx,$src,$fields,$fflags);$self->{_RECNO}=++($ctx->{recno});$self->{_EOF}='';if ($ctx->{strict}){$ctx->{strict_n}||= $ctx->{fld_idx};if ($ctx->{strict_n}!=$ctx->{fld_idx}){unless ($ctx->{useIO}& useIO_EOF){$self->__parse_error($ctx,2014,$ctx->{used})}$result=undef}}if ($ctx->{useIO}){if (defined$ctx->{tmp}and $ctx->{used}< $ctx->{size}and $ctx->{has_ahead}){$self->{_AHEAD}=substr($ctx->{tmp},$ctx->{used},$ctx->{size}- $ctx->{used})}else {$ctx->{has_ahead}=0;if ($ctx->{useIO}& useIO_EOF){$self->{_EOF}=1}}%{$self->{_CACHE}}=%$ctx;if ($fflags){if ($ctx->{keep_meta_info}){$self->{_FFLAGS}=$fflags}else {undef$fflags}}}else {%{$self->{_CACHE}}=%$ctx}if ($result and $ctx->{types}){my$len=@$fields;for(my$i=0;$i <= $len && $i <= $ctx->{types_len};$i++){my$value=$fields->[$i];next unless defined$value;my$type=ord(substr($ctx->{types},$i,1));if ($type==IV){$fields->[$i]=int($value)}elsif ($type==NV){$fields->[$i]=$value + 0.0}}}$result}sub ____parse {my ($self,$ctx,$src,$fields,$fflags)=@_;my ($quot,$sep,$esc,$eol)=@{$ctx}{qw/quo sep escape_char eol/};utf8::encode($sep)if!$ctx->{utf8}and $ctx->{sep_len};utf8::encode($quot)if!$ctx->{utf8}and $ctx->{quo_len};utf8::encode($eol)if!$ctx->{utf8}and $ctx->{eol_len};my$seenSomething=0;my$waitingForField=1;my ($value,$v_ref);$ctx->{fld_idx}=my$fnum=0;$ctx->{flag}=0;my$re_str=join '|',map({$_ eq "\0" ? '[\\0]' : quotemeta($_)}sort {length$b <=> length$a}grep {defined $_ and $_ ne ''}$sep,$quot,$esc,$eol),"\015","\012","\x09"," ";$ctx->{_re}=qr/$re_str/;my$re=qr/$re_str|[^\x09\x20-\x7E]|$/;LOOP: while($self->__get_from_src($ctx,$src)){while($ctx->{tmp}=~ /\G(.*?)($re)/gs){my ($hit,$c)=($1,$2);$ctx->{used}=pos($ctx->{tmp});if (!$waitingForField and $c eq '' and $hit ne '' and $ctx->{useIO}and!($ctx->{useIO}& useIO_EOF)){$self->{_AHEAD}=$hit;$ctx->{has_ahead}=1;$ctx->{has_leftover}=1;last}last if$seenSomething and $hit eq '' and $c eq '';if (!$v_ref){if ($ctx->{is_bound}){$v_ref=$self->__bound_field($ctx,$fnum,0)}else {$value='';$v_ref=\$value}$fnum++;return unless$v_ref;$ctx->{flag}=0;$ctx->{fld_idx}++}$seenSomething=1;if (defined$hit and $hit ne ''){if ($waitingForField){$waitingForField=0}if ($hit =~ /[^\x09\x20-\x7E]/){$ctx->{flag}|= IS_BINARY}$$v_ref .= $hit}RESTART: if (defined$c and defined$sep and $c eq $sep){if ($waitingForField){if ($ctx->{blank_is_undef}or $ctx->{empty_is_undef}){$$v_ref=undef}else {$$v_ref=""}unless ($ctx->{is_bound}){push @$fields,$$v_ref}$v_ref=undef;if ($ctx->{keep_meta_info}and $fflags){push @$fflags,$ctx->{flag}}}elsif ($ctx->{flag}& IS_QUOTED){$$v_ref .= $c}else {$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);$v_ref=undef;$waitingForField=1}}elsif (defined$c and defined$quot and $quot ne "\0" and $c eq $quot){if ($waitingForField){$ctx->{flag}|= IS_QUOTED;$waitingForField=0;next}if ($ctx->{flag}& IS_QUOTED){my$quoesc=0;my$c2=$self->__get($ctx);if ($ctx->{allow_whitespace}){while($self->__is_whitespace($ctx,$c2)){if ($ctx->{allow_loose_quotes}and!(defined$esc and $c2 eq $esc)){$$v_ref .= $c;$c=$c2}$c2=$self->__get($ctx)}}if (!defined$c2){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}if (defined$c2 and defined$sep and $c2 eq $sep){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);$v_ref=undef;$waitingForField=1;next}if (defined$c2 and ($c2 eq "\012" or (defined$eol and $c2 eq $eol))){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}if (defined$esc and $c eq $esc){$quoesc=1;if (defined$c2 and $c2 eq '0'){$$v_ref .= "\0";next}if (defined$c2 and defined$quot and $c2 eq $quot){if ($ctx->{utf8}){$ctx->{flag}|= IS_BINARY}$$v_ref .= $c2;next}if ($ctx->{allow_loose_escapes}and defined$c2 and $c2 ne "\015"){$$v_ref .= $c;$c=$c2;goto RESTART}}if (defined$c2 and $c2 eq "\015"){if ($ctx->{eol_is_cr}){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}my$c3=$self->__get($ctx);if (defined$c3 and $c3 eq "\012"){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}if ($ctx->{useIO}and!$ctx->{eol_len}and $c3 !~ /[^\x09\x20-\x7E]/){$self->__set_eol_is_cr($ctx);$ctx->{used}--;$ctx->{has_ahead}=1;$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}$self->__parse_error($ctx,$quoesc ? 2023 : 2010,$ctx->{used}- 2);return}if ($ctx->{allow_loose_quotes}and!$quoesc){$$v_ref .= $c;$c=$c2;goto RESTART}if ($quoesc){$ctx->{used}--;$self->__error_inside_quotes($ctx,2023);return}$self->__error_inside_quotes($ctx,2011);return}if ($ctx->{allow_loose_quotes}){$ctx->{flag}|= IS_ERROR;$$v_ref .= $c}else {$self->__error_inside_field($ctx,2034);return}}elsif (defined$c and defined$esc and $esc ne "\0" and $c eq $esc){if ($waitingForField){$waitingForField=0;if ($ctx->{allow_unquoted_escape}){my$c2=$self->__get($ctx);$$v_ref="";if (!defined$c2){$ctx->{used}--;$self->__error_inside_field($ctx,2035);return}if ($c2 eq '0'){$$v_ref .= "\0"}elsif ((defined$quot and $c2 eq $quot)or (defined$sep and $c2 eq $sep)or (defined$esc and $c2 eq $esc)or $ctx->{allow_loose_escapes}){if ($ctx->{utf8}){$ctx->{flag}|= IS_BINARY}$$v_ref .= $c2}else {$self->__parse_inside_quotes($ctx,2025);return}}}elsif ($ctx->{flag}& IS_QUOTED){my$c2=$self->__get($ctx);if (!defined$c2){$ctx->{used}--;$self->__error_inside_quotes($ctx,2024);return}if ($c2 eq '0'){$$v_ref .= "\0"}elsif ((defined$quot and $c2 eq $quot)or (defined$sep and $c2 eq $sep)or (defined$esc and $c2 eq $esc)or $ctx->{allow_loose_escapes}){if ($ctx->{utf8}){$ctx->{flag}|= IS_BINARY}$$v_ref .= $c2}else {$ctx->{used}--;$self->__error_inside_quotes($ctx,2025);return}}elsif ($v_ref){my$c2=$self->__get($ctx);if (!defined$c2){$ctx->{used}--;$self->__error_inside_field($ctx,2035);return}$$v_ref .= $c2}else {$self->__error_inside_field($ctx,2036);return}}elsif (defined$c and ($c eq "\012" or $c eq '' or (defined$eol and $c eq $eol and $eol ne "\015"))){EOLX: if ($waitingForField){if ($ctx->{blank_is_undef}or $ctx->{empty_is_undef}){$$v_ref=undef}else {$$v_ref=""}unless ($ctx->{is_bound}){push @$fields,$$v_ref}if ($ctx->{keep_meta_info}and $fflags){push @$fflags,$ctx->{flag}}return 1}if ($ctx->{flag}& IS_QUOTED){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}){$self->__error_inside_quotes($ctx,2021);return}$$v_ref .= $c}elsif ($ctx->{verbatim}){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}){$self->__error_inside_field($ctx,2030);return}$$v_ref .= $c unless$ctx->{eol}eq $c and $ctx->{useIO}}else {if (!$ctx->{recno}and $ctx->{fld_idx}==1 and $ctx->{useIO}and $hit =~ /^sep=(.{1,16})$/i){$ctx->{sep}=$1;use bytes;my$len=length$ctx->{sep};if ($len <= 16){$ctx->{sep_len}=$len==1 ? 0 : $len;return$self->____parse($ctx,$src,$fields,$fflags)}}$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}}elsif (defined$c and $c eq "\015" and!$ctx->{verbatim}){if ($waitingForField){$waitingForField=0;if ($ctx->{eol_is_cr}){$c="\012";goto RESTART}my$c2=$self->__get($ctx);if (!defined$c2){$c=undef;goto RESTART}if ($c2 eq "\012"){$c=$c2;goto RESTART}if ($ctx->{useIO}and!$ctx->{eol_len}and $c2 !~ /[^\x09\x20-\x7E]/){$self->__set_eol_is_cr($ctx);$ctx->{used}--;$ctx->{has_ahead}=1;$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}$ctx->{used}--;$self->__error_inside_field($ctx,2031);return}if ($ctx->{flag}& IS_QUOTED){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}){$self->__error_inside_quotes($ctx,2022);return}$$v_ref .= $c}else {if ($ctx->{eol_is_cr}){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}my$c2=$self->__get($ctx);if (defined$c2 and $c2 eq "\012"){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}if ($ctx->{useIO}and!$ctx->{eol_len}and $c2 !~ /[^\x09\x20-\x7E]/){$self->__set_eol_is_cr($ctx);$ctx->{used}--;$ctx->{has_ahead}=1;$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}$self->__error_inside_field($ctx,2032);return}}else {if ($ctx->{eolx}and $c eq $eol){$c='';goto EOLX}if ($waitingForField){if ($ctx->{allow_whitespace}and $self->__is_whitespace($ctx,$c)){do {$c=$self->__get($ctx);last if!defined$c}while$self->__is_whitespace($ctx,$c);goto RESTART}$waitingForField=0;goto RESTART}if ($ctx->{flag}& IS_QUOTED){if (!defined$c or $c =~ /[^\x09\x20-\x7E]/){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}or $ctx->{utf8}){$self->__error_inside_quotes($ctx,2026);return}}$$v_ref .= $c}else {if (!defined$c or $c =~ /[^\x09\x20-\x7E]/){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}or $ctx->{utf8}){$self->__error_inside_field($ctx,2037);return}}$$v_ref .= $c}}last LOOP if$ctx->{useIO}and $ctx->{verbatim}and $ctx->{used}==$ctx->{size}}}if ($waitingForField){if ($seenSomething or!$ctx->{useIO}){if (!$v_ref){if ($ctx->{is_bound}){$v_ref=$self->__bound_field($ctx,$fnum,0)}else {$value='';$v_ref=\$value}$fnum++;return unless$v_ref;$ctx->{flag}=0;$ctx->{fld_idx}++}if ($ctx->{blank_is_undef}or $ctx->{empty_is_undef}){$$v_ref=undef}else {$$v_ref=""}unless ($ctx->{is_bound}){push @$fields,$$v_ref}if ($ctx->{keep_meta_info}and $fflags){push @$fflags,$ctx->{flag}}return 1}$self->SetDiag(2012);return}if ($ctx->{flag}& IS_QUOTED){$self->__error_inside_quotes($ctx,2027);return}if ($v_ref){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum)}return 1}sub __get_from_src {my ($self,$ctx,$src)=@_;return 1 if defined$ctx->{tmp}and $ctx->{used}<= 0;return 1 if$ctx->{used}< $ctx->{size};return unless$ctx->{useIO};my$res=$src->getline;if (defined$res){if ($ctx->{has_ahead}){$ctx->{tmp}=$self->{_AHEAD};$ctx->{tmp}.= $ctx->{eol}if$ctx->{eol_len};$ctx->{tmp}.= $res;$ctx->{has_ahead}=0}else {$ctx->{tmp}=$res}if ($ctx->{size}=length$ctx->{tmp}){$ctx->{used}=-1;$ctx->{utf8}=1 if utf8::is_utf8($ctx->{tmp});pos($ctx->{tmp})=0;return 1}}elsif (delete$ctx->{has_leftover}){$ctx->{tmp}=$self->{_AHEAD};$ctx->{has_ahead}=0;$ctx->{useIO}|= useIO_EOF;if ($ctx->{size}=length$ctx->{tmp}){$ctx->{used}=-1;$ctx->{utf8}=1 if utf8::is_utf8($ctx->{tmp});pos($ctx->{tmp})=0;return 1}}$ctx->{tmp}='' unless defined$ctx->{tmp};$ctx->{useIO}|= useIO_EOF;return}sub __set_eol_is_cr {my ($self,$ctx)=@_;$ctx->{eol}="\015";$ctx->{eol_is_cr}=1;$ctx->{eol_len}=1;%{$self->{_CACHE}}=%$ctx;$self->{eol}=$ctx->{eol}}sub __bound_field {my ($self,$ctx,$i,$keep)=@_;if ($i >= $ctx->{is_bound}){$self->SetDiag(3006);return}if (ref$ctx->{bound}eq 'ARRAY'){my$ref=$ctx->{bound}[$i];if (ref$ref){if ($keep){return$ref}unless (Scalar::Util::readonly($$ref)){$$ref="";return$ref}}}$self->SetDiag(3008);return}sub __get {my ($self,$ctx)=@_;return unless defined$ctx->{used};return if$ctx->{used}>= $ctx->{size};my$pos=pos($ctx->{tmp});if ($ctx->{tmp}=~ /\G($ctx->{_re}|.)/gs){my$c=$1;if ($c =~ /[^\x09\x20-\x7e]/){$ctx->{flag}|= IS_BINARY}$ctx->{used}=pos($ctx->{tmp});return$c}else {pos($ctx->{tmp})=$pos;return}}sub __error_inside_quotes {my ($self,$ctx,$error)=@_;$self->__parse_error($ctx,$error,$ctx->{used}- 1)}sub __error_inside_field {my ($self,$ctx,$error)=@_;$self->__parse_error($ctx,$error,$ctx->{used}- 1)}sub __parse_error {my ($self,$ctx,$error,$pos)=@_;$self->{_ERROR_POS}=$pos;$self->{_ERROR_FLD}=$ctx->{fld_idx};$self->{_ERROR_INPUT}=$ctx->{tmp}if$ctx->{tmp};$self->SetDiag($error);return}sub __is_whitespace {my ($self,$ctx,$c)=@_;return unless defined$c;return ((!defined$ctx->{sep}or $c ne $ctx->{sep})&& (!defined$ctx->{quo}or $c ne $ctx->{quo})&& (!defined$ctx->{escape_char}or $c ne $ctx->{escape_char})&& ($c eq " " or $c eq "\t"))}sub __push_value {my ($self,$ctx,$v_ref,$fields,$fflags,$flag,$fnum)=@_;utf8::encode($$v_ref)if$ctx->{utf8};if ($ctx->{formula}&& $$v_ref && substr($$v_ref,0,1)eq '='){my$value=$self->_formula($ctx,$$v_ref,$fnum);push @$fields,defined$value ? $value : undef;return}if ((!defined $$v_ref or $$v_ref eq '')and ($ctx->{empty_is_undef}or (!($flag & IS_QUOTED)and $ctx->{blank_is_undef}))){$$v_ref=undef}else {if ($ctx->{allow_whitespace}&&!($flag & IS_QUOTED)){$$v_ref =~ s/[ \t]+$//}if ($flag & IS_BINARY and $ctx->{decode_utf8}and ($ctx->{utf8}|| _is_valid_utf8($$v_ref))){utf8::decode($$v_ref)}}unless ($ctx->{is_bound}){push @$fields,$$v_ref}if ($ctx->{keep_meta_info}and $fflags){push @$fflags,$flag}}sub getline {my ($self,$io)=@_;my (@fields,@fflags);my$res=$self->__parse(\@fields,\@fflags,$io,1);$res ? \@fields : undef}sub getline_all {my ($self,$io,$offset,$len)=@_;my$ctx=$self->_setup_ctx;my$tail=0;my$n=0;$offset ||= 0;if ($offset < 0){$tail=-$offset;$offset=-1}my (@row,@list);while ($self->___parse($ctx,\@row,undef,$io,1)){$ctx=$self->_setup_ctx;if ($offset > 0){$offset--;@row=();next}if ($n++ >= $tail and $tail){shift@list;$n--}if (($ctx->{has_hooks}|| 0)& HOOK_AFTER_PARSE){unless ($self->_hook(after_parse=>\@row)){@row=();next}}push@list,[@row];@row=();last if defined$len && $n >= $len and $offset >= 0}if (defined$len && $n > $len){@list=splice(@list,0,$len)}return \@list}sub _is_valid_utf8 {return ($_[0]=~ /^(?: + [\x00-\x7F] + |[\xC2-\xDF][\x80-\xBF] + |[\xE0][\xA0-\xBF][\x80-\xBF] + |[\xE1-\xEC][\x80-\xBF][\x80-\xBF] + |[\xED][\x80-\x9F][\x80-\xBF] + |[\xEE-\xEF][\x80-\xBF][\x80-\xBF] + |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] + |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] + |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] + )+$/x)? 1 : 0}sub _set_error_diag {my ($self,$error,$pos)=@_;$self->SetDiag($error);if (defined$pos){$_[0]->{_ERROR_POS}=$pos}return}sub error_input {my$self=shift;if ($self and ((Scalar::Util::reftype($self)|| '')eq 'HASH' or (ref$self)=~ /^Text::CSV/)){return$self->{_ERROR_INPUT}}return}sub _sv_diag {my ($self,$error)=@_;bless [$error,$ERRORS->{$error}],'Text::CSV::ErrorDiag'}sub _set_diag {my ($self,$ctx,$error)=@_;$last_error=$self->_sv_diag($error);$self->{_ERROR_DIAG}=$last_error;if ($error==0){$self->{_ERROR_POS}=0;$self->{_ERROR_FLD}=0;$self->{_ERROR_INPUT}=undef;$ctx->{has_error_input}=0}if ($error==2012){$self->{_EOF}=1}if ($ctx->{auto_diag}){$self->error_diag}return$last_error}sub SetDiag {my ($self,$error,$errstr)=@_;my$res;if (ref$self){my$ctx=$self->_setup_ctx;$res=$self->_set_diag($ctx,$error)}else {$res=$self->_sv_diag($error)}if (defined$errstr){$res->[1]=$errstr}$res}package Text::CSV::ErrorDiag;use strict;use overload ('""'=>\&stringify,'+'=>\&numeric,'-'=>\&numeric,'*'=>\&numeric,'/'=>\&numeric,fallback=>1,);sub numeric {my ($left,$right)=@_;return ref$left ? $left->[0]: $right->[0]}sub stringify {$_[0]->[1]}1; +TEXT_CSV_PP + +$fatpacked{"Text/Glob.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_GLOB'; + package Text::Glob;use strict;use Exporter;use vars qw/$VERSION @ISA @EXPORT_OK $strict_leading_dot $strict_wildcard_slash/;$VERSION='0.11';@ISA='Exporter';@EXPORT_OK=qw(glob_to_regex glob_to_regex_string match_glob);$strict_leading_dot=1;$strict_wildcard_slash=1;use constant debug=>0;sub glob_to_regex {my$glob=shift;my$regex=glob_to_regex_string($glob);return qr/^$regex$/}sub glob_to_regex_string {my$glob=shift;my$seperator=$Text::Glob::seperator;$seperator="/" unless defined$seperator;$seperator=quotemeta($seperator);my ($regex,$in_curlies,$escaping);local $_;my$first_byte=1;for ($glob =~ m/(.)/gs){if ($first_byte){if ($strict_leading_dot){$regex .= '(?=[^\.])' unless $_ eq '.'}$first_byte=0}if ($_ eq '/'){$first_byte=1}if ($_ eq '.' || $_ eq '(' || $_ eq ')' || $_ eq '|' || $_ eq '+' || $_ eq '^' || $_ eq '$' || $_ eq '@' || $_ eq '%'){$regex .= "\\$_"}elsif ($_ eq '*'){$regex .= $escaping ? "\\*" : $strict_wildcard_slash ? "(?:(?!$seperator).)*" : ".*"}elsif ($_ eq '?'){$regex .= $escaping ? "\\?" : $strict_wildcard_slash ? "(?!$seperator)." : "."}elsif ($_ eq '{'){$regex .= $escaping ? "\\{" : "(";++$in_curlies unless$escaping}elsif ($_ eq '}' && $in_curlies){$regex .= $escaping ? "}" : ")";--$in_curlies unless$escaping}elsif ($_ eq ',' && $in_curlies){$regex .= $escaping ? "," : "|"}elsif ($_ eq "\\"){if ($escaping){$regex .= "\\\\";$escaping=0}else {$escaping=1}next}else {$regex .= $_;$escaping=0}$escaping=0}print "# $glob $regex\n" if debug;return$regex}sub match_glob {print "# ",join(', ',map {"'$_'"}@_),"\n" if debug;my$glob=shift;my$regex=glob_to_regex$glob;local $_;grep {$_ =~ $regex}@_}1; +TEXT_GLOB + +$fatpacked{"Text/Table/Any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE_ANY'; + package Text::Table::Any;our$DATE='2019-11-29';our$VERSION='0.096';our@BACKENDS=qw(Text::Table::Tiny Text::Table::TinyColor Text::Table::TinyColorWide Text::Table::TinyWide Text::Table::Org Text::Table::CSV Text::Table::TSV Text::Table::LTSV Text::Table::ASV Text::Table::HTML Text::Table::HTML::DataTables Text::Table::Paragraph Text::ANSITable Text::ASCIITable Text::FormatTable Text::MarkdownTable Text::Table Text::TabularDisplay Text::Table::XLSX Term::TablePrint);sub _encode {my$val=shift;$val =~ s/([\\"])/\\$1/g;"\"$val\""}sub backends {@BACKENDS}sub table {my%params=@_;my$rows=$params{rows}or die "Must provide rows!";my$backend=$params{backend}|| 'Text::Table::Tiny';my$header_row=$params{header_row}// 1;if ($backend eq 'Text::Table::Tiny'){require Text::Table::Tiny;return Text::Table::Tiny::table(rows=>$rows,header_row=>$header_row)."\n"}elsif ($backend eq 'Text::Table::TinyColor'){require Text::Table::TinyColor;return Text::Table::TinyColor::table(rows=>$rows,header_row=>$header_row)."\n"}elsif ($backend eq 'Text::Table::TinyColorWide'){require Text::Table::TinyColorWide;return Text::Table::TinyColorWide::table(rows=>$rows,header_row=>$header_row)."\n"}elsif ($backend eq 'Text::Table::TinyWide'){require Text::Table::TinyWide;return Text::Table::TinyWide::table(rows=>$rows,header_row=>$header_row)."\n"}elsif ($backend eq 'Text::Table::Org'){require Text::Table::Org;return Text::Table::Org::table(rows=>$rows,header_row=>$header_row)}elsif ($backend eq 'Text::Table::CSV'){require Text::Table::CSV;return Text::Table::CSV::table(rows=>$rows,header_row=>$header_row)}elsif ($backend eq 'Text::Table::TSV'){require Text::Table::TSV;return Text::Table::TSV::table(rows=>$rows)}elsif ($backend eq 'Text::Table::LTSV'){require Text::Table::LTSV;return Text::Table::LTSV::table(rows=>$rows)}elsif ($backend eq 'Text::Table::ASV'){require Text::Table::ASV;return Text::Table::ASV::table(rows=>$rows,header_row=>$header_row)}elsif ($backend eq 'Text::Table::HTML'){require Text::Table::HTML;return Text::Table::HTML::table(rows=>$rows,header_row=>$header_row)}elsif ($backend eq 'Text::Table::HTML::DataTables'){require Text::Table::HTML::DataTables;return Text::Table::HTML::DataTables::table(rows=>$rows,header_row=>$header_row)}elsif ($backend eq 'Text::Table::Paragraph'){require Text::Table::Paragraph;return Text::Table::Paragraph::table(rows=>$rows,header_row=>$header_row)}elsif ($backend eq 'Text::ANSITable'){require Text::ANSITable;my$t=Text::ANSITable->new(use_utf8=>0,use_box_chars=>0,use_color=>0,border_style=>'Default::single_ascii',);if ($header_row){$t->columns($rows->[0]);$t->add_row($rows->[$_])for 1..@$rows-1}else {$t->columns([map {"col$_"}0..$#{$rows->[0]}]);$t->add_row($_)for @$rows}return$t->draw}elsif ($backend eq 'Text::ASCIITable'){require Text::ASCIITable;my$t=Text::ASCIITable->new();if ($header_row){$t->setCols(@{$rows->[0]});$t->addRow(@{$rows->[$_]})for 1..@$rows-1}else {$t->setCols(map {"col$_"}0..$#{$rows->[0]});$t->addRow(@$_)for @$rows}return "$t"}elsif ($backend eq 'Text::FormatTable'){require Text::FormatTable;my$t=Text::FormatTable->new(join('|',('l')x @{$rows->[0]}));$t->head(@{$rows->[0]});$t->row(@{$rows->[$_]})for 1..@$rows-1;return$t->render}elsif ($backend eq 'Text::MarkdownTable'){require Text::MarkdownTable;my$out="";my$fields=$header_row ? $rows->[0]: [map {"col$_"}0..$#{$rows->[0]}];my$t=Text::MarkdownTable->new(file=>\$out,columns=>$fields);for (($header_row ? 1:0).. $#{$rows}){my$row=$rows->[$_];$t->add({map {$fields->[$_]=>$row->[$_]}0..@$fields-1 })}$t->done;return$out}elsif ($backend eq 'Text::Table'){require Text::Table;my$t=Text::Table->new(@{$rows->[0]});$t->load(@{$rows}[1..@$rows-1]);return$t}elsif ($backend eq 'Text::TabularDisplay'){require Text::TabularDisplay;my$t=Text::TabularDisplay->new(@{$rows->[0]});$t->add(@{$rows->[$_]})for 1..@$rows-1;return$t->render ."\n"}elsif ($backend eq 'Text::Table::XLSX'){require Text::Table::XLSX;return Text::Table::XLSX::table(rows=>$rows,header_row=>$header_row)}elsif ($backend eq 'Term::TablePrint'){require Term::TablePrint;my$rows2;if ($header_row){$rows2=$rows}else {$rows2=[@$rows];shift @$rows2}return Term::TablePrint::print_table($rows)}else {die "Unknown backend '$backend'"}}1; +TEXT_TABLE_ANY + +$fatpacked{"Text/Table/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE_TINY'; + use 5.006;use strict;use warnings;package Text::Table::Tiny;$Text::Table::Tiny::VERSION='0.05';use parent 'Exporter';use List::Util qw();use Carp qw/croak/;our@EXPORT_OK=qw/generate_table/;our$COLUMN_SEPARATOR='|';our$ROW_SEPARATOR='-';our$CORNER_MARKER='+';our$HEADER_ROW_SEPARATOR='=';our$HEADER_CORNER_MARKER='O';sub generate_table {my%params=@_;my$rows=$params{rows}or croak "generate_table(): you must pass the 'rows' argument!";my$widths=_maxwidths($rows);my$max_index=_max_array_index($rows);my$format=_get_format($widths);my$row_sep=_get_row_separator($widths);my$head_row_sep=_get_header_row_separator($widths);my@table;push(@table,$row_sep)unless$params{top_and_tail};my$data_begins=0;if ($params{header_row}){my$header_row=$rows->[0];$data_begins++;push@table,sprintf($format,map {defined($header_row->[$_])? $header_row->[$_]: ''}(0..$max_index));push@table,$params{separate_rows}? $head_row_sep : $row_sep}my$row_number=0;my$last_line_number=int(@$rows);$last_line_number-- if$params{header_row};for my$row (@{$rows}[$data_begins..$#$rows]){$row_number++;push(@table,sprintf($format,map {defined($row->[$_])? $row->[$_]: ''}(0..$max_index)));push(@table,$row_sep)if$params{separate_rows}&& (!$params{top_and_tail}|| $row_number < $last_line_number)}push(@table,$row_sep)unless$params{separate_rows}|| $params{top_and_tail};return join("\n",grep {$_}@table)}sub _maxwidths {my$rows=shift;my$max_index=_max_array_index($rows);my$widths=[];for my$i (0..$max_index){my$max=List::Util::max(map {defined $$_[$i]? length($$_[$i]): 0}@$rows);push @$widths,$max}return$widths}sub _max_array_index {my$rows=shift;return List::Util::max(map {$#$_}@$rows)}sub _get_format {my$widths=shift;return "$COLUMN_SEPARATOR ".join(" $COLUMN_SEPARATOR ",map {"%-${_}s"}@$widths)." $COLUMN_SEPARATOR"}sub _get_row_separator {my$widths=shift;return "$CORNER_MARKER$ROW_SEPARATOR".join("$ROW_SEPARATOR$CORNER_MARKER$ROW_SEPARATOR",map {$ROW_SEPARATOR x $_}@$widths)."$ROW_SEPARATOR$CORNER_MARKER"}sub _get_header_row_separator {my$widths=shift;return "$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR".join("$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR",map {$HEADER_ROW_SEPARATOR x $_}@$widths)."$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER"}*table=\&generate_table;1; +TEXT_TABLE_TINY + +$fatpacked{"Try/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TRY_TINY'; + package Try::Tiny;use 5.006;our$VERSION='0.30';use strict;use warnings;use Exporter 5.57 'import';our@EXPORT=our@EXPORT_OK=qw(try catch finally);use Carp;$Carp::Internal{+__PACKAGE__}++;BEGIN {my$su=$INC{'Sub/Util.pm'}&& defined&Sub::Util::set_subname;my$sn=$INC{'Sub/Name.pm'}&& eval {Sub::Name->VERSION(0.08)};unless ($su || $sn){$su=eval {require Sub::Util}&& defined&Sub::Util::set_subname;unless ($su){$sn=eval {require Sub::Name;Sub::Name->VERSION(0.08)}}}*_subname=$su ? \&Sub::Util::set_subname : $sn ? \&Sub::Name::subname : sub {$_[1]};*_HAS_SUBNAME=($su || $sn)? sub(){1}: sub(){0}}my%_finally_guards;sub try (&;@) {my ($try,@code_refs)=@_;my$wantarray=wantarray;my ($catch,@finally)=();for my$code_ref (@code_refs){if (ref($code_ref)eq 'Try::Tiny::Catch'){croak 'A try() may not be followed by multiple catch() blocks' if$catch;$catch=${$code_ref}}elsif (ref($code_ref)eq 'Try::Tiny::Finally'){push@finally,${$code_ref}}else {croak('try() encountered an unexpected argument (' .(defined$code_ref ? $code_ref : 'undef').') - perhaps a missing semi-colon before or')}}_subname(caller().'::try {...} '=>$try)if _HAS_SUBNAME;local$_finally_guards{guards}=[map {Try::Tiny::ScopeGuard->_new($_)}@finally ];my$prev_error=$@;my (@ret,$error);my$failed=not eval {$@=$prev_error;if ($wantarray){@ret=$try->()}elsif (defined$wantarray){$ret[0]=$try->()}else {$try->()};return 1};$error=$@;$@=$prev_error;if ($failed){push @$_,$error for @{$_finally_guards{guards}};if ($catch){for ($error){return$catch->($error)}}return}else {return$wantarray ? @ret : $ret[0]}}sub catch (&;@) {my ($block,@rest)=@_;croak 'Useless bare catch()' unless wantarray;_subname(caller().'::catch {...} '=>$block)if _HAS_SUBNAME;return (bless(\$block,'Try::Tiny::Catch'),@rest,)}sub finally (&;@) {my ($block,@rest)=@_;croak 'Useless bare finally()' unless wantarray;_subname(caller().'::finally {...} '=>$block)if _HAS_SUBNAME;return (bless(\$block,'Try::Tiny::Finally'),@rest,)}{package Try::Tiny::ScopeGuard;use constant UNSTABLE_DOLLARAT=>("$]" < '5.013002')? 1 : 0;sub _new {shift;bless [@_ ]}sub DESTROY {my ($code,@args)=@{$_[0]};local $@ if UNSTABLE_DOLLARAT;eval {$code->(@args);1}or do {warn "Execution of finally() block $code resulted in an exception, which " .'*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. ' .'Your program will continue as if this event never took place. ' ."Original exception text follows:\n\n" .(defined $@ ? $@ : '$@ left undefined...')."\n" }}}__PACKAGE__ +TRY_TINY + +$fatpacked{"YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML'; + package YAML;our$VERSION='1.30';use YAML::Mo;use Exporter;push@YAML::ISA,'Exporter';our@EXPORT=qw{Dump Load};our@EXPORT_OK=qw{freeze thaw DumpFile LoadFile Bless Blessed};our ($UseCode,$DumpCode,$LoadCode,$SpecVersion,$UseHeader,$UseVersion,$UseBlock,$UseFold,$UseAliases,$Indent,$SortKeys,$Preserve,$AnchorPrefix,$CompressSeries,$InlineSeries,$Purity,$Stringify,$Numify,$LoadBlessed,$QuoteNumericStrings,$DumperClass,$LoaderClass);use YAML::Node;use Scalar::Util qw/openhandle/;use constant VALUE=>"\x07YAML\x07VALUE\x07";has dumper_class=>default=>sub {'YAML::Dumper'};has loader_class=>default=>sub {'YAML::Loader'};has dumper_object=>default=>sub {$_[0]->init_action_object("dumper")};has loader_object=>default=>sub {$_[0]->init_action_object("loader")};sub Dump {my$yaml=YAML->new;$yaml->dumper_class($YAML::DumperClass)if$YAML::DumperClass;return$yaml->dumper_object->dump(@_)}sub Load {my$yaml=YAML->new;$yaml->loader_class($YAML::LoaderClass)if$YAML::LoaderClass;return$yaml->loader_object->load(@_)}{no warnings 'once';*freeze=\ &Dump;*thaw=\ &Load}sub DumpFile {my$OUT;my$filename=shift;if (openhandle$filename){$OUT=$filename}else {my$mode='>';if ($filename =~ /^\s*(>{1,2})\s*(.*)$/){($mode,$filename)=($1,$2)}open$OUT,$mode,$filename or YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT',$filename,"$!")}binmode$OUT,':utf8';local $/="\n";print$OUT Dump(@_);unless (ref$filename eq 'GLOB'){close$OUT or do {my$errsav=$!;YAML::Mo::Object->die('YAML_DUMP_ERR_FILE_OUTPUT_CLOSE',$filename,$errsav)}}}sub LoadFile {my$IN;my$filename=shift;if (openhandle$filename){$IN=$filename}else {open$IN,'<',$filename or YAML::Mo::Object->die('YAML_LOAD_ERR_FILE_INPUT',$filename,"$!")}binmode$IN,':utf8';return Load(do {local $/;<$IN>})}sub init_action_object {my$self=shift;my$object_class=(shift).'_class';my$module_name=$self->$object_class;eval "require $module_name";$self->die("Error in require $module_name - $@")if $@ and "$@" !~ /Can't locate/;my$object=$self->$object_class->new;$object->set_global_options;return$object}my$global={};sub Bless {require YAML::Dumper::Base;YAML::Dumper::Base::bless($global,@_)}sub Blessed {require YAML::Dumper::Base;YAML::Dumper::Base::blessed($global,@_)}sub global_object {$global}1; +YAML + +$fatpacked{"YAML/Any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_ANY'; + use strict;use warnings;package YAML::Any;our$VERSION='1.30';use Exporter ();@YAML::Any::ISA='Exporter';@YAML::Any::EXPORT=qw(Dump Load);@YAML::Any::EXPORT_OK=qw(DumpFile LoadFile);my@dump_options=qw(UseCode DumpCode SpecVersion Indent UseHeader UseVersion SortKeys AnchorPrefix UseBlock UseFold CompressSeries InlineSeries UseAliases Purity Stringify);my@load_options=qw(UseCode LoadCode Preserve);my@implementations=qw(YAML::XS YAML::Syck YAML::Old YAML YAML::Tiny);sub import {__PACKAGE__->implementation;goto&Exporter::import}sub Dump {no strict 'refs';no warnings 'once';my$implementation=__PACKAGE__->implementation;for my$option (@dump_options){my$var="$implementation\::$option";my$value=$$var;local $$var;$$var=defined$value ? $value : ${"YAML::$option"}}return &{"$implementation\::Dump"}(@_)}sub DumpFile {no strict 'refs';no warnings 'once';my$implementation=__PACKAGE__->implementation;for my$option (@dump_options){my$var="$implementation\::$option";my$value=$$var;local $$var;$$var=defined$value ? $value : ${"YAML::$option"}}return &{"$implementation\::DumpFile"}(@_)}sub Load {no strict 'refs';no warnings 'once';my$implementation=__PACKAGE__->implementation;for my$option (@load_options){my$var="$implementation\::$option";my$value=$$var;local $$var;$$var=defined$value ? $value : ${"YAML::$option"}}return &{"$implementation\::Load"}(@_)}sub LoadFile {no strict 'refs';no warnings 'once';my$implementation=__PACKAGE__->implementation;for my$option (@load_options){my$var="$implementation\::$option";my$value=$$var;local $$var;$$var=defined$value ? $value : ${"YAML::$option"}}return &{"$implementation\::LoadFile"}(@_)}sub order {return@YAML::Any::_TEST_ORDER if@YAML::Any::_TEST_ORDER;return@implementations}sub implementation {my@order=__PACKAGE__->order;for my$module (@order){my$path=$module;$path =~ s/::/\//g;$path .= '.pm';return$module if exists$INC{$path};eval "require $module; 1" and return$module}croak("YAML::Any couldn't find any of these YAML implementations: @order")}sub croak {require Carp;Carp::croak(@_)}1; +YAML_ANY + +$fatpacked{"YAML/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_DUMPER'; + package YAML::Dumper;use YAML::Mo;extends 'YAML::Dumper::Base';use YAML::Dumper::Base;use YAML::Node;use YAML::Types;use Scalar::Util qw();use B ();use Carp ();use constant KEY=>3;use constant BLESSED=>4;use constant FROMARRAY=>5;use constant VALUE=>"\x07YAML\x07VALUE\x07";my$ESCAPE_CHAR='[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';my$LIT_CHAR='|';sub dump {my$self=shift;$self->stream('');$self->document(0);for my$document (@_){$self->{document}++;$self->transferred({});$self->id_refcnt({});$self->id_anchor({});$self->anchor(1);$self->level(0);$self->offset->[0]=0 - $self->indent_width;$self->_prewalk($document);$self->_emit_header($document);$self->_emit_node($document)}return$self->stream}sub _emit_header {my$self=shift;my ($node)=@_;if (not $self->use_header and $self->document==1){$self->die('YAML_DUMP_ERR_NO_HEADER')unless ref($node)=~ /^(HASH|ARRAY)$/;$self->die('YAML_DUMP_ERR_NO_HEADER')if ref($node)eq 'HASH' and keys(%$node)==0;$self->die('YAML_DUMP_ERR_NO_HEADER')if ref($node)eq 'ARRAY' and @$node==0;$self->headless(1);return}$self->{stream}.= '---';if ($self->use_version){}}sub _prewalk {my$self=shift;my$stringify=$self->stringify;my ($class,$type,$node_id)=$self->node_info(\$_[0],$stringify);if ($type eq 'GLOB'){$self->transferred->{$node_id}=YAML::Type::glob->yaml_dump($_[0]);$self->_prewalk($self->transferred->{$node_id});return}if (ref($_[0])eq 'Regexp'){return}if (not ref $_[0]){$self->{id_refcnt}{$node_id}++ if$self->purity;return}my$value=$_[0];($class,$type,$node_id)=$self->node_info($value,$stringify);return if (ref($value)and not $type);if ($self->transferred->{$node_id}){(undef,undef,$node_id)=(ref$self->transferred->{$node_id})? $self->node_info($self->transferred->{$node_id},$stringify): $self->node_info(\ $self->transferred->{$node_id},$stringify);$self->{id_refcnt}{$node_id}++;return}if ($type eq 'CODE'){$self->transferred->{$node_id}='placeholder';YAML::Type::code->yaml_dump($self->dump_code,$_[0],$self->transferred->{$node_id});($class,$type,$node_id)=$self->node_info(\ $self->transferred->{$node_id},$stringify);$self->{id_refcnt}{$node_id}++;return}if (defined$class){if ($value->can('yaml_dump')){$value=$value->yaml_dump}elsif ($type eq 'SCALAR'){$self->transferred->{$node_id}='placeholder';YAML::Type::blessed->yaml_dump ($_[0],$self->transferred->{$node_id});($class,$type,$node_id)=$self->node_info(\ $self->transferred->{$node_id},$stringify);$self->{id_refcnt}{$node_id}++;return}else {$value=YAML::Type::blessed->yaml_dump($value)}$self->transferred->{$node_id}=$value;(undef,$type,$node_id)=$self->node_info($value,$stringify)}require YAML;if (defined YAML->global_object()->{blessed_map}{$node_id}){$value=YAML->global_object()->{blessed_map}{$node_id};$self->transferred->{$node_id}=$value;($class,$type,$node_id)=$self->node_info($value,$stringify);$self->_prewalk($value);return}if ($type eq 'REF' or $type eq 'SCALAR'){$value=YAML::Type::ref->yaml_dump($value);$self->transferred->{$node_id}=$value;(undef,$type,$node_id)=$self->node_info($value,$stringify)}elsif ($type eq 'GLOB'){my$ref_ynode=$self->transferred->{$node_id}=YAML::Type::ref->yaml_dump($value);my$glob_ynode=$ref_ynode->{&VALUE}=YAML::Type::glob->yaml_dump($$value);(undef,undef,$node_id)=$self->node_info($glob_ynode,$stringify);$self->transferred->{$node_id}=$glob_ynode;$self->_prewalk($glob_ynode);return}return if ++($self->{id_refcnt}{$node_id})> 1;if ($type eq 'HASH'){$self->_prewalk($value->{$_})for keys %{$value};return}elsif ($type eq 'ARRAY'){$self->_prewalk($_)for @{$value};return}$self->warn(<<"...");return}sub _emit_node {my$self=shift;my ($type,$node_id);my$ref=ref($_[0]);if ($ref){if ($ref eq 'Regexp'){$self->_emit(' !!perl/regexp');$self->_emit_str("$_[0]");return}(undef,$type,$node_id)=$self->node_info($_[0],$self->stringify)}else {$type=$ref || 'SCALAR';(undef,undef,$node_id)=$self->node_info(\$_[0],$self->stringify)}my ($ynode,$tag)=('')x 2;my ($value,$context)=(@_,0);if (defined$self->transferred->{$node_id}){$value=$self->transferred->{$node_id};$ynode=ynode($value);if (ref$value){$tag=defined$ynode ? $ynode->tag->short : '';(undef,$type,$node_id)=$self->node_info($value,$self->stringify)}else {$ynode=ynode($self->transferred->{$node_id});$tag=defined$ynode ? $ynode->tag->short : '';$type='SCALAR';(undef,undef,$node_id)=$self->node_info(\ $self->transferred->{$node_id},$self->stringify)}}elsif ($ynode=ynode($value)){$tag=$ynode->tag->short}if ($self->use_aliases){$self->{id_refcnt}{$node_id}||= 0;if ($self->{id_refcnt}{$node_id}> 1){if (defined$self->{id_anchor}{$node_id}){$self->{stream}.= ' *' .$self->{id_anchor}{$node_id}."\n";return}my$anchor=$self->anchor_prefix .$self->{anchor}++;$self->{stream}.= ' &' .$anchor;$self->{id_anchor}{$node_id}=$anchor}}return$self->_emit_str("$value")if ref($value)and not $type;return$self->_emit_scalar($value,$tag)if$type eq 'SCALAR' and $tag;return$self->_emit_str($value)if$type eq 'SCALAR';return$self->_emit_mapping($value,$tag,$node_id,$context)if$type eq 'HASH';return$self->_emit_sequence($value,$tag)if$type eq 'ARRAY';$self->warn('YAML_DUMP_WARN_BAD_NODE_TYPE',$type);return$self->_emit_str("$value")}sub _emit_mapping {my$self=shift;my ($value,$tag,$node_id,$context)=@_;$self->{stream}.= " !$tag" if$tag;my$empty_hash=not(eval {keys %$value});$self->warn('YAML_EMIT_WARN_KEYS',$@)if $@;return ($self->{stream}.= " {}\n")if$empty_hash;if ($context==FROMARRAY and $self->compress_series and not (defined$self->{id_anchor}{$node_id}or $tag or $empty_hash)){$self->{stream}.= ' ';$self->offset->[$self->level+1]=$self->offset->[$self->level]+ 2}else {$context=0;$self->{stream}.= "\n" unless$self->headless && not($self->headless(0));$self->offset->[$self->level+1]=$self->offset->[$self->level]+ $self->indent_width}$self->{level}++;my@keys;if ($self->sort_keys==1){if (ynode($value)){@keys=keys %$value}else {@keys=sort keys %$value}}elsif ($self->sort_keys==2){@keys=sort keys %$value}elsif (ref($self->sort_keys)eq 'ARRAY'){my$i=1;my%order=map {($_,$i++)}@{$self->sort_keys};@keys=sort {(defined$order{$a}and defined$order{$b})? ($order{$a}<=> $order{$b}): ($a cmp $b)}keys %$value}else {@keys=keys %$value}if (exists$value->{&VALUE}){for (my$i=0;$i < @keys;$i++){if ($keys[$i]eq &VALUE){splice(@keys,$i,1);push@keys,&VALUE;last}}}for my$key (@keys){$self->_emit_key($key,$context);$context=0;$self->{stream}.= ':';$self->_emit_node($value->{$key})}$self->{level}--}sub _emit_sequence {my$self=shift;my ($value,$tag)=@_;$self->{stream}.= " !$tag" if$tag;return ($self->{stream}.= " []\n")if @$value==0;$self->{stream}.= "\n" unless$self->headless && not($self->headless(0));if ($self->inline_series and @$value <= $self->inline_series and not (scalar grep {ref or /\n/}@$value)){$self->{stream}=~ s/\n\Z/ /;$self->{stream}.= '[';for (my$i=0;$i < @$value;$i++){$self->_emit_str($value->[$i],KEY);last if$i==$#{$value};$self->{stream}.= ', '}$self->{stream}.= "]\n";return}$self->offset->[$self->level + 1]=$self->offset->[$self->level]+ $self->indent_width;$self->{level}++;for my$val (@$value){$self->{stream}.= ' ' x $self->offset->[$self->level];$self->{stream}.= '-';$self->_emit_node($val,FROMARRAY)}$self->{level}--}sub _emit_key {my$self=shift;my ($value,$context)=@_;$self->{stream}.= ' ' x $self->offset->[$self->level]unless$context==FROMARRAY;$self->_emit_str($value,KEY)}sub _emit_scalar {my$self=shift;my ($value,$tag)=@_;$self->{stream}.= " !$tag";$self->_emit_str($value,BLESSED)}sub _emit {my$self=shift;$self->{stream}.= join '',@_}sub _emit_str {my$self=shift;my$type=$_[1]|| 0;$self->offset->[$self->level + 1]=$self->offset->[$self->level]+ $self->indent_width;$self->{level}++;my$sf=$type==KEY ? '' : ' ';my$sb=$type==KEY ? '? ' : ' ';my$ef=$type==KEY ? '' : "\n";my$eb="\n";while (1){$self->_emit($sf),$self->_emit_plain($_[0]),$self->_emit($ef),last if not defined $_[0];$self->_emit($sf,'=',$ef),last if $_[0]eq VALUE;$self->_emit($sf),$self->_emit_double($_[0]),$self->_emit($ef),last if $_[0]=~ /$ESCAPE_CHAR/;if ($_[0]=~ /\n/){$self->_emit($sb),$self->_emit_block($LIT_CHAR,$_[0]),$self->_emit($eb),last if$self->use_block;Carp::cluck "[YAML] \$UseFold is no longer supported" if$self->use_fold;$self->_emit($sf),$self->_emit_double($_[0]),$self->_emit($ef),last if length $_[0]<= 30;$self->_emit($sf),$self->_emit_double($_[0]),$self->_emit($ef),last if $_[0]!~ /\n\s*\S/;$self->_emit($sb),$self->_emit_block($LIT_CHAR,$_[0]),$self->_emit($eb),last}$self->_emit($sf),$self->_emit_number($_[0]),$self->_emit($ef),last if$self->is_literal_number($_[0]);$self->_emit($sf),$self->_emit_plain($_[0]),$self->_emit($ef),last if$self->is_valid_plain($_[0]);$self->_emit($sf),$self->_emit_double($_[0]),$self->_emit($ef),last if $_[0]=~ /'/;$self->_emit($sf),$self->_emit_single($_[0]),$self->_emit($ef);last}$self->{level}--;return}sub is_literal_number {my$self=shift;return B::svref_2object(\$_[0])->FLAGS & (B::SVp_IOK | B::SVp_NOK)&& 0 + $_[0]eq $_[0]}sub _emit_number {my$self=shift;return$self->_emit_plain($_[0])}sub is_valid_plain {my$self=shift;return 0 unless length $_[0];return 0 if$self->quote_numeric_strings and Scalar::Util::looks_like_number($_[0]);return 0 if $_[0]=~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;return 0 if $_[0]=~ /[\{\[\]\},]/;return 0 if $_[0]=~ /[:\-\?]\s/;return 0 if $_[0]=~ /\s#/;return 0 if $_[0]=~ /\:(\s|$)/;return 0 if $_[0]=~ /[\s\|\>]$/;return 0 if $_[0]eq '-';return 0 if $_[0]eq '=';return 1}sub _emit_block {my$self=shift;my ($indicator,$value)=@_;$self->{stream}.= $indicator;$value =~ /(\n*)\Z/;my$chomp=length $1 ? (length $1 > 1)? '+' : '' : '-';$value='~' if not defined$value;$self->{stream}.= $chomp;$self->{stream}.= $self->indent_width if$value =~ /^\s/;$self->{stream}.= $self->indent($value)}sub _emit_plain {my$self=shift;$self->{stream}.= defined $_[0]? $_[0]: '~'}sub _emit_double {my$self=shift;(my$escaped=$self->escape($_[0]))=~ s/"/\\"/g;$self->{stream}.= qq{"$escaped"}}sub _emit_single {my$self=shift;my$item=shift;$item =~ s{'}{''}g;$self->{stream}.= "'$item'"}sub indent {my$self=shift;my ($text)=@_;return$text unless length$text;$text =~ s/\n\Z//;my$indent=' ' x $self->offset->[$self->level];$text =~ s/^/$indent/gm;$text="\n$text";return$text}my@escapes=qw(\0 \x01 \x02 \x03 \x04 \x05 \x06 \a \x08 \t \n \v \f \r \x0e \x0f \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17 \x18 \x19 \x1a \e \x1c \x1d \x1e \x1f);sub escape {my$self=shift;my ($text)=@_;$text =~ s/\\/\\\\/g;$text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge;return$text}1; + YAML::Dumper can't handle dumping this type of data. + Please report this to the author. + + id: $node_id + type: $type + class: $class + value: $value + + ... +YAML_DUMPER + +$fatpacked{"YAML/Dumper/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_DUMPER_BASE'; + package YAML::Dumper::Base;use YAML::Mo;use YAML::Node;has spec_version=>default=>sub {'1.0'};has indent_width=>default=>sub {2};has use_header=>default=>sub {1};has use_version=>default=>sub {0};has sort_keys=>default=>sub {1};has anchor_prefix=>default=>sub {''};has dump_code=>default=>sub {0};has use_block=>default=>sub {0};has use_fold=>default=>sub {0};has compress_series=>default=>sub {1};has inline_series=>default=>sub {0};has use_aliases=>default=>sub {1};has purity=>default=>sub {0};has stringify=>default=>sub {0};has quote_numeric_strings=>default=>sub {0};has stream=>default=>sub {''};has document=>default=>sub {0};has transferred=>default=>sub {{}};has id_refcnt=>default=>sub {{}};has id_anchor=>default=>sub {{}};has anchor=>default=>sub {1};has level=>default=>sub {0};has offset=>default=>sub {[]};has headless=>default=>sub {0};has blessed_map=>default=>sub {{}};sub set_global_options {my$self=shift;$self->spec_version($YAML::SpecVersion)if defined$YAML::SpecVersion;$self->indent_width($YAML::Indent)if defined$YAML::Indent;$self->use_header($YAML::UseHeader)if defined$YAML::UseHeader;$self->use_version($YAML::UseVersion)if defined$YAML::UseVersion;$self->sort_keys($YAML::SortKeys)if defined$YAML::SortKeys;$self->anchor_prefix($YAML::AnchorPrefix)if defined$YAML::AnchorPrefix;$self->dump_code($YAML::DumpCode || $YAML::UseCode)if defined$YAML::DumpCode or defined$YAML::UseCode;$self->use_block($YAML::UseBlock)if defined$YAML::UseBlock;$self->use_fold($YAML::UseFold)if defined$YAML::UseFold;$self->compress_series($YAML::CompressSeries)if defined$YAML::CompressSeries;$self->inline_series($YAML::InlineSeries)if defined$YAML::InlineSeries;$self->use_aliases($YAML::UseAliases)if defined$YAML::UseAliases;$self->purity($YAML::Purity)if defined$YAML::Purity;$self->stringify($YAML::Stringify)if defined$YAML::Stringify;$self->quote_numeric_strings($YAML::QuoteNumericStrings)if defined$YAML::QuoteNumericStrings}sub dump {my$self=shift;$self->die('dump() not implemented in this class.')}sub blessed {my$self=shift;my ($ref)=@_;$ref=\$_[0]unless ref$ref;my (undef,undef,$node_id)=YAML::Mo::Object->node_info($ref);$self->{blessed_map}->{$node_id}}sub bless {my$self=shift;my ($ref,$blessing)=@_;my$ynode;$ref=\$_[0]unless ref$ref;my (undef,undef,$node_id)=YAML::Mo::Object->node_info($ref);if (not defined$blessing){$ynode=YAML::Node->new($ref)}elsif (ref$blessing){$self->die()unless ynode($blessing);$ynode=$blessing}else {no strict 'refs';my$transfer=$blessing ."::yaml_dump";$self->die()unless defined &{$transfer};$ynode=&{$transfer}($ref);$self->die()unless ynode($ynode)}$self->{blessed_map}->{$node_id}=$ynode;my$object=ynode($ynode)or $self->die();return$object}1; +YAML_DUMPER_BASE + +$fatpacked{"YAML/Error.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_ERROR'; + package YAML::Error;use YAML::Mo;has 'code';has 'type'=>default=>sub {'Error'};has 'line';has 'document';has 'arguments'=>default=>sub {[]};my ($error_messages,%line_adjust);sub format_message {my$self=shift;my$output='YAML ' .$self->type .': ';my$code=$self->code;if ($error_messages->{$code}){$code=sprintf($error_messages->{$code},@{$self->arguments})}$output .= $code ."\n";$output .= ' Code: ' .$self->code ."\n" if defined$self->code;$output .= ' Line: ' .$self->line ."\n" if defined$self->line;$output .= ' Document: ' .$self->document ."\n" if defined$self->document;return$output}sub error_messages {$error_messages}%$error_messages=map {s/^\s+//;s/\\n/\n/;$_}split "\n",<<'...';%line_adjust=map {($_,1)}qw(YAML_PARSE_ERR_BAD_MAJOR_VERSION YAML_PARSE_WARN_BAD_MINOR_VERSION YAML_PARSE_ERR_TEXT_AFTER_INDICATOR YAML_PARSE_ERR_NO_ANCHOR YAML_PARSE_ERR_MANY_EXPLICIT YAML_PARSE_ERR_MANY_IMPLICIT YAML_PARSE_ERR_MANY_ANCHOR YAML_PARSE_ERR_ANCHOR_ALIAS YAML_PARSE_ERR_BAD_ALIAS YAML_PARSE_ERR_MANY_ALIAS YAML_LOAD_ERR_NO_CONVERT YAML_LOAD_ERR_NO_DEFAULT_VALUE YAML_LOAD_ERR_NON_EMPTY_STRING YAML_LOAD_ERR_BAD_MAP_TO_SEQ YAML_LOAD_ERR_BAD_STR_TO_INT YAML_LOAD_ERR_BAD_STR_TO_DATE YAML_LOAD_ERR_BAD_STR_TO_TIME YAML_LOAD_WARN_DUPLICATE_KEY YAML_PARSE_ERR_INLINE_MAP YAML_PARSE_ERR_INLINE_SEQUENCE YAML_PARSE_ERR_BAD_DOUBLE YAML_PARSE_ERR_BAD_SINGLE YAML_PARSE_ERR_BAD_INLINE_IMPLICIT YAML_PARSE_ERR_BAD_IMPLICIT YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP YAML_LOAD_WARN_BAD_REGEXP_ELEM YAML_LOAD_WARN_REGEXP_CREATE YAML_LOAD_WARN_GLOB_NAME YAML_LOAD_WARN_PARSE_CODE YAML_LOAD_WARN_CODE_DEPARSE YAML_LOAD_WARN_BAD_GLOB_ELEM YAML_PARSE_ERR_ZERO_INDENT);package YAML::Warning;our@ISA='YAML::Error';1; + YAML_PARSE_ERR_BAD_CHARS + Invalid characters in stream. This parser only supports printable ASCII + YAML_PARSE_ERR_BAD_MAJOR_VERSION + Can't parse a %s document with a 1.0 parser + YAML_PARSE_WARN_BAD_MINOR_VERSION + Parsing a %s document with a 1.0 parser + YAML_PARSE_WARN_MULTIPLE_DIRECTIVES + '%s directive used more than once' + YAML_PARSE_ERR_TEXT_AFTER_INDICATOR + No text allowed after indicator + YAML_PARSE_ERR_NO_ANCHOR + No anchor for alias '*%s' + YAML_PARSE_ERR_NO_SEPARATOR + Expected separator '---' + YAML_PARSE_ERR_SINGLE_LINE + Couldn't parse single line value + YAML_PARSE_ERR_BAD_ANCHOR + Invalid anchor + YAML_DUMP_ERR_INVALID_INDENT + Invalid Indent width specified: '%s' + YAML_LOAD_USAGE + usage: YAML::Load($yaml_stream_scalar) + YAML_PARSE_ERR_BAD_NODE + Can't parse node + YAML_PARSE_ERR_BAD_EXPLICIT + Unsupported explicit transfer: '%s' + YAML_DUMP_USAGE_DUMPCODE + Invalid value for DumpCode: '%s' + YAML_LOAD_ERR_FILE_INPUT + Couldn't open %s for input:\n%s + YAML_DUMP_ERR_FILE_CONCATENATE + Can't concatenate to YAML file %s + YAML_DUMP_ERR_FILE_OUTPUT + Couldn't open %s for output:\n%s + YAML_DUMP_ERR_FILE_OUTPUT_CLOSE + Error closing %s:\n%s + YAML_DUMP_ERR_NO_HEADER + With UseHeader=0, the node must be a plain hash or array + YAML_DUMP_WARN_BAD_NODE_TYPE + Can't perform serialization for node type: '%s' + YAML_EMIT_WARN_KEYS + Encountered a problem with 'keys':\n%s + YAML_DUMP_WARN_DEPARSE_FAILED + Deparse failed for CODE reference + YAML_DUMP_WARN_CODE_DUMMY + Emitting dummy subroutine for CODE reference + YAML_PARSE_ERR_MANY_EXPLICIT + More than one explicit transfer + YAML_PARSE_ERR_MANY_IMPLICIT + More than one implicit request + YAML_PARSE_ERR_MANY_ANCHOR + More than one anchor + YAML_PARSE_ERR_ANCHOR_ALIAS + Can't define both an anchor and an alias + YAML_PARSE_ERR_BAD_ALIAS + Invalid alias + YAML_PARSE_ERR_MANY_ALIAS + More than one alias + YAML_LOAD_ERR_NO_CONVERT + Can't convert implicit '%s' node to explicit '%s' node + YAML_LOAD_ERR_NO_DEFAULT_VALUE + No default value for '%s' explicit transfer + YAML_LOAD_ERR_NON_EMPTY_STRING + Only the empty string can be converted to a '%s' + YAML_LOAD_ERR_BAD_MAP_TO_SEQ + Can't transfer map as sequence. Non numeric key '%s' encountered. + YAML_DUMP_ERR_BAD_GLOB + '%s' is an invalid value for Perl glob + YAML_DUMP_ERR_BAD_REGEXP + '%s' is an invalid value for Perl Regexp + YAML_LOAD_ERR_BAD_MAP_ELEMENT + Invalid element in map + YAML_LOAD_WARN_DUPLICATE_KEY + Duplicate map key '%s' found. Ignoring. + YAML_LOAD_ERR_BAD_SEQ_ELEMENT + Invalid element in sequence + YAML_PARSE_ERR_INLINE_MAP + Can't parse inline map + YAML_PARSE_ERR_INLINE_SEQUENCE + Can't parse inline sequence + YAML_PARSE_ERR_BAD_DOUBLE + Can't parse double quoted string + YAML_PARSE_ERR_BAD_SINGLE + Can't parse single quoted string + YAML_PARSE_ERR_BAD_INLINE_IMPLICIT + Can't parse inline implicit value '%s' + YAML_PARSE_ERR_BAD_IMPLICIT + Unrecognized implicit value '%s' + YAML_PARSE_ERR_INDENTATION + Error. Invalid indentation level + YAML_PARSE_ERR_INCONSISTENT_INDENTATION + Inconsistent indentation level + YAML_LOAD_WARN_UNRESOLVED_ALIAS + Can't resolve alias *%s + YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP + No 'REGEXP' element for Perl regexp + YAML_LOAD_WARN_BAD_REGEXP_ELEM + Unknown element '%s' in Perl regexp + YAML_LOAD_WARN_GLOB_NAME + No 'NAME' element for Perl glob + YAML_LOAD_WARN_PARSE_CODE + Couldn't parse Perl code scalar: %s + YAML_LOAD_WARN_CODE_DEPARSE + Won't parse Perl code unless $YAML::LoadCode is set + YAML_EMIT_ERR_BAD_LEVEL + Internal Error: Bad level detected + YAML_PARSE_WARN_AMBIGUOUS_TAB + Amibiguous tab converted to spaces + YAML_LOAD_WARN_BAD_GLOB_ELEM + Unknown element '%s' in Perl glob + YAML_PARSE_ERR_ZERO_INDENT + Can't use zero as an indentation width + YAML_LOAD_WARN_GLOB_IO + Can't load an IO filehandle. Yet!!! + ... +YAML_ERROR + +$fatpacked{"YAML/Loader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_LOADER'; + package YAML::Loader;use YAML::Mo;extends 'YAML::Loader::Base';use YAML::Loader::Base;use YAML::Types;use YAML::Node;use constant LEAF=>1;use constant COLLECTION=>2;use constant VALUE=>"\x07YAML\x07VALUE\x07";use constant COMMENT=>"\x07YAML\x07COMMENT\x07";my$ESCAPE_CHAR='[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';my$FOLD_CHAR='>';my$LIT_CHAR='|';my$LIT_CHAR_RX="\\$LIT_CHAR";sub load {my$self=shift;$self->stream($_[0]|| '');return$self->_parse()}sub _parse {my$self=shift;my (%directives,$preface);$self->{stream}=~ s|\015\012|\012|g;$self->{stream}=~ s|\015|\012|g;$self->line(0);$self->die('YAML_PARSE_ERR_BAD_CHARS')if$self->stream =~ /$ESCAPE_CHAR/;$self->{stream}=~ s/(.)\n\Z/$1/s;$self->lines([split /\x0a/,$self->stream,-1]);$self->line(1);$self->_parse_throwaway_comments();$self->document(0);$self->documents([]);$self->zero_indent([]);if (not $self->eos){if ($self->lines->[0]!~ /^---(\s|$)/){unshift @{$self->lines},'---';$self->{line}--}}while (not $self->eos){$self->anchor2node({});$self->{document}++;$self->done(0);$self->level(0);$self->offset->[0]=-1;if ($self->lines->[0]=~ /^---\s*(.*)$/){my@words=split /\s/,$1;%directives=();while (@words){if ($words[0]=~ /^#(\w+):(\S.*)$/){my ($key,$value)=($1,$2);shift(@words);if (defined$directives{$key}){$self->warn('YAML_PARSE_WARN_MULTIPLE_DIRECTIVES',$key,$self->document);next}$directives{$key}=$value}elsif ($words[0]eq ''){shift@words}else {last}}$self->preface(join ' ',@words)}else {$self->die('YAML_PARSE_ERR_NO_SEPARATOR')}if (not $self->done){$self->_parse_next_line(COLLECTION)}if ($self->done){$self->{indent}=-1;$self->content('')}$directives{YAML}||= '1.0';$directives{TAB}||= 'NONE';($self->{major_version},$self->{minor_version})=split /\./,$directives{YAML},2;$self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION',$directives{YAML})if$self->major_version ne '1';$self->warn('YAML_PARSE_WARN_BAD_MINOR_VERSION',$directives{YAML})if$self->minor_version ne '0';$self->die('Unrecognized TAB policy')unless$directives{TAB}=~ /^(NONE|\d+)(:HARD)?$/;push @{$self->documents},$self->_parse_node()}return wantarray ? @{$self->documents}: $self->documents->[-1]}sub _parse_node {my$self=shift;my$preface=$self->preface;$self->preface('');my ($node,$type,$indicator,$chomp,$parsed_inline)=('')x 5;my ($anchor,$alias,$explicit,$implicit)=('')x 4;($anchor,$alias,$explicit,$implicit,$preface)=$self->_parse_qualifiers($preface);if ($anchor){$self->anchor2node->{$anchor}=CORE::bless [],'YAML-anchor2node'}$self->inline('');while (length$preface){if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)//){$indicator=$1;if ($preface =~ s/^([+-])[0-9]*//){$chomp=$1}elsif ($preface =~ s/^[0-9]+([+-]?)//){$chomp=$1}if ($preface =~ s/^(?:\s+#.*$|\s*)$//){}else {$self->die('YAML_PARSE_ERR_TEXT_AFTER_INDICATOR')}}else {$self->inline($preface);$preface=''}}if ($alias){$self->die('YAML_PARSE_ERR_NO_ANCHOR',$alias)unless defined$self->anchor2node->{$alias};if (ref($self->anchor2node->{$alias})ne 'YAML-anchor2node'){$node=$self->anchor2node->{$alias}}else {$node=do {my$sv="*$alias"};push @{$self->anchor2node->{$alias}},[\$node,$self->line]}}elsif (length$self->inline){$node=$self->_parse_inline(1,$implicit,$explicit);$parsed_inline=1;if (length$self->inline){$self->die('YAML_PARSE_ERR_SINGLE_LINE')}}elsif ($indicator eq $LIT_CHAR){$self->{level}++;$node=$self->_parse_block($chomp);$node=$self->_parse_implicit($node)if$implicit;$self->{level}--}elsif ($indicator eq $FOLD_CHAR){$self->{level}++;$node=$self->_parse_unfold($chomp);$node=$self->_parse_implicit($node)if$implicit;$self->{level}--}else {$self->{level}++;$self->offset->[$self->level]||= 0;if ($self->indent==$self->offset->[$self->level]){if ($self->content =~ /^-( |$)/){$node=$self->_parse_seq($anchor)}elsif ($self->content =~ /(^\?|\:( |$))/){$node=$self->_parse_mapping($anchor)}elsif ($preface =~ /^\s*$/){$node=$self->_parse_implicit('')}else {$self->die('YAML_PARSE_ERR_BAD_NODE')}}else {$node=undef}$self->{level}--}$#{$self->offset}=$self->level;if ($explicit){$node=$self->_parse_explicit($node,$explicit)if!$parsed_inline}if ($anchor){if (ref($self->anchor2node->{$anchor})eq 'YAML-anchor2node'){for my$ref (@{$self->anchor2node->{$anchor}}){${$ref->[0]}=$node;$self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',$anchor,$ref->[1])}}$self->anchor2node->{$anchor}=$node}return$node}sub _parse_qualifiers {my$self=shift;my ($preface)=@_;my ($anchor,$alias,$explicit,$implicit,$token)=('')x 5;$self->inline('');while ($preface =~ /^[&*!]/){if ($preface =~ s/^\!(\S+)\s*//){$self->die('YAML_PARSE_ERR_MANY_EXPLICIT')if$explicit;$explicit=$1}elsif ($preface =~ s/^\!\s*//){$self->die('YAML_PARSE_ERR_MANY_IMPLICIT')if$implicit;$implicit=1}elsif ($preface =~ s/^\&([^ ,:]*)\s*//){$token=$1;$self->die('YAML_PARSE_ERR_BAD_ANCHOR')unless$token =~ /^[a-zA-Z0-9_.\/-]+$/;$self->die('YAML_PARSE_ERR_MANY_ANCHOR')if$anchor;$self->die('YAML_PARSE_ERR_ANCHOR_ALIAS')if$alias;$anchor=$token}elsif ($preface =~ s/^\*([^ ,:]*)\s*//){$token=$1;$self->die('YAML_PARSE_ERR_BAD_ALIAS')unless$token =~ /^[a-zA-Z0-9_.\/-]+$/;$self->die('YAML_PARSE_ERR_MANY_ALIAS')if$alias;$self->die('YAML_PARSE_ERR_ANCHOR_ALIAS')if$anchor;$alias=$token}}return ($anchor,$alias,$explicit,$implicit,$preface)}sub _parse_explicit {my$self=shift;my ($node,$explicit)=@_;my ($type,$class);if ($explicit =~ /^\!?perl\/(hash|array|ref|scalar)(?:\:(\w(\w|\:\:)*)?)?$/){($type,$class)=(($1 || ''),($2 || ''));if ($type eq "ref"){$self->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE','XXX',$explicit)unless exists$node->{VALUE()}and scalar(keys %$node)==1;my$value=$node->{VALUE()};$node=\$value}if ($type eq "scalar" and length($class)and!ref($node)){my$value=$node;$node=\$value}if (length($class)and $YAML::LoadBlessed){CORE::bless($node,$class)}return$node}if ($explicit =~ m{^!?perl/(glob|regexp|code)(?:\:(\w(\w|\:\:)*)?)?$}){($type,$class)=(($1 || ''),($2 || ''));my$type_class="YAML::Type::$type";no strict 'refs';if ($type_class->can('yaml_load')){return$type_class->yaml_load($node,$class,$self)}else {$self->die('YAML_LOAD_ERR_NO_CONVERT','XXX',$explicit)}}elsif ($YAML::TagClass->{$explicit}|| $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$}){$class=$YAML::TagClass->{$explicit}|| $2;if ($class->can('yaml_load')){require YAML::Node;return$class->yaml_load(YAML::Node->new($node,$explicit))}elsif ($YAML::LoadBlessed){if (ref$node){return CORE::bless$node,$class}else {return CORE::bless \$node,$class}}else {return$node}}elsif (ref$node){require YAML::Node;return YAML::Node->new($node,$explicit)}else {return$node}}sub _parse_mapping {my$self=shift;my ($anchor)=@_;my$mapping=$self->preserve ? YAML::Node->new({}): {};$self->anchor2node->{$anchor}=$mapping;my$key;while (not $self->done and $self->indent==$self->offset->[$self->level]){if ($self->{content}=~ s/^\?\s*//){$self->preface($self->content);$self->_parse_next_line(COLLECTION);$key=$self->_parse_node();$key="$key"}elsif ($self->{content}=~ s/^\=\s*(?=:)//){$key=VALUE}elsif ($self->{content}=~ s/^\=\s*(?=:)//){$key=COMMENT}else {$self->inline($self->content);$key=$self->_parse_inline();$key="$key";$self->content($self->inline);$self->inline('')}unless ($self->{content}=~ s/^:(?:\s+#.*$|\s*)//){$self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT')}$self->preface($self->content);my$level=$self->level;my$zero_indent=$self->zero_indent;$zero_indent->[$level ]=0;$self->_parse_next_line(COLLECTION);my$value=$self->_parse_node();$#$zero_indent=$level;if (exists$mapping->{$key}){$self->warn('YAML_LOAD_WARN_DUPLICATE_KEY',$key)}else {$mapping->{$key}=$value}}return$mapping}sub _parse_seq {my$self=shift;my ($anchor)=@_;my$seq=[];$self->anchor2node->{$anchor}=$seq;while (not $self->done and $self->indent==$self->offset->[$self->level]){if ($self->content =~ /^-(?: (.*))?$/){$self->preface(defined($1)? $1 : '')}else {if ($self->zero_indent->[$self->level ]){last}$self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT')}my$preface=$self->preface;if ($preface =~ m/^ (\s*) ( - (?: \ .* | $ ) ) /x){$self->indent($self->offset->[$self->level]+ 2 + length($1));$self->content($2);$self->level($self->level + 1);$self->offset->[$self->level]=$self->indent;$self->preface('');push @$seq,$self->_parse_seq('');$self->{level}--;$#{$self->offset}=$self->level}elsif ($preface =~ /^ (\s*) ((') (?:''|[^'])*? ' \s* \: (?:\ |$).*) $/x or $preface =~ /^ (\s*) ((") (?:\\\\|[^"])*? " \s* \: (?:\ |$).*) $/x or $preface =~ /^ (\s*) (\?.*$)/x or $preface =~ /^ (\s*) ([^'"\s:#&!\[\]\{\},*|>].*\:(\ .*|$))/x){$self->indent($self->offset->[$self->level]+ 2 + length($1));$self->content($2);$self->level($self->level + 1);$self->offset->[$self->level]=$self->indent;$self->preface('');push @$seq,$self->_parse_mapping('');$self->{level}--;$#{$self->offset}=$self->level}else {$self->_parse_next_line(COLLECTION);push @$seq,$self->_parse_node()}}return$seq}sub _parse_inline {my$self=shift;my ($top,$top_implicit,$top_explicit)=(@_,'','','');$self->{inline}=~ s/^\s*(.*)\s*$/$1/;my ($node,$anchor,$alias,$explicit,$implicit)=('')x 5;($anchor,$alias,$explicit,$implicit,$self->{inline})=$self->_parse_qualifiers($self->inline);if ($anchor){$self->anchor2node->{$anchor}=CORE::bless [],'YAML-anchor2node'}$implicit ||= $top_implicit;$explicit ||= $top_explicit;($top_implicit,$top_explicit)=('','');if ($alias){$self->die('YAML_PARSE_ERR_NO_ANCHOR',$alias)unless defined$self->anchor2node->{$alias};if (ref($self->anchor2node->{$alias})ne 'YAML-anchor2node'){$node=$self->anchor2node->{$alias}}else {$node=do {my$sv="*$alias"};push @{$self->anchor2node->{$alias}},[\$node,$self->line]}}elsif ($self->inline =~ /^\{/){$node=$self->_parse_inline_mapping($anchor)}elsif ($self->inline =~ /^\[/){$node=$self->_parse_inline_seq($anchor)}elsif ($self->inline =~ /^"/){$node=$self->_parse_inline_double_quoted();$node=$self->_unescape($node);$node=$self->_parse_implicit($node)if$implicit}elsif ($self->inline =~ /^'/){$node=$self->_parse_inline_single_quoted();$node=$self->_parse_implicit($node)if$implicit}else {if ($top){$node=$self->inline;$self->inline('')}else {$node=$self->_parse_inline_simple()}$node=$self->_parse_implicit($node)unless$explicit;if ($self->numify and defined$node and not ref$node and length$node and $node =~ m/\A-?(?:0|[1-9][0-9]*)?(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?\z/){$node += 0}}if ($explicit){$node=$self->_parse_explicit($node,$explicit)}if ($anchor){if (ref($self->anchor2node->{$anchor})eq 'YAML-anchor2node'){for my$ref (@{$self->anchor2node->{$anchor}}){${$ref->[0]}=$node;$self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',$anchor,$ref->[1])}}$self->anchor2node->{$anchor}=$node}return$node}sub _parse_inline_mapping {my$self=shift;my ($anchor)=@_;my$node={};$self->anchor2node->{$anchor}=$node;$self->die('YAML_PARSE_ERR_INLINE_MAP')unless$self->{inline}=~ s/^\{\s*//;while (not $self->{inline}=~ s/^\s*\}(\s+#.*$|\s*)//){my$key=$self->_parse_inline();$self->die('YAML_PARSE_ERR_INLINE_MAP')unless$self->{inline}=~ s/^\: \s*//;my$value=$self->_parse_inline();if (exists$node->{$key}){$self->warn('YAML_LOAD_WARN_DUPLICATE_KEY',$key)}else {$node->{$key}=$value}next if$self->inline =~ /^\s*\}/;$self->die('YAML_PARSE_ERR_INLINE_MAP')unless$self->{inline}=~ s/^\,\s*//}return$node}sub _parse_inline_seq {my$self=shift;my ($anchor)=@_;my$node=[];$self->anchor2node->{$anchor}=$node;$self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')unless$self->{inline}=~ s/^\[\s*//;while (not $self->{inline}=~ s/^\s*\](\s+#.*$|\s*)//){my$value=$self->_parse_inline();push @$node,$value;next if$self->inline =~ /^\s*\]/;$self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')unless$self->{inline}=~ s/^\,\s*//}return$node}sub _parse_inline_double_quoted {my$self=shift;my$inline=$self->inline;if ($inline =~ s/^"//){my$node='';while ($inline =~ s/^(\\.|[^"\\]+)//){my$capture=$1;$capture =~ s/^\\"/"/;$node .= $capture;last unless length$inline}if ($inline =~ s/^"(?:\s+#.*|\s*)//){$self->inline($inline);return$node}}$self->die('YAML_PARSE_ERR_BAD_DOUBLE')}sub _parse_inline_single_quoted {my$self=shift;my$inline=$self->inline;if ($inline =~ s/^'//){my$node='';while ($inline =~ s/^(''|[^']+)//){my$capture=$1;$capture =~ s/^''/'/;$node .= $capture;last unless length$inline}if ($inline =~ s/^'(?:\s+#.*|\s*)//){$self->inline($inline);return$node}}$self->die('YAML_PARSE_ERR_BAD_SINGLE')}sub _parse_inline_simple {my$self=shift;my$value;if ($self->inline =~ /^(|[^!@#%^&*].*?)(?=[\[\]\{\},]|, |: |- |:\s*$|$)/){$value=$1;substr($self->{inline},0,length($1))=''}else {$self->die('YAML_PARSE_ERR_BAD_INLINE_IMPLICIT',$value)}return$value}sub _parse_implicit {my$self=shift;my ($value)=@_;$value =~ s/^#.*$//;$value =~ s/\s+#.*$//;$value =~ s/\s*$//;return$value if$value eq '';return undef if$value =~ /^~$/;return$value unless$value =~ /^[\@\`]/ or $value =~ /^[\-\?]\s/;$self->die('YAML_PARSE_ERR_BAD_IMPLICIT',$value)}sub _parse_unfold {my$self=shift;my ($chomp)=@_;my$node='';my$space=0;while (not $self->done and $self->indent==$self->offset->[$self->level]){$node .= $self->content."\n";$self->_parse_next_line(LEAF)}$node =~ s/^(\S.*)\n(?=\S)/$1 /gm;$node =~ s/^(\S.*)\n(\n+\S)/$1$2/gm;$node =~ s/\n*\Z// unless$chomp eq '+';$node .= "\n" unless$chomp;return$node}sub _parse_block {my$self=shift;my ($chomp)=@_;my$node='';while (not $self->done and $self->indent==$self->offset->[$self->level]){$node .= $self->content ."\n";$self->_parse_next_line(LEAF)}return$node if '+' eq $chomp;$node =~ s/\n*\Z/\n/;$node =~ s/\n\Z// if$chomp eq '-';return$node}sub _parse_throwaway_comments {my$self=shift;while (@{$self->lines}and $self->lines->[0]=~ m{^\s*(\#|$)}){shift @{$self->lines};$self->{line}++}$self->eos($self->{done}=not @{$self->lines})}sub _parse_next_line {my$self=shift;my ($type)=@_;my$level=$self->level;my$offset=$self->offset->[$level];$self->die('YAML_EMIT_ERR_BAD_LEVEL')unless defined$offset;shift @{$self->lines};$self->eos($self->{done}=not @{$self->lines});if ($self->eos){$self->offset->[$level + 1]=$offset + 1;return}$self->{line}++;if ($self->preface =~ qr/(?:^|\s)(?:$FOLD_CHAR|$LIT_CHAR_RX)(?:[+-]([0-9]*)|([0-9]*)[+-]?)(?:\s+#.*|\s*)$/){my$explicit_indent=defined $1 ? $1 : defined $2 ? $2 : '';$self->die('YAML_PARSE_ERR_ZERO_INDENT')if length($explicit_indent)and $explicit_indent==0;$type=LEAF;if (length($explicit_indent)){$self->offset->[$level + 1]=$offset + $explicit_indent}else {while (@{$self->lines}&& ($self->lines->[0]=~ /^\s*#/)){$self->lines->[0]=~ /^( *)/;last unless length($1)<= $offset;shift @{$self->lines};$self->{line}++}$self->eos($self->{done}=not @{$self->lines});return if$self->eos;if ($self->lines->[0]=~ /^( *)\S/ and length($1)> $offset){$self->offset->[$level+1]=length($1)}else {$self->offset->[$level+1]=$offset + 1}}$offset=$self->offset->[++$level]}elsif ($type==COLLECTION and $self->preface =~ /^(\s*(\!\S*|\&\S+))*\s*$/){$self->_parse_throwaway_comments();my$zero_indent=$self->zero_indent;if ($self->eos){$self->offset->[$level+1]=$offset + 1;return}elsif (defined$zero_indent->[$level ]and not $zero_indent->[$level ]and $self->lines->[0]=~ /^( {$offset,})-(?: |$)/){my$new_offset=length($1);$self->offset->[$level+1]=$new_offset;if ($new_offset==$offset){$zero_indent->[$level+1 ]=1}}else {$self->lines->[0]=~ /^( *)\S/ or $self->die('YAML_PARSE_ERR_NONSPACE_INDENTATION');if (length($1)> $offset){$self->offset->[$level+1]=length($1)}else {$self->offset->[$level+1]=$offset + 1}}$offset=$self->offset->[++$level]}if ($type==LEAF){if (@{$self->lines}and $self->lines->[0]=~ m{^( *)(\#)} and length($1)< $offset){if (length($1)< $offset){shift @{$self->lines};$self->{line}++;while (@{$self->lines}and $self->lines->[0]=~ m{^( *)(\#)}){shift @{$self->lines};$self->{line}++}}}$self->eos($self->{done}=not @{$self->lines})}else {$self->_parse_throwaway_comments()}return if$self->eos;if ($self->lines->[0]=~ /^---(\s|$)/){$self->done(1);return}if ($type==LEAF and $self->lines->[0]=~ /^ {$offset}(.*)$/){$self->indent($offset);$self->content($1)}elsif ($self->lines->[0]=~ /^\s*$/){$self->indent($offset);$self->content('')}else {$self->lines->[0]=~ /^( *)(\S.*)$/;while ($self->offset->[$level]> length($1)){$level--}$self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')if$self->offset->[$level]!=length($1);$self->indent(length($1));$self->content($2)}$self->die('YAML_PARSE_ERR_INDENTATION')if$self->indent - $offset > 1}my%unescapes=(0=>"\x00",a=>"\x07",t=>"\x09",n=>"\x0a",'v'=>"\x0b",f=>"\x0c",r=>"\x0d",e=>"\x1b",'\\'=>'\\',);sub _unescape {my$self=shift;my ($node)=@_;$node =~ s/\\([never\\fart0]|x([0-9a-fA-F]{2}))/ + (length($1)>1)?pack("H2",$2):$unescapes{$1}/gex;return$node}1; +YAML_LOADER + +$fatpacked{"YAML/Loader/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_LOADER_BASE'; + package YAML::Loader::Base;use YAML::Mo;has load_code=>default=>sub {0};has preserve=>default=>sub {0};has stream=>default=>sub {''};has document=>default=>sub {0};has line=>default=>sub {0};has documents=>default=>sub {[]};has lines=>default=>sub {[]};has eos=>default=>sub {0};has done=>default=>sub {0};has anchor2node=>default=>sub {{}};has level=>default=>sub {0};has offset=>default=>sub {[]};has preface=>default=>sub {''};has content=>default=>sub {''};has indent=>default=>sub {0};has major_version=>default=>sub {0};has minor_version=>default=>sub {0};has inline=>default=>sub {''};has numify=>default=>sub {0};has zero_indent=>default=>sub {[]};sub set_global_options {my$self=shift;$self->load_code($YAML::LoadCode || $YAML::UseCode)if defined$YAML::LoadCode or defined$YAML::UseCode;$self->preserve($YAML::Preserve)if defined$YAML::Preserve;$self->numify($YAML::Numify)if defined$YAML::Numify}sub load {die 'load() not implemented in this class.'}1; +YAML_LOADER_BASE + +$fatpacked{"YAML/Marshall.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_MARSHALL'; + use strict;use warnings;package YAML::Marshall;use YAML::Node ();sub import {my$class=shift;no strict 'refs';my$package=caller;unless (grep {$_ eq $class}@{$package .'::ISA'}){push @{$package .'::ISA'},$class}my$tag=shift;if ($tag){no warnings 'once';$YAML::TagClass->{$tag}=$package;${$package ."::YamlTag"}=$tag}}sub yaml_dump {my$self=shift;no strict 'refs';my$tag=${ref($self)."::YamlTag"}|| 'perl/' .ref($self);$self->yaml_node($self,$tag)}sub yaml_load {my ($class,$node)=@_;if (my$ynode=$class->yaml_ynode($node)){$node=$ynode->{NODE}}bless$node,$class}sub yaml_node {shift;YAML::Node->new(@_)}sub yaml_ynode {shift;YAML::Node::ynode(@_)}1; +YAML_MARSHALL + +$fatpacked{"YAML/Mo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_MO'; + package YAML::Mo;no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.'::'.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};@_=(default,@_)if!($#_%2);$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=\&{$P.$b}and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;exists$a{default}or return$m;my($d,$r)=$a{default};my$g='HASH'eq($r=ref$d)?sub{+{%$d}}:'ARRAY'eq$r?sub{[@$d]}:'CODE'eq$r?$d:sub{$d};my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=$g and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$g->(@_):$m->(@_)}}};my$i=\&import;*{$M.import}=sub{(@_==2 and not$_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};@f=qw[builder default import];use strict;use warnings;our$DumperModule='Data::Dumper';my ($_new_error,$_info,$_scalar_info);no strict 'refs';*{$M.'Object::die'}=sub {my$self=shift;my$error=$self->$_new_error(@_);$error->type('Error');Carp::croak($error->format_message)};*{$M.'Object::warn'}=sub {my$self=shift;return unless $^W;my$error=$self->$_new_error(@_);$error->type('Warning');Carp::cluck($error->format_message)};*{$M.'Object::node_info'}=sub {my$self=shift;my$stringify=$_[1]|| 0;my ($class,$type,$id)=ref($_[0])? $stringify ? &$_info("$_[0]"): do {require overload;my@info=&$_info(overload::StrVal($_[0]));if (ref($_[0])eq 'Regexp'){@info[0,1]=(undef,'REGEXP')}@info}: &$_scalar_info($_[0]);($class,$type,$id)=&$_scalar_info("$_[0]")unless$id;return wantarray ? ($class,$type,$id): $id};$_info=sub {return (($_[0])=~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o)};$_scalar_info=sub {my$id='undef';if (defined $_[0]){\$_[0]=~ /\((\w+)\)$/o or CORE::die();$id="$1-S"}return (undef,undef,$id)};$_new_error=sub {require Carp;my$self=shift;require YAML::Error;my$code=shift || 'unknown error';my$error=YAML::Error->new(code=>$code);$error->line($self->line)if$self->can('line');$error->document($self->document)if$self->can('document');$error->arguments([@_]);return$error};1; +YAML_MO + +$fatpacked{"YAML/Node.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_NODE'; + use strict;use warnings;package YAML::Node;use YAML::Tag;require YAML::Mo;use Exporter;our@ISA=qw(Exporter YAML::Mo::Object);our@EXPORT=qw(ynode);sub ynode {my$self;if (ref($_[0])eq 'HASH'){$self=tied(%{$_[0]})}elsif (ref($_[0])eq 'ARRAY'){$self=tied(@{$_[0]})}elsif (ref(\$_[0])eq 'GLOB'){$self=tied(*{$_[0]})}else {$self=tied($_[0])}return (ref($self)=~ /^yaml_/)? $self : undef}sub new {my ($class,$node,$tag)=@_;my$self;$self->{NODE}=$node;my (undef,$type)=YAML::Mo::Object->node_info($node);$self->{KIND}=(not defined$type)? 'scalar' : ($type eq 'ARRAY')? 'sequence' : ($type eq 'HASH')? 'mapping' : $class->die("Can't create YAML::Node from '$type'");tag($self,($tag || ''));if ($self->{KIND}eq 'scalar'){yaml_scalar->new($self,$_[1]);return \ $_[1]}my$package="yaml_" .$self->{KIND};$package->new($self)}sub node {$_->{NODE}}sub kind {$_->{KIND}}sub tag {my ($self,$value)=@_;if (defined$value){$self->{TAG}=YAML::Tag->new($value);return$self}else {return$self->{TAG}}}sub keys {my ($self,$value)=@_;if (defined$value){$self->{KEYS}=$value;return$self}else {return$self->{KEYS}}}package yaml_scalar;@yaml_scalar::ISA=qw(YAML::Node);sub new {my ($class,$self)=@_;tie $_[2],$class,$self}sub TIESCALAR {my ($class,$self)=@_;bless$self,$class;$self}sub FETCH {my ($self)=@_;$self->{NODE}}sub STORE {my ($self,$value)=@_;$self->{NODE}=$value}package yaml_sequence;@yaml_sequence::ISA=qw(YAML::Node);sub new {my ($class,$self)=@_;my$new;tie @$new,$class,$self;$new}sub TIEARRAY {my ($class,$self)=@_;bless$self,$class}sub FETCHSIZE {my ($self)=@_;scalar @{$self->{NODE}}}sub FETCH {my ($self,$index)=@_;$self->{NODE}[$index]}sub STORE {my ($self,$index,$value)=@_;$self->{NODE}[$index]=$value}sub undone {die "Not implemented yet"}*STORESIZE=*POP=*PUSH=*SHIFT=*UNSHIFT=*SPLICE=*DELETE=*EXISTS=*STORESIZE=*POP=*PUSH=*SHIFT=*UNSHIFT=*SPLICE=*DELETE=*EXISTS=*undone;package yaml_mapping;@yaml_mapping::ISA=qw(YAML::Node);sub new {my ($class,$self)=@_;@{$self->{KEYS}}=sort keys %{$self->{NODE}};my$new;tie %$new,$class,$self;$new}sub TIEHASH {my ($class,$self)=@_;bless$self,$class}sub FETCH {my ($self,$key)=@_;if (exists$self->{NODE}{$key}){return (grep {$_ eq $key}@{$self->{KEYS}})? $self->{NODE}{$key}: undef}return$self->{HASH}{$key}}sub STORE {my ($self,$key,$value)=@_;if (exists$self->{NODE}{$key}){$self->{NODE}{$key}=$value}elsif (exists$self->{HASH}{$key}){$self->{HASH}{$key}=$value}else {if (not grep {$_ eq $key}@{$self->{KEYS}}){push(@{$self->{KEYS}},$key)}$self->{HASH}{$key}=$value}$value}sub DELETE {my ($self,$key)=@_;my$return;if (exists$self->{NODE}{$key}){$return=$self->{NODE}{$key}}elsif (exists$self->{HASH}{$key}){$return=delete$self->{NODE}{$key}}for (my$i=0;$i < @{$self->{KEYS}};$i++){if ($self->{KEYS}[$i]eq $key){splice(@{$self->{KEYS}},$i,1)}}return$return}sub CLEAR {my ($self)=@_;@{$self->{KEYS}}=();%{$self->{HASH}}=()}sub FIRSTKEY {my ($self)=@_;$self->{ITER}=0;$self->{KEYS}[0]}sub NEXTKEY {my ($self)=@_;$self->{KEYS}[++$self->{ITER}]}sub EXISTS {my ($self,$key)=@_;exists$self->{NODE}{$key}}1; +YAML_NODE + +$fatpacked{"YAML/Tag.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_TAG'; + use strict;use warnings;package YAML::Tag;use overload '""'=>sub {${$_[0]}};sub new {my ($class,$self)=@_;bless \$self,$class}sub short {${$_[0]}}sub canonical {${$_[0]}}1; +YAML_TAG + +$fatpacked{"YAML/Types.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_TYPES'; + package YAML::Types;use YAML::Mo;use YAML::Node;package YAML::Type::blessed;use YAML::Mo;sub yaml_dump {my$self=shift;my ($value)=@_;my ($class,$type)=YAML::Mo::Object->node_info($value);no strict 'refs';my$kind=lc($type).':';my$tag=${$class .'::ClassTag'}|| "!perl/$kind$class";if ($type eq 'REF'){YAML::Node->new({(&YAML::VALUE,${$_[0]})},$tag)}elsif ($type eq 'SCALAR'){$_[1]=$$value;YAML::Node->new($_[1],$tag)}elsif ($type eq 'GLOB'){return YAML::Type::glob->yaml_dump($value,$tag)}else {YAML::Node->new($value,$tag)}}package YAML::Type::undef;sub yaml_dump {my$self=shift}sub yaml_load {my$self=shift}package YAML::Type::glob;sub yaml_dump {my$self=shift;my$tag=pop @_ if 2==@_;$tag='!perl/glob:' unless defined$tag;my$ynode=YAML::Node->new({},$tag);for my$type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)){my$value=*{$_[0]}{$type};$value=$$value if$type eq 'SCALAR';if (defined$value){if ($type eq 'IO'){my@stats=qw(device inode mode links uid gid rdev size atime mtime ctime blksize blocks);undef$value;$value->{stat}=YAML::Node->new({});if ($value->{fileno}=fileno(*{$_[0]})){local $^W;map {$value->{stat}{shift@stats}=$_}stat(*{$_[0]});$value->{tell}=tell(*{$_[0]})}}$ynode->{$type}=$value}}return$ynode}sub yaml_load {my$self=shift;my ($node,$class,$loader)=@_;my ($name,$package);if (defined$node->{NAME}){$name=$node->{NAME};delete$node->{NAME}}else {$loader->warn('YAML_LOAD_WARN_GLOB_NAME');return undef}if (defined$node->{PACKAGE}){$package=$node->{PACKAGE};delete$node->{PACKAGE}}else {$package='main'}no strict 'refs';if (exists$node->{SCALAR}){if ($YAML::LoadBlessed and $loader->load_code){*{"${package}::$name"}=\$node->{SCALAR}}delete$node->{SCALAR}}for my$elem (qw(ARRAY HASH CODE IO)){if (exists$node->{$elem}){if ($elem eq 'IO'){$loader->warn('YAML_LOAD_WARN_GLOB_IO');delete$node->{IO};next}if ($YAML::LoadBlessed and $loader->load_code){*{"${package}::$name"}=$node->{$elem}}delete$node->{$elem}}}for my$elem (sort keys %$node){$loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM',$elem)}return *{"${package}::$name"}}package YAML::Type::code;my$dummy_warned=0;my$default='{ "DUMMY" }';sub yaml_dump {my$self=shift;my$code;my ($dumpflag,$value)=@_;my ($class,$type)=YAML::Mo::Object->node_info($value);my$tag="!perl/code";$tag .= ":$class" if defined$class;if (not $dumpflag){$code=$default}else {bless$value,"CODE" if$class;eval {require B::Deparse};return if $@;my$deparse=B::Deparse->new();eval {local $^W=0;$code=$deparse->coderef2text($value)};if ($@){warn YAML::YAML_DUMP_WARN_DEPARSE_FAILED()if $^W;$code=$default}bless$value,$class if$class;chomp$code;$code .= "\n"}$_[2]=$code;YAML::Node->new($_[2],$tag)}sub yaml_load {my$self=shift;my ($node,$class,$loader)=@_;if ($loader->load_code){my$code=eval "package main; sub $node";if ($@){$loader->warn('YAML_LOAD_WARN_PARSE_CODE',$@);return sub {}}else {CORE::bless$code,$class if ($class and $YAML::LoadBlessed);return$code}}else {return CORE::bless sub {},$class if ($class and $YAML::LoadBlessed);return sub {}}}package YAML::Type::ref;sub yaml_dump {my$self=shift;YAML::Node->new({(&YAML::VALUE,${$_[0]})},'!perl/ref')}sub yaml_load {my$self=shift;my ($node,$class,$loader)=@_;$loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE','ptr')unless exists$node->{&YAML::VALUE};return \$node->{&YAML::VALUE}}package YAML::Type::regexp;sub yaml_dump {die "YAML::Type::regexp::yaml_dump not currently implemented"}use constant _QR_TYPES=>{''=>sub {qr{$_[0]}},x=>sub {qr{$_[0]}x},i=>sub {qr{$_[0]}i},s=>sub {qr{$_[0]}s},m=>sub {qr{$_[0]}m},ix=>sub {qr{$_[0]}ix},sx=>sub {qr{$_[0]}sx},mx=>sub {qr{$_[0]}mx},si=>sub {qr{$_[0]}si},mi=>sub {qr{$_[0]}mi},ms=>sub {qr{$_[0]}sm},six=>sub {qr{$_[0]}six},mix=>sub {qr{$_[0]}mix},msx=>sub {qr{$_[0]}msx},msi=>sub {qr{$_[0]}msi},msix=>sub {qr{$_[0]}msix},};sub yaml_load {my$self=shift;my ($node,$class)=@_;return qr{$node} unless$node =~ /^\(\?([\^\-uxism]*):(.*)\)\z/s;my ($flags,$re)=($1,$2);$flags =~ s/-.*//;$flags =~ s/^\^//;$flags =~ tr/u//d;my$sub=_QR_TYPES->{$flags}|| sub {qr{$_[0]}};my$qr=&$sub($re);bless$qr,$class if (length$class and $YAML::LoadBlessed);return$qr}1; +YAML_TYPES + +$fatpacked{"namespace/clean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NAMESPACE_CLEAN'; + package namespace::clean;use warnings;use strict;our$VERSION='0.27';$VERSION=eval$VERSION if$VERSION =~ /_/;our$STORAGE_VAR='__NAMESPACE_CLEAN_STORAGE';use B::Hooks::EndOfScope 'on_scope_end';BEGIN {my$provider;if ("$]" < 5.008007){require Package::Stash::PP;$provider='Package::Stash::PP'}else {require Package::Stash;$provider='Package::Stash'}eval <<"EOS" or die $@}use namespace::clean::_Util qw(DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT);my$RemoveSubs=sub {my$cleanee=shift;my$store=shift;my$cleanee_stash=stash_for($cleanee);my$deleted_stash;SYMBOL: for my$f (@_){next SYMBOL if$store->{exclude}{$f };my$sub=$cleanee_stash->get_symbol("&$f")or next SYMBOL;my$need_debugger_fixup=(DEBUGGER_NEEDS_CV_RENAME or DEBUGGER_NEEDS_CV_PIVOT)&& $^P & 0x01 && defined&DB::sub && ref(my$globref=\$cleanee_stash->namespace->{$f})eq 'GLOB' && ($deleted_stash ||= stash_for("namespace::clean::deleted::$cleanee"));if (DEBUGGER_NEEDS_CV_RENAME and $need_debugger_fixup){namespace::clean::_Util::get_subname($sub)eq ($cleanee_stash->name ."::$f")and $deleted_stash->add_symbol("&$f",namespace::clean::_Util::set_subname($deleted_stash->name ."::$f",$sub),)}elsif (DEBUGGER_NEEDS_CV_PIVOT and $need_debugger_fixup){$deleted_stash->add_symbol("&$f",$sub)}my@symbols=map {my$name=$_ .$f;my$def=$cleanee_stash->get_symbol($name);defined($def)? [$name,$def]: ()}'$','@','%','';$cleanee_stash->remove_glob($f);DEBUGGER_NEEDS_CV_PIVOT and $need_debugger_fixup and *$globref=$deleted_stash->namespace->{$f};$cleanee_stash->add_symbol(@$_)for@symbols}};sub clean_subroutines {my ($nc,$cleanee,@subs)=@_;$RemoveSubs->($cleanee,{},@subs)}sub import {my ($pragma,@args)=@_;my (%args,$is_explicit);ARG: while (@args){if ($args[0]=~ /^\-/){my$key=shift@args;my$value=shift@args;$args{$key }=$value}else {$is_explicit++;last ARG}}my$cleanee=exists$args{-cleanee }? $args{-cleanee }: scalar caller;if ($is_explicit){on_scope_end {$RemoveSubs->($cleanee,{},@args)}}else {my$functions=$pragma->get_functions($cleanee);my$store=$pragma->get_class_store($cleanee);my$stash=stash_for($cleanee);my%except=map {($_=>1)}($args{-except }? (ref$args{-except }eq 'ARRAY' ? @{$args{-except }}: $args{-except }): ());for my$f (keys %$functions){next if$except{$f };next unless$stash->has_symbol("&$f");$store->{remove}{$f }=1}on_scope_end {$RemoveSubs->($cleanee,$store,keys %{$store->{remove}})};return 1}}sub unimport {my ($pragma,%args)=@_;my$cleanee=exists$args{-cleanee }? $args{-cleanee }: scalar caller;my$functions=$pragma->get_functions($cleanee);my$store=$pragma->get_class_store($cleanee);for my$f (keys %$functions){next if$store->{remove}{$f }or $store->{exclude}{$f };$store->{exclude}{$f }=1}return 1}sub get_class_store {my ($pragma,$class)=@_;my$stash=stash_for($class);my$var="%$STORAGE_VAR";$stash->add_symbol($var,{})unless$stash->has_symbol($var);return$stash->get_symbol($var)}sub get_functions {my ($pragma,$class)=@_;my$stash=stash_for($class);return {map {$_=>$stash->get_symbol("&$_")}$stash->list_all_symbols('CODE')}}'Danger! Laws of Thermodynamics may not apply.' + + sub stash_for (\$) { + $provider->new(\$_[0]); + } + + 1; + + EOS +NAMESPACE_CLEAN + +$fatpacked{"namespace/clean/_Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NAMESPACE_CLEAN__UTIL'; + package namespace::clean::_Util;use warnings;use strict;use base 'Exporter';our@EXPORT_OK=qw(DEBUGGER_NEEDS_CV_RENAME DEBUGGER_NEEDS_CV_PIVOT);use constant DEBUGGER_NEEDS_CV_RENAME=>(("$]" > 5.008_008)and ("$]" < 5.013_006));use constant DEBUGGER_NEEDS_CV_PIVOT=>((!DEBUGGER_NEEDS_CV_RENAME)and ("$]" < 5.015_005));BEGIN {DEBUGGER_NEEDS_CV_RENAME and (eval <<'EOS' or die $@)}1; + { + my( $sub_name_loaded, $sub_util_loaded ); + + sub _namer_load_error { + return '' if $sub_util_loaded or $sub_name_loaded; + + # if S::N is loaded first *and* so is B - then go with that, otherwise + # prefer Sub::Util as S::U will provide a faster get_subname and will + # not need further require() calls + # this is rather arbitrary but remember this code exists only perls + # between 5.8.9 ~ 5.13.5 + + # when changing version also change in Makefile.PL + my $sn_ver = 0.04; + + local $@; + my $err = ''; + + ( + ! ( + $INC{"B.pm"} + and + $INC{"Sub/Name.pm"} + and + eval { Sub::Name->VERSION($sn_ver) } + ) + and + eval { require Sub::Util } + and + # see https://github.com/moose/Moo/commit/dafa5118 + defined &Sub::Util::set_subname + and + $sub_util_loaded = 1 + ) + or + ( + eval { require Sub::Name and Sub::Name->VERSION($sn_ver) } + and + $sub_name_loaded = 1 + ) + or + $err = "When running under -d on this perl $], namespace::clean requires either Sub::Name $sn_ver or Sub::Util to be installed" + ; + + $err; + } + + sub set_subname { + if( my $err = _namer_load_error() ) { + die $err; + } + elsif( $sub_name_loaded ) { + &Sub::Name::subname; + } + elsif( $sub_util_loaded ) { + &Sub::Util::set_subname; + } + else { + die "How the fuck did we get here? Read source and debug please!"; + } + } + + sub get_subname { + if( + _namer_load_error() + or + ! $sub_util_loaded + ) { + require B; + my $gv = B::svref_2object( $_[0] )->GV; + join '::', $gv->STASH->NAME, $gv->NAME; + } + else { + &Sub::Util::subname; + } + } + } + 1; + EOS +NAMESPACE_CLEAN__UTIL + +s/^ //mg for values %fatpacked; + +my $class = 'FatPacked::'.(0+\%fatpacked); +no strict 'refs'; +*{"${class}::files"} = sub { keys %{$_[0]} }; + +if ($] < 5.008) { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + my $pos = 0; + my $last = length $fat; + return (sub { + return 0 if $pos == $last; + my $next = (1 + index $fat, "\n", $pos) || $last; + $_ .= substr $fat, $pos, $next - $pos; + $pos = $next; + return 1; + }); + } + }; +} + +else { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + open my $fh, '<', \$fat + or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; + return $fh; + } + return; + }; +} + +unshift @INC, bless \%fatpacked, $class; + } # END OF FATPACK CODE + + + +use warnings; +use strict; + +use Getopt::Long; +use GraphQL::Client; +use JSON::MaybeXS; + +our $VERSION = '0.600'; # 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 '-'; + +if (!$url) { + print STDERR "The or --url option argument is required.\n"; + pod2usage(2); +} + +$transport = expand_vars($transport); + +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 < [ [--variables JSON] | [--variable KEY=VALUE]... ] + [--operation-name NAME] [--transport KEY=VALUE]... + [--[no-]unpack] [--format json|json:pretty|yaml|perl|csv|tsv|table] + [--output FILE] + + graphql --version|--help|--manual + +=head1 DESCRIPTION + +C is a command-line program for executing queries and mutations on +a L server. + +=head1 INSTALL + +There are several ways to install F to your system. + +=head2 from CPAN + +You can install F using L: + + cpanm GraphQL::Client + +=head2 from GitHub + +You can also choose to download F as a self-contained executable: + + curl -OL https://raw.githubusercontent.com/chazmcgarvey/graphql-client/solo/graphql + chmod +x graphql + +To hack on the code, clone the repo instead: + + git clone https://github.com/chazmcgarvey/graphql-client.git + cd graphql-client + make bootstrap # installs dependencies; requires cpanm + +=head1 OPTIONS + +=head2 C<--url URL> + +The URL of the GraphQL server endpoint. + +If no C<--url> option is given, the first argument is assumed to be the URL. + +This option is required. + +Alias: C<-u> + +=head2 C<--query STR> + +The query or mutation to execute. + +If no C<--query> option is given, the next argument (after URL) is assumed to be the query. + +If the value is "-" (which is the default), the query will be read from C. + +See: L + +Alias: C<--mutation> + +=head2 C<--variables JSON> + +Provide the variables as a JSON object. + +Aliases: C<--vars>, C<-V> + +=head2 C<--variable KEY=VALUE> + +An alternative way to provide variables. Repeat this option to provide multiple variables. + +If used in combination with L, this option is silently ignored. + +See: L + +Aliases: C<--var>, C<-d> + +=head2 C<--operation-name NAME> + +Inform the server which query/mutation to execute. + +Alias: C<-n> + +=head2 C<--output FILE> + +Write the response to a file instead of STDOUT. + +Alias: C<-o> + +=head2 C<--transport KEY=VALUE> + +Key-value pairs for configuring the transport (usually HTTP). + +Alias: C<-t> + +=head2 C<--format STR> + +Specify the output format to use. See L. + +Alias: C<-f> + +=head2 C<--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 L. + +=head1 FORMAT + +The argument for L can be one of: + +=over 4 + +=item * + +C - Comma-separated values (requires L) + +=item * + +C - Human-readable JSON (default) + +=item * + +C - JSON + +=item * + +C - Perl code (requires L) + +=item * + +C - Table (requires L) + +=item * + +C - Tab-separated values (requires L) + +=item * + +C - YAML (requires L) + +=back + +The C, C, and C
formats will only work if the response has a particular shape: + + { + "data" : { + "onefield" : [ + { + "key" : "value", + ... + }, + ... + ] + } + } + +or + + { + "data" : { + "onefield" : [ + "value", + ... + ] + } + } + +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 L, but this can be overridden using the +C environment variable if desired, like this: + + PERL_TEXT_TABLE=Text::Table::HTML graphql ... -f table + +The list of supported modules is at L. + +=head1 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 L: + + graphql http://myserver/graphql {hello} + + # Output: + { + "data" : { + "hello" : "Hello world!" + } + } + + graphql http://myserver/graphql {hello} --unpack + + # Output: + { + "hello" : "Hello world!" + } + +=head1 ENVIRONMENT + +Some environment variables affect the way C behaves: + +=over 4 + +=item * + +C - Set to 1 to print diagnostic messages to STDERR. + +=item * + +C - Set the HTTP user agent string. + +=item * + +C - Set table format backend; see L. + +=back + +=head1 EXIT STATUS + +Here is a consolidated summary of what exit statuses mean: + +=over 4 + +=item * + +C<0> - Success + +=item * + +C<1> - Client or server errors + +=item * + +C<2> - Option usage is wrong + +=item * + +C<3> - Could not format the response as requested + +=back + +=head1 BUGS + +Please report any bugs or feature requests on the bugtracker website +L + +When submitting a bug or request, please include a test-file or a +patch to an existing test-file that illustrates the bug or desired +feature. + +=head1 AUTHOR + +Charles McGarvey + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2020 by Charles McGarvey. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut -- 2.45.2