my %fatpacked;
$fatpacked{"App/Codeowners.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS';
- package App::Codeowners;use v5.10.1;use utf8;use warnings;use strict;use App::Codeowners::Formatter;use App::Codeowners::Options;use App::Codeowners::Util qw(find_codeowners_in_directory run_git git_ls_files git_toplevel);use Color::ANSI::Util 0.03 qw(ansifg);use File::Codeowners;use Path::Tiny;our$VERSION='0.49';sub main {my$class=shift;my$self=bless {},$class;my$opts=App::Codeowners::Options->new(@_);my$color=$opts->{color};local$ENV{NO_COLOR}=1 if defined$color &&!$color;my$command=$opts->command;my$handler=$self->can("_command_$command")or die "Unknown command: $command\n";binmode(STDOUT,':encoding(UTF-8)');$self->$handler($opts);exit 0}sub _command_show {my$self=shift;my$opts=shift;my$toplevel=git_toplevel('.')or die "Not a git repo\n";my$codeowners_path=find_codeowners_in_directory($toplevel)or die "No CODEOWNERS file in $toplevel\n";my$codeowners=File::Codeowners->parse_from_filepath($codeowners_path);my ($proc,$cdup)=run_git(qw{rev-parse --show-cdup});$proc->wait and exit 1;my$show_projects=$opts->{projects}// scalar @{$codeowners->projects};my$formatter=App::Codeowners::Formatter->new(format=>$opts->{format}|| ' * %-50F %O',handle=>*STDOUT,columns=>['File',$opts->{patterns}? 'Pattern' : (),'Owner',$show_projects ? 'Project' : (),],);my%filter_owners=map {$_=>1}@{$opts->{owner}};my%filter_projects=map {$_=>1}@{$opts->{project}};my%filter_patterns=map {$_=>1}@{$opts->{pattern}};$proc=git_ls_files('.',$opts->args);while (my$filepath=$proc->next){my$match=$codeowners->match(path($filepath)->relative($cdup));if (%filter_owners){for my$owner (@{$match->{owners}}){goto ADD_RESULT if$filter_owners{$owner}}next}if (%filter_patterns){goto ADD_RESULT if$filter_patterns{$match->{pattern}|| ''};next}if (%filter_projects){goto ADD_RESULT if$filter_projects{$match->{project}|| ''};next}ADD_RESULT: $formatter->add_result([$filepath,$opts->{patterns}? $match->{pattern}: (),$match->{owners},$show_projects ? $match->{project}: (),])}$proc->wait and exit 1}sub _command_owners {my$self=shift;my$opts=shift;my$toplevel=git_toplevel('.')or die "Not a git repo\n";my$codeowners_path=find_codeowners_in_directory($toplevel)or die "No CODEOWNERS file in $toplevel\n";my$codeowners=File::Codeowners->parse_from_filepath($codeowners_path);my$results=$codeowners->owners($opts->{pattern});my$formatter=App::Codeowners::Formatter->new(format=>$opts->{format}|| '%O',handle=>*STDOUT,columns=>[qw(Owner)],);$formatter->add_result(map {[$_]}@$results)}sub _command_patterns {my$self=shift;my$opts=shift;my$toplevel=git_toplevel('.')or die "Not a git repo\n";my$codeowners_path=find_codeowners_in_directory($toplevel)or die "No CODEOWNERS file in $toplevel\n";my$codeowners=File::Codeowners->parse_from_filepath($codeowners_path);my$results=$codeowners->patterns($opts->{owner});my$formatter=App::Codeowners::Formatter->new(format=>$opts->{format}|| '%T',handle=>*STDOUT,columns=>[qw(Pattern)],);$formatter->add_result(map {[$_]}@$results)}sub _command_projects {my$self=shift;my$opts=shift;my$toplevel=git_toplevel('.')or die "Not a git repo\n";my$codeowners_path=find_codeowners_in_directory($toplevel)or die "No CODEOWNERS file in $toplevel\n";my$codeowners=File::Codeowners->parse_from_filepath($codeowners_path);my$results=$codeowners->projects;my$formatter=App::Codeowners::Formatter->new(format=>$opts->{format}|| '%P',handle=>*STDOUT,columns=>[qw(Project)],);$formatter->add_result(map {[$_]}@$results)}sub _command_create {goto&_command_update}sub _command_update {my$self=shift;my$opts=shift;my ($filepath)=$opts->args;my$path=path($filepath || '.');my$repopath;die "Does not exist: $path\n" if!$path->parent->exists;if ($path->is_dir){$repopath=$path;$path=find_codeowners_in_directory($path)|| $repopath->child('CODEOWNERS')}my$is_new=!$path->is_file;my$codeowners;if ($is_new){$codeowners=File::Codeowners->new;my$template=<<'END';for my$line (split(/\n/,$template)){$codeowners->append(comment=>$line)}}else {$codeowners=File::Codeowners->parse_from_filepath($path)}if ($repopath){my ($proc,@filepaths)=git_ls_files($repopath);$proc->wait and exit 1;$codeowners->clear_unowned;$codeowners->add_unowned(grep {!$codeowners->match($_)}@filepaths)}$codeowners->write_to_filepath($path);print STDERR "Wrote $path\n"}1;
+ package App::Codeowners;use v5.10.1;use utf8;use warnings;use strict;use App::Codeowners::Formatter;use App::Codeowners::Options;use App::Codeowners::Util qw(find_codeowners_in_directory run_git git_ls_files git_toplevel);use Color::ANSI::Util 0.03 qw(ansifg);use File::Codeowners;use Path::Tiny;our$VERSION='0.50';sub main {my$class=shift;my$self=bless {},$class;my$opts=App::Codeowners::Options->new(@_);my$color=$opts->{color};local$ENV{NO_COLOR}=1 if defined$color &&!$color;my$command=$opts->command;my$handler=$self->can("_command_$command")or die "Unknown command: $command\n";binmode(STDOUT,':encoding(UTF-8)');$self->$handler($opts);exit 0}sub _command_show {my$self=shift;my$opts=shift;my$toplevel=git_toplevel('.')or die "Not a git repo\n";my$codeowners_path=find_codeowners_in_directory($toplevel)or die "No CODEOWNERS file in $toplevel\n";my$codeowners=File::Codeowners->parse_from_filepath($codeowners_path);my ($proc,$cdup)=run_git(qw{rev-parse --show-cdup});$proc->wait and exit 1;my$show_projects=$opts->{projects}// scalar @{$codeowners->projects};my$formatter=App::Codeowners::Formatter->new(format=>$opts->{format}|| ' * %-50F %O',handle=>*STDOUT,columns=>['File',$opts->{patterns}? 'Pattern' : (),'Owner',$show_projects ? 'Project' : (),],);my%filter_owners=map {$_=>1}@{$opts->{owner}};my%filter_projects=map {$_=>1}@{$opts->{project}};my%filter_patterns=map {$_=>1}@{$opts->{pattern}};$proc=git_ls_files('.',$opts->args);while (my$filepath=$proc->next){my$match=$codeowners->match(path($filepath)->relative($cdup));if (%filter_owners){for my$owner (@{$match->{owners}}){goto ADD_RESULT if$filter_owners{$owner}}next}if (%filter_patterns){goto ADD_RESULT if$filter_patterns{$match->{pattern}|| ''};next}if (%filter_projects){goto ADD_RESULT if$filter_projects{$match->{project}|| ''};next}ADD_RESULT: $formatter->add_result([$filepath,$opts->{patterns}? $match->{pattern}: (),$match->{owners},$show_projects ? $match->{project}: (),])}$proc->wait and exit 1}sub _command_owners {my$self=shift;my$opts=shift;my$toplevel=git_toplevel('.')or die "Not a git repo\n";my$codeowners_path=find_codeowners_in_directory($toplevel)or die "No CODEOWNERS file in $toplevel\n";my$codeowners=File::Codeowners->parse_from_filepath($codeowners_path);my$results=$codeowners->owners($opts->{pattern});my$formatter=App::Codeowners::Formatter->new(format=>$opts->{format}|| '%O',handle=>*STDOUT,columns=>[qw(Owner)],);$formatter->add_result(map {[$_]}@$results)}sub _command_patterns {my$self=shift;my$opts=shift;my$toplevel=git_toplevel('.')or die "Not a git repo\n";my$codeowners_path=find_codeowners_in_directory($toplevel)or die "No CODEOWNERS file in $toplevel\n";my$codeowners=File::Codeowners->parse_from_filepath($codeowners_path);my$results=$codeowners->patterns($opts->{owner});my$formatter=App::Codeowners::Formatter->new(format=>$opts->{format}|| '%T',handle=>*STDOUT,columns=>[qw(Pattern)],);$formatter->add_result(map {[$_]}@$results)}sub _command_projects {my$self=shift;my$opts=shift;my$toplevel=git_toplevel('.')or die "Not a git repo\n";my$codeowners_path=find_codeowners_in_directory($toplevel)or die "No CODEOWNERS file in $toplevel\n";my$codeowners=File::Codeowners->parse_from_filepath($codeowners_path);my$results=$codeowners->projects;my$formatter=App::Codeowners::Formatter->new(format=>$opts->{format}|| '%P',handle=>*STDOUT,columns=>[qw(Project)],);$formatter->add_result(map {[$_]}@$results)}sub _command_create {goto&_command_update}sub _command_update {my$self=shift;my$opts=shift;my ($filepath)=$opts->args;my$path=path($filepath || '.');my$repopath;die "Does not exist: $path\n" if!$path->parent->exists;if ($path->is_dir){$repopath=$path;$path=find_codeowners_in_directory($path)|| $repopath->child('CODEOWNERS')}my$is_new=!$path->is_file;my$codeowners;if ($is_new){$codeowners=File::Codeowners->new;my$template=<<'END';for my$line (split(/\n/,$template)){$codeowners->append(comment=>$line)}}else {$codeowners=File::Codeowners->parse_from_filepath($path)}if ($repopath){my ($proc,@filepaths)=git_ls_files($repopath);$proc->wait and exit 1;$codeowners->clear_unowned;$codeowners->add_unowned(grep {!$codeowners->match($_)}@filepaths)}$codeowners->write_to_filepath($path);print STDERR "Wrote $path\n"}1;
This file shows mappings between subdirs/files and the individuals and
teams who own them. You can read this file yourself or use tools to query it,
so you can quickly determine who to speak with or send pull requests to.
APP_CODEOWNERS
$fatpacked{"App/Codeowners/Formatter.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_FORMATTER';
- package App::Codeowners::Formatter;use warnings;use strict;our$VERSION='0.49';use Module::Load;sub new {my$class=shift;my$args={@_==1 && ref $_[0]eq 'HASH' ? %{$_[0]}: @_};$args->{results}=[];($class,my$format)=$class->_best_formatter($args->{format})if$args->{format};$args->{format}=$format;my$self=bless$args,$class;$self->start;return$self}sub _best_formatter {my$class=shift;my$type=shift || '';return ($class,$type)if$class ne __PACKAGE__;my ($name,$format)=$type =~ /^([A-Za-z]+)(?::(.*))?$/;if (!$name){$name='';$format=''}$name=lc($name);$name =~ s/:.*//;my@formatters=$class->formatters;my$package=__PACKAGE__.'::String';for my$formatter (@formatters){my$module=lc($formatter);$module =~ s/.*:://;if ($module eq $name){$package=$formatter;$type=$format;last}}load$package;return ($package,$type)}sub DESTROY {my$self=shift;my$global_destruction=shift;return if$global_destruction;my$results=$self->{results};$self->finish($results)if$results;delete$self->{results}}sub handle {shift->{handle}}sub format {shift->{format}|| ''}sub columns {shift->{columns}|| []}sub results {shift->{results}}sub add_result {my$self=shift;$self->stream($_)for @_}sub start {}sub stream {push @{$_[0]->results},$_[1]}sub finish {}sub formatters {return qw(App::Codeowners::Formatter::CSV App::Codeowners::Formatter::JSON App::Codeowners::Formatter::String App::Codeowners::Formatter::TSV App::Codeowners::Formatter::Table App::Codeowners::Formatter::YAML)}1;
+ package App::Codeowners::Formatter;use warnings;use strict;our$VERSION='0.50';use Module::Load;sub new {my$class=shift;my$args={@_==1 && ref $_[0]eq 'HASH' ? %{$_[0]}: @_};$args->{results}=[];($class,my$format)=$class->_best_formatter($args->{format})if$args->{format};$args->{format}=$format;my$self=bless$args,$class;$self->start;return$self}sub _best_formatter {my$class=shift;my$type=shift || '';return ($class,$type)if$class ne __PACKAGE__;my ($name,$format)=$type =~ /^([A-Za-z]+)(?::(.*))?$/;if (!$name){$name='';$format=''}$name=lc($name);$name =~ s/:.*//;my@formatters=$class->formatters;my$package=__PACKAGE__.'::String';for my$formatter (@formatters){my$module=lc($formatter);$module =~ s/.*:://;if ($module eq $name){$package=$formatter;$type=$format;last}}load$package;return ($package,$type)}sub DESTROY {my$self=shift;my$global_destruction=shift;return if$global_destruction;my$results=$self->{results};$self->finish($results)if$results;delete$self->{results}}sub handle {shift->{handle}}sub format {shift->{format}|| ''}sub columns {shift->{columns}|| []}sub results {shift->{results}}sub add_result {my$self=shift;$self->stream($_)for @_}sub start {}sub stream {push @{$_[0]->results},$_[1]}sub finish {}sub formatters {return qw(App::Codeowners::Formatter::CSV App::Codeowners::Formatter::JSON App::Codeowners::Formatter::String App::Codeowners::Formatter::TSV App::Codeowners::Formatter::Table App::Codeowners::Formatter::YAML)}1;
APP_CODEOWNERS_FORMATTER
$fatpacked{"App/Codeowners/Formatter/CSV.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_FORMATTER_CSV';
- package App::Codeowners::Formatter::CSV;use warnings;use strict;our$VERSION='0.49';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(stringify);sub start {my$self=shift;$self->text_csv->print($self->handle,$self->columns)}sub stream {my$self=shift;my$result=shift;$self->text_csv->print($self->handle,[map {stringify($_)}@$result])}sub text_csv {my$self=shift;$self->{text_csv}||= do {eval {require Text::CSV}or die "Missing dependency: Text::CSV\n";my%options;$options{escape_char}=$self->escape_char if$self->escape_char;$options{quote}=$self->quote if$self->quote;$options{sep}=$self->sep if$self->sep;if ($options{sep}&& $options{sep}eq ($options{quote}|| '"')){die "Invalid separator value for CSV format.\n"}Text::CSV->new({binary=>1,eol=>$/,%options})}or die "Failed to construct Text::CSV object"}sub sep {$_[0]->{sep}|| $_[0]->format}sub quote {$_[0]->{quote}}sub escape_char {$_[0]->{escape_char}}1;
+ package App::Codeowners::Formatter::CSV;use warnings;use strict;our$VERSION='0.50';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(stringify);sub start {my$self=shift;$self->text_csv->print($self->handle,$self->columns)}sub stream {my$self=shift;my$result=shift;$self->text_csv->print($self->handle,[map {stringify($_)}@$result])}sub text_csv {my$self=shift;$self->{text_csv}||= do {eval {require Text::CSV}or die "Missing dependency: Text::CSV\n";my%options;$options{escape_char}=$self->escape_char if$self->escape_char;$options{quote}=$self->quote if$self->quote;$options{sep}=$self->sep if$self->sep;if ($options{sep}&& $options{sep}eq ($options{quote}|| '"')){die "Invalid separator value for CSV format.\n"}Text::CSV->new({binary=>1,eol=>$/,%options})}or die "Failed to construct Text::CSV object"}sub sep {$_[0]->{sep}|| $_[0]->format}sub quote {$_[0]->{quote}}sub escape_char {$_[0]->{escape_char}}1;
APP_CODEOWNERS_FORMATTER_CSV
$fatpacked{"App/Codeowners/Formatter/JSON.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_FORMATTER_JSON';
- package App::Codeowners::Formatter::JSON;use warnings;use strict;our$VERSION='0.49';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(zip);sub finish {my$self=shift;my$results=shift;eval {require JSON::MaybeXS}or die "Missing dependency: JSON::MaybeXS\n";my%options;$options{pretty}=1 if lc($self->format)eq 'pretty';my$json=JSON::MaybeXS->new(canonical=>1,%options);my$columns=$self->columns;$results=[map {+{zip @$columns,@$_}}@$results];print {$self->handle}$json->encode($results)}1;
+ package App::Codeowners::Formatter::JSON;use warnings;use strict;our$VERSION='0.50';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(zip);sub finish {my$self=shift;my$results=shift;eval {require JSON::MaybeXS}or die "Missing dependency: JSON::MaybeXS\n";my%options;$options{pretty}=1 if lc($self->format)eq 'pretty';my$json=JSON::MaybeXS->new(canonical=>1,%options);my$columns=$self->columns;$results=[map {+{zip @$columns,@$_}}@$results];print {$self->handle}$json->encode($results)}1;
APP_CODEOWNERS_FORMATTER_JSON
$fatpacked{"App/Codeowners/Formatter/String.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_FORMATTER_STRING';
- package App::Codeowners::Formatter::String;use warnings;use strict;our$VERSION='0.49';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(stringf zip);use Color::ANSI::Util 0.03 qw(ansifg);sub stream {my$self=shift;my$result=shift;$result={zip @{$self->columns},@$result};my%info=(F=>$self->_create_filterer->($result->{File},undef),O=>$self->_create_filterer->($result->{Owner},$self->_owner_colorgen),P=>$self->_create_filterer->($result->{Project},undef),T=>$self->_create_filterer->($result->{Pattern},undef),);my$text=stringf($self->format,%info);print {$self->handle}$text,"\n"}sub _expand_filter_args {my$arg=shift || '';my@filters=split(/,/,$arg);my$color_override;for (my$i=0;$i < @filters;++$i){my$filter=$filters[$i]or next;if ($filter =~ /^(?:nocolor|color:([0-9a-fA-F]{3,6}))$/){$color_override=$1 || '';splice(@filters,$i,1);redo}}return (\@filters,$color_override)}sub _ansi_reset {"\033[0m"}sub _colored {my$text=shift;my$rgb=shift or return$text;return$text if$ENV{NO_COLOR}|| (defined$ENV{COLOR_DEPTH}&&!$ENV{COLOR_DEPTH});$rgb =~ s/^(.)(.)(.)$/$1$1$2$2$3$3/;if ($rgb !~ m/^[0-9a-fA-F]{6}$/){warn "Color value must be in 'ffffff' or 'fff' form.\n";return$text}my ($begin,$end)=(ansifg($rgb),_ansi_reset);return "${begin}${text}${end}"}sub _create_filterer {my$self=shift;my%filter=(quote=>sub {local $_=$_[0];s/"/\"/s;"\"$_\""},);return sub {my$value=shift || '';my$color=shift || '';my$gencolor=ref($color)eq 'CODE' ? $color : sub {$color};return sub {my$arg=shift;my ($filters,$color)=_expand_filter_args($arg);if (ref($value)eq 'ARRAY'){$value=join(',',map {_colored($_,$color // $gencolor->($_))}@$value)}else {$value=_colored($value,$color // $gencolor->($value))}for my$key (@$filters){if (my$filter=$filter{$key}){$value=$filter->($value)}else {warn "Unknown filter: $key\n"}}$value || ''}}}sub _owner_colorgen {my$self=shift;my@contrasting_colors=qw(e6194b 3cb44b ffe119 4363d8 f58231 911eb4 42d4f4 f032e6 bfef45 fabebe 469990 e6beff 9a6324 fffac8 800000 aaffc3 808000 ffd8b1 000075 a9a9a9);my%owner_colors;my$num=-1;$self->{owner_color}||= sub {my$owner=shift or return;$owner_colors{$owner}||= do {$num=($num + 1)% scalar@contrasting_colors;$contrasting_colors[$num]}}}1;
+ package App::Codeowners::Formatter::String;use warnings;use strict;our$VERSION='0.50';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(stringf zip);use Color::ANSI::Util 0.03 qw(ansifg);sub stream {my$self=shift;my$result=shift;$result={zip @{$self->columns},@$result};my%info=(F=>$self->_create_filterer->($result->{File},undef),O=>$self->_create_filterer->($result->{Owner},$self->_owner_colorgen),P=>$self->_create_filterer->($result->{Project},undef),T=>$self->_create_filterer->($result->{Pattern},undef),);my$text=stringf($self->format,%info);print {$self->handle}$text,"\n"}sub _expand_filter_args {my$arg=shift || '';my@filters=split(/,/,$arg);my$color_override;for (my$i=0;$i < @filters;++$i){my$filter=$filters[$i]or next;if ($filter =~ /^(?:nocolor|color:([0-9a-fA-F]{3,6}))$/){$color_override=$1 || '';splice(@filters,$i,1);redo}}return (\@filters,$color_override)}sub _ansi_reset {"\033[0m"}sub _colored {my$text=shift;my$rgb=shift or return$text;return$text if$ENV{NO_COLOR}|| (defined$ENV{COLOR_DEPTH}&&!$ENV{COLOR_DEPTH});$rgb =~ s/^(.)(.)(.)$/$1$1$2$2$3$3/;if ($rgb !~ m/^[0-9a-fA-F]{6}$/){warn "Color value must be in 'ffffff' or 'fff' form.\n";return$text}my ($begin,$end)=(ansifg($rgb),_ansi_reset);return "${begin}${text}${end}"}sub _create_filterer {my$self=shift;my%filter=(quote=>sub {local $_=$_[0];s/"/\"/s;"\"$_\""},);return sub {my$value=shift || '';my$color=shift || '';my$gencolor=ref($color)eq 'CODE' ? $color : sub {$color};return sub {my$arg=shift;my ($filters,$color)=_expand_filter_args($arg);if (ref($value)eq 'ARRAY'){$value=join(',',map {_colored($_,$color // $gencolor->($_))}@$value)}else {$value=_colored($value,$color // $gencolor->($value))}for my$key (@$filters){if (my$filter=$filter{$key}){$value=$filter->($value)}else {warn "Unknown filter: $key\n"}}$value || ''}}}sub _owner_colorgen {my$self=shift;my@contrasting_colors=qw(e6194b 3cb44b ffe119 4363d8 f58231 911eb4 42d4f4 f032e6 bfef45 fabebe 469990 e6beff 9a6324 fffac8 800000 aaffc3 808000 ffd8b1 000075 a9a9a9);my%owner_colors;my$num=-1;$self->{owner_color}||= sub {my$owner=shift or return;$owner_colors{$owner}||= do {$num=($num + 1)% scalar@contrasting_colors;$contrasting_colors[$num]}}}1;
APP_CODEOWNERS_FORMATTER_STRING
$fatpacked{"App/Codeowners/Formatter/TSV.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_FORMATTER_TSV';
- package App::Codeowners::Formatter::TSV;use warnings;use strict;our$VERSION='0.49';use parent 'App::Codeowners::Formatter::CSV';sub sep {"\t"}1;
+ package App::Codeowners::Formatter::TSV;use warnings;use strict;our$VERSION='0.50';use parent 'App::Codeowners::Formatter::CSV';sub sep {"\t"}1;
APP_CODEOWNERS_FORMATTER_TSV
$fatpacked{"App/Codeowners/Formatter/Table.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_FORMATTER_TABLE';
- package App::Codeowners::Formatter::Table;use warnings;use strict;our$VERSION='0.49';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(stringify);sub finish {my$self=shift;my$results=shift;eval {require Text::Table::Any}or die "Missing dependency: Text::Table::Any\n";my$table=Text::Table::Any::table(header_row=>1,rows=>[$self->columns,map {[map {stringify($_)}@$_]}@$results],backend=>$ENV{PERL_TEXT_TABLE},);print {$self->handle}$table}1;
+ package App::Codeowners::Formatter::Table;use warnings;use strict;our$VERSION='0.50';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(stringify);sub finish {my$self=shift;my$results=shift;eval {require Text::Table::Any}or die "Missing dependency: Text::Table::Any\n";my$table=Text::Table::Any::table(header_row=>1,rows=>[$self->columns,map {[map {stringify($_)}@$_]}@$results],backend=>$ENV{PERL_TEXT_TABLE},);print {$self->handle}$table}1;
APP_CODEOWNERS_FORMATTER_TABLE
$fatpacked{"App/Codeowners/Formatter/YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_FORMATTER_YAML';
- package App::Codeowners::Formatter::YAML;use warnings;use strict;our$VERSION='0.49';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(zip);sub finish {my$self=shift;my$results=shift;eval {require YAML}or die "Missing dependency: YAML\n";my$columns=$self->columns;$results=[map {+{zip @$columns,@$_}}@$results];print {$self->handle}YAML::Dump($results)}1;
+ package App::Codeowners::Formatter::YAML;use warnings;use strict;our$VERSION='0.50';use parent 'App::Codeowners::Formatter';use App::Codeowners::Util qw(zip);sub finish {my$self=shift;my$results=shift;eval {require YAML}or die "Missing dependency: YAML\n";my$columns=$self->columns;$results=[map {+{zip @$columns,@$_}}@$results];print {$self->handle}YAML::Dump($results)}1;
APP_CODEOWNERS_FORMATTER_YAML
$fatpacked{"App/Codeowners/Options.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_OPTIONS';
- package App::Codeowners::Options;use v5.10.1;use warnings;use strict;use Encode qw(decode);use Getopt::Long 2.39 ();use Path::Tiny;our$VERSION='0.49';sub pod2usage {eval {require Pod::Usage};if ($@){my$ref=$VERSION eq '9999.999' ? 'master' : "v$VERSION";my$exit=(@_==1 && $_[0]=~ /^\d+$/ && $_[0])// (@_ % 2==0 && {@_}->{'-exitval'})// 2;print STDERR <<END;exit$exit}else {Pod::Usage::pod2usage(@_)}}sub early_options {return {'color|colour!'=>(-t STDOUT ? 1 : 0),'format|f=s'=>undef,'help|h|?'=>0,'manual|man'=>0,'shell-completion:s'=>undef,'version|v'=>0,}}sub command_options {return {'create'=>{},'owners'=>{'pattern=s'=>'',},'patterns'=>{'owner=s'=>'',},'projects'=>{},'show'=>{'owner=s@'=>[],'pattern=s@'=>[],'project=s@'=>[],'patterns!'=>0,'projects!'=>undef,},'update'=>{},}}sub commands {my$self=shift;my@commands=sort keys %{$self->command_options};return@commands}sub options {my$self=shift;my@command_options;if (my$command=$self->{command}){@command_options=keys %{$self->command_options->{$command}|| {}}}return (keys %{$self->early_options},@command_options)}sub new {my$class=shift;my@args=@_;@args=map {decode('UTF-8',$_)}@args if grep {/\P{ASCII}/}@args;my$self=bless {},$class;my@args_copy=@args;my$opts=$self->get_options(args=>\@args,spec=>$self->early_options,config=>'pass_through',)or pod2usage(2);if ($ENV{CODEOWNERS_COMPLETIONS}){$self->{command}=$args[0]|| '';my$cword=$ENV{CWORD};my$cur=$ENV{CUR}|| '';while (0 < --$cword){last if$cur eq ($args_copy[$cword]|| '')}$self->completions($cword,@args_copy);exit 0}if ($opts->{version}){my$progname=path($0)->basename;print "${progname} ${VERSION}\n";exit 0}if ($opts->{help}){pod2usage(-exitval=>0,-verbose=>99,-sections=>[qw(NAME SYNOPSIS OPTIONS COMMANDS)])}if ($opts->{manual}){pod2usage(-exitval=>0,-verbose=>2)}if (defined$opts->{shell_completion}){$self->shell_completion($opts->{shell_completion});exit 0}my$command=shift@args;my$command_options=$self->command_options->{$command || ''};if (!$command_options){unshift@args,$command if defined$command;$command='show';$command_options=$self->command_options->{$command}}my$more_opts=$self->get_options(args=>\@args,spec=>$command_options,)or pod2usage(2);%$self=(%$opts,%$more_opts,command=>$command,args=>\@args);return$self}sub command {my$self=shift;my$command=$self->{command};my@commands=sort keys %{$self->command_options};return if not grep {$_ eq $command}@commands;$command =~ s/[^a-z]/_/g;return$command}sub args {my$self=shift;return @{$self->{args}|| []}}sub get_options {my$self=shift;my$args={@_==1 && ref $_[0]eq 'HASH' ? %{$_[0]}: @_};my%options;my%results;while (my ($opt,$default_value)=each %{$args->{spec}}){my ($name)=$opt =~ /^([^=:!|]+)/;$name =~ s/-/_/g;$results{$name}=$default_value;$options{$opt}=\$results{$name}}if (my$fn=$args->{callback}){$options{'<>'}=sub {my$arg=shift;$fn->($arg,\%results)}}my$p=Getopt::Long::Parser->new;$p->configure($args->{config}|| 'default');return if!$p->getoptionsfromarray($args->{args},%options);return \%results}sub shell_completion {my$self=shift;my$type=lc(shift || 'bash');if ($type eq 'bash'){print <<'END'}else {warn "No such shell completion: $type\n"}}sub completions {my$self=shift;my$cword=shift;my@words=@_;my$current=$words[$cword]|| '';my$prev=$words[$cword - 1]|| '';my$reply;if ($prev eq '--format' || $prev eq '-f'){$reply=$self->_completion_formats}elsif ($current =~ /^-/){$reply=$self->_completion_options}else {if (!$self->command){$reply=[$self->commands,@{$self->_completion_options([keys %{$self->early_options}])}]}else {print 'file';exit 9}}local $,="\n";print grep {/^\Q$current\E/}@$reply;exit 0}sub _completion_options {my$self=shift;my$opts=shift || [$self->options];my@options;for my$option (@$opts){my ($names,$op,$vtype)=$option =~ /^([^=:!]+)([=:!]?)(.*)$/;my@names=split(/\|/,$names);for my$name (@names){if ($op eq '!'){push@options,"--$name","--no-$name"}else {if (length($name)> 1){push@options,"--$name"}else {push@options,"-$name"}}}}return [sort@options]}sub _completion_formats {[qw(csv json json:pretty tsv yaml)]}1;
+ package App::Codeowners::Options;use v5.10.1;use warnings;use strict;use Encode qw(decode);use Getopt::Long 2.39 ();use Path::Tiny;our$VERSION='0.50';sub _pod2usage {eval {require Pod::Usage};if ($@){my$ref=$VERSION eq '9999.999' ? 'master' : "v$VERSION";my$exit=(@_==1 && $_[0]=~ /^\d+$/ && $_[0])// (@_ % 2==0 && {@_}->{'-exitval'})// 2;print STDERR <<END;exit$exit}else {Pod::Usage::pod2usage(@_)}}sub _early_options {return {'color|colour!'=>(-t STDOUT ? 1 : 0),'format|f=s'=>undef,'help|h|?'=>0,'manual|man'=>0,'shell-completion:s'=>undef,'version|v'=>0,}}sub _command_options {return {'create'=>{},'owners'=>{'pattern=s'=>'',},'patterns'=>{'owner=s'=>'',},'projects'=>{},'show'=>{'owner=s@'=>[],'pattern=s@'=>[],'project=s@'=>[],'patterns!'=>0,'projects!'=>undef,},'update'=>{},}}sub _commands {my$self=shift;my@commands=sort keys %{$self->_command_options};return@commands}sub _options {my$self=shift;my@command_options;if (my$command=$self->{command}){@command_options=keys %{$self->_command_options->{$command}|| {}}}return (keys %{$self->_early_options},@command_options)}sub new {my$class=shift;my@args=@_;@args=map {decode('UTF-8',$_)}@args if grep {/\P{ASCII}/}@args;my$self=bless {},$class;my@args_copy=@args;my$opts=$self->get_options(args=>\@args,spec=>$self->_early_options,config=>'pass_through',)or _pod2usage(2);if ($ENV{CODEOWNERS_COMPLETIONS}){$self->{command}=$args[0]|| '';my$cword=$ENV{CWORD};my$cur=$ENV{CUR}|| '';while (0 < --$cword){last if$cur eq ($args_copy[$cword]|| '')}$self->completions($cword,@args_copy);exit 0}if ($opts->{version}){my$progname=path($0)->basename;print "${progname} ${VERSION}\n";exit 0}if ($opts->{help}){_pod2usage(-exitval=>0,-verbose=>99,-sections=>[qw(NAME SYNOPSIS OPTIONS COMMANDS)])}if ($opts->{manual}){_pod2usage(-exitval=>0,-verbose=>2)}if (defined$opts->{shell_completion}){$self->shell_completion($opts->{shell_completion});exit 0}my$command=shift@args;my$command_options=$self->_command_options->{$command || ''};if (!$command_options){unshift@args,$command if defined$command;$command='show';$command_options=$self->_command_options->{$command}}my$more_opts=$self->get_options(args=>\@args,spec=>$command_options,)or _pod2usage(2);%$self=(%$opts,%$more_opts,command=>$command,args=>\@args);return$self}sub command {my$self=shift;my$command=$self->{command};my@commands=sort keys %{$self->_command_options};return if not grep {$_ eq $command}@commands;$command =~ s/[^a-z]/_/g;return$command}sub args {my$self=shift;return @{$self->{args}|| []}}sub get_options {my$self=shift;my$args={@_==1 && ref $_[0]eq 'HASH' ? %{$_[0]}: @_};my%options;my%results;while (my ($opt,$default_value)=each %{$args->{spec}}){my ($name)=$opt =~ /^([^=:!|]+)/;$name =~ s/-/_/g;$results{$name}=$default_value;$options{$opt}=\$results{$name}}if (my$fn=$args->{callback}){$options{'<>'}=sub {my$arg=shift;$fn->($arg,\%results)}}my$p=Getopt::Long::Parser->new;$p->configure($args->{config}|| 'default');return if!$p->getoptionsfromarray($args->{args},%options);return \%results}sub shell_completion {my$self=shift;my$type=lc(shift || 'bash');if ($type eq 'bash'){print <<'END'}else {warn "No such shell completion: $type\n"}}sub completions {my$self=shift;my$cword=shift;my@words=@_;my$current=$words[$cword]|| '';my$prev=$words[$cword - 1]|| '';my$reply;if ($prev eq '--format' || $prev eq '-f'){$reply=$self->_completion_formats}elsif ($current =~ /^-/){$reply=$self->_completion_options}else {if (!$self->command){$reply=[$self->_commands,@{$self->_completion_options([keys %{$self->_early_options}])}]}else {print 'file';exit 9}}local $,="\n";print grep {/^\Q$current\E/}@$reply;exit 0}sub _completion_options {my$self=shift;my$opts=shift || [$self->_options];my@options;for my$option (@$opts){my ($names,$op,$vtype)=$option =~ /^([^=:!]+)([=:!]?)(.*)$/;my@names=split(/\|/,$names);for my$name (@names){if ($op eq '!'){push@options,"--$name","--no-$name"}else {if (length($name)> 1){push@options,"--$name"}else {push@options,"-$name"}}}}return [sort@options]}sub _completion_formats {[qw(csv json json:pretty tsv yaml)]}1;
Online documentation is available at:
https://github.com/chazmcgarvey/git-codeowners/blob/$ref/README.md
APP_CODEOWNERS_OPTIONS
$fatpacked{"App/Codeowners/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_UTIL';
- package App::Codeowners::Util;use warnings;use strict;use Encode qw(decode);use Exporter qw(import);use Path::Tiny;our@EXPORT_OK=qw(colorstrip find_codeowners_in_directory find_nearest_codeowners git_ls_files git_toplevel run_command run_git stringf stringify unbackslash zip);our$VERSION='0.49';sub find_nearest_codeowners {my$path=path(shift || '.')->absolute;while (!$path->is_rootdir){my$filepath=find_codeowners_in_directory($path);return$filepath if$filepath;$path=$path->parent}}sub find_codeowners_in_directory {my$path=path(shift)or die;my@tries=([qw(CODEOWNERS)],[qw(docs CODEOWNERS)],[qw(.bitbucket CODEOWNERS)],[qw(.github CODEOWNERS)],[qw(.gitlab CODEOWNERS)],);for my$parts (@tries){my$try=$path->child(@$parts);return$try if$try->is_file}}sub run_command {my$filter;$filter=pop if ref($_[-1])eq 'CODE';print STDERR "# @_\n" if$ENV{GIT_CODEOWNERS_DEBUG};my ($child_in,$child_out);require IPC::Open2;my$pid=IPC::Open2::open2($child_out,$child_in,@_);close($child_in);binmode($child_out,':encoding(UTF-8)');my$proc=App::Codeowners::Util::Process->new(pid=>$pid,fh=>$child_out,filter=>$filter,);return wantarray ? ($proc,@{$proc->all}): $proc}sub run_git {return run_command('git',@_)}sub git_ls_files {my$dir=shift || '.';return run_git('-C',$dir,'ls-files',@_,\&_unescape_git_filepath)}sub _unescape_git_filepath {return $_ if $_ !~ /^"(.+)"$/;return decode('UTF-8',unbackslash($1))}sub git_toplevel {my$dir=shift || '.';my ($proc,$path)=run_git('-C',$dir,qw{rev-parse --show-toplevel});return if$proc->wait!=0 ||!$path;return path($path)}sub colorstrip {my$str=shift || '';$str =~ s/\e\[[\d;]*m//g;return$str}sub stringify {my$item=shift;return ref($item)eq 'ARRAY' ? join(',',@$item): $item}sub zip (\@\@) {my$max=-1;$max < $#$_ && ($max=$#$_)foreach @_;map {my$ix=$_;map $_->[$ix],@_}0 .. $max}sub _replace {my ($args,$orig,$alignment,$min_width,$max_width,$passme,$formchar)=@_;return$orig unless defined$args->{$formchar};$alignment='+' unless defined$alignment;my$replacement=$args->{$formchar};if (ref$replacement eq 'CODE'){$passme ||= "";$passme =~ tr/{}//d;$replacement=$replacement->($passme)}my$replength;if (eval {require Unicode::GCString}){my$gcstring=Unicode::GCString->new(colorstrip($replacement));$replength=$gcstring->columns}else {$replength=length colorstrip($replacement)}$min_width ||= $replength;$max_width ||= $replength;if (($replength > $min_width)&& ($replength < $max_width)){return$replacement}if ($replength > $max_width){return substr($replacement,0,$max_width)}my$padding=$min_width - $replength;$padding=0 if$padding < 0;if ($alignment eq '-'){return$replacement .' ' x $padding}return ' ' x $padding .$replacement}my$regex=qr/
+ package App::Codeowners::Util;use warnings;use strict;use Exporter qw(import);use File::Codeowners::Util;use Path::Tiny;our@EXPORT_OK=qw(colorstrip find_codeowners_in_directory find_nearest_codeowners git_ls_files git_toplevel run_command run_git stringf stringify unbackslash zip);our$VERSION='0.50';sub find_nearest_codeowners {goto&File::Codeowners::Util::find_nearest_codeowners}sub find_codeowners_in_directory {goto&File::Codeowners::Util::find_codeowners_in_directory}sub run_command {goto&File::Codeowners::Util::run_command}sub run_git {goto&File::Codeowners::Util::run_git}sub git_ls_files {goto&File::Codeowners::Util::git_ls_files}sub git_toplevel {goto&File::Codeowners::Util::git_toplevel}sub colorstrip {my$str=shift || '';$str =~ s/\e\[[\d;]*m//g;return$str}sub stringify {my$item=shift;return ref($item)eq 'ARRAY' ? join(',',@$item): $item}sub _replace {my ($args,$orig,$alignment,$min_width,$max_width,$passme,$formchar)=@_;return$orig unless defined$args->{$formchar};$alignment='+' unless defined$alignment;my$replacement=$args->{$formchar};if (ref$replacement eq 'CODE'){$passme ||= "";$passme =~ tr/{}//d;$replacement=$replacement->($passme)}my$replength;if (eval {require Unicode::GCString}){my$gcstring=Unicode::GCString->new(colorstrip($replacement));$replength=$gcstring->columns}else {$replength=length colorstrip($replacement)}$min_width ||= $replength;$max_width ||= $replength;if (($replength > $min_width)&& ($replength < $max_width)){return$replacement}if ($replength > $max_width){return substr($replacement,0,$max_width)}my$padding=$min_width - $replength;$padding=0 if$padding < 0;if ($alignment eq '-'){return$replacement .' ' x $padding}return ' ' x $padding .$replacement}my$regex=qr/
(% # leading '%'
(-)? # left-align, rather than right
(\d*)? # (optional) minimum field width
(?:\.(\d*))? # (optional) maximum field width
(\{.*?\})? # (optional) stuff inside
(\S) # actual format character
- )/x;sub stringf {my$format=shift || return;my$args=UNIVERSAL::isa($_[0],'HASH')? shift : {@_};$args->{'n'}="\n" unless exists$args->{'n'};$args->{'t'}="\t" unless exists$args->{'t'};$args->{'%'}="%" unless exists$args->{'%'};$format =~ s/$regex/_replace($args, $1, $2, $3, $4, $5, $6)/ge;return$format}my%unbackslash;sub unbackslash {my$str=shift;%unbackslash=((map {$_=>$_}('\\','"','$','@')),('r'=>"\r",'n'=>"\n",'t'=>"\t"),(map {'x' .unpack('H2',chr($_))=>chr($_)}(0..255)),(map {sprintf('%03o',$_)=>chr($_)}(0..255)),('a'=>"\x07",'b'=>"\x08",'f'=>"\x0c",'v'=>"\x0b"),)if!%unbackslash;$str =~ s/ (\A|\G|[^\\]) \\ ( [0-7]{3} | x[\da-fA-F]{2} | . ) / $1 . $unbackslash{lc($2)} /gsxe;return$str}{package App::Codeowners::Util::Process;sub new {my$class=shift;return bless {@_},$class}sub next {my$self=shift;my$line=readline($self->{fh});if (defined$line){chomp$line;if (my$filter=$self->{filter}){local $_=$line;$line=$filter->($line)}}$line}sub all {my$self=shift;chomp(my@lines=readline($self->{fh}));if (my$filter=$self->{filter}){$_=$filter->($_)for@lines}\@lines}sub wait {my$self=shift;my$pid=$self->{pid}or return;if (my$fh=$self->{fh}){close($fh);delete$self->{fh}}waitpid($pid,0);my$status=$?;print STDERR "# -> status $status\n" if$ENV{GIT_CODEOWNERS_DEBUG};delete$self->{pid};return$status}sub DESTROY {my ($self,$global_destruction)=@_;return if$global_destruction;$self->wait}}1;
+ )/x;sub stringf {my$format=shift || return;my$args=UNIVERSAL::isa($_[0],'HASH')? shift : {@_};$args->{'n'}="\n" unless exists$args->{'n'};$args->{'t'}="\t" unless exists$args->{'t'};$args->{'%'}="%" unless exists$args->{'%'};$format =~ s/$regex/_replace($args, $1, $2, $3, $4, $5, $6)/ge;return$format}my%unbackslash;sub unbackslash {my$str=shift;%unbackslash=((map {$_=>$_}('\\','"','$','@')),('r'=>"\r",'n'=>"\n",'t'=>"\t"),(map {'x' .unpack('H2',chr($_))=>chr($_)}(0..255)),(map {sprintf('%03o',$_)=>chr($_)}(0..255)),('a'=>"\x07",'b'=>"\x08",'f'=>"\x0c",'v'=>"\x0b"),)if!%unbackslash;$str =~ s/ (\A|\G|[^\\]) \\ ( [0-7]{3} | x[\da-fA-F]{2} | . ) / $1 . $unbackslash{lc($2)} /gsxe;return$str}sub zip (\@\@) {my$max=-1;$max < $#$_ && ($max=$#$_)foreach @_;map {my$ix=$_;map $_->[$ix],@_}0 .. $max}1;
APP_CODEOWNERS_UTIL
$fatpacked{"Color/ANSI/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COLOR_ANSI_UTIL';
- package Color::ANSI::Util;our$DATE='2019-08-20';our$VERSION='0.163';use 5.010001;use strict;use warnings;use Color::RGB::Util qw(rgb_diff);require Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(ansi16_to_rgb rgb_to_ansi16 rgb_to_ansi16_fg_code ansi16fg rgb_to_ansi16_bg_code ansi16bg ansi256_to_rgb rgb_to_ansi256 rgb_to_ansi256_fg_code ansi256fg rgb_to_ansi256_bg_code ansi256bg rgb_to_ansi24b_fg_code ansi24bfg rgb_to_ansi24b_bg_code ansi24bbg rgb_to_ansi_fg_code ansifg rgb_to_ansi_bg_code ansibg ansi_reset);our%SPEC;my%ansi16=(0=>'000000',1=>'800000',2=>'008000',3=>'808000',4=>'000080',5=>'800080',6=>'008080',7=>'c0c0c0',8=>'808080',9=>'ff0000',10=>'00ff00',11=>'ffff00',12=>'0000ff',13=>'ff00ff',14=>'00ffff',15=>'ffffff',);my@revansi16;for my$idx (sort {$a<=>$b}keys%ansi16){push@revansi16,[$ansi16{$idx},$idx]}my%ansi256=(%ansi16,16=>'000000',17=>'00005f',18=>'000087',19=>'0000af',20=>'0000d7',21=>'0000ff',22=>'005f00',23=>'005f5f',24=>'005f87',25=>'005faf',26=>'005fd7',27=>'005fff',28=>'008700',29=>'00875f',30=>'008787',31=>'0087af',32=>'0087d7',33=>'0087ff',34=>'00af00',35=>'00af5f',36=>'00af87',37=>'00afaf',38=>'00afd7',39=>'00afff',40=>'00d700',41=>'00d75f',42=>'00d787',43=>'00d7af',44=>'00d7d7',45=>'00d7ff',46=>'00ff00',47=>'00ff5f',48=>'00ff87',49=>'00ffaf',50=>'00ffd7',51=>'00ffff',52=>'5f0000',53=>'5f005f',54=>'5f0087',55=>'5f00af',56=>'5f00d7',57=>'5f00ff',58=>'5f5f00',59=>'5f5f5f',60=>'5f5f87',61=>'5f5faf',62=>'5f5fd7',63=>'5f5fff',64=>'5f8700',65=>'5f875f',66=>'5f8787',67=>'5f87af',68=>'5f87d7',69=>'5f87ff',70=>'5faf00',71=>'5faf5f',72=>'5faf87',73=>'5fafaf',74=>'5fafd7',75=>'5fafff',76=>'5fd700',77=>'5fd75f',78=>'5fd787',79=>'5fd7af',80=>'5fd7d7',81=>'5fd7ff',82=>'5fff00',83=>'5fff5f',84=>'5fff87',85=>'5fffaf',86=>'5fffd7',87=>'5fffff',88=>'870000',89=>'87005f',90=>'870087',91=>'8700af',92=>'8700d7',93=>'8700ff',94=>'875f00',95=>'875f5f',96=>'875f87',97=>'875faf',98=>'875fd7',99=>'875fff',100=>'878700',101=>'87875f',102=>'878787',103=>'8787af',104=>'8787d7',105=>'8787ff',106=>'87af00',107=>'87af5f',108=>'87af87',109=>'87afaf',110=>'87afd7',111=>'87afff',112=>'87d700',113=>'87d75f',114=>'87d787',115=>'87d7af',116=>'87d7d7',117=>'87d7ff',118=>'87ff00',119=>'87ff5f',120=>'87ff87',121=>'87ffaf',122=>'87ffd7',123=>'87ffff',124=>'af0000',125=>'af005f',126=>'af0087',127=>'af00af',128=>'af00d7',129=>'af00ff',130=>'af5f00',131=>'af5f5f',132=>'af5f87',133=>'af5faf',134=>'af5fd7',135=>'af5fff',136=>'af8700',137=>'af875f',138=>'af8787',139=>'af87af',140=>'af87d7',141=>'af87ff',142=>'afaf00',143=>'afaf5f',144=>'afaf87',145=>'afafaf',146=>'afafd7',147=>'afafff',148=>'afd700',149=>'afd75f',150=>'afd787',151=>'afd7af',152=>'afd7d7',153=>'afd7ff',154=>'afff00',155=>'afff5f',156=>'afff87',157=>'afffaf',158=>'afffd7',159=>'afffff',160=>'d70000',161=>'d7005f',162=>'d70087',163=>'d700af',164=>'d700d7',165=>'d700ff',166=>'d75f00',167=>'d75f5f',168=>'d75f87',169=>'d75faf',170=>'d75fd7',171=>'d75fff',172=>'d78700',173=>'d7875f',174=>'d78787',175=>'d787af',176=>'d787d7',177=>'d787ff',178=>'d7af00',179=>'d7af5f',180=>'d7af87',181=>'d7afaf',182=>'d7afd7',183=>'d7afff',184=>'d7d700',185=>'d7d75f',186=>'d7d787',187=>'d7d7af',188=>'d7d7d7',189=>'d7d7ff',190=>'d7ff00',191=>'d7ff5f',192=>'d7ff87',193=>'d7ffaf',194=>'d7ffd7',195=>'d7ffff',196=>'ff0000',197=>'ff005f',198=>'ff0087',199=>'ff00af',200=>'ff00d7',201=>'ff00ff',202=>'ff5f00',203=>'ff5f5f',204=>'ff5f87',205=>'ff5faf',206=>'ff5fd7',207=>'ff5fff',208=>'ff8700',209=>'ff875f',210=>'ff8787',211=>'ff87af',212=>'ff87d7',213=>'ff87ff',214=>'ffaf00',215=>'ffaf5f',216=>'ffaf87',217=>'ffafaf',218=>'ffafd7',219=>'ffafff',220=>'ffd700',221=>'ffd75f',222=>'ffd787',223=>'ffd7af',224=>'ffd7d7',225=>'ffd7ff',226=>'ffff00',227=>'ffff5f',228=>'ffff87',229=>'ffffaf',230=>'ffffd7',231=>'ffffff',232=>'080808',233=>'121212',234=>'1c1c1c',235=>'262626',236=>'303030',237=>'3a3a3a',238=>'444444',239=>'4e4e4e',240=>'585858',241=>'606060',242=>'666666',243=>'767676',244=>'808080',245=>'8a8a8a',246=>'949494',247=>'9e9e9e',248=>'a8a8a8',249=>'b2b2b2',250=>'bcbcbc',251=>'c6c6c6',252=>'d0d0d0',253=>'dadada',254=>'e4e4e4',255=>'eeeeee',);my@revansi256;for my$idx (sort {$a<=>$b}keys%ansi256){push@revansi256,[$ansi256{$idx},$idx]}$SPEC{ansi16_to_rgb}={v=>1.1,summary=>'Convert ANSI-16 color to RGB',description=><<'_',args=>{color=>{schema=>'color::ansi16*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'color::rgb24*',},result_naked=>1,};sub ansi16_to_rgb {my ($input)=@_;if ($input =~ /^\d+$/){if ($input >= 0 && $input <= 15){return$ansi16{$input + 0}}else {die "Invalid ANSI 16-color number '$input'"}}elsif ($input =~ /^(?:(bold|bright) \s )?(black|red|green|yellow|blue|magenta|cyan|white)$/ix){my ($bold,$col)=(lc($1 // ""),lc($2));my$i;if ($col eq 'black'){$i=0}elsif ($col eq 'red'){$i=1}elsif ($col eq 'green'){$i=2}elsif ($col eq 'yellow'){$i=3}elsif ($col eq 'blue'){$i=4}elsif ($col eq 'magenta'){$i=5}elsif ($col eq 'cyan'){$i=6}elsif ($col eq 'white'){$i=7}$i += 8 if$bold;return$ansi16{$i}}else {die "Invalid ANSI 16-color name '$input'"}}sub _rgb_to_indexed {my ($rgb,$table)=@_;my ($smallest_diff,$res);for my$e (@$table){my$diff=rgb_diff($rgb,$e->[0],'hsv_hue1');return$e->[1]if$diff==0;if (!defined($smallest_diff)|| $smallest_diff > $diff){$smallest_diff=$diff;$res=$e->[1]}}return$res}$SPEC{ansi256_to_rgb}={v=>1.1,summary=>'Convert ANSI-256 color to RGB',args=>{color=>{schema=>'color::ansi256*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'color::rgb24',},result_naked=>1,};sub ansi256_to_rgb {my ($input)=@_;$input += 0;exists($ansi256{$input})or die "Invalid ANSI 256-color index '$input'";$ansi256{$input}}$SPEC{rgb_to_ansi16}={v=>1.1,summary=>'Convert RGB to ANSI-16 color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'color::ansi16*',},result_naked=>1,};sub rgb_to_ansi16 {my ($input)=@_;_rgb_to_indexed($input,\@revansi16)}$SPEC{rgb_to_ansi256}={v=>1.1,summary=>'Convert RGB to ANSI-256 color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'color::ansi256*',},result_naked=>1,};sub rgb_to_ansi256 {my ($input)=@_;_rgb_to_indexed($input,\@revansi256)}$SPEC{rgb_to_ansi16_fg_code}={v=>1.1,summary=>'Convert RGB to ANSI-16 color escape sequence to change foreground color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi16_fg_code {my ($input)=@_;my$res=_rgb_to_indexed($input,\@revansi16);return "\e[" .($res >= 8 ? ($res+30-8).";1" : ($res+30))."m"}sub ansi16fg {goto&rgb_to_ansi16_fg_code}$SPEC{rgb_to_ansi16_bg_code}={v=>1.1,summary=>'Convert RGB to ANSI-16 color escape sequence to change background color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi16_bg_code {my ($input)=@_;my$res=_rgb_to_indexed($input,\@revansi16);return "\e[" .($res >= 8 ? ($res+40-8): ($res+40))."m"}sub ansi16bg {goto&rgb_to_ansi16_bg_code}$SPEC{rgb_to_ansi256_fg_code}={v=>1.1,summary=>'Convert RGB to ANSI-256 color escape sequence to change foreground color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi256_fg_code {my ($input)=@_;my$res=_rgb_to_indexed($input,\@revansi16);return "\e[38;5;${res}m"}sub ansi256fg {goto&rgb_to_ansi256_fg_code}$SPEC{rgb_to_ansi256_bg_code}={v=>1.1,summary=>'Convert RGB to ANSI-256 color escape sequence to change background color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi256_bg_code {my ($input)=@_;my$res=_rgb_to_indexed($input,\@revansi16);return "\e[48;5;${res}m"}sub ansi256bg {goto&rgb_to_ansi256_bg_code}$SPEC{rgb_to_ansi24b_fg_code}={v=>1.1,summary=>'Convert RGB to ANSI 24bit-color escape sequence to change foreground color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi24b_fg_code {my ($rgb)=@_;return sprintf("\e[38;2;%d;%d;%dm",hex(substr($rgb,0,2)),hex(substr($rgb,2,2)),hex(substr($rgb,4,2)))}sub ansi24bfg {goto&rgb_to_ansi24b_fg_code}$SPEC{rgb_to_ansi24b_bg_code}={v=>1.1,summary=>'Convert RGB to ANSI 24bit-color escape sequence to change background color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi24b_bg_code {my ($rgb)=@_;return sprintf("\e[48;2;%d;%d;%dm",hex(substr($rgb,0,2)),hex(substr($rgb,2,2)),hex(substr($rgb,4,2)))}sub ansi24bbg {goto&rgb_to_ansi24b_bg_code}our$_use_termdetsw=1;our$_color_depth;sub _color_depth {unless (defined$_color_depth){{if (exists$ENV{NO_COLOR}){$_color_depth=0;last}if (defined$ENV{COLOR}&&!$ENV{COLOR}){$_color_depth=0;last}if (defined$ENV{COLOR_DEPTH}){$_color_depth=$ENV{COLOR_DEPTH};last}if ($_use_termdetsw){eval {require Term::Detect::Software};if (!$@){$_color_depth=Term::Detect::Software::detect_terminal_cached()->{color_depth};last}}if ($ENV{KONSOLE_DBUS_SERVICE}){$_color_depth=2**24;last}$_color_depth=16}};$_color_depth}$SPEC{rgb_to_ansi_fg_code}={v=>1.1,summary=>'Convert RGB to ANSI color escape sequence to change foreground color',description=><<'_',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi_fg_code {my ($rgb)=@_;my$cd=_color_depth();if ($cd >= 2**24){rgb_to_ansi24b_fg_code($rgb)}elsif ($cd >= 256){rgb_to_ansi256_fg_code($rgb)}elsif ($cd >= 16){rgb_to_ansi16_fg_code($rgb)}else {""}}sub ansifg {goto&rgb_to_ansi_fg_code}$SPEC{rgb_to_ansi_bg_code}={v=>1.1,summary=>'Convert RGB to ANSI color escape sequence to change background color',description=><<'_',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi_bg_code {my ($rgb)=@_;my$cd=_color_depth();if ($cd >= 2**24){rgb_to_ansi24b_bg_code($rgb)}elsif ($cd >= 256){rgb_to_ansi256_bg_code($rgb)}else {rgb_to_ansi16_bg_code($rgb)}}sub ansibg {goto&rgb_to_ansi_bg_code}sub ansi_reset {"\e[0m"}1;
+ package Color::ANSI::Util;our$AUTHORITY='cpan:PERLANCAR';our$DATE='2020-06-09';our$DIST='Color-ANSI-Util';our$VERSION='0.164';use 5.010001;use strict;use warnings;use Color::RGB::Util qw(rgb_diff);require Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(ansi16_to_rgb rgb_to_ansi16 rgb_to_ansi16_fg_code ansi16fg rgb_to_ansi16_bg_code ansi16bg ansi256_to_rgb rgb_to_ansi256 rgb_to_ansi256_fg_code ansi256fg rgb_to_ansi256_bg_code ansi256bg rgb_to_ansi24b_fg_code ansi24bfg rgb_to_ansi24b_bg_code ansi24bbg rgb_to_ansi_fg_code ansifg rgb_to_ansi_bg_code ansibg ansi_reset);our%SPEC;my%ansi16=(0=>'000000',1=>'800000',2=>'008000',3=>'808000',4=>'000080',5=>'800080',6=>'008080',7=>'c0c0c0',8=>'808080',9=>'ff0000',10=>'00ff00',11=>'ffff00',12=>'0000ff',13=>'ff00ff',14=>'00ffff',15=>'ffffff',);my@revansi16;for my$idx (sort {$a<=>$b}keys%ansi16){push@revansi16,[$ansi16{$idx},$idx]}my%ansi256=(%ansi16,16=>'000000',17=>'00005f',18=>'000087',19=>'0000af',20=>'0000d7',21=>'0000ff',22=>'005f00',23=>'005f5f',24=>'005f87',25=>'005faf',26=>'005fd7',27=>'005fff',28=>'008700',29=>'00875f',30=>'008787',31=>'0087af',32=>'0087d7',33=>'0087ff',34=>'00af00',35=>'00af5f',36=>'00af87',37=>'00afaf',38=>'00afd7',39=>'00afff',40=>'00d700',41=>'00d75f',42=>'00d787',43=>'00d7af',44=>'00d7d7',45=>'00d7ff',46=>'00ff00',47=>'00ff5f',48=>'00ff87',49=>'00ffaf',50=>'00ffd7',51=>'00ffff',52=>'5f0000',53=>'5f005f',54=>'5f0087',55=>'5f00af',56=>'5f00d7',57=>'5f00ff',58=>'5f5f00',59=>'5f5f5f',60=>'5f5f87',61=>'5f5faf',62=>'5f5fd7',63=>'5f5fff',64=>'5f8700',65=>'5f875f',66=>'5f8787',67=>'5f87af',68=>'5f87d7',69=>'5f87ff',70=>'5faf00',71=>'5faf5f',72=>'5faf87',73=>'5fafaf',74=>'5fafd7',75=>'5fafff',76=>'5fd700',77=>'5fd75f',78=>'5fd787',79=>'5fd7af',80=>'5fd7d7',81=>'5fd7ff',82=>'5fff00',83=>'5fff5f',84=>'5fff87',85=>'5fffaf',86=>'5fffd7',87=>'5fffff',88=>'870000',89=>'87005f',90=>'870087',91=>'8700af',92=>'8700d7',93=>'8700ff',94=>'875f00',95=>'875f5f',96=>'875f87',97=>'875faf',98=>'875fd7',99=>'875fff',100=>'878700',101=>'87875f',102=>'878787',103=>'8787af',104=>'8787d7',105=>'8787ff',106=>'87af00',107=>'87af5f',108=>'87af87',109=>'87afaf',110=>'87afd7',111=>'87afff',112=>'87d700',113=>'87d75f',114=>'87d787',115=>'87d7af',116=>'87d7d7',117=>'87d7ff',118=>'87ff00',119=>'87ff5f',120=>'87ff87',121=>'87ffaf',122=>'87ffd7',123=>'87ffff',124=>'af0000',125=>'af005f',126=>'af0087',127=>'af00af',128=>'af00d7',129=>'af00ff',130=>'af5f00',131=>'af5f5f',132=>'af5f87',133=>'af5faf',134=>'af5fd7',135=>'af5fff',136=>'af8700',137=>'af875f',138=>'af8787',139=>'af87af',140=>'af87d7',141=>'af87ff',142=>'afaf00',143=>'afaf5f',144=>'afaf87',145=>'afafaf',146=>'afafd7',147=>'afafff',148=>'afd700',149=>'afd75f',150=>'afd787',151=>'afd7af',152=>'afd7d7',153=>'afd7ff',154=>'afff00',155=>'afff5f',156=>'afff87',157=>'afffaf',158=>'afffd7',159=>'afffff',160=>'d70000',161=>'d7005f',162=>'d70087',163=>'d700af',164=>'d700d7',165=>'d700ff',166=>'d75f00',167=>'d75f5f',168=>'d75f87',169=>'d75faf',170=>'d75fd7',171=>'d75fff',172=>'d78700',173=>'d7875f',174=>'d78787',175=>'d787af',176=>'d787d7',177=>'d787ff',178=>'d7af00',179=>'d7af5f',180=>'d7af87',181=>'d7afaf',182=>'d7afd7',183=>'d7afff',184=>'d7d700',185=>'d7d75f',186=>'d7d787',187=>'d7d7af',188=>'d7d7d7',189=>'d7d7ff',190=>'d7ff00',191=>'d7ff5f',192=>'d7ff87',193=>'d7ffaf',194=>'d7ffd7',195=>'d7ffff',196=>'ff0000',197=>'ff005f',198=>'ff0087',199=>'ff00af',200=>'ff00d7',201=>'ff00ff',202=>'ff5f00',203=>'ff5f5f',204=>'ff5f87',205=>'ff5faf',206=>'ff5fd7',207=>'ff5fff',208=>'ff8700',209=>'ff875f',210=>'ff8787',211=>'ff87af',212=>'ff87d7',213=>'ff87ff',214=>'ffaf00',215=>'ffaf5f',216=>'ffaf87',217=>'ffafaf',218=>'ffafd7',219=>'ffafff',220=>'ffd700',221=>'ffd75f',222=>'ffd787',223=>'ffd7af',224=>'ffd7d7',225=>'ffd7ff',226=>'ffff00',227=>'ffff5f',228=>'ffff87',229=>'ffffaf',230=>'ffffd7',231=>'ffffff',232=>'080808',233=>'121212',234=>'1c1c1c',235=>'262626',236=>'303030',237=>'3a3a3a',238=>'444444',239=>'4e4e4e',240=>'585858',241=>'606060',242=>'666666',243=>'767676',244=>'808080',245=>'8a8a8a',246=>'949494',247=>'9e9e9e',248=>'a8a8a8',249=>'b2b2b2',250=>'bcbcbc',251=>'c6c6c6',252=>'d0d0d0',253=>'dadada',254=>'e4e4e4',255=>'eeeeee',);my@revansi256;for my$idx (sort {$a<=>$b}keys%ansi256){push@revansi256,[$ansi256{$idx},$idx]}$SPEC{ansi16_to_rgb}={v=>1.1,summary=>'Convert ANSI-16 color to RGB',description=><<'_',args=>{color=>{schema=>'color::ansi16*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'color::rgb24*',},result_naked=>1,};sub ansi16_to_rgb {my ($input)=@_;if ($input =~ /^\d+$/){if ($input >= 0 && $input <= 15){return$ansi16{$input + 0}}else {die "Invalid ANSI 16-color number '$input'"}}elsif ($input =~ /^(?:(bold|bright) \s )?(black|red|green|yellow|blue|magenta|cyan|white)$/ix){my ($bold,$col)=(lc($1 // ""),lc($2));my$i;if ($col eq 'black'){$i=0}elsif ($col eq 'red'){$i=1}elsif ($col eq 'green'){$i=2}elsif ($col eq 'yellow'){$i=3}elsif ($col eq 'blue'){$i=4}elsif ($col eq 'magenta'){$i=5}elsif ($col eq 'cyan'){$i=6}elsif ($col eq 'white'){$i=7}$i += 8 if$bold;return$ansi16{$i}}else {die "Invalid ANSI 16-color name '$input'"}}sub _rgb_to_indexed {my ($rgb,$table)=@_;my ($smallest_diff,$res);for my$e (@$table){my$diff=rgb_diff($rgb,$e->[0],'hsv_hue1');return$e->[1]if$diff==0;if (!defined($smallest_diff)|| $smallest_diff > $diff){$smallest_diff=$diff;$res=$e->[1]}}return$res}$SPEC{ansi256_to_rgb}={v=>1.1,summary=>'Convert ANSI-256 color to RGB',args=>{color=>{schema=>'color::ansi256*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'color::rgb24',},result_naked=>1,};sub ansi256_to_rgb {my ($input)=@_;$input += 0;exists($ansi256{$input})or die "Invalid ANSI 256-color index '$input'";$ansi256{$input}}$SPEC{rgb_to_ansi16}={v=>1.1,summary=>'Convert RGB to ANSI-16 color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'color::ansi16*',},result_naked=>1,};sub rgb_to_ansi16 {my ($input)=@_;_rgb_to_indexed($input,\@revansi16)}$SPEC{rgb_to_ansi256}={v=>1.1,summary=>'Convert RGB to ANSI-256 color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'color::ansi256*',},result_naked=>1,};sub rgb_to_ansi256 {my ($input)=@_;_rgb_to_indexed($input,\@revansi256)}$SPEC{rgb_to_ansi16_fg_code}={v=>1.1,summary=>'Convert RGB to ANSI-16 color escape sequence to change foreground color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi16_fg_code {my ($input)=@_;my$res=_rgb_to_indexed($input,\@revansi16);return "\e[" .($res >= 8 ? ($res+30-8).";1" : ($res+30))."m"}sub ansi16fg {goto&rgb_to_ansi16_fg_code}$SPEC{rgb_to_ansi16_bg_code}={v=>1.1,summary=>'Convert RGB to ANSI-16 color escape sequence to change background color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi16_bg_code {my ($input)=@_;my$res=_rgb_to_indexed($input,\@revansi16);return "\e[" .($res >= 8 ? ($res+40-8): ($res+40))."m"}sub ansi16bg {goto&rgb_to_ansi16_bg_code}$SPEC{rgb_to_ansi256_fg_code}={v=>1.1,summary=>'Convert RGB to ANSI-256 color escape sequence to change foreground color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi256_fg_code {my ($input)=@_;my$res=_rgb_to_indexed($input,\@revansi16);return "\e[38;5;${res}m"}sub ansi256fg {goto&rgb_to_ansi256_fg_code}$SPEC{rgb_to_ansi256_bg_code}={v=>1.1,summary=>'Convert RGB to ANSI-256 color escape sequence to change background color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi256_bg_code {my ($input)=@_;my$res=_rgb_to_indexed($input,\@revansi16);return "\e[48;5;${res}m"}sub ansi256bg {goto&rgb_to_ansi256_bg_code}$SPEC{rgb_to_ansi24b_fg_code}={v=>1.1,summary=>'Convert RGB to ANSI 24bit-color escape sequence to change foreground color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi24b_fg_code {my ($rgb)=@_;return sprintf("\e[38;2;%d;%d;%dm",hex(substr($rgb,0,2)),hex(substr($rgb,2,2)),hex(substr($rgb,4,2)))}sub ansi24bfg {goto&rgb_to_ansi24b_fg_code}$SPEC{rgb_to_ansi24b_bg_code}={v=>1.1,summary=>'Convert RGB to ANSI 24bit-color escape sequence to change background color',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi24b_bg_code {my ($rgb)=@_;return sprintf("\e[48;2;%d;%d;%dm",hex(substr($rgb,0,2)),hex(substr($rgb,2,2)),hex(substr($rgb,4,2)))}sub ansi24bbg {goto&rgb_to_ansi24b_bg_code}our$_use_termdetsw=1;our$_color_depth;sub _color_depth {unless (defined$_color_depth){{if (exists$ENV{NO_COLOR}){$_color_depth=0;last}if (defined$ENV{COLOR}&&!$ENV{COLOR}){$_color_depth=0;last}if (defined$ENV{COLOR_DEPTH}){$_color_depth=$ENV{COLOR_DEPTH};last}if ($_use_termdetsw){eval {require Term::Detect::Software};if (!$@){$_color_depth=Term::Detect::Software::detect_terminal_cached()->{color_depth};last}}if ($ENV{KONSOLE_DBUS_SERVICE}){$_color_depth=2**24;last}$_color_depth=16}};$_color_depth}$SPEC{rgb_to_ansi_fg_code}={v=>1.1,summary=>'Convert RGB to ANSI color escape sequence to change foreground color',description=><<'_',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi_fg_code {my ($rgb)=@_;my$cd=_color_depth();if ($cd >= 2**24){rgb_to_ansi24b_fg_code($rgb)}elsif ($cd >= 256){rgb_to_ansi256_fg_code($rgb)}elsif ($cd >= 16){rgb_to_ansi16_fg_code($rgb)}else {""}}sub ansifg {goto&rgb_to_ansi_fg_code}$SPEC{rgb_to_ansi_bg_code}={v=>1.1,summary=>'Convert RGB to ANSI color escape sequence to change background color',description=><<'_',args=>{color=>{schema=>'color::rgb24*',req=>1,pos=>0,},},args_as=>'array',result=>{schema=>'str*',},result_naked=>1,};sub rgb_to_ansi_bg_code {my ($rgb)=@_;my$cd=_color_depth();if ($cd >= 2**24){rgb_to_ansi24b_bg_code($rgb)}elsif ($cd >= 256){rgb_to_ansi256_bg_code($rgb)}else {rgb_to_ansi16_bg_code($rgb)}}sub ansibg {goto&rgb_to_ansi_bg_code}sub ansi_reset {my$conditional=shift;if ($conditional){my$cd=_color_depth();return "" if$cd < 16}"\e[0m"}1;
Returns 6-hexdigit, e.g. 'ff00cc'.
COLOR_ANSI_UTIL
$fatpacked{"Color/RGB/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COLOR_RGB_UTIL';
- package Color::RGB::Util;our$DATE='2019-08-20';our$VERSION='0.599';use 5.010001;use strict;use warnings;require Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(assign_rgb_color assign_rgb_dark_color assign_rgb_light_color int2rgb mix_2_rgb_colors mix_rgb_colors rand_rgb_color rand_rgb_colors reverse_rgb_color rgb2grayscale rgb2hsv rgb2hsl rgb2int rgb2sepia rgb_diff rgb_distance rgb_is_dark rgb_is_light rgb_luminance tint_rgb_color);my$re_rgb=qr/\A#?([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})\z/;sub _min {$_[0]< $_[1]? $_[0]: $_[1]}sub assign_rgb_color {require Digest::SHA;my ($str)=@_;my$sha1=Digest::SHA::sha1_hex($str);substr($sha1,0,2).substr($sha1,18,2).substr($sha1,38,2)}sub assign_rgb_dark_color {my$str=shift;my$rgb=assign_rgb_color($str);rgb_is_dark($rgb)? $rgb : mix_2_rgb_colors($rgb,'000000')}sub assign_rgb_light_color {my$str=shift;my$rgb=assign_rgb_color($str);rgb_is_light($rgb)? $rgb : mix_2_rgb_colors($rgb,'ffffff')}sub int2rgb {my$int=shift;return sprintf("%02x%02x%02x",($int & 0xff0000)>> 16,($int & 0x00ff00)>> 8,($int & 0x0000ff),)}sub mix_2_rgb_colors {my ($rgb1,$rgb2,$pct)=@_;$pct //= 0.5;my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color, must be in 'ffffff' form";my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color, must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}return sprintf("%02x%02x%02x",$r1 + $pct*($r2-$r1),$g1 + $pct*($g2-$g1),$b1 + $pct*($b2-$b1),)}sub mix_rgb_colors {my (@weights,@r,@g,@b);while (@_ >= 2){my ($rgb,$weight)=splice @_,0,2;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";push@r,hex$r;push@g,hex$g;push@b,hex$b;push@weights,$weight}my$tot_r=0;for (0..$#r){$tot_r += $r[$_]*$weights[$_]}my$tot_g=0;for (0..$#g){$tot_g += $g[$_]*$weights[$_]}my$tot_b=0;for (0..$#b){$tot_b += $b[$_]*$weights[$_]}my$tot_weight=0;$tot_weight += $_ for@weights;die "Zero/negative total weight" unless$tot_weight > 0;return sprintf("%02x%02x%02x",$tot_r / $tot_weight,$tot_g / $tot_weight,$tot_b / $tot_weight,)}sub rand_rgb_color {my ($rgb1,$rgb2)=@_;$rgb1 //= '000000';my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color, must be in 'ffffff' form";$rgb2 //= 'ffffff';my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color, must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}return sprintf("%02x%02x%02x",$r1 + rand()*($r2-$r1+1),$g1 + rand()*($g2-$g1+1),$b1 + rand()*($b2-$b1+1),)}sub rand_rgb_colors {my$opts=ref $_[0]eq 'HASH' ? shift : {};my$num=shift // 1;my$light_color=exists($opts->{light_color})? $opts->{light_color}: 1;my$max_attempts=$opts->{max_attempts}// 1000;my$avoid_colors=$opts->{avoid_colors};my@res;while (@res < $num){my$num_attempts=0;my$rgb;while (1){$rgb=rand_rgb_color();my$reject=0;REJECT: {if ($light_color){do {$reject++;last}if rgb_is_dark($rgb)}elsif (defined$light_color){do {$reject++;last}if rgb_is_light($rgb)}if ($avoid_colors && ref$avoid_colors eq 'ARRAY'){do {$reject++;last}if grep {$rgb eq $_}@$avoid_colors}if ($avoid_colors && ref$avoid_colors eq 'HASH'){do {$reject++;last}if$avoid_colors->{$rgb}}}last if!$reject;last if ++$num_attempts >= $max_attempts}push@res,$rgb}@res}sub reverse_rgb_color {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color, must be in 'ffffff' form";for ($r,$g,$b){$_=hex $_}return sprintf("%02x%02x%02x",255-$r,255-$g,255-$b)}sub rgb2grayscale {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color, must be in 'ffffff' form";for ($r,$g,$b){$_=hex $_}my$avg=int(($r + $g + $b)/3);return sprintf("%02x%02x%02x",$avg,$avg,$avg)}sub rgb2int {my$rgb=shift;$rgb =~ $re_rgb or die "Invalid rgb color, must be in 'ffffff' form";hex($rgb)}sub rgb2sepia {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color, must be in 'ffffff' form";for ($r,$g,$b){$_=hex $_}my$or=($r*0.393)+ ($g*0.769)+ ($b*0.189);my$og=($r*0.349)+ ($g*0.686)+ ($b*0.168);my$ob=($r*0.272)+ ($g*0.534)+ ($b*0.131);for ($or,$og,$ob){$_=255 if $_ > 255}return sprintf("%02x%02x%02x",$or,$og,$ob)}sub rgb_diff {my ($rgb1,$rgb2,$algo)=@_;$algo //= 'euclidean';my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color, must be in 'ffffff' form";my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color, must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}my$dr2=($r1-$r2)**2;my$dg2=($g1-$g2)**2;my$db2=($b1-$b2)**2;if ($algo eq 'approx1' || $algo eq 'approx2'){my$rm=($r1 + $r2)/2;if ($algo eq 'approx1'){return (2*$dr2 + 4*$dg2 + 3*$db2 + $rm*($dr2 - $db2)/256)**0.5}else {if ($rm < 128){return (3*$dr2 + 4*$dg2 + 2*$db2)**0.5}else {return (2*$dr2 + 4*$dg2 + 3*$db2)**0.5}}}elsif ($algo eq 'hsv_euclidean' || $algo eq 'hsv_hue1'){my$hsv1=rgb2hsv($rgb1);my ($h1,$s1,$v1)=split / /,$hsv1;my$hsv2=rgb2hsv($rgb2);my ($h2,$s2,$v2)=split / /,$hsv2;my$dh2=(_min(abs($h2-$h1),360-abs($h2-$h1))/180)**2;my$ds2=($s2-$s1)**2;my$dv2=(($v2-$v1)/255.0)**2;if ($algo eq 'hsv_hue1'){return (5*$dh2 + $ds2 + $dv2)**0.5}else {return ($dh2 + $ds2 + $dv2)**0.5}}else {return ($dr2 + $dg2 + $db2)**0.5}}sub rgb_distance {my ($rgb1,$rgb2)=@_;my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color, must be in 'ffffff' form";my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color, must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}(($r1-$r2)**2 + ($g1-$g2)**2 + ($b1-$b2)**2)**0.5}sub rgb_is_dark {my ($rgb)=@_;rgb_distance($rgb,"000000")< rgb_distance($rgb,"ffffff")? 1:0}sub rgb_is_light {my ($rgb)=@_;rgb_distance($rgb,"000000")> rgb_distance($rgb,"ffffff")? 1:0}sub _rgb_luminance {my ($r,$g,$b)=@_;0.2126*$r/255 + 0.7152*$g/255 + 0.0722*$b/255}sub rgb_luminance {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color, must be in 'ffffff' form";for ($r,$g,$b){$_=hex $_}return _rgb_luminance($r,$g,$b)}sub tint_rgb_color {my ($rgb1,$rgb2,$pct)=@_;$pct //= 0.5;my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color, must be in 'ffffff' form";my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color, must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}my$lum=_rgb_luminance($r1,$g1,$b1);return sprintf("%02x%02x%02x",$r1 + $pct*($r2-$r1)*$lum,$g1 + $pct*($g2-$g1)*$lum,$b1 + $pct*($b2-$b1)*$lum,)}sub rgb2hsl {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color, must be in 'ffffff' form";for ($r,$g,$b){$_=hex($_)/255}my$max=$r;my$maxc='r';my$min=$r;if ($g > $max){$max=$g;$maxc='g'}if ($b > $max){$max=$b;$maxc='b'}if ($g < $min){$min=$g}if ($b < $min){$min=$b}my ($h,$s,$l);if ($max==$min){$h=0}elsif ($maxc eq 'r'){$h=60 * (($g - $b)/ ($max - $min))% 360}elsif ($maxc eq 'g'){$h=(60 * (($b - $r)/ ($max - $min))+ 120)}elsif ($maxc eq 'b'){$h=(60 * (($r - $g)/ ($max - $min))+ 240)}$l=($max + $min)/ 2;if ($max==$min){$s=0}elsif($l <= .5){$s=($max - $min)/ ($max + $min)}else {$s=($max - $min)/ (2 - ($max + $min))}return sprintf("%.3g %.3g %.3g",$h,$s,$l)}sub rgb2hsv {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color, must be in 'ffffff' form";for ($r,$g,$b){$_=hex($_)/255}my$max=$r;my$maxc='r';my$min=$r;if ($g > $max){$max=$g;$maxc='g'}if($b > $max){$max=$b;$maxc='b'}if($g < $min){$min=$g}if($b < $min){$min=$b}my ($h,$s,$v);if ($max==$min){$h=0}elsif ($maxc eq 'r'){$h=60 * (($g - $b)/ ($max - $min))% 360}elsif ($maxc eq 'g'){$h=(60 * (($b - $r)/ ($max - $min))+ 120)}elsif ($maxc eq 'b'){$h=(60 * (($r - $g)/ ($max - $min))+ 240)}$v=$max;if($max==0){$s=0}else {$s=1 - ($min / $max)}return sprintf("%.3g %.3g %.3g",$h,$s,$v)}1;
+ package Color::RGB::Util;our$AUTHORITY='cpan:PERLANCAR';our$DATE='2021-01-19';our$DIST='Color-RGB-Util';our$VERSION='0.604';use 5.010001;use strict;use warnings;require Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(assign_rgb_color assign_rgb_dark_color assign_rgb_light_color hsl2hsv hsl2rgb hsv2hsl hsv2rgb int2rgb mix_2_rgb_colors mix_rgb_colors rand_rgb_color rand_rgb_colors reverse_rgb_color rgb2grayscale rgb2hsv rgb2hsl rgb2int rgb2sepia rgb_diff rgb_distance rgb_is_dark rgb_is_light rgb_luminance tint_rgb_color);my$re_rgb=qr/\A#?([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})\z/;sub _min {$_[0]< $_[1]? $_[0]: $_[1]}sub _wrap_h {my$h=shift;$h %= 360 if abs($h)> 360;$h >= 0 ? $h : 360+$h}sub assign_rgb_color {require Digest::SHA;my ($str)=@_;my$sha1=Digest::SHA::sha1_hex($str);substr($sha1,0,2).substr($sha1,18,2).substr($sha1,38,2)}sub assign_rgb_dark_color {my$str=shift;my$rgb=assign_rgb_color($str);rgb_is_dark($rgb)? $rgb : mix_2_rgb_colors($rgb,'000000')}sub assign_rgb_light_color {my$str=shift;my$rgb=assign_rgb_color($str);rgb_is_light($rgb)? $rgb : mix_2_rgb_colors($rgb,'ffffff')}sub int2rgb {my$int=shift;return sprintf("%02x%02x%02x",($int & 0xff0000)>> 16,($int & 0x00ff00)>> 8,($int & 0x0000ff),)}sub mix_2_rgb_colors {my ($rgb1,$rgb2,$pct)=@_;$pct //= 0.5;my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color '$rgb1', must be in 'ffffff' form";my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color '$rgb2', must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}return sprintf("%02x%02x%02x",$r1 + $pct*($r2-$r1),$g1 + $pct*($g2-$g1),$b1 + $pct*($b2-$b1),)}sub mix_rgb_colors {my (@weights,@r,@g,@b);while (@_ >= 2){my ($rgb,$weight)=splice @_,0,2;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";push@r,hex$r;push@g,hex$g;push@b,hex$b;push@weights,$weight}my$tot_r=0;for (0..$#r){$tot_r += $r[$_]*$weights[$_]}my$tot_g=0;for (0..$#g){$tot_g += $g[$_]*$weights[$_]}my$tot_b=0;for (0..$#b){$tot_b += $b[$_]*$weights[$_]}my$tot_weight=0;$tot_weight += $_ for@weights;die "Zero/negative total weight" unless$tot_weight > 0;return sprintf("%02x%02x%02x",$tot_r / $tot_weight,$tot_g / $tot_weight,$tot_b / $tot_weight,)}sub rand_rgb_color {my ($rgb1,$rgb2)=@_;$rgb1 //= '000000';my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color '$rgb1', must be in 'ffffff' form";$rgb2 //= 'ffffff';my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color '$rgb2', must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}return sprintf("%02x%02x%02x",$r1 + rand()*($r2-$r1+1),$g1 + rand()*($g2-$g1+1),$b1 + rand()*($b2-$b1+1),)}sub rand_rgb_colors {my$opts=ref $_[0]eq 'HASH' ? shift : {};my$num=shift // 1;my$light_color=exists($opts->{light_color})? $opts->{light_color}: 1;my$max_attempts=$opts->{max_attempts}// 1000;my$avoid_colors=$opts->{avoid_colors};my$hash_prefix=$opts->{hash_prefix};my$num_check=10;my$min_distance=rgb_diff("000000","ffffff","approx2")/ 2 / $num;my@res;while (@res < $num){my$num_attempts=0;my$rgb;while (1){$rgb=rand_rgb_color();my$reject=0;REJECT: {if ($light_color){do {$reject++;last}if rgb_is_dark($rgb)}elsif (defined$light_color){do {$reject++;last}if rgb_is_light($rgb)}if ($avoid_colors && ref$avoid_colors eq 'ARRAY'){do {$reject++;last}if grep {$rgb eq $_}@$avoid_colors}if ($avoid_colors && ref$avoid_colors eq 'HASH'){do {$reject++;last}if$avoid_colors->{$rgb}}for (1..$num_check){last if@res-$_ < 0;my$prev_rgb=$res[@res - $_ ];do {$reject++;last REJECT}if rgb_diff($rgb,$prev_rgb,"approx2")< $min_distance}}last if!$reject;last if ++$num_attempts >= $max_attempts}push@res,($hash_prefix ? "#" : "").$rgb}@res}sub reverse_rgb_color {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";for ($r,$g,$b){$_=hex $_}return sprintf("%02x%02x%02x",255-$r,255-$g,255-$b)}sub rgb2grayscale {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";for ($r,$g,$b){$_=hex $_}my$avg=int(($r + $g + $b)/3);return sprintf("%02x%02x%02x",$avg,$avg,$avg)}sub rgb2int {my$rgb=shift;$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";hex($rgb)}sub rgb2sepia {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";for ($r,$g,$b){$_=hex $_}my$or=($r*0.393)+ ($g*0.769)+ ($b*0.189);my$og=($r*0.349)+ ($g*0.686)+ ($b*0.168);my$ob=($r*0.272)+ ($g*0.534)+ ($b*0.131);for ($or,$og,$ob){$_=255 if $_ > 255}return sprintf("%02x%02x%02x",$or,$og,$ob)}sub rgb_diff {my ($rgb1,$rgb2,$algo)=@_;$algo //= 'euclidean';my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color '$rgb1', must be in 'ffffff' form";my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color '$rgb2', must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}my$dr2=($r1-$r2)**2;my$dg2=($g1-$g2)**2;my$db2=($b1-$b2)**2;if ($algo eq 'approx1' || $algo eq 'approx2'){my$rm=($r1 + $r2)/2;if ($algo eq 'approx1'){return (2*$dr2 + 4*$dg2 + 3*$db2 + $rm*($dr2 - $db2)/256)**0.5}else {if ($rm < 128){return (3*$dr2 + 4*$dg2 + 2*$db2)**0.5}else {return (2*$dr2 + 4*$dg2 + 3*$db2)**0.5}}}elsif ($algo eq 'hsv_euclidean' || $algo eq 'hsv_hue1'){my$hsv1=rgb2hsv($rgb1);my ($h1,$s1,$v1)=split / /,$hsv1;my$hsv2=rgb2hsv($rgb2);my ($h2,$s2,$v2)=split / /,$hsv2;my$dh2=(_min(abs($h2-$h1),360-abs($h2-$h1))/180)**2;my$ds2=($s2-$s1)**2;my$dv2=(($v2-$v1)/255.0)**2;if ($algo eq 'hsv_hue1'){return (5*$dh2 + $ds2 + $dv2)**0.5}else {return ($dh2 + $ds2 + $dv2)**0.5}}else {return ($dr2 + $dg2 + $db2)**0.5}}sub rgb_distance {my ($rgb1,$rgb2)=@_;my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color '$rgb1', must be in 'ffffff' form";my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color '$rgb2', must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}(($r1-$r2)**2 + ($g1-$g2)**2 + ($b1-$b2)**2)**0.5}sub rgb_is_dark {my ($rgb)=@_;rgb_distance($rgb,"000000")< rgb_distance($rgb,"ffffff")? 1:0}sub rgb_is_light {my ($rgb)=@_;rgb_distance($rgb,"000000")> rgb_distance($rgb,"ffffff")? 1:0}sub _rgb_luminance {my ($r,$g,$b)=@_;0.2126*$r/255 + 0.7152*$g/255 + 0.0722*$b/255}sub rgb_luminance {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";for ($r,$g,$b){$_=hex $_}return _rgb_luminance($r,$g,$b)}sub tint_rgb_color {my ($rgb1,$rgb2,$pct)=@_;$pct //= 0.5;my ($r1,$g1,$b1)=$rgb1 =~ $re_rgb or die "Invalid rgb1 color '$rgb1', must be in 'ffffff' form";my ($r2,$g2,$b2)=$rgb2 =~ $re_rgb or die "Invalid rgb2 color '$rgb2', must be in 'ffffff' form";for ($r1,$g1,$b1,$r2,$g2,$b2){$_=hex $_}my$lum=_rgb_luminance($r1,$g1,$b1);return sprintf("%02x%02x%02x",$r1 + $pct*($r2-$r1)*$lum,$g1 + $pct*($g2-$g1)*$lum,$b1 + $pct*($b2-$b1)*$lum,)}sub rgb2hsl {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";for ($r,$g,$b){$_=hex($_)/255}my$max=$r;my$maxc='r';my$min=$r;if ($g > $max){$max=$g;$maxc='g'}if ($b > $max){$max=$b;$maxc='b'}if ($g < $min){$min=$g}if ($b < $min){$min=$b}my ($h,$s,$l);if ($max==$min){$h=0}elsif ($maxc eq 'r'){$h=60 * (($g - $b)/ ($max - $min))% 360}elsif ($maxc eq 'g'){$h=(60 * (($b - $r)/ ($max - $min))+ 120)}elsif ($maxc eq 'b'){$h=(60 * (($r - $g)/ ($max - $min))+ 240)}$l=($max + $min)/ 2;if ($max==$min){$s=0}elsif($l <= .5){$s=($max - $min)/ ($max + $min)}else {$s=($max - $min)/ (2 - ($max + $min))}return sprintf("%.3g %.3g %.3g",$h,$s,$l)}sub rgb2hsv {my ($rgb)=@_;my ($r,$g,$b)=$rgb =~ $re_rgb or die "Invalid rgb color '$rgb', must be in 'ffffff' form";for ($r,$g,$b){$_=hex($_)/255}my$max=$r;my$maxc='r';my$min=$r;if ($g > $max){$max=$g;$maxc='g'}if($b > $max){$max=$b;$maxc='b'}if($g < $min){$min=$g}if($b < $min){$min=$b}my ($h,$s,$v);if ($max==$min){$h=0}elsif ($maxc eq 'r'){$h=60 * (($g - $b)/ ($max - $min))% 360}elsif ($maxc eq 'g'){$h=(60 * (($b - $r)/ ($max - $min))+ 120)}elsif ($maxc eq 'b'){$h=(60 * (($r - $g)/ ($max - $min))+ 240)}$v=$max;if($max==0){$s=0}else {$s=1 - ($min / $max)}return sprintf("%.3g %.3g %.3g",$h,$s,$v)}sub hsl2hsv {my$hsl=shift;my ($h,$s,$l)=split / /,$hsl;$h>=0 && $h<=360 or $h=_wrap_h($h);$s>=0 && $s<=1 or die "Invalid S in HSL '$hsl', must be in 0-1";$l>=0 && $l<=1 or die "Invalid L in HSL '$hsl', must be in 0-1";my$_h=$h;my$_s;my$_v;$l *= 2;$s *= ($l <= 1)? $l : 2-$l;$_v=($l+$s)/ 2;$_s=(2*$s)/ ($l+$s);"$_h $_s $_v"}sub hsv2hsl {my$hsv=shift;my ($h,$s,$v)=split / /,$hsv;$h>=0 && $h<=360 or $h=_wrap_h($h);$s>=0 && $s<=1 or die "Invalid S in HSV '$hsv', must be in 0-1";$v>=0 && $v<=1 or die "Invalid V in HSV '$hsv', must be in 0-1";my$_h=$h;my$_s=$s * $v;my$_l=(2-$s)* $v;$_s /= $_l <= 1 ? ($_l==0 ? 1 : $_l): (2-$_l);$_l /= 2;"$_h $_s $_l"}sub hsl2rgb {hsv2rgb(hsl2hsv(shift))}sub hsv2rgb {my$hsv=shift;my ($h,$s,$v)=split / /,$hsv;$h>=0 && $h<=360 or $h=_wrap_h($h);$s>=0 && $s<=1 or die "Invalid S in HSV '$hsv', must be in 0-1";$v>=0 && $v<=1 or die "Invalid V in HSV '$hsv', must be in 0-1";my$i=int($h/60);my$f=$h/60 - $i;my$p=$v * (1-$s);my$q=$v * (1-$f*$s);my$t=$v * (1-(1-$f)*$s);my ($r,$g,$b);if ($i==0){$r=$v;$g=$t;$b=$p}elsif ($i==1){$r=$q;$g=$v;$b=$p}elsif ($i==2){$r=$p;$g=$v;$b=$t}elsif ($i==3){$r=$p;$g=$q;$b=$v}elsif ($i==4){$r=$t;$g=$p;$b=$v}else {$r=$v;$g=$p;$b=$q}return sprintf("%02x%02x%02x",$r*255,$g*255,$b*255)}1;
COLOR_RGB_UTIL
$fatpacked{"File/Codeowners.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_CODEOWNERS';
- package File::Codeowners;use v5.10.1;use warnings;use strict;use Encode qw(encode);use Path::Tiny 0.089;use Scalar::Util qw(openhandle);use Text::Gitignore qw(build_gitignore_matcher);our$VERSION='0.49';sub _croak {require Carp;Carp::croak(@_)}sub _usage {_croak("Usage: @_\n")}sub new {my$class=shift;my$self=bless {},$class}sub parse {my$self=shift;my$input=shift or _usage(q{$codeowners->parse($input)});return$self->parse_from_array($input,@_)if @_;return$self->parse_from_array($input)if ref($input)eq 'ARRAY';return$self->parse_from_string($input)if ref($input)eq 'SCALAR';return$self->parse_from_fh($input)if openhandle($input);return$self->parse_from_filepath($input)}sub parse_from_filepath {my$self=shift;my$path=shift or _usage(q{$codeowners->parse_from_filepath($filepath)});$self=bless({},$self)if!ref($self);return$self->parse_from_fh(path($path)->openr_utf8)}sub parse_from_fh {my$self=shift;my$fh=shift or _usage(q{$codeowners->parse_from_fh($fh)});$self=bless({},$self)if!ref($self);my@lines;my$parse_unowned;my%unowned;my$current_project;while (my$line=<$fh>){my$lineno=$. - 1;chomp$line;if ($line eq '### UNOWNED (File::Codeowners)'){$parse_unowned++;last}elsif ($line =~ /^\h*#(.*)/){my$comment=$1;my$project;if ($comment =~ /^\h*Project:\h*(.+?)\h*$/i){$project=$current_project=$1 || undef}$lines[$lineno]={comment=>$comment,$project ? (project=>$project): (),}}elsif ($line =~ /^\h*$/){}elsif ($line =~ /^\h*(.+?)(?<!\\)\h+(.+)/){my$pattern=$1;my@owners=$2 =~ /( (?:\@+"[^"]*") | (?:\H+) )/gx;$lines[$lineno]={pattern=>$pattern,owners=>\@owners,$current_project ? (project=>$current_project): (),}}else {die "Parse error on line $.: $line\n"}}if ($parse_unowned){while (my$line=<$fh>){chomp$line;if ($line =~ /# (.+)/){my$filepath=$1;$unowned{$filepath}++}}}$self->{lines}=\@lines;$self->{unowned}=\%unowned;return$self}sub parse_from_array {my$self=shift;my$arr=shift or _usage(q{$codeowners->parse_from_array(\@lines)});$self=bless({},$self)if!ref($self);$arr=[$arr,@_]if @_;my$str=join("\n",@$arr);return$self->parse_from_string(\$str)}sub parse_from_string {my$self=shift;my$str=shift or _usage(q{$codeowners->parse_from_string(\$string)});$self=bless({},$self)if!ref($self);my$ref=ref($str)eq 'SCALAR' ? $str : \$str;open(my$fh,'<:encoding(UTF-8)',$ref)or die "open failed: $!";return$self->parse_from_fh($fh)}sub write_to_filepath {my$self=shift;my$path=shift or _usage(q{$codeowners->write_to_filepath($filepath)});path($path)->spew_utf8([map {"$_\n"}@{$self->write_to_array}])}sub write_to_fh {my$self=shift;my$fh=shift or _usage(q{$codeowners->write_to_fh($fh)});my$charset=shift;for my$line (@{$self->write_to_array($charset)}){print$fh "$line\n"}}sub write_to_string {my$self=shift;my$charset=shift;my$str=join("\n",@{$self->write_to_array($charset)})."\n";return \$str}sub write_to_array {my$self=shift;my$charset=shift;my@format;for my$line (@{$self->_lines}){if (my$comment=$line->{comment}){push@format,"#$comment"}elsif (my$pattern=$line->{pattern}){my$owners=join(' ',@{$line->{owners}});push@format,"$pattern $owners"}else {push@format,''}}my@unowned=sort keys %{$self->_unowned};if (@unowned){push@format,'' if$format[-1];push@format,'### UNOWNED (File::Codeowners)';for my$unowned (@unowned){push@format,"# $unowned"}}if (defined$charset){$_=encode($charset,$_)for@format}return \@format}sub match {my$self=shift;my$filepath=shift or _usage(q{$codeowners->match($filepath)});my$lines=$self->{match_lines}||= [reverse grep {($_ || {})->{pattern}}@{$self->_lines}];for my$line (@$lines){my$matcher=$line->{matcher}||= build_gitignore_matcher([$line->{pattern}]);return {pattern=>$line->{pattern},owners=>[@{$line->{owners}|| []}],$line->{project}? (project=>$line->{project}): (),}if$matcher->($filepath)}return undef}sub owners {my$self=shift;my$pattern=shift;return$self->{owners}if!$pattern && $self->{owners};my%owners;for my$line (@{$self->_lines}){next if$pattern && $line->{pattern}&& $pattern ne $line->{pattern};$owners{$_}++ for (@{$line->{owners}|| []})}my$owners=[sort keys%owners];$self->{owners}=$owners if!$pattern;return$owners}sub patterns {my$self=shift;my$owner=shift;return$self->{patterns}if!$owner && $self->{patterns};my%patterns;for my$line (@{$self->_lines}){next if$owner &&!grep {$_ eq $owner}@{$line->{owners}|| []};my$pattern=$line->{pattern};$patterns{$pattern}++ if$pattern}my$patterns=[sort keys%patterns];$self->{patterns}=$patterns if!$owner;return$patterns}sub projects {my$self=shift;return$self->{projects}if$self->{projects};my%projects;for my$line (@{$self->_lines}){my$project=$line->{project};$projects{$project}++ if$project}my$projects=[sort keys%projects];$self->{projects}=$projects;return$projects}sub update_owners {my$self=shift;my$pattern=shift;my$owners=shift;$pattern && $owners or _usage(q{$codeowners->update_owners($pattern => \@owners)});$owners=[$owners]if ref($owners)ne 'ARRAY';$self->_clear;my$count=0;for my$line (@{$self->_lines}){next if!$line->{pattern};next if$pattern ne $line->{pattern};$line->{owners}=[@$owners];++$count}return$count}sub update_owners_by_project {my$self=shift;my$project=shift;my$owners=shift;$project && $owners or _usage(q{$codeowners->update_owners_by_project($project => \@owners)});$owners=[$owners]if ref($owners)ne 'ARRAY';$self->_clear;my$count=0;for my$line (@{$self->_lines}){next if!$line->{project}||!$line->{owners};next if$project ne $line->{project};$line->{owners}=[@$owners];++$count}return$count}sub rename_owner {my$self=shift;my$old_owner=shift;my$new_owner=shift;$old_owner && $new_owner or _usage(q{$codeowners->rename_owner($owner => $new_owner)});$self->_clear;my$count=0;for my$line (@{$self->_lines}){next if!exists$line->{owners};for (my$i=0;$i < @{$line->{owners}};++$i){next if$line->{owners}[$i]ne $old_owner;$line->{owners}[$i]=$new_owner;++$count}}return$count}sub rename_project {my$self=shift;my$old_project=shift;my$new_project=shift;$old_project && $new_project or _usage(q{$codeowners->rename_project($project => $new_project)});$self->_clear;my$count=0;for my$line (@{$self->_lines}){next if!exists$line->{project}|| $old_project ne $line->{project};$line->{project}=$new_project;$line->{comment}=" Project: $new_project" if exists$line->{comment};++$count}return$count}sub append {my$self=shift;$self->_clear;push @{$self->_lines},(@_ ? {@_}: undef)}sub prepend {my$self=shift;$self->_clear;unshift @{$self->_lines},(@_ ? {@_}: undef)}sub unowned {my$self=shift;[sort keys %{$self->{unowned}|| {}}]}sub add_unowned {my$self=shift;$self->_unowned->{$_}++ for @_}sub remove_unowned {my$self=shift;delete$self->_unowned->{$_}for @_}sub is_unowned {my$self=shift;my$filepath=shift;$self->_unowned->{$filepath}}sub clear_unowned {my$self=shift;$self->{unowned}={}}sub _lines {shift->{lines}||= []}sub _unowned {shift->{unowned}||= {}}sub _clear {my$self=shift;delete$self->{match_lines};delete$self->{owners};delete$self->{patterns};delete$self->{projects}}1;
+ package File::Codeowners;use v5.10.1;use warnings;use strict;use Encode qw(encode);use Path::Tiny 0.089;use Scalar::Util qw(openhandle);use Text::Gitignore qw(build_gitignore_matcher);our$VERSION='0.51';sub _croak {require Carp;Carp::croak(@_)}sub _usage {_croak("Usage: @_\n")}sub new {my$class=shift;my$self=bless {},$class}sub parse {my$self=shift;my$input=shift or _usage(q{$codeowners->parse($input)});return$self->parse_from_array($input,@_)if @_;return$self->parse_from_array($input)if ref($input)eq 'ARRAY';return$self->parse_from_string($input)if ref($input)eq 'SCALAR';return$self->parse_from_fh($input)if openhandle($input);return$self->parse_from_filepath($input)}sub parse_from_filepath {my$self=shift;my$path=shift or _usage(q{$codeowners->parse_from_filepath($filepath)});$self=bless({},$self)if!ref($self);return$self->parse_from_fh(path($path)->openr_utf8)}sub parse_from_fh {my$self=shift;my$fh=shift or _usage(q{$codeowners->parse_from_fh($fh)});$self=bless({},$self)if!ref($self);my@lines;my$parse_unowned;my%unowned;my$current_project;while (my$line=<$fh>){my$lineno=$. - 1;chomp$line;if ($line eq '### UNOWNED (File::Codeowners)'){$parse_unowned++;last}elsif ($line =~ /^\h*#(.*)/){my$comment=$1;my$project;if ($comment =~ /^\h*Project:\h*(.+?)\h*$/i){$project=$current_project=$1 || undef}$lines[$lineno]={comment=>$comment,$project ? (project=>$project): (),}}elsif ($line =~ /^\h*$/){}elsif ($line =~ /^\h*(.+?)(?<!\\)\h+(.+)/){my$pattern=$1;my@owners=$2 =~ /( (?:\@+"[^"]*") | (?:\H+) )/gx;$lines[$lineno]={pattern=>$pattern,owners=>\@owners,$current_project ? (project=>$current_project): (),}}else {die "Parse error on line $.: $line\n"}}if ($parse_unowned){while (my$line=<$fh>){chomp$line;if ($line =~ /# (.+)/){my$filepath=$1;$unowned{$filepath}++}}}$self->{lines}=\@lines;$self->{unowned}=\%unowned;return$self}sub parse_from_array {my$self=shift;my$arr=shift or _usage(q{$codeowners->parse_from_array(\@lines)});$self=bless({},$self)if!ref($self);$arr=[$arr,@_]if @_;my$str=join("\n",@$arr);return$self->parse_from_string(\$str)}sub parse_from_string {my$self=shift;my$str=shift or _usage(q{$codeowners->parse_from_string(\$string)});$self=bless({},$self)if!ref($self);my$ref=ref($str)eq 'SCALAR' ? $str : \$str;open(my$fh,'<:encoding(UTF-8)',$ref)or die "open failed: $!";return$self->parse_from_fh($fh)}sub write_to_filepath {my$self=shift;my$path=shift or _usage(q{$codeowners->write_to_filepath($filepath)});path($path)->spew_utf8([map {"$_\n"}@{$self->write_to_array}])}sub write_to_fh {my$self=shift;my$fh=shift or _usage(q{$codeowners->write_to_fh($fh)});my$charset=shift;for my$line (@{$self->write_to_array($charset)}){print$fh "$line\n"}}sub write_to_string {my$self=shift;my$charset=shift;my$str=join("\n",@{$self->write_to_array($charset)})."\n";return \$str}sub write_to_array {my$self=shift;my$charset=shift;my@format;for my$line (@{$self->_lines}){if (my$comment=$line->{comment}){push@format,"#$comment"}elsif (my$pattern=$line->{pattern}){my$owners=join(' ',@{$line->{owners}});push@format,"$pattern $owners"}else {push@format,''}}my@unowned=sort keys %{$self->_unowned};if (@unowned){push@format,'' if$format[-1];push@format,'### UNOWNED (File::Codeowners)';for my$unowned (@unowned){push@format,"# $unowned"}}if (defined$charset){$_=encode($charset,$_)for@format}return \@format}sub match {my$self=shift;my$filepath=shift or _usage(q{$codeowners->match($filepath)});my$lines=$self->{match_lines}||= [reverse grep {($_ || {})->{pattern}}@{$self->_lines}];for my$line (@$lines){my$matcher=$line->{matcher}||= build_gitignore_matcher([$line->{pattern}]);return {pattern=>$line->{pattern},owners=>[@{$line->{owners}|| []}],$line->{project}? (project=>$line->{project}): (),}if$matcher->($filepath)}return undef}sub owners {my$self=shift;my$pattern=shift;return$self->{owners}if!$pattern && $self->{owners};my%owners;for my$line (@{$self->_lines}){next if$pattern && $line->{pattern}&& $pattern ne $line->{pattern};$owners{$_}++ for (@{$line->{owners}|| []})}my$owners=[sort keys%owners];$self->{owners}=$owners if!$pattern;return$owners}sub patterns {my$self=shift;my$owner=shift;return$self->{patterns}if!$owner && $self->{patterns};my%patterns;for my$line (@{$self->_lines}){next if$owner &&!grep {$_ eq $owner}@{$line->{owners}|| []};my$pattern=$line->{pattern};$patterns{$pattern}++ if$pattern}my$patterns=[sort keys%patterns];$self->{patterns}=$patterns if!$owner;return$patterns}sub projects {my$self=shift;return$self->{projects}if$self->{projects};my%projects;for my$line (@{$self->_lines}){my$project=$line->{project};$projects{$project}++ if$project}my$projects=[sort keys%projects];$self->{projects}=$projects;return$projects}sub update_owners {my$self=shift;my$pattern=shift;my$owners=shift;$pattern && $owners or _usage(q{$codeowners->update_owners($pattern => \@owners)});$owners=[$owners]if ref($owners)ne 'ARRAY';$self->_clear;my$count=0;for my$line (@{$self->_lines}){next if!$line->{pattern};next if$pattern ne $line->{pattern};$line->{owners}=[@$owners];++$count}return$count}sub update_owners_by_project {my$self=shift;my$project=shift;my$owners=shift;$project && $owners or _usage(q{$codeowners->update_owners_by_project($project => \@owners)});$owners=[$owners]if ref($owners)ne 'ARRAY';$self->_clear;my$count=0;for my$line (@{$self->_lines}){next if!$line->{project}||!$line->{owners};next if$project ne $line->{project};$line->{owners}=[@$owners];++$count}return$count}sub rename_owner {my$self=shift;my$old_owner=shift;my$new_owner=shift;$old_owner && $new_owner or _usage(q{$codeowners->rename_owner($owner => $new_owner)});$self->_clear;my$count=0;for my$line (@{$self->_lines}){next if!exists$line->{owners};for (my$i=0;$i < @{$line->{owners}};++$i){next if$line->{owners}[$i]ne $old_owner;$line->{owners}[$i]=$new_owner;++$count}}return$count}sub rename_project {my$self=shift;my$old_project=shift;my$new_project=shift;$old_project && $new_project or _usage(q{$codeowners->rename_project($project => $new_project)});$self->_clear;my$count=0;for my$line (@{$self->_lines}){next if!exists$line->{project}|| $old_project ne $line->{project};$line->{project}=$new_project;$line->{comment}=" Project: $new_project" if exists$line->{comment};++$count}return$count}sub append {my$self=shift;$self->_clear;push @{$self->_lines},(@_ ? {@_}: undef)}sub prepend {my$self=shift;$self->_clear;unshift @{$self->_lines},(@_ ? {@_}: undef)}sub unowned {my$self=shift;[sort keys %{$self->{unowned}|| {}}]}sub add_unowned {my$self=shift;$self->_unowned->{$_}++ for @_}sub remove_unowned {my$self=shift;delete$self->_unowned->{$_}for @_}sub is_unowned {my$self=shift;my$filepath=shift;$self->_unowned->{$filepath}}sub clear_unowned {my$self=shift;$self->{unowned}={}}sub _lines {shift->{lines}||= []}sub _unowned {shift->{unowned}||= {}}sub _clear {my$self=shift;delete$self->{match_lines};delete$self->{owners};delete$self->{patterns};delete$self->{projects}}1;
FILE_CODEOWNERS
+$fatpacked{"File/Codeowners/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_CODEOWNERS_UTIL';
+ package File::Codeowners::Util;use warnings;use strict;use Encode qw(decode);use Exporter qw(import);use Path::Tiny;our@EXPORT_OK=qw(find_codeowners_in_directory find_nearest_codeowners git_ls_files git_toplevel run_command run_git);our$VERSION='0.51';sub find_nearest_codeowners {my$path=path(shift || '.')->absolute;while (!$path->is_rootdir){my$filepath=find_codeowners_in_directory($path);return$filepath if$filepath;$path=$path->parent}}sub find_codeowners_in_directory {my$path=path(shift)or die;my@tries=([qw(CODEOWNERS)],[qw(docs CODEOWNERS)],[qw(.bitbucket CODEOWNERS)],[qw(.github CODEOWNERS)],[qw(.gitlab CODEOWNERS)],);for my$parts (@tries){my$try=$path->child(@$parts);return$try if$try->is_file}}sub run_command {my$filter;$filter=pop if ref($_[-1])eq 'CODE';print STDERR "# @_\n" if$ENV{FILE_CODEOWNERS_DEBUG};my ($child_in,$child_out);require IPC::Open2;my$pid=IPC::Open2::open2($child_out,$child_in,@_);close($child_in);binmode($child_out,':encoding(UTF-8)');my$proc=File::Codeowners::Util::Process->new(pid=>$pid,fh=>$child_out,filter=>$filter,);return wantarray ? ($proc,@{$proc->all}): $proc}sub run_git {return run_command('git',@_)}sub git_toplevel {my$dir=shift || '.';my ($proc,$path)=run_git('-C',$dir,qw{rev-parse --show-toplevel});return if$proc->wait!=0 ||!$path;return path($path)}sub git_ls_files {my$dir=shift || '.';return run_git('-C',$dir,'ls-files',@_,\&_unescape_git_filepath)}sub _unescape_git_filepath {return $_ if $_ !~ /^"(.+)"$/;return decode('UTF-8',_unbackslash($1))}my%unbackslash;sub _unbackslash {my$str=shift;%unbackslash=((map {$_=>$_}('\\','"','$','@')),('r'=>"\r",'n'=>"\n",'t'=>"\t"),(map {'x' .unpack('H2',chr($_))=>chr($_)}(0..255)),(map {sprintf('%03o',$_)=>chr($_)}(0..255)),('a'=>"\x07",'b'=>"\x08",'f'=>"\x0c",'v'=>"\x0b"),)if!%unbackslash;$str =~ s/ (\A|\G|[^\\]) \\ ( [0-7]{3} | x[\da-fA-F]{2} | . ) / $1 . $unbackslash{lc($2)} /gsxe;return$str}{package File::Codeowners::Util::Process;sub new {my$class=shift;return bless {@_},$class}sub next {my$self=shift;my$line=readline($self->{fh});if (defined$line){chomp$line;if (my$filter=$self->{filter}){local $_=$line;$line=$filter->($line)}}$line}sub all {my$self=shift;chomp(my@lines=readline($self->{fh}));if (my$filter=$self->{filter}){$_=$filter->($_)for@lines}\@lines}sub wait {my$self=shift;my$pid=$self->{pid}or return;if (my$fh=$self->{fh}){close($fh);delete$self->{fh}}waitpid($pid,0);my$status=$?;print STDERR "# -> status $status\n" if$ENV{FILE_CODEOWNERS_DEBUG};delete$self->{pid};return$status}sub DESTROY {my ($self,$global_destruction)=@_;return if$global_destruction;$self->wait}}1;
+FILE_CODEOWNERS_UTIL
+
$fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH';
- package File::Which;use strict;use warnings;use Exporter ();use File::Spec ();our$VERSION='1.23';our@ISA='Exporter';our@EXPORT='which';our@EXPORT_OK='where';use constant IS_VMS=>($^O eq 'VMS');use constant IS_MAC=>($^O eq 'MacOS');use constant IS_WIN=>($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');use constant IS_DOS=>IS_WIN();use constant IS_CYG=>($^O eq 'cygwin' || $^O eq 'msys');our$IMPLICIT_CURRENT_DIR=IS_WIN || IS_VMS || IS_MAC;my@PATHEXT=('');if (IS_WIN){if ($ENV{PATHEXT}){push@PATHEXT,split ';',$ENV{PATHEXT}}else {push@PATHEXT,qw{.com .exe .bat}}}elsif (IS_VMS){push@PATHEXT,qw{.exe .com}}elsif (IS_CYG){push@PATHEXT,qw{.exe .com}}sub which {my ($exec)=@_;return undef unless defined$exec;return undef if$exec eq '';my$all=wantarray;my@results=();if (IS_VMS){my$symbol=`SHOW SYMBOL $exec`;chomp($symbol);unless ($?){return$symbol unless$all;push@results,$symbol}}if (IS_MAC){my@aliases=split /\,/,$ENV{Aliases};for my$alias (@aliases){if (lc($alias)eq lc($exec)){chomp(my$file=`Alias $alias`);last unless$file;return$file unless$all;push@results,$file;last}}}return$exec if!IS_VMS and!IS_MAC and!IS_WIN and $exec =~ /\// and -f $exec and -x $exec;my@path;if($^O eq 'MSWin32'){@path=split(';',$ENV{PATH});s/"//g for@path;@path=grep length,@path}else {@path=File::Spec->path}if ($IMPLICIT_CURRENT_DIR){unshift@path,File::Spec->curdir}for my$base (map {File::Spec->catfile($_,$exec)}@path){for my$ext (@PATHEXT){my$file=$base.$ext;next if -d $file;if (-x _ or (IS_MAC || ((IS_WIN or IS_CYG)and grep {$file =~ /$_\z/i}@PATHEXT[1..$#PATHEXT])and -e _)){return$file unless$all;push@results,$file}}}if ($all){return@results}else {return undef}}sub where {my@res=which($_[0]);return@res}1;
+ package File::Which;use strict;use warnings;use base qw(Exporter);use File::Spec ();our$VERSION='1.24';our@EXPORT='which';our@EXPORT_OK='where';use constant IS_VMS=>($^O eq 'VMS');use constant IS_MAC=>($^O eq 'MacOS');use constant IS_WIN=>($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');use constant IS_DOS=>IS_WIN();use constant IS_CYG=>($^O eq 'cygwin' || $^O eq 'msys');our$IMPLICIT_CURRENT_DIR=IS_WIN || IS_VMS || IS_MAC;my@PATHEXT=('');if (IS_WIN){if ($ENV{PATHEXT}){push@PATHEXT,split /;/,$ENV{PATHEXT}}else {push@PATHEXT,qw{.com .exe .bat}}}elsif (IS_VMS){push@PATHEXT,qw{.exe .com}}elsif (IS_CYG){push@PATHEXT,qw{.exe .com}}sub which {my ($exec)=@_;return undef unless defined$exec;return undef if$exec eq '';my$all=wantarray;my@results=();if (IS_VMS){my$symbol=`SHOW SYMBOL $exec`;chomp($symbol);unless ($?){return$symbol unless$all;push@results,$symbol}}if (IS_MAC){my@aliases=split /\,/,$ENV{Aliases};for my$alias (@aliases){if (lc($alias)eq lc($exec)){chomp(my$file=`Alias $alias`);last unless$file;return$file unless$all;push@results,$file;last}}}return$exec if!IS_VMS and!IS_MAC and!IS_WIN and $exec =~ /\// and -f $exec and -x $exec;my@path;if($^O eq 'MSWin32'){@path=split /;/,$ENV{PATH};s/"//g for@path;@path=grep length,@path}else {@path=File::Spec->path}if ($IMPLICIT_CURRENT_DIR){unshift@path,File::Spec->curdir}for my$base (map {File::Spec->catfile($_,$exec)}@path){for my$ext (@PATHEXT){my$file=$base.$ext;next if -d $file;if (-x _ or (IS_MAC || ((IS_WIN or IS_CYG)and grep {$file =~ /$_\z/i}@PATHEXT[1..$#PATHEXT])and -e _)){return$file unless$all;push@results,$file}}}if ($all){return@results}else {return undef}}sub where {my@res=which($_[0]);return@res}1;
FILE_WHICH
$fatpacked{"Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG';
- use 5.004;use strict;use warnings;package Getopt::Long;use vars qw($VERSION);$VERSION=2.51;use vars qw($VERSION_STRING);$VERSION_STRING="2.51";use Exporter;use vars qw(@ISA @EXPORT @EXPORT_OK);@ISA=qw(Exporter);sub GetOptions(@);sub GetOptionsFromArray(@);sub GetOptionsFromString(@);sub Configure(@);sub HelpMessage(@);sub VersionMessage(@);BEGIN {@EXPORT=qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);@EXPORT_OK=qw(&HelpMessage &VersionMessage &Configure &GetOptionsFromArray &GetOptionsFromString)}use vars@EXPORT,@EXPORT_OK;use vars qw($error $debug $major_version $minor_version);use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough);use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);my$bundling_values;sub config(@);sub ConfigDefaults();sub ParseOptionSpec($$);sub OptCtl($);sub FindOption($$$$$);sub ValidValue ($$$$$);my$requested_version=0;sub ConfigDefaults() {if (defined$ENV{"POSIXLY_CORRECT"}){$genprefix="(--|-)";$autoabbrev=0;$bundling=0;$getopt_compat=0;$order=$REQUIRE_ORDER}else {$genprefix="(--|-|\\+)";$autoabbrev=1;$bundling=0;$getopt_compat=1;$order=$PERMUTE}$debug=0;$error=0;$ignorecase=1;$passthrough=0;$gnu_compat=0;$longprefix="(--)";$bundling_values=0}sub import {my$pkg=shift;my@syms=();my@config=();my$dest=\@syms;for (@_){if ($_ eq ':config'){$dest=\@config;next}push(@$dest,$_)}local$Exporter::ExportLevel=1;push(@syms,qw(&GetOptions))if@syms;$requested_version=0;$pkg->SUPER::import(@syms);Configure(@config)if@config}($REQUIRE_ORDER,$PERMUTE,$RETURN_IN_ORDER)=(0..2);($major_version,$minor_version)=$VERSION =~ /^(\d+)\.(\d+)/;ConfigDefaults();package Getopt::Long::Parser;my$default_config=do {Getopt::Long::Configure ()};sub new {my$that=shift;my$class=ref($that)|| $that;my%atts=@_;my$self={caller_pkg=>(caller)[0]};bless ($self,$class);if (defined$atts{config}){my$save=Getopt::Long::Configure ($default_config,@{$atts{config}});$self->{settings}=Getopt::Long::Configure ($save);delete ($atts{config})}else {$self->{settings}=$default_config}if (%atts){die(__PACKAGE__.": unhandled attributes: ".join(" ",sort(keys(%atts)))."\n")}$self}sub configure {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings},@_);$self->{settings}=Getopt::Long::Configure ($save)}sub getoptions {my ($self)=shift;return$self->getoptionsfromarray(\@ARGV,@_)}sub getoptionsfromarray {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings});my$ret=0;$Getopt::Long::caller=$self->{caller_pkg};eval {local ($SIG{__DIE__})='DEFAULT';$ret=Getopt::Long::GetOptionsFromArray (@_)};Getopt::Long::Configure ($save);die ($@)if $@;return$ret}package Getopt::Long;use constant CTL_TYPE=>0;use constant CTL_CNAME=>1;use constant CTL_DEFAULT=>2;use constant CTL_DEST=>3;use constant CTL_DEST_SCALAR=>0;use constant CTL_DEST_ARRAY=>1;use constant CTL_DEST_HASH=>2;use constant CTL_DEST_CODE=>3;use constant CTL_AMIN=>4;use constant CTL_AMAX=>5;use constant PAT_INT=>"[-+]?_*[0-9][0-9_]*";use constant PAT_XINT=>"(?:"."[-+]?_*[1-9][0-9_]*"."|"."0x_*[0-9a-f][0-9a-f_]*"."|"."0b_*[01][01_]*"."|"."0[0-7_]*".")";use constant PAT_FLOAT=>"[-+]?"."(?=[0-9.])"."[0-9_]*"."(\.[0-9_]+)?"."([eE][-+]?[0-9_]+)?";sub GetOptions(@) {unshift(@_,\@ARGV);goto&GetOptionsFromArray}sub GetOptionsFromString(@) {my ($string)=shift;require Text::ParseWords;my$args=[Text::ParseWords::shellwords($string)];$caller ||= (caller)[0];my$ret=GetOptionsFromArray($args,@_);return ($ret,$args)if wantarray;if (@$args){$ret=0;warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n")}$ret}sub GetOptionsFromArray(@) {my ($argv,@optionlist)=@_;my$argend='--';my%opctl=();my$pkg=$caller || (caller)[0];my@ret=();my%linkage;my$userlinkage;my$opt;my$prefix=$genprefix;$error='';if ($debug){local ($^W)=0;print STDERR ("Getopt::Long $Getopt::Long::VERSION_STRING ","called from package \"$pkg\".","\n ","argv: ",defined($argv)? UNIVERSAL::isa($argv,'ARRAY')? "(@$argv)" : $argv : "<undef>","\n ","autoabbrev=$autoabbrev,"."bundling=$bundling,","bundling_values=$bundling_values,","getopt_compat=$getopt_compat,","gnu_compat=$gnu_compat,","order=$order,","\n ","ignorecase=$ignorecase,","requested_version=$requested_version,","passthrough=$passthrough,","genprefix=\"$genprefix\",","longprefix=\"$longprefix\".","\n")}$userlinkage=undef;if (@optionlist && ref($optionlist[0])and UNIVERSAL::isa($optionlist[0],'HASH')){$userlinkage=shift (@optionlist);print STDERR ("=> user linkage: $userlinkage\n")if$debug}if (@optionlist && $optionlist[0]=~ /^\W+$/ &&!($optionlist[0]eq '<>' && @optionlist > 0 && ref($optionlist[1]))){$prefix=shift (@optionlist);$prefix =~ s/(\W)/\\$1/g;$prefix="([" .$prefix ."])";print STDERR ("=> prefix=\"$prefix\"\n")if$debug}%opctl=();while (@optionlist){my$opt=shift (@optionlist);unless (defined($opt)){$error .= "Undefined argument in option spec\n";next}$opt=$+ if$opt =~ /^$prefix+(.*)$/s;if ($opt eq '<>'){if ((defined$userlinkage)&&!(@optionlist > 0 && ref($optionlist[0]))&& (exists$userlinkage->{$opt})&& ref($userlinkage->{$opt})){unshift (@optionlist,$userlinkage->{$opt})}unless (@optionlist > 0 && ref($optionlist[0])&& ref($optionlist[0])eq 'CODE'){$error .= "Option spec <> requires a reference to a subroutine\n";shift (@optionlist)if@optionlist && ref($optionlist[0]);next}$linkage{'<>'}=shift (@optionlist);next}my ($name,$orig)=ParseOptionSpec ($opt,\%opctl);unless (defined$name){$error .= $orig;shift (@optionlist)if@optionlist && ref($optionlist[0]);next}if (defined$userlinkage){unless (@optionlist > 0 && ref($optionlist[0])){if (exists$userlinkage->{$orig}&& ref($userlinkage->{$orig})){print STDERR ("=> found userlinkage for \"$orig\": ","$userlinkage->{$orig}\n")if$debug;unshift (@optionlist,$userlinkage->{$orig})}else {next}}}if (@optionlist > 0 && ref($optionlist[0])){print STDERR ("=> link \"$orig\" to $optionlist[0]\n")if$debug;my$rl=ref($linkage{$orig}=shift (@optionlist));if ($rl eq "ARRAY"){$opctl{$name}[CTL_DEST]=CTL_DEST_ARRAY}elsif ($rl eq "HASH"){$opctl{$name}[CTL_DEST]=CTL_DEST_HASH}elsif ($rl eq "SCALAR" || $rl eq "REF"){}elsif ($rl eq "CODE"){}else {$error .= "Invalid option linkage for \"$opt\"\n"}}else {my$ov=$orig;$ov =~ s/\W/_/g;if ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;")}elsif ($opctl{$name}[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;")}else {print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;")}}if ($opctl{$name}[CTL_TYPE]eq 'I' && ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY || $opctl{$name}[CTL_DEST]==CTL_DEST_HASH)){$error .= "Invalid option linkage for \"$opt\"\n"}}$error .= "GetOptionsFromArray: 1st parameter is not an array reference\n" unless$argv && UNIVERSAL::isa($argv,'ARRAY');die ($error)if$error;$error=0;if (defined($auto_version)? $auto_version : ($requested_version >= 2.3203)){if (!defined($opctl{version})){$opctl{version}=['','version',0,CTL_DEST_CODE,undef];$linkage{version}=\&VersionMessage}$auto_version=1}if (defined($auto_help)? $auto_help : ($requested_version >= 2.3203)){if (!defined($opctl{help})&&!defined($opctl{'?'})){$opctl{help}=$opctl{'?'}=['','help',0,CTL_DEST_CODE,undef];$linkage{help}=\&HelpMessage}$auto_help=1}if ($debug){my ($arrow,$k,$v);$arrow="=> ";while (($k,$v)=each(%opctl)){print STDERR ($arrow,"\$opctl{$k} = $v ",OptCtl($v),"\n");$arrow=" "}}my$goon=1;while ($goon && @$argv > 0){$opt=shift (@$argv);print STDERR ("=> arg \"",$opt,"\"\n")if$debug;if (defined($opt)&& $opt eq $argend){push (@ret,$argend)if$passthrough;last}my$tryopt=$opt;my$found;my$key;my$arg;my$ctl;($found,$opt,$ctl,$arg,$key)=FindOption ($argv,$prefix,$argend,$opt,\%opctl);if ($found){next unless defined$opt;my$argcnt=0;while (defined$arg){print STDERR ("=> cname for \"$opt\" is ")if$debug;$opt=$ctl->[CTL_CNAME];print STDERR ("\"$ctl->[CTL_CNAME]\"\n")if$debug;if (defined$linkage{$opt}){print STDERR ("=> ref(\$L{$opt}) -> ",ref($linkage{$opt}),"\n")if$debug;if (ref($linkage{$opt})eq 'SCALAR' || ref($linkage{$opt})eq 'REF'){if ($ctl->[CTL_TYPE]eq '+'){print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")if$debug;if (defined ${$linkage{$opt}}){${$linkage{$opt}}+= $arg}else {${$linkage{$opt}}=$arg}}elsif ($ctl->[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> ref(\$L{$opt}) auto-vivified"," to ARRAY\n")if$debug;my$t=$linkage{$opt};$$t=$linkage{$opt}=[];print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")if$debug;push (@{$linkage{$opt}},$arg)}elsif ($ctl->[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> ref(\$L{$opt}) auto-vivified"," to HASH\n")if$debug;my$t=$linkage{$opt};$$t=$linkage{$opt}={};print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")if$debug;$linkage{$opt}->{$key}=$arg}else {print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")if$debug;${$linkage{$opt}}=$arg}}elsif (ref($linkage{$opt})eq 'ARRAY'){print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")if$debug;push (@{$linkage{$opt}},$arg)}elsif (ref($linkage{$opt})eq 'HASH'){print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")if$debug;$linkage{$opt}->{$key}=$arg}elsif (ref($linkage{$opt})eq 'CODE'){print STDERR ("=> &L{$opt}(\"$opt\"",$ctl->[CTL_DEST]==CTL_DEST_HASH ? ", \"$key\"" : "",", \"$arg\")\n")if$debug;my$eval_error=do {local $@;local$SIG{__DIE__}='DEFAULT';eval {&{$linkage{$opt}}(Getopt::Long::CallBack->new (name=>$opt,ctl=>$ctl,opctl=>\%opctl,linkage=>\%linkage,prefix=>$prefix,),$ctl->[CTL_DEST]==CTL_DEST_HASH ? ($key): (),$arg)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("Invalid REF type \"",ref($linkage{$opt}),"\" in linkage\n");die("Getopt::Long -- internal error!\n")}}elsif ($ctl->[CTL_DEST]==CTL_DEST_ARRAY){if (defined$userlinkage->{$opt}){print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")if$debug;push (@{$userlinkage->{$opt}},$arg)}else {print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")if$debug;$userlinkage->{$opt}=[$arg]}}elsif ($ctl->[CTL_DEST]==CTL_DEST_HASH){if (defined$userlinkage->{$opt}){print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")if$debug;$userlinkage->{$opt}->{$key}=$arg}else {print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")if$debug;$userlinkage->{$opt}={$key=>$arg}}}else {if ($ctl->[CTL_TYPE]eq '+'){print STDERR ("=> \$L{$opt} += \"$arg\"\n")if$debug;if (defined$userlinkage->{$opt}){$userlinkage->{$opt}+= $arg}else {$userlinkage->{$opt}=$arg}}else {print STDERR ("=>\$L{$opt} = \"$arg\"\n")if$debug;$userlinkage->{$opt}=$arg}}$argcnt++;last if$argcnt >= $ctl->[CTL_AMAX]&& $ctl->[CTL_AMAX]!=-1;undef($arg);if ($argcnt < $ctl->[CTL_AMIN]){if (@$argv){if (ValidValue($ctl,$argv->[0],1,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}warn("Value \"$$argv[0]\" invalid for option $opt\n");$error++}else {warn("Insufficient arguments for option $opt\n");$error++}}if (@$argv && ValidValue($ctl,$argv->[0],0,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}}}elsif ($order==$PERMUTE){my$cb;if (defined ($cb=$linkage{'<>'})){print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")if$debug;my$eval_error=do {local $@;local$SIG{__DIE__}='DEFAULT';eval {&$cb($tryopt)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("=> saving \"$tryopt\" ","(not an option, may permute)\n")if$debug;push (@ret,$tryopt)}next}else {unshift (@$argv,$tryopt);return ($error==0)}}if (@ret && ($order==$PERMUTE || $passthrough)){print STDERR ("=> restoring \"",join('" "',@ret),"\"\n")if$debug;unshift (@$argv,@ret)}return ($error==0)}sub OptCtl ($) {my ($v)=@_;my@v=map {defined($_)? ($_): ("<undef>")}@$v;"[".join(",","\"$v[CTL_TYPE]\"","\"$v[CTL_CNAME]\"","\"$v[CTL_DEFAULT]\"",("\$","\@","\%","\&")[$v[CTL_DEST]|| 0],$v[CTL_AMIN]|| '',$v[CTL_AMAX]|| '',)."]"}sub ParseOptionSpec ($$) {my ($opt,$opctl)=@_;if ($opt !~ m;^
+ use 5.004;use strict;use warnings;package Getopt::Long;use vars qw($VERSION);$VERSION=2.52;use vars qw($VERSION_STRING);$VERSION_STRING="2.52";use Exporter;use vars qw(@ISA @EXPORT @EXPORT_OK);@ISA=qw(Exporter);sub GetOptions(@);sub GetOptionsFromArray(@);sub GetOptionsFromString(@);sub Configure(@);sub HelpMessage(@);sub VersionMessage(@);BEGIN {@EXPORT=qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);@EXPORT_OK=qw(&HelpMessage &VersionMessage &Configure &GetOptionsFromArray &GetOptionsFromString)}use vars@EXPORT,@EXPORT_OK;use vars qw($error $debug $major_version $minor_version);use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order $passthrough);use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);my$bundling_values;sub config(@);sub ConfigDefaults();sub ParseOptionSpec($$);sub OptCtl($);sub FindOption($$$$$);sub ValidValue ($$$$$);my$requested_version=0;sub ConfigDefaults() {if (defined$ENV{"POSIXLY_CORRECT"}){$genprefix="(--|-)";$autoabbrev=0;$bundling=0;$getopt_compat=0;$order=$REQUIRE_ORDER}else {$genprefix="(--|-|\\+)";$autoabbrev=1;$bundling=0;$getopt_compat=1;$order=$PERMUTE}$debug=0;$error=0;$ignorecase=1;$passthrough=0;$gnu_compat=0;$longprefix="(--)";$bundling_values=0}sub import {my$pkg=shift;my@syms=();my@config=();my$dest=\@syms;for (@_){if ($_ eq ':config'){$dest=\@config;next}push(@$dest,$_)}local$Exporter::ExportLevel=1;push(@syms,qw(&GetOptions))if@syms;$requested_version=0;$pkg->SUPER::import(@syms);Configure(@config)if@config}($REQUIRE_ORDER,$PERMUTE,$RETURN_IN_ORDER)=(0..2);($major_version,$minor_version)=$VERSION =~ /^(\d+)\.(\d+)/;ConfigDefaults();package Getopt::Long::Parser;my$default_config=do {Getopt::Long::Configure ()};sub new {my$that=shift;my$class=ref($that)|| $that;my%atts=@_;my$self={caller_pkg=>(caller)[0]};bless ($self,$class);if (defined$atts{config}){my$save=Getopt::Long::Configure ($default_config,@{$atts{config}});$self->{settings}=Getopt::Long::Configure ($save);delete ($atts{config})}else {$self->{settings}=$default_config}if (%atts){die(__PACKAGE__.": unhandled attributes: ".join(" ",sort(keys(%atts)))."\n")}$self}sub configure {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings},@_);$self->{settings}=Getopt::Long::Configure ($save)}sub getoptions {my ($self)=shift;return$self->getoptionsfromarray(\@ARGV,@_)}sub getoptionsfromarray {my ($self)=shift;my$save=Getopt::Long::Configure ($self->{settings});my$ret=0;$Getopt::Long::caller=$self->{caller_pkg};eval {local ($SIG{__DIE__})='DEFAULT';$ret=Getopt::Long::GetOptionsFromArray (@_)};Getopt::Long::Configure ($save);die ($@)if $@;return$ret}package Getopt::Long;use constant CTL_TYPE=>0;use constant CTL_CNAME=>1;use constant CTL_DEFAULT=>2;use constant CTL_DEST=>3;use constant CTL_DEST_SCALAR=>0;use constant CTL_DEST_ARRAY=>1;use constant CTL_DEST_HASH=>2;use constant CTL_DEST_CODE=>3;use constant CTL_AMIN=>4;use constant CTL_AMAX=>5;use constant PAT_INT=>"[-+]?_*[0-9][0-9_]*";use constant PAT_XINT=>"(?:"."[-+]?_*[1-9][0-9_]*"."|"."0x_*[0-9a-f][0-9a-f_]*"."|"."0b_*[01][01_]*"."|"."0[0-7_]*".")";use constant PAT_FLOAT=>"[-+]?"."(?=[0-9.])"."[0-9_]*"."(\.[0-9_]+)?"."([eE][-+]?[0-9_]+)?";sub GetOptions(@) {unshift(@_,\@ARGV);goto&GetOptionsFromArray}sub GetOptionsFromString(@) {my ($string)=shift;require Text::ParseWords;my$args=[Text::ParseWords::shellwords($string)];$caller ||= (caller)[0];my$ret=GetOptionsFromArray($args,@_);return ($ret,$args)if wantarray;if (@$args){$ret=0;warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n")}$ret}sub GetOptionsFromArray(@) {my ($argv,@optionlist)=@_;my$argend='--';my%opctl=();my$pkg=$caller || (caller)[0];my@ret=();my%linkage;my$userlinkage;my$opt;my$prefix=$genprefix;$error='';if ($debug){local ($^W)=0;print STDERR ("Getopt::Long $Getopt::Long::VERSION_STRING ","called from package \"$pkg\".","\n ","argv: ",defined($argv)? UNIVERSAL::isa($argv,'ARRAY')? "(@$argv)" : $argv : "<undef>","\n ","autoabbrev=$autoabbrev,"."bundling=$bundling,","bundling_values=$bundling_values,","getopt_compat=$getopt_compat,","gnu_compat=$gnu_compat,","order=$order,","\n ","ignorecase=$ignorecase,","requested_version=$requested_version,","passthrough=$passthrough,","genprefix=\"$genprefix\",","longprefix=\"$longprefix\".","\n")}$userlinkage=undef;if (@optionlist && ref($optionlist[0])and UNIVERSAL::isa($optionlist[0],'HASH')){$userlinkage=shift (@optionlist);print STDERR ("=> user linkage: $userlinkage\n")if$debug}if (@optionlist && $optionlist[0]=~ /^\W+$/ &&!($optionlist[0]eq '<>' && @optionlist > 0 && ref($optionlist[1]))){$prefix=shift (@optionlist);$prefix =~ s/(\W)/\\$1/g;$prefix="([" .$prefix ."])";print STDERR ("=> prefix=\"$prefix\"\n")if$debug}%opctl=();while (@optionlist){my$opt=shift (@optionlist);unless (defined($opt)){$error .= "Undefined argument in option spec\n";next}$opt=$+ if$opt =~ /^$prefix+(.*)$/s;if ($opt eq '<>'){if ((defined$userlinkage)&&!(@optionlist > 0 && ref($optionlist[0]))&& (exists$userlinkage->{$opt})&& ref($userlinkage->{$opt})){unshift (@optionlist,$userlinkage->{$opt})}unless (@optionlist > 0 && ref($optionlist[0])&& ref($optionlist[0])eq 'CODE'){$error .= "Option spec <> requires a reference to a subroutine\n";shift (@optionlist)if@optionlist && ref($optionlist[0]);next}$linkage{'<>'}=shift (@optionlist);next}my ($name,$orig)=ParseOptionSpec ($opt,\%opctl);unless (defined$name){$error .= $orig;shift (@optionlist)if@optionlist && ref($optionlist[0]);next}if (defined$userlinkage){unless (@optionlist > 0 && ref($optionlist[0])){if (exists$userlinkage->{$orig}&& ref($userlinkage->{$orig})){print STDERR ("=> found userlinkage for \"$orig\": ","$userlinkage->{$orig}\n")if$debug;unshift (@optionlist,$userlinkage->{$orig})}else {next}}}if (@optionlist > 0 && ref($optionlist[0])){print STDERR ("=> link \"$orig\" to $optionlist[0]\n")if$debug;my$rl=ref($linkage{$orig}=shift (@optionlist));if ($rl eq "ARRAY"){$opctl{$name}[CTL_DEST]=CTL_DEST_ARRAY}elsif ($rl eq "HASH"){$opctl{$name}[CTL_DEST]=CTL_DEST_HASH}elsif ($rl eq "SCALAR" || $rl eq "REF"){}elsif ($rl eq "CODE"){}else {$error .= "Invalid option linkage for \"$opt\"\n"}}else {my$ov=$orig;$ov =~ s/\W/_/g;if ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;")}elsif ($opctl{$name}[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;")}else {print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")if$debug;eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;")}}if ($opctl{$name}[CTL_TYPE]eq 'I' && ($opctl{$name}[CTL_DEST]==CTL_DEST_ARRAY || $opctl{$name}[CTL_DEST]==CTL_DEST_HASH)){$error .= "Invalid option linkage for \"$opt\"\n"}}$error .= "GetOptionsFromArray: 1st parameter is not an array reference\n" unless$argv && UNIVERSAL::isa($argv,'ARRAY');die ($error)if$error;$error=0;if (defined($auto_version)? $auto_version : ($requested_version >= 2.3203)){if (!defined($opctl{version})){$opctl{version}=['','version',0,CTL_DEST_CODE,undef];$linkage{version}=\&VersionMessage}$auto_version=1}if (defined($auto_help)? $auto_help : ($requested_version >= 2.3203)){if (!defined($opctl{help})&&!defined($opctl{'?'})){$opctl{help}=$opctl{'?'}=['','help',0,CTL_DEST_CODE,undef];$linkage{help}=\&HelpMessage}$auto_help=1}if ($debug){my ($arrow,$k,$v);$arrow="=> ";while (($k,$v)=each(%opctl)){print STDERR ($arrow,"\$opctl{$k} = $v ",OptCtl($v),"\n");$arrow=" "}}my$goon=1;while ($goon && @$argv > 0){$opt=shift (@$argv);print STDERR ("=> arg \"",$opt,"\"\n")if$debug;if (defined($opt)&& $opt eq $argend){push (@ret,$argend)if$passthrough;last}my$tryopt=$opt;my$found;my$key;my$arg;my$ctl;($found,$opt,$ctl,$arg,$key)=FindOption ($argv,$prefix,$argend,$opt,\%opctl);if ($found){next unless defined$opt;my$argcnt=0;while (defined$arg){my$given=$opt;print STDERR ("=> cname for \"$opt\" is ")if$debug;$opt=$ctl->[CTL_CNAME];print STDERR ("\"$ctl->[CTL_CNAME]\"\n")if$debug;if (defined$linkage{$opt}){print STDERR ("=> ref(\$L{$opt}) -> ",ref($linkage{$opt}),"\n")if$debug;if (ref($linkage{$opt})eq 'SCALAR' || ref($linkage{$opt})eq 'REF'){if ($ctl->[CTL_TYPE]eq '+'){print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")if$debug;if (defined ${$linkage{$opt}}){${$linkage{$opt}}+= $arg}else {${$linkage{$opt}}=$arg}}elsif ($ctl->[CTL_DEST]==CTL_DEST_ARRAY){print STDERR ("=> ref(\$L{$opt}) auto-vivified"," to ARRAY\n")if$debug;my$t=$linkage{$opt};$$t=$linkage{$opt}=[];print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")if$debug;push (@{$linkage{$opt}},$arg)}elsif ($ctl->[CTL_DEST]==CTL_DEST_HASH){print STDERR ("=> ref(\$L{$opt}) auto-vivified"," to HASH\n")if$debug;my$t=$linkage{$opt};$$t=$linkage{$opt}={};print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")if$debug;$linkage{$opt}->{$key}=$arg}else {print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")if$debug;${$linkage{$opt}}=$arg}}elsif (ref($linkage{$opt})eq 'ARRAY'){print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")if$debug;push (@{$linkage{$opt}},$arg)}elsif (ref($linkage{$opt})eq 'HASH'){print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")if$debug;$linkage{$opt}->{$key}=$arg}elsif (ref($linkage{$opt})eq 'CODE'){print STDERR ("=> &L{$opt}(\"$opt\"",$ctl->[CTL_DEST]==CTL_DEST_HASH ? ", \"$key\"" : "",", \"$arg\")\n")if$debug;my$eval_error=do {local $@;local$SIG{__DIE__}='DEFAULT';eval {&{$linkage{$opt}}(Getopt::Long::CallBack->new (name=>$opt,given=>$given,ctl=>$ctl,opctl=>\%opctl,linkage=>\%linkage,prefix=>$prefix,),$ctl->[CTL_DEST]==CTL_DEST_HASH ? ($key): (),$arg)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("Invalid REF type \"",ref($linkage{$opt}),"\" in linkage\n");die("Getopt::Long -- internal error!\n")}}elsif ($ctl->[CTL_DEST]==CTL_DEST_ARRAY){if (defined$userlinkage->{$opt}){print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")if$debug;push (@{$userlinkage->{$opt}},$arg)}else {print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")if$debug;$userlinkage->{$opt}=[$arg]}}elsif ($ctl->[CTL_DEST]==CTL_DEST_HASH){if (defined$userlinkage->{$opt}){print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")if$debug;$userlinkage->{$opt}->{$key}=$arg}else {print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")if$debug;$userlinkage->{$opt}={$key=>$arg}}}else {if ($ctl->[CTL_TYPE]eq '+'){print STDERR ("=> \$L{$opt} += \"$arg\"\n")if$debug;if (defined$userlinkage->{$opt}){$userlinkage->{$opt}+= $arg}else {$userlinkage->{$opt}=$arg}}else {print STDERR ("=>\$L{$opt} = \"$arg\"\n")if$debug;$userlinkage->{$opt}=$arg}}$argcnt++;last if$argcnt >= $ctl->[CTL_AMAX]&& $ctl->[CTL_AMAX]!=-1;undef($arg);if ($argcnt < $ctl->[CTL_AMIN]){if (@$argv){if (ValidValue($ctl,$argv->[0],1,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}warn("Value \"$$argv[0]\" invalid for option $opt\n");$error++}else {warn("Insufficient arguments for option $opt\n");$error++}}if (@$argv && ValidValue($ctl,$argv->[0],0,$argend,$prefix)){$arg=shift(@$argv);if ($ctl->[CTL_TYPE]=~ /^[iIo]$/){$arg =~ tr/_//d;$arg=$ctl->[CTL_TYPE]eq 'o' && $arg =~ /^0/ ? oct($arg): 0+$arg}($key,$arg)=$arg =~ /^([^=]+)=(.*)/ if$ctl->[CTL_DEST]==CTL_DEST_HASH;next}}}elsif ($order==$PERMUTE){my$cb;if (defined ($cb=$linkage{'<>'})){print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")if$debug;my$eval_error=do {local $@;local$SIG{__DIE__}='DEFAULT';eval {&$cb($tryopt)};$@};print STDERR ("=> die($eval_error)\n")if$debug && $eval_error ne '';if ($eval_error =~ /^!/){if ($eval_error =~ /^!FINISH\b/){$goon=0}}elsif ($eval_error ne ''){warn ($eval_error);$error++}}else {print STDERR ("=> saving \"$tryopt\" ","(not an option, may permute)\n")if$debug;push (@ret,$tryopt)}next}else {unshift (@$argv,$tryopt);return ($error==0)}}if (@ret && ($order==$PERMUTE || $passthrough)){print STDERR ("=> restoring \"",join('" "',@ret),"\"\n")if$debug;unshift (@$argv,@ret)}return ($error==0)}sub OptCtl ($) {my ($v)=@_;my@v=map {defined($_)? ($_): ("<undef>")}@$v;"[".join(",","\"$v[CTL_TYPE]\"","\"$v[CTL_CNAME]\"","\"$v[CTL_DEFAULT]\"",("\$","\@","\%","\&")[$v[CTL_DEST]|| 0],$v[CTL_AMIN]|| '',$v[CTL_AMAX]|| '',)."]"}sub ParseOptionSpec ($$) {my ($opt,$opctl)=@_;if ($opt !~ m;^
(
# Option name
(?: \w+[-\w]* )
# ... or an optional-with-default spec
: (?: -?\d+ | \+ ) [@%]?
)?
- $;x){return (undef,"Error in option spec: \"$opt\"\n")}my ($names,$spec)=($1,$2);$spec='' unless defined$spec;my$orig;my@names;if (defined$names){@names=split (/\|/,$names);$orig=$names[0]}else {@names=('');$orig=''}my$entry;if ($spec eq '' || $spec eq '+' || $spec eq '!'){$entry=[$spec,$orig,undef,CTL_DEST_SCALAR,0,0]}elsif ($spec =~ /^:(-?\d+|\+)([@%])?$/){my$def=$1;my$dest=$2;my$type=$def eq '+' ? 'I' : 'i';$dest ||= '$';$dest=$dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;$entry=[$type,$orig,$def eq '+' ? undef : $def,$dest,0,1]}else {my ($mand,$type,$dest)=$spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;return (undef,"Cannot repeat while bundling: \"$opt\"\n")if$bundling && defined($4);my ($mi,$cm,$ma)=($5,$6,$7);return (undef,"{0} is useless in option spec: \"$opt\"\n")if defined($mi)&&!$mi &&!defined($ma)&&!defined($cm);$type='i' if$type eq 'n';$dest ||= '$';$dest=$dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;$mi=$mand eq '=' ? 1 : 0 unless defined$mi;$mand=$mi ? '=' : ':';$ma=$mi ? $mi : 1 unless defined$ma || defined$cm;return (undef,"Max must be greater than zero in option spec: \"$opt\"\n")if defined($ma)&&!$ma;return (undef,"Max less than min in option spec: \"$opt\"\n")if defined($ma)&& $ma < $mi;$entry=[$type,$orig,undef,$dest,$mi,$ma||-1]}my$dups='';for (@names){$_=lc ($_)if$ignorecase > (($bundling && length($_)==1)? 1 : 0);if (exists$opctl->{$_}){$dups .= "Duplicate specification \"$opt\" for option \"$_\"\n"}if ($spec eq '!'){$opctl->{"no$_"}=$entry;$opctl->{"no-$_"}=$entry;$opctl->{$_}=[@$entry];$opctl->{$_}->[CTL_TYPE]=''}else {$opctl->{$_}=$entry}}if ($dups && $^W){for (split(/\n+/,$dups)){warn($_."\n")}}($names[0],$orig)}sub FindOption ($$$$$) {my ($argv,$prefix,$argend,$opt,$opctl)=@_;print STDERR ("=> find \"$opt\"\n")if$debug;return (0)unless defined($opt);return (0)unless$opt =~ /^($prefix)(.*)$/s;return (0)if$opt eq "-" &&!defined$opctl->{''};$opt=substr($opt,length($1));my$starter=$1;print STDERR ("=> split \"$starter\"+\"$opt\"\n")if$debug;my$optarg;my$rest;if (($starter=~/^$longprefix$/ || ($getopt_compat && ($bundling==0 || $bundling==2)))&& (my$oppos=index($opt,'=',1))> 0){my$optorg=$opt;$opt=substr($optorg,0,$oppos);$optarg=substr($optorg,$oppos + 1);print STDERR ("=> option \"",$opt,"\", optarg = \"$optarg\"\n")if$debug}my$tryopt=$opt;if (($bundling || $bundling_values)&& $starter eq '-'){$tryopt=$ignorecase ? lc($opt): $opt;if ($bundling==2 && length($tryopt)> 1 && defined ($opctl->{$tryopt})){print STDERR ("=> $starter$tryopt overrides unbundling\n")if$debug}elsif ($bundling_values){$tryopt=$opt;$rest=length ($tryopt)> 0 ? substr ($tryopt,1): '';$tryopt=substr ($tryopt,0,1);$tryopt=lc ($tryopt)if$ignorecase > 1;print STDERR ("=> $starter$tryopt unbundled from ","$starter$tryopt$rest\n")if$debug;$optarg=$rest eq '' ? undef : $rest;$rest=undef}else {$tryopt=$opt;$rest=length ($tryopt)> 0 ? substr ($tryopt,1): '';$tryopt=substr ($tryopt,0,1);$tryopt=lc ($tryopt)if$ignorecase > 1;print STDERR ("=> $starter$tryopt unbundled from ","$starter$tryopt$rest\n")if$debug;$rest=undef unless$rest ne ''}}elsif ($autoabbrev && $opt ne ""){my@names=sort(keys (%$opctl));$opt=lc ($opt)if$ignorecase;$tryopt=$opt;my$pat=quotemeta ($opt);my@hits=grep (/^$pat/,@names);print STDERR ("=> ",scalar(@hits)," hits (@hits) with \"$pat\" ","out of ",scalar(@names),"\n")if$debug;unless ((@hits <= 1)|| (grep ($_ eq $opt,@hits)==1)){my%hit;for (@hits){my$hit=$opctl->{$_}->[CTL_CNAME]if defined$opctl->{$_}->[CTL_CNAME];$hit="no" .$hit if$opctl->{$_}->[CTL_TYPE]eq '!';$hit{$hit}=1}if (keys(%hit)==2){if ($auto_version && exists($hit{version})){delete$hit{version}}elsif ($auto_help && exists($hit{help})){delete$hit{help}}}unless (keys(%hit)==1){return (0)if$passthrough;warn ("Option ",$opt," is ambiguous (",join(", ",@hits),")\n");$error++;return (1,undef)}@hits=keys(%hit)}if (@hits==1 && $hits[0]ne $opt){$tryopt=$hits[0];$tryopt=lc ($tryopt)if$ignorecase > (($bundling && length($tryopt)==1)? 1 : 0);print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")if$debug}}elsif ($ignorecase){$tryopt=lc ($opt)}my$ctl=$opctl->{$tryopt};unless (defined$ctl){return (0)if$passthrough;if ($bundling==1 && length($starter)==1){$opt=substr($opt,0,1);unshift (@$argv,$starter.$rest)if defined$rest}if ($opt eq ""){warn ("Missing option after ",$starter,"\n")}else {warn ("Unknown option: ",$opt,"\n")}$error++;return (1,undef)}$opt=$tryopt;print STDERR ("=> found ",OptCtl($ctl)," for \"",$opt,"\"\n")if$debug;my$type=$ctl->[CTL_TYPE];my$arg;if ($type eq '' || $type eq '!' || $type eq '+'){if (defined$optarg){return (0)if$passthrough;warn ("Option ",$opt," does not take an argument\n");$error++;undef$opt;undef$optarg if$bundling_values}elsif ($type eq '' || $type eq '+'){$arg=1}else {$opt =~ s/^no-?//i;$arg=0}unshift (@$argv,$starter.$rest)if defined$rest;return (1,$opt,$ctl,$arg)}my$mand=$ctl->[CTL_AMIN];if ($gnu_compat){my$optargtype=0;if (defined($optarg)){$optargtype=(length($optarg)==0)? 1 : 2}elsif (defined$rest || @$argv > 0){$optargtype=3}if(($optargtype==0)&&!$mand){if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}my$val =defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0;return (1,$opt,$ctl,$val)}return (1,$opt,$ctl,$type eq 's' ? '' : 0)if$optargtype==1}if (defined$optarg ? ($optarg eq ''):!(defined$rest || @$argv > 0)){if ($mand){return (0)if$passthrough;warn ("Option ",$opt," requires an argument\n");$error++;return (1,undef)}if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}return (1,$opt,$ctl,defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0)}$arg=(defined$rest ? $rest : (defined$optarg ? $optarg : shift (@$argv)));my$key;if ($ctl->[CTL_DEST]==CTL_DEST_HASH && defined$arg){($key,$arg)=($arg =~ /^([^=]*)=(.*)$/s)? ($1,$2): ($arg,defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: ($mand ? undef : ($type eq 's' ? "" : 1)));if (!defined$arg){warn ("Option $opt, key \"$key\", requires a value\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}}my$key_valid=$ctl->[CTL_DEST]==CTL_DEST_HASH ? "[^=]+=" : "";if ($type eq 's'){return (1,$opt,$ctl,$arg,$key)if$mand;return (1,$opt,$ctl,$arg,$key)if$ctl->[CTL_DEST]==CTL_DEST_HASH;return (1,$opt,$ctl,$arg,$key)if defined$optarg || defined$rest;return (1,$opt,$ctl,$arg,$key)if$arg eq "-";if ($arg eq $argend || $arg =~ /^$prefix.+/){unshift (@$argv,$arg);$arg=''}}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;if ($bundling && defined$rest && $rest =~ /^($key_valid)($o_valid)(.*)$/si){($key,$arg,$rest)=($1,$2,$+);chop($key)if$key;$arg=($type eq 'o' && $arg =~ /^0/)? oct($arg): 0+$arg;unshift (@$argv,$starter.$rest)if defined$rest && $rest ne ''}elsif ($arg =~ /^$o_valid$/si){$arg =~ tr/_//d;$arg=($type eq 'o' && $arg =~ /^0/)? oct($arg): 0+$arg}else {if (defined$optarg || $mand){if ($passthrough){unshift (@$argv,defined$rest ? $starter.$rest : $arg)unless defined$optarg;return (0)}warn ("Value \"",$arg,"\" invalid for option ",$opt," (",$type eq 'o' ? "extended " : '',"number expected)\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}$arg=defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: 0}}}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;if ($bundling && defined$rest && $rest =~ /^($key_valid)($o_valid)(.*)$/s){$arg =~ tr/_//d;($key,$arg,$rest)=($1,$2,$+);chop($key)if$key;unshift (@$argv,$starter.$rest)if defined$rest && $rest ne ''}elsif ($arg =~ /^$o_valid$/){$arg =~ tr/_//d}else {if (defined$optarg || $mand){if ($passthrough){unshift (@$argv,defined$rest ? $starter.$rest : $arg)unless defined$optarg;return (0)}warn ("Value \"",$arg,"\" invalid for option ",$opt," (real number expected)\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);$arg=0.0}}}else {die("Getopt::Long internal error (Can't happen)\n")}return (1,$opt,$ctl,$arg,$key)}sub ValidValue ($$$$$) {my ($ctl,$arg,$mand,$argend,$prefix)=@_;if ($ctl->[CTL_DEST]==CTL_DEST_HASH){return 0 unless$arg =~ /[^=]+=(.*)/;$arg=$1}my$type=$ctl->[CTL_TYPE];if ($type eq 's'){return (1)if$mand;return (1)if$arg eq "-";return 0 if$arg eq $argend || $arg =~ /^$prefix.+/;return 1}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;return$arg =~ /^$o_valid$/si}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;return$arg =~ /^$o_valid$/}die("ValidValue: Cannot happen\n")}sub Configure (@) {my (@options)=@_;my$prevconfig=[$error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values ];if (ref($options[0])eq 'ARRAY'){($error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values)=@{shift(@options)}}my$opt;for$opt (@options){my$try=lc ($opt);my$action=1;if ($try =~ /^no_?(.*)$/s){$action=0;$try=$+}if (($try eq 'default' or $try eq 'defaults')&& $action){ConfigDefaults ()}elsif (($try eq 'posix_default' or $try eq 'posix_defaults')){local$ENV{POSIXLY_CORRECT};$ENV{POSIXLY_CORRECT}=1 if$action;ConfigDefaults ()}elsif ($try eq 'auto_abbrev' or $try eq 'autoabbrev'){$autoabbrev=$action}elsif ($try eq 'getopt_compat'){$getopt_compat=$action;$genprefix=$action ? "(--|-|\\+)" : "(--|-)"}elsif ($try eq 'gnu_getopt'){if ($action){$gnu_compat=1;$bundling=1;$getopt_compat=0;$genprefix="(--|-)";$order=$PERMUTE;$bundling_values=0}}elsif ($try eq 'gnu_compat'){$gnu_compat=$action;$bundling=0;$bundling_values=1}elsif ($try =~ /^(auto_?)?version$/){$auto_version=$action}elsif ($try =~ /^(auto_?)?help$/){$auto_help=$action}elsif ($try eq 'ignorecase' or $try eq 'ignore_case'){$ignorecase=$action}elsif ($try eq 'ignorecase_always' or $try eq 'ignore_case_always'){$ignorecase=$action ? 2 : 0}elsif ($try eq 'bundling'){$bundling=$action;$bundling_values=0 if$action}elsif ($try eq 'bundling_override'){$bundling=$action ? 2 : 0;$bundling_values=0 if$action}elsif ($try eq 'bundling_values'){$bundling_values=$action;$bundling=0 if$action}elsif ($try eq 'require_order'){$order=$action ? $REQUIRE_ORDER : $PERMUTE}elsif ($try eq 'permute'){$order=$action ? $PERMUTE : $REQUIRE_ORDER}elsif ($try eq 'pass_through' or $try eq 'passthrough'){$passthrough=$action}elsif ($try =~ /^prefix=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .quotemeta($genprefix).")";eval {'' =~ /$genprefix/};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^prefix_pattern=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .$genprefix .")" unless$genprefix =~ /^\(.*\)$/;eval {'' =~ m"$genprefix"};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^long_prefix_pattern=(.+)$/ && $action){$longprefix=$1;$longprefix="(" .$longprefix .")" unless$longprefix =~ /^\(.*\)$/;eval {'' =~ m"$longprefix"};die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n")if $@}elsif ($try eq 'debug'){$debug=$action}else {die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")}}$prevconfig}sub config (@) {Configure (@_)}sub VersionMessage(@) {my$pa=setup_pa_args("version",@_);my$v=$main::VERSION;my$fh=$pa->{-output}|| (($pa->{-exitval}eq "NOEXIT" || $pa->{-exitval}< 2)? \*STDOUT : \*STDERR);print$fh (defined($pa->{-message})? $pa->{-message}: (),$0,defined$v ? " version $v" : (),"\n","(",__PACKAGE__,"::","GetOptions"," version ",defined($Getopt::Long::VERSION_STRING)? $Getopt::Long::VERSION_STRING : $VERSION,";"," Perl version ",$] >= 5.006 ? sprintf("%vd",$^V): $],")\n");exit($pa->{-exitval})unless$pa->{-exitval}eq "NOEXIT"}sub HelpMessage(@) {eval {require Pod::Usage;import Pod::Usage;1}|| die("Cannot provide help: cannot load Pod::Usage\n");pod2usage(setup_pa_args("help",@_))}sub setup_pa_args($@) {my$tag=shift;@_=()if @_==2 && $_[0]eq $tag;my$pa;if (@_ > 1){$pa={@_ }}else {$pa=shift || {}}if (UNIVERSAL::isa($pa,'HASH')){$pa->{-message}=$pa->{-msg};delete($pa->{-msg})}elsif ($pa =~ /^-?\d+$/){$pa={-exitval=>$pa }}else {$pa={-message=>$pa }}$pa->{-verbose}=0 unless exists($pa->{-verbose});$pa->{-exitval}=0 unless exists($pa->{-exitval});$pa}sub VERSION {$requested_version=$_[1]if @_ > 1;shift->SUPER::VERSION(@_)}package Getopt::Long::CallBack;sub new {my ($pkg,%atts)=@_;bless {%atts },$pkg}sub name {my$self=shift;''.$self->{name}}use overload '""'=>\&name,fallback=>1;1;
+ $;x){return (undef,"Error in option spec: \"$opt\"\n")}my ($names,$spec)=($1,$2);$spec='' unless defined$spec;my$orig;my@names;if (defined$names){@names=split (/\|/,$names);$orig=$names[0]}else {@names=('');$orig=''}my$entry;if ($spec eq '' || $spec eq '+' || $spec eq '!'){$entry=[$spec,$orig,undef,CTL_DEST_SCALAR,0,0]}elsif ($spec =~ /^:(-?\d+|\+)([@%])?$/){my$def=$1;my$dest=$2;my$type=$def eq '+' ? 'I' : 'i';$dest ||= '$';$dest=$dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;$entry=[$type,$orig,$def eq '+' ? undef : $def,$dest,0,1]}else {my ($mand,$type,$dest)=$spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;return (undef,"Cannot repeat while bundling: \"$opt\"\n")if$bundling && defined($4);my ($mi,$cm,$ma)=($5,$6,$7);return (undef,"{0} is useless in option spec: \"$opt\"\n")if defined($mi)&&!$mi &&!defined($ma)&&!defined($cm);$type='i' if$type eq 'n';$dest ||= '$';$dest=$dest eq '@' ? CTL_DEST_ARRAY : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;$mi=$mand eq '=' ? 1 : 0 unless defined$mi;$mand=$mi ? '=' : ':';$ma=$mi ? $mi : 1 unless defined$ma || defined$cm;return (undef,"Max must be greater than zero in option spec: \"$opt\"\n")if defined($ma)&&!$ma;return (undef,"Max less than min in option spec: \"$opt\"\n")if defined($ma)&& $ma < $mi;$entry=[$type,$orig,undef,$dest,$mi,$ma||-1]}my$dups='';for (@names){$_=lc ($_)if$ignorecase > (($bundling && length($_)==1)? 1 : 0);if (exists$opctl->{$_}){$dups .= "Duplicate specification \"$opt\" for option \"$_\"\n"}if ($spec eq '!'){$opctl->{"no$_"}=$entry;$opctl->{"no-$_"}=$entry;$opctl->{$_}=[@$entry];$opctl->{$_}->[CTL_TYPE]=''}else {$opctl->{$_}=$entry}}if ($dups && $^W){for (split(/\n+/,$dups)){warn($_."\n")}}($names[0],$orig)}sub FindOption ($$$$$) {my ($argv,$prefix,$argend,$opt,$opctl)=@_;print STDERR ("=> find \"$opt\"\n")if$debug;return (0)unless defined($opt);return (0)unless$opt =~ /^($prefix)(.*)$/s;return (0)if$opt eq "-" &&!defined$opctl->{''};$opt=substr($opt,length($1));my$starter=$1;print STDERR ("=> split \"$starter\"+\"$opt\"\n")if$debug;my$optarg;my$rest;if (($starter=~/^$longprefix$/ || ($getopt_compat && ($bundling==0 || $bundling==2)))&& (my$oppos=index($opt,'=',1))> 0){my$optorg=$opt;$opt=substr($optorg,0,$oppos);$optarg=substr($optorg,$oppos + 1);print STDERR ("=> option \"",$opt,"\", optarg = \"$optarg\"\n")if$debug}my$tryopt=$opt;if (($bundling || $bundling_values)&& $starter eq '-'){$tryopt=$ignorecase ? lc($opt): $opt;if ($bundling==2 && length($tryopt)> 1 && defined ($opctl->{$tryopt})){print STDERR ("=> $starter$tryopt overrides unbundling\n")if$debug}elsif ($bundling_values){$tryopt=$opt;$rest=length ($tryopt)> 0 ? substr ($tryopt,1): '';$tryopt=substr ($tryopt,0,1);$tryopt=lc ($tryopt)if$ignorecase > 1;print STDERR ("=> $starter$tryopt unbundled from ","$starter$tryopt$rest\n")if$debug;$optarg=$rest eq '' ? undef : $rest;$rest=undef}else {$tryopt=$opt;$rest=length ($tryopt)> 0 ? substr ($tryopt,1): '';$tryopt=substr ($tryopt,0,1);$tryopt=lc ($tryopt)if$ignorecase > 1;print STDERR ("=> $starter$tryopt unbundled from ","$starter$tryopt$rest\n")if$debug;$rest=undef unless$rest ne ''}}elsif ($autoabbrev && $opt ne ""){my@names=sort(keys (%$opctl));$opt=lc ($opt)if$ignorecase;$tryopt=$opt;my$pat=quotemeta ($opt);my@hits=grep (/^$pat/,@names);print STDERR ("=> ",scalar(@hits)," hits (@hits) with \"$pat\" ","out of ",scalar(@names),"\n")if$debug;unless ((@hits <= 1)|| (grep ($_ eq $opt,@hits)==1)){my%hit;for (@hits){my$hit=$opctl->{$_}->[CTL_CNAME]if defined$opctl->{$_}->[CTL_CNAME];$hit="no" .$hit if$opctl->{$_}->[CTL_TYPE]eq '!';$hit{$hit}=1}if (keys(%hit)==2){if ($auto_version && exists($hit{version})){delete$hit{version}}elsif ($auto_help && exists($hit{help})){delete$hit{help}}}unless (keys(%hit)==1){return (0)if$passthrough;warn ("Option ",$opt," is ambiguous (",join(", ",@hits),")\n");$error++;return (1,undef)}@hits=keys(%hit)}if (@hits==1 && $hits[0]ne $opt){$tryopt=$hits[0];$tryopt=lc ($tryopt)if$ignorecase > (($bundling && length($tryopt)==1)? 1 : 0);print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")if$debug}}elsif ($ignorecase){$tryopt=lc ($opt)}my$ctl=$opctl->{$tryopt};unless (defined$ctl){return (0)if$passthrough;if ($bundling==1 && length($starter)==1){$opt=substr($opt,0,1);unshift (@$argv,$starter.$rest)if defined$rest}if ($opt eq ""){warn ("Missing option after ",$starter,"\n")}else {warn ("Unknown option: ",$opt,"\n")}$error++;return (1,undef)}$opt=$tryopt;print STDERR ("=> found ",OptCtl($ctl)," for \"",$opt,"\"\n")if$debug;my$type=$ctl->[CTL_TYPE];my$arg;if ($type eq '' || $type eq '!' || $type eq '+'){if (defined$optarg){return (0)if$passthrough;warn ("Option ",$opt," does not take an argument\n");$error++;undef$opt;undef$optarg if$bundling_values}elsif ($type eq '' || $type eq '+'){$arg=1}else {$opt =~ s/^no-?//i;$arg=0}unshift (@$argv,$starter.$rest)if defined$rest;return (1,$opt,$ctl,$arg)}my$mand=$ctl->[CTL_AMIN];if ($gnu_compat){my$optargtype=0;if (defined($optarg)){$optargtype=(length($optarg)==0)? 1 : 2}elsif (defined$rest || @$argv > 0){$optargtype=3}if(($optargtype==0)&&!$mand){if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}my$val =defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0;return (1,$opt,$ctl,$val)}return (1,$opt,$ctl,$type eq 's' ? '' : 0)if$optargtype==1}if (defined$optarg ? ($optarg eq ''):!(defined$rest || @$argv > 0)){if ($mand || $ctl->[CTL_DEST]==CTL_DEST_HASH){return (0)if$passthrough;warn ("Option ",$opt," requires an argument\n");$error++;return (1,undef)}if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}return (1,$opt,$ctl,defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: $type eq 's' ? '' : 0)}$arg=(defined$rest ? $rest : (defined$optarg ? $optarg : shift (@$argv)));my$key;if ($ctl->[CTL_DEST]==CTL_DEST_HASH && defined$arg){($key,$arg)=($arg =~ /^([^=]*)=(.*)$/s)? ($1,$2): ($arg,defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: ($mand ? undef : ($type eq 's' ? "" : 1)));if (!defined$arg){warn ("Option $opt, key \"$key\", requires a value\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}}my$key_valid=$ctl->[CTL_DEST]==CTL_DEST_HASH ? "[^=]+=" : "";if ($type eq 's'){return (1,$opt,$ctl,$arg,$key)if$mand;return (1,$opt,$ctl,$arg,$key)if$ctl->[CTL_DEST]==CTL_DEST_HASH;return (1,$opt,$ctl,$arg,$key)if defined$optarg || defined$rest;return (1,$opt,$ctl,$arg,$key)if$arg eq "-";if ($arg eq $argend || $arg =~ /^$prefix.+/){unshift (@$argv,$arg);$arg=''}}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;if ($bundling && defined$rest && $rest =~ /^($key_valid)($o_valid)(.*)$/si){($key,$arg,$rest)=($1,$2,$+);chop($key)if$key;$arg=($type eq 'o' && $arg =~ /^0/)? oct($arg): 0+$arg;unshift (@$argv,$starter.$rest)if defined$rest && $rest ne ''}elsif ($arg =~ /^$o_valid$/si){$arg =~ tr/_//d;$arg=($type eq 'o' && $arg =~ /^0/)? oct($arg): 0+$arg}else {if (defined$optarg || $mand){if ($passthrough){unshift (@$argv,defined$rest ? $starter.$rest : $arg)unless defined$optarg;return (0)}warn ("Value \"",$arg,"\" invalid for option ",$opt," (",$type eq 'o' ? "extended " : '',"number expected)\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);if ($type eq 'I'){my@c=@$ctl;$c[CTL_TYPE]='+';return (1,$opt,\@c,1)}$arg=defined($ctl->[CTL_DEFAULT])? $ctl->[CTL_DEFAULT]: 0}}}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;if ($bundling && defined$rest && $rest =~ /^($key_valid)($o_valid)(.*)$/s){$arg =~ tr/_//d;($key,$arg,$rest)=($1,$2,$+);chop($key)if$key;unshift (@$argv,$starter.$rest)if defined$rest && $rest ne ''}elsif ($arg =~ /^$o_valid$/){$arg =~ tr/_//d}else {if (defined$optarg || $mand){if ($passthrough){unshift (@$argv,defined$rest ? $starter.$rest : $arg)unless defined$optarg;return (0)}warn ("Value \"",$arg,"\" invalid for option ",$opt," (real number expected)\n");$error++;unshift (@$argv,$starter.$rest)if defined$rest;return (1,undef)}else {unshift (@$argv,defined$rest ? $starter.$rest : $arg);$arg=0.0}}}else {die("Getopt::Long internal error (Can't happen)\n")}return (1,$opt,$ctl,$arg,$key)}sub ValidValue ($$$$$) {my ($ctl,$arg,$mand,$argend,$prefix)=@_;if ($ctl->[CTL_DEST]==CTL_DEST_HASH){return 0 unless$arg =~ /[^=]+=(.*)/;$arg=$1}my$type=$ctl->[CTL_TYPE];if ($type eq 's'){return (1)if$mand;return (1)if$arg eq "-";return 0 if$arg eq $argend || $arg =~ /^$prefix.+/;return 1}elsif ($type eq 'i' || $type eq 'I' || $type eq 'o'){my$o_valid=$type eq 'o' ? PAT_XINT : PAT_INT;return$arg =~ /^$o_valid$/si}elsif ($type eq 'f'){my$o_valid=PAT_FLOAT;return$arg =~ /^$o_valid$/}die("ValidValue: Cannot happen\n")}sub Configure (@) {my (@options)=@_;my$prevconfig=[$error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values ];if (ref($options[0])eq 'ARRAY'){($error,$debug,$major_version,$minor_version,$caller,$autoabbrev,$getopt_compat,$ignorecase,$bundling,$order,$gnu_compat,$passthrough,$genprefix,$auto_version,$auto_help,$longprefix,$bundling_values)=@{shift(@options)}}my$opt;for$opt (@options){my$try=lc ($opt);my$action=1;if ($try =~ /^no_?(.*)$/s){$action=0;$try=$+}if (($try eq 'default' or $try eq 'defaults')&& $action){ConfigDefaults ()}elsif (($try eq 'posix_default' or $try eq 'posix_defaults')){local$ENV{POSIXLY_CORRECT};$ENV{POSIXLY_CORRECT}=1 if$action;ConfigDefaults ()}elsif ($try eq 'auto_abbrev' or $try eq 'autoabbrev'){$autoabbrev=$action}elsif ($try eq 'getopt_compat'){$getopt_compat=$action;$genprefix=$action ? "(--|-|\\+)" : "(--|-)"}elsif ($try eq 'gnu_getopt'){if ($action){$gnu_compat=1;$bundling=1;$getopt_compat=0;$genprefix="(--|-)";$order=$PERMUTE;$bundling_values=0}}elsif ($try eq 'gnu_compat'){$gnu_compat=$action;$bundling=0;$bundling_values=1}elsif ($try =~ /^(auto_?)?version$/){$auto_version=$action}elsif ($try =~ /^(auto_?)?help$/){$auto_help=$action}elsif ($try eq 'ignorecase' or $try eq 'ignore_case'){$ignorecase=$action}elsif ($try eq 'ignorecase_always' or $try eq 'ignore_case_always'){$ignorecase=$action ? 2 : 0}elsif ($try eq 'bundling'){$bundling=$action;$bundling_values=0 if$action}elsif ($try eq 'bundling_override'){$bundling=$action ? 2 : 0;$bundling_values=0 if$action}elsif ($try eq 'bundling_values'){$bundling_values=$action;$bundling=0 if$action}elsif ($try eq 'require_order'){$order=$action ? $REQUIRE_ORDER : $PERMUTE}elsif ($try eq 'permute'){$order=$action ? $PERMUTE : $REQUIRE_ORDER}elsif ($try eq 'pass_through' or $try eq 'passthrough'){$passthrough=$action}elsif ($try =~ /^prefix=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .quotemeta($genprefix).")";eval {'' =~ /$genprefix/};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^prefix_pattern=(.+)$/ && $action){$genprefix=$1;$genprefix="(" .$genprefix .")" unless$genprefix =~ /^\(.*\)$/;eval {'' =~ m"$genprefix"};die("Getopt::Long: invalid pattern \"$genprefix\"\n")if $@}elsif ($try =~ /^long_prefix_pattern=(.+)$/ && $action){$longprefix=$1;$longprefix="(" .$longprefix .")" unless$longprefix =~ /^\(.*\)$/;eval {'' =~ m"$longprefix"};die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n")if $@}elsif ($try eq 'debug'){$debug=$action}else {die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")}}$prevconfig}sub config (@) {Configure (@_)}sub VersionMessage(@) {my$pa=setup_pa_args("version",@_);my$v=$main::VERSION;my$fh=$pa->{-output}|| (($pa->{-exitval}eq "NOEXIT" || $pa->{-exitval}< 2)? \*STDOUT : \*STDERR);print$fh (defined($pa->{-message})? $pa->{-message}: (),$0,defined$v ? " version $v" : (),"\n","(",__PACKAGE__,"::","GetOptions"," version ",defined($Getopt::Long::VERSION_STRING)? $Getopt::Long::VERSION_STRING : $VERSION,";"," Perl version ",$] >= 5.006 ? sprintf("%vd",$^V): $],")\n");exit($pa->{-exitval})unless$pa->{-exitval}eq "NOEXIT"}sub HelpMessage(@) {eval {require Pod::Usage;import Pod::Usage;1}|| die("Cannot provide help: cannot load Pod::Usage\n");pod2usage(setup_pa_args("help",@_))}sub setup_pa_args($@) {my$tag=shift;@_=()if @_==2 && $_[0]eq $tag;my$pa;if (@_ > 1){$pa={@_ }}else {$pa=shift || {}}if (UNIVERSAL::isa($pa,'HASH')){$pa->{-message}=$pa->{-msg};delete($pa->{-msg})}elsif ($pa =~ /^-?\d+$/){$pa={-exitval=>$pa }}else {$pa={-message=>$pa }}$pa->{-verbose}=0 unless exists($pa->{-verbose});$pa->{-exitval}=0 unless exists($pa->{-exitval});$pa}sub VERSION {$requested_version=$_[1]if @_ > 1;shift->SUPER::VERSION(@_)}package Getopt::Long::CallBack;sub new {my ($pkg,%atts)=@_;bless {%atts },$pkg}sub name {my$self=shift;''.$self->{name}}sub given {my$self=shift;$self->{given}}use overload '""'=>\&name,fallback=>1;1;
GETOPT_LONG
$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;
+ package JSON::MaybeXS;use strict;use warnings FATAL=>'all';use base qw(Exporter);our$VERSION='1.004003';$VERSION =~ tr/_//d;sub _choose_json_module {return 'Cpanel::JSON::XS' if$INC{'Cpanel/JSON/XS.pm'};return 'JSON::XS' if$INC{'JSON/XS.pm'}&& eval {JSON::XS->VERSION(3.0);1};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;JSON::XS->VERSION(3.0);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/
+ 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.06';@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;
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 =~ /^(?:
+ /}}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}else {delete$self->{false};delete$self->{true}}return$self}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]
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;
+ 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.06';1;
JSON_PP_BOOLEAN
$fatpacked{"Path/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_TINY';
- use 5.008001;use strict;use warnings;package Path::Tiny;our$VERSION='0.112';use Config;use Exporter 5.57 (qw/import/);use File::Spec 0.86 ();use Carp ();our@EXPORT=qw/path/;our@EXPORT_OK=qw/cwd rootdir tempfile tempdir/;use constant {PATH=>0,CANON=>1,VOL=>2,DIR=>3,FILE=>4,TEMP=>5,IS_WIN32=>($^O eq 'MSWin32'),};use overload (q{""}=>sub {$_[0]->[PATH]},bool=>sub () {1},fallback=>1,);sub FREEZE {return $_[0]->[PATH]}sub THAW {return path($_[2])}{no warnings 'once';*TO_JSON=*FREEZE};my$HAS_UU;sub _check_UU {local$SIG{__DIE__};!!eval {require Unicode::UTF8;Unicode::UTF8->VERSION(0.58);1}}my$HAS_PU;sub _check_PU {local$SIG{__DIE__};!!eval {require Encode;require PerlIO::utf8_strict;PerlIO::utf8_strict->VERSION(0.003);1}}my$HAS_FLOCK=$Config{d_flock}|| $Config{d_fcntl_can_lock}|| $Config{d_lockf};my$SLASH=qr{[\\/]};my$NOTSLASH=qr{[^\\/]};my$DRV_VOL=qr{[a-z]:}i;my$UNC_VOL=qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x;my$WIN32_ROOT=qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x;sub _win32_vol {my ($path,$drv)=@_;require Cwd;my$dcwd=eval {Cwd::getdcwd($drv)};$dcwd="$drv" unless defined$dcwd && length$dcwd;$dcwd =~ s{$SLASH?$}{/};$path =~ s{^$DRV_VOL}{$dcwd};return$path}sub _is_root {return IS_WIN32()? ($_[0]=~ /^$WIN32_ROOT$/): ($_[0]eq '/')}BEGIN {*_same=IS_WIN32()? sub {lc($_[0])eq lc($_[1])}: sub {$_[0]eq $_[1]}}my%MODEBITS=(om=>0007,gm=>0070,um=>0700);{my$m=0;$MODEBITS{$_}=(1 << $m++)for qw/ox ow or gx gw gr ux uw ur/};sub _symbolic_chmod {my ($mode,$symbolic)=@_;for my$clause (split /,\s*/,$symbolic){if ($clause =~ m{\A([augo]+)([=+-])([rwx]+)\z}){my ($who,$action,$perms)=($1,$2,$3);$who =~ s/a/ugo/g;for my$w (split //,$who){my$p=0;$p |= $MODEBITS{"$w$_"}for split //,$perms;if ($action eq '='){$mode=($mode & ~$MODEBITS{"${w}m"})| $p}else {$mode=$action eq "+" ? ($mode | $p): ($mode & ~$p)}}}else {Carp::croak("Invalid mode clause '$clause' for chmod()")}}return$mode}{package flock;use warnings::register}my$WARNED_NO_FLOCK=0;sub _throw {my ($self,$function,$file,$msg)=@_;if ($function =~ /^flock/ && $! =~ /operation not supported|function not implemented/i &&!warnings::fatal_enabled('flock')){if (!$WARNED_NO_FLOCK){warnings::warn(flock=>"Flock not available: '$!': continuing in unsafe mode");$WARNED_NO_FLOCK++}}else {$msg=$! unless defined$msg;Path::Tiny::Error->throw($function,(defined$file ? $file : $self->[PATH]),$msg)}return}sub _get_args {my ($raw,@valid)=@_;if (defined($raw)&& ref($raw)ne 'HASH'){my (undef,undef,undef,$called_as)=caller(1);$called_as =~ s{^.*::}{};Carp::croak("Options for $called_as must be a hash reference")}my$cooked={};for my$k (@valid){$cooked->{$k}=delete$raw->{$k}if exists$raw->{$k}}if (keys %$raw){my (undef,undef,undef,$called_as)=caller(1);$called_as =~ s{^.*::}{};Carp::croak("Invalid option(s) for $called_as: " .join(", ",keys %$raw))}return$cooked}sub path {my$path=shift;Carp::croak("Path::Tiny paths require defined, positive-length parts")unless 1 + @_==grep {defined && length}$path,@_;if (!@_ && ref($path)eq __PACKAGE__ &&!$path->[TEMP]){return$path}$path="$path";if (IS_WIN32()){$path=_win32_vol($path,$1)if$path =~ m{^($DRV_VOL)(?:$NOTSLASH|$)};$path .= "/" if$path =~ m{^$UNC_VOL$}}if (@_){$path .= (_is_root($path)? "" : "/").join("/",@_)}my$cpath=$path=File::Spec->canonpath($path);$path =~ tr[\\][/] if IS_WIN32();$path="/" if$path eq '/..';$path .= "/" if IS_WIN32()&& $path =~ m{^$UNC_VOL$};if (_is_root($path)){$path =~ s{/?$}{/}}else {$path =~ s{/$}{}}if ($path =~ m{^(~[^/]*).*}){require File::Glob;my ($homedir)=File::Glob::bsd_glob($1);$homedir =~ tr[\\][/] if IS_WIN32();$path =~ s{^(~[^/]*)}{$homedir}}bless [$path,$cpath ],__PACKAGE__}sub new {shift;path(@_)}sub cwd {require Cwd;return path(Cwd::getcwd())}sub rootdir {path(File::Spec->rootdir)}sub tempfile {shift if @_ && $_[0]eq 'Path::Tiny';my$opts=(@_ && ref $_[0]eq 'HASH')? shift @_ : {};$opts=_get_args($opts,qw/realpath/);my ($maybe_template,$args)=_parse_file_temp_args(@_);$args->{TEMPLATE}=$maybe_template->[0]if @$maybe_template;require File::Temp;my$temp=File::Temp->new(TMPDIR=>1,%$args);close$temp;my$self=$opts->{realpath}? path($temp)->realpath : path($temp)->absolute;$self->[TEMP]=$temp;return$self}sub tempdir {shift if @_ && $_[0]eq 'Path::Tiny';my$opts=(@_ && ref $_[0]eq 'HASH')? shift @_ : {};$opts=_get_args($opts,qw/realpath/);my ($maybe_template,$args)=_parse_file_temp_args(@_);require File::Temp;my$temp=File::Temp->newdir(@$maybe_template,TMPDIR=>1,%$args);my$self=$opts->{realpath}? path($temp)->realpath : path($temp)->absolute;$self->[TEMP]=$temp;$temp->{REALNAME}=$self->[CANON]if IS_WIN32;return$self}sub _parse_file_temp_args {my$leading_template=(scalar(@_)% 2==1 ? shift(@_): '');my%args=@_;%args=map {uc($_),$args{$_}}keys%args;my@template=(exists$args{TEMPLATE}? delete$args{TEMPLATE}: $leading_template ? $leading_template : ());return (\@template,\%args)}sub _splitpath {my ($self)=@_;@{$self}[VOL,DIR,FILE ]=File::Spec->splitpath($self->[PATH])}sub _resolve_symlinks {my ($self)=@_;my$new=$self;my ($count,%seen)=0;while (-l $new->[PATH]){if ($seen{$new->[PATH]}++){$self->_throw('readlink',$self->[PATH],"symlink loop detected")}if (++$count > 100){$self->_throw('readlink',$self->[PATH],"maximum symlink depth exceeded")}my$resolved=readlink$new->[PATH]or $new->_throw('readlink',$new->[PATH]);$resolved=path($resolved);$new=$resolved->is_absolute ? $resolved : $new->sibling($resolved)}return$new}sub absolute {my ($self,$base)=@_;if (IS_WIN32){return$self if length$self->volume;if ($self->is_absolute){require Cwd;my ($drv)=Win32::GetCwd()=~ /^($DRV_VOL | $UNC_VOL)/x;return path($drv .$self->[PATH])}}else {return$self if$self->is_absolute}require Cwd;return path(Cwd::getcwd(),$_[0]->[PATH])unless defined$base;$base=path($base);return path(($base->is_absolute ? $base : $base->absolute),$_[0]->[PATH])}sub append {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$mode=$args->{truncate}? ">" : ">>";my$fh=$self->filehandle({locked=>1 },$mode,$binmode);print {$fh}map {ref eq 'ARRAY' ? @$_ : $_}@data;close$fh or $self->_throw('close')}sub append_raw {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);$args->{binmode}=':unix';append($self,$args,@data)}sub append_utf8 {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){$args->{binmode}=":unix";append($self,$args,map {Unicode::UTF8::encode_utf8($_)}@data)}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$args->{binmode}=":unix:utf8_strict";append($self,$args,@data)}else {$args->{binmode}=":unix:encoding(UTF-8)";append($self,$args,@data)}}sub assert {my ($self,$assertion)=@_;return$self unless$assertion;if (ref$assertion eq 'CODE'){local $_=$self;$assertion->()or Path::Tiny::Error->throw("assert",$self->[PATH],"failed assertion")}else {Carp::croak("argument to assert must be a code reference argument")}return$self}sub basename {my ($self,@suffixes)=@_;$self->_splitpath unless defined$self->[FILE];my$file=$self->[FILE];for my$s (@suffixes){my$re=ref($s)eq 'Regexp' ? qr/$s$/ : qr/\Q$s\E$/;last if$file =~ s/$re//}return$file}sub canonpath {$_[0]->[CANON]}sub cached_temp {my$self=shift;$self->_throw("cached_temp",$self,"has no cached File::Temp object")unless defined$self->[TEMP];return$self->[TEMP]}sub child {my ($self,@parts)=@_;return path($self->[PATH],@parts)}sub children {my ($self,$filter)=@_;my$dh;opendir$dh,$self->[PATH]or $self->_throw('opendir');my@children=readdir$dh;closedir$dh or $self->_throw('closedir');if (not defined$filter){@children=grep {$_ ne '.' && $_ ne '..'}@children}elsif ($filter && ref($filter)eq 'Regexp'){@children=grep {$_ ne '.' && $_ ne '..' && $_ =~ $filter}@children}else {Carp::croak("Invalid argument '$filter' for children()")}return map {path($self->[PATH],$_)}@children}sub chmod {my ($self,$new_mode)=@_;my$mode;if ($new_mode =~ /\d/){$mode=($new_mode =~ /^0/ ? oct($new_mode): $new_mode)}elsif ($new_mode =~ /[=+-]/){$mode=_symbolic_chmod($self->stat->mode & 07777,$new_mode)}else {Carp::croak("Invalid mode argument '$new_mode' for chmod()")}CORE::chmod($mode,$self->[PATH])or $self->_throw("chmod");return 1}sub copy {my ($self,$dest)=@_;require File::Copy;File::Copy::copy($self->[PATH],$dest)or Carp::croak("copy failed for $self to $dest: $!");return -d $dest ? path($dest,$self->basename): path($dest)}sub digest {my ($self,@opts)=@_;my$args=(@opts && ref$opts[0]eq 'HASH')? shift@opts : {};$args=_get_args($args,qw/chunk_size/);unshift@opts,'SHA-256' unless@opts;require Digest;my$digest=Digest->new(@opts);if ($args->{chunk_size}){my$fh=$self->filehandle({locked=>1 },"<",":unix");my$buf;$digest->add($buf)while read$fh,$buf,$args->{chunk_size}}else {$digest->add($self->slurp_raw)}return$digest->hexdigest}sub dirname {my ($self)=@_;$self->_splitpath unless defined$self->[DIR];return length$self->[DIR]? $self->[DIR]: "."}sub edit {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/binmode/);Carp::croak("Callback for edit() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';local $_=$self->slurp(exists($args->{binmode})? {binmode=>$args->{binmode}}: ());$cb->();$self->spew($args,$_);return}sub edit_utf8 {my ($self,$cb)=@_;Carp::croak("Callback for edit_utf8() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';local $_=$self->slurp_utf8;$cb->();$self->spew_utf8($_);return}sub edit_raw {$_[2]={binmode=>":unix" };goto&edit}sub edit_lines {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/binmode/);Carp::croak("Callback for edit_lines() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$resolved_path=$self->_resolve_symlinks;my$temp=path($resolved_path .$$ .int(rand(2**31)));my$temp_fh=$temp->filehandle({exclusive=>1,locked=>1 },">",$binmode);my$in_fh=$self->filehandle({locked=>1 },'<',$binmode);local $_;while (<$in_fh>){$cb->();$temp_fh->print($_)}close$temp_fh or $self->_throw('close',$temp);close$in_fh or $self->_throw('close');return$temp->move($resolved_path)}sub edit_lines_raw {$_[2]={binmode=>":unix" };goto&edit_lines}sub edit_lines_utf8 {$_[2]={binmode=>":raw:encoding(UTF-8)" };goto&edit_lines}sub exists {-e $_[0]->[PATH]}sub is_file {-e $_[0]->[PATH]&&!-d _}sub is_dir {-d $_[0]->[PATH]}sub filehandle {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked exclusive/);$args->{locked}=1 if$args->{exclusive};my ($opentype,$binmode)=@args;$opentype="<" unless defined$opentype;Carp::croak("Invalid file mode '$opentype'")unless grep {$opentype eq $_}qw/< +< > +> >> +>>/;$binmode=((caller(0))[10]|| {})->{'open' .substr($opentype,-1,1)}unless defined$binmode;$binmode="" unless defined$binmode;my ($fh,$lock,$trunc);if ($HAS_FLOCK && $args->{locked}&&!$ENV{PERL_PATH_TINY_NO_FLOCK}){require Fcntl;if (grep {$opentype eq $_}qw(> +>)){my$flags=$opentype eq ">" ? Fcntl::O_WRONLY(): Fcntl::O_RDWR();$flags |= Fcntl::O_CREAT();$flags |= Fcntl::O_EXCL()if$args->{exclusive};sysopen($fh,$self->[PATH],$flags)or $self->_throw("sysopen");if ($binmode =~ s/^:unix//){binmode($fh,":raw")or $self->_throw("binmode (:raw)");while (1 < (my$layers=()=PerlIO::get_layers($fh,output=>1))){binmode($fh,":pop")or $self->_throw("binmode (:pop)")}}if (length$binmode){binmode($fh,$binmode)or $self->_throw("binmode ($binmode)")}$lock=Fcntl::LOCK_EX();$trunc=1}elsif ($^O eq 'aix' && $opentype eq "<"){if (-w $self->[PATH]){$opentype="+<";$lock=Fcntl::LOCK_EX()}}else {$lock=$opentype eq "<" ? Fcntl::LOCK_SH(): Fcntl::LOCK_EX()}}unless ($fh){my$mode=$opentype .$binmode;open$fh,$mode,$self->[PATH]or $self->_throw("open ($mode)")}do {flock($fh,$lock)or $self->_throw("flock ($lock)")}if$lock;do {truncate($fh,0)or $self->_throw("truncate")}if$trunc;return$fh}sub is_absolute {substr($_[0]->dirname,0,1)eq '/'}sub is_relative {substr($_[0]->dirname,0,1)ne '/'}sub is_rootdir {my ($self)=@_;$self->_splitpath unless defined$self->[DIR];return$self->[DIR]eq '/' && $self->[FILE]eq ''}sub iterator {my$self=shift;my$args=_get_args(shift,qw/recurse follow_symlinks/);my@dirs=$self;my$current;return sub {my$next;while (@dirs){if (ref$dirs[0]eq 'Path::Tiny'){if (!-r $dirs[0]){shift@dirs and next}$current=$dirs[0];my$dh;opendir($dh,$current->[PATH])or $self->_throw('opendir',$current->[PATH]);$dirs[0]=$dh;if (-l $current->[PATH]&&!$args->{follow_symlinks}){shift@dirs and next}}while (defined($next=readdir$dirs[0])){next if$next eq '.' || $next eq '..';my$path=$current->child($next);push@dirs,$path if$args->{recurse}&& -d $path &&!(!$args->{follow_symlinks}&& -l $path);return$path}shift@dirs}return}}sub lines {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open<'}unless defined$binmode;my$fh=$self->filehandle({locked=>1 },"<",$binmode);my$chomp=$args->{chomp};if ($args->{count}){my ($counter,$mod,@result)=(0,abs($args->{count}));while (my$line=<$fh>){$line =~ s/(?:\x{0d}?\x{0a}|\x{0d})$// if$chomp;$result[$counter++ ]=$line;last if$counter==$args->{count};$counter %= $mod}splice(@result,0,0,splice(@result,$counter))if@result==$mod && $counter % $mod;return@result}elsif ($chomp){return map {s/(?:\x{0d}?\x{0a}|\x{0d})$//;$_}<$fh>}else {return wantarray ? <$fh> : (my$count=()=<$fh>)}}sub lines_raw {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);if ($args->{chomp}&&!$args->{count}){return split /\n/,slurp_raw($self)}else {$args->{binmode}=":raw";return lines($self,$args)}}my$CRLF=qr/(?:\x{0d}?\x{0a}|\x{0d})/;sub lines_utf8 {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);if ((defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU()))&& $args->{chomp}&&!$args->{count}){my$slurp=slurp_utf8($self);$slurp =~ s/$CRLF$//;return split$CRLF,$slurp,-1}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$args->{binmode}=":unix:utf8_strict";return lines($self,$args)}else {$args->{binmode}=":raw:encoding(UTF-8)";return lines($self,$args)}}sub mkpath {my ($self,$args)=@_;$args={}unless ref$args eq 'HASH';my$err;$args->{error}=\$err unless defined$args->{error};require File::Path;my@dirs=File::Path::make_path($self->[PATH],$args);if ($err && @$err){my ($file,$message)=%{$err->[0]};Carp::croak("mkpath failed for $file: $message")}return@dirs}sub move {my ($self,$dst)=@_;return rename($self->[PATH],$dst)|| $self->_throw('rename',$self->[PATH]."' -> '$dst")}my%opens=(opena=>">>",openr=>"<",openw=>">",openrw=>"+<");while (my ($k,$v)=each%opens){no strict 'refs';*{$k}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);my ($binmode)=@args;$binmode=((caller(0))[10]|| {})->{'open' .substr($v,-1,1)}unless defined$binmode;$self->filehandle($args,$v,$binmode)};*{$k ."_raw"}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);$self->filehandle($args,$v,":raw")};*{$k ."_utf8"}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);$self->filehandle($args,$v,":raw:encoding(UTF-8)")}}sub parent {my ($self,$level)=@_;$level=1 unless defined$level && $level > 0;$self->_splitpath unless defined$self->[FILE];my$parent;if (length$self->[FILE]){if ($self->[FILE]eq '.' || $self->[FILE]eq ".."){$parent=path($self->[PATH]."/..")}else {$parent=path(_non_empty($self->[VOL].$self->[DIR]))}}elsif (length$self->[DIR]){if ($self->[DIR]=~ m{(?:^\.\./|/\.\./|/\.\.$)}){$parent=path($self->[VOL].$self->[DIR]."/..")}else {(my$dir=$self->[DIR])=~ s{/[^\/]+/$}{/};$parent=path($self->[VOL].$dir)}}else {$parent=path(_non_empty($self->[VOL]))}return$level==1 ? $parent : $parent->parent($level - 1)}sub _non_empty {my ($string)=shift;return ((defined($string)&& length($string))? $string : ".")}sub realpath {my$self=shift;$self=$self->_resolve_symlinks;require Cwd;$self->_splitpath if!defined$self->[FILE];my$check_parent=length$self->[FILE]&& $self->[FILE]ne '.' && $self->[FILE]ne '..';my$realpath=eval {local$SIG{__WARN__}=sub {};Cwd::realpath($check_parent ? $self->parent->[PATH]: $self->[PATH])};$self->_throw("resolving realpath")unless defined$realpath && length$realpath && -e $realpath;return ($check_parent ? path($realpath,$self->[FILE]): path($realpath))}sub relative {my ($self,$base)=@_;$base=path(defined$base && length$base ? $base : '.');$self=$self->absolute if$self->is_relative;$base=$base->absolute if$base->is_relative;$self=$self->absolute if!length$self->volume && length$base->volume;$base=$base->absolute if length$self->volume &&!length$base->volume;if (!_same($self->volume,$base->volume)){Carp::croak("relative() can't cross volumes: '$self' vs '$base'")}return path(".")if _same($self->[PATH],$base->[PATH]);if ($base->subsumes($self)){$base="" if$base->is_rootdir;my$relative="$self";$relative =~ s{\A\Q$base/}{};return path($relative)}my (@common,@self_parts,@base_parts);@base_parts=split /\//,$base->_just_filepath;if ($self->is_rootdir){@common=("");shift@base_parts}else {@self_parts=split /\//,$self->_just_filepath;while (@self_parts && @base_parts && _same($self_parts[0],$base_parts[0])){push@common,shift@base_parts;shift@self_parts}}if (my$new_base=$self->_resolve_between(\@common,\@base_parts)){return$self->relative($new_base)}my@new_path=(("..")x (0+ @base_parts),@self_parts);return path(@new_path)}sub _just_filepath {my$self=shift;my$self_vol=$self->volume;return "$self" if!length$self_vol;(my$self_path="$self")=~ s{\A\Q$self_vol}{};return$self_path}sub _resolve_between {my ($self,$common,$base)=@_;my$path=$self->volume .join("/",@$common);my$changed=0;for my$p (@$base){$path .= "/$p";if ($p eq '..'){$changed=1;if (-e $path){$path=path($path)->realpath->[PATH]}else {$path =~ s{/[^/]+/..$}{/}}}if (-l $path){$changed=1;$path=path($path)->realpath->[PATH]}}return$changed ? path($path): undef}sub remove {my$self=shift;return 0 if!-e $self->[PATH]&&!-l $self->[PATH];return unlink($self->[PATH])|| $self->_throw('unlink')}sub remove_tree {my ($self,$args)=@_;return 0 if!-e $self->[PATH]&&!-l $self->[PATH];$args={}unless ref$args eq 'HASH';my$err;$args->{error}=\$err unless defined$args->{error};$args->{safe}=1 unless defined$args->{safe};require File::Path;my$count=File::Path::remove_tree($self->[PATH],$args);if ($err && @$err){my ($file,$message)=%{$err->[0]};Carp::croak("remove_tree failed for $file: $message")}return$count}sub sibling {my$self=shift;return path($self->parent->[PATH],@_)}sub slurp {my$self=shift;my$args=_get_args(shift,qw/binmode/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open<'}unless defined$binmode;my$fh=$self->filehandle({locked=>1 },"<",$binmode);if ((defined($binmode)? $binmode : "")eq ":unix" and my$size=-s $fh){my$buf;read$fh,$buf,$size;return$buf}else {local $/;return scalar <$fh>}}sub slurp_raw {$_[1]={binmode=>":unix" };goto&slurp}sub slurp_utf8 {if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){return Unicode::UTF8::decode_utf8(slurp($_[0],{binmode=>":unix" }))}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$_[1]={binmode=>":unix:utf8_strict" };goto&slurp}else {$_[1]={binmode=>":raw:encoding(UTF-8)" };goto&slurp}}sub spew {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$resolved_path=$self->_resolve_symlinks;my$temp=path($resolved_path .$$ .int(rand(2**31)));my$fh=$temp->filehandle({exclusive=>1,locked=>1 },">",$binmode);print {$fh}map {ref eq 'ARRAY' ? @$_ : $_}@data;close$fh or $self->_throw('close',$temp->[PATH]);return$temp->move($resolved_path)}sub spew_raw {splice @_,1,0,{binmode=>":unix" };goto&spew}sub spew_utf8 {if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){my$self=shift;spew($self,{binmode=>":unix" },map {Unicode::UTF8::encode_utf8($_)}map {ref eq 'ARRAY' ? @$_ : $_}@_)}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){splice @_,1,0,{binmode=>":unix:utf8_strict" };goto&spew}else {splice @_,1,0,{binmode=>":unix:encoding(UTF-8)" };goto&spew}}sub stat {my$self=shift;require File::stat;return File::stat::stat($self->[PATH])|| $self->_throw('stat')}sub lstat {my$self=shift;require File::stat;return File::stat::lstat($self->[PATH])|| $self->_throw('lstat')}sub stringify {$_[0]->[PATH]}sub subsumes {my$self=shift;Carp::croak("subsumes() requires a defined, positive-length argument")unless defined $_[0];my$other=path(shift);if ($self->is_absolute &&!$other->is_absolute){$other=$other->absolute}elsif ($other->is_absolute &&!$self->is_absolute){$self=$self->absolute}if (length$self->volume &&!length$other->volume){$other=$other->absolute}elsif (length$other->volume &&!length$self->volume){$self=$self->absolute}if ($self->[PATH]eq '.'){return!!1}elsif ($self->is_rootdir){return$other->[PATH]=~ m{^\Q$self->[PATH]\E}}else {return$other->[PATH]=~ m{^\Q$self->[PATH]\E(?:/|$)}}}sub touch {my ($self,$epoch)=@_;if (!-e $self->[PATH]){my$fh=$self->openw;close$fh or $self->_throw('close')}if (defined$epoch){utime$epoch,$epoch,$self->[PATH]or $self->_throw("utime ($epoch)")}else {utime undef,undef,$self->[PATH]or $self->_throw("utime ()")}return$self}sub touchpath {my ($self)=@_;my$parent=$self->parent;$parent->mkpath unless$parent->exists;$self->touch}sub visit {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/recurse follow_symlinks/);Carp::croak("Callback for visit() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';my$next=$self->iterator($args);my$state={};while (my$file=$next->()){local $_=$file;my$r=$cb->($file,$state);last if ref($r)eq 'SCALAR' &&!$$r}return$state}sub volume {my ($self)=@_;$self->_splitpath unless defined$self->[VOL];return$self->[VOL]}package Path::Tiny::Error;our@CARP_NOT=qw/Path::Tiny/;use overload (q{""}=>sub {(shift)->{msg}},fallback=>1);sub throw {my ($class,$op,$file,$err)=@_;chomp(my$trace=Carp::shortmess);my$msg="Error $op on '$file': $err$trace\n";die bless {op=>$op,file=>$file,err=>$err,msg=>$msg },$class}1;
+ use 5.008001;use strict;use warnings;package Path::Tiny;our$VERSION='0.118';use Config;use Exporter 5.57 (qw/import/);use File::Spec 0.86 ();use Carp ();our@EXPORT=qw/path/;our@EXPORT_OK=qw/cwd rootdir tempfile tempdir/;use constant {PATH=>0,CANON=>1,VOL=>2,DIR=>3,FILE=>4,TEMP=>5,IS_WIN32=>($^O eq 'MSWin32'),};use overload (q{""}=>sub {$_[0]->[PATH]},bool=>sub () {1},fallback=>1,);sub FREEZE {return $_[0]->[PATH]}sub THAW {return path($_[2])}{no warnings 'once';*TO_JSON=*FREEZE};my$HAS_UU;sub _check_UU {local$SIG{__DIE__};!!eval {require Unicode::UTF8;Unicode::UTF8->VERSION(0.58);1}}my$HAS_PU;sub _check_PU {local$SIG{__DIE__};!!eval {require Encode;require PerlIO::utf8_strict;PerlIO::utf8_strict->VERSION(0.003);1}}my$HAS_FLOCK=$Config{d_flock}|| $Config{d_fcntl_can_lock}|| $Config{d_lockf};my$SLASH=qr{[\\/]};my$NOTSLASH=qr{[^\\/]};my$DRV_VOL=qr{[a-z]:}i;my$UNC_VOL=qr{$SLASH $SLASH $NOTSLASH+ $SLASH $NOTSLASH+}x;my$WIN32_ROOT=qr{(?: $UNC_VOL $SLASH | $DRV_VOL $SLASH | $SLASH )}x;sub _win32_vol {my ($path,$drv)=@_;require Cwd;my$dcwd=eval {Cwd::getdcwd($drv)};$dcwd="$drv" unless defined$dcwd && length$dcwd;$dcwd =~ s{$SLASH?\z}{/};$path =~ s{^$DRV_VOL}{$dcwd};return$path}sub _is_root {return IS_WIN32()? ($_[0]=~ /^$WIN32_ROOT\z/): ($_[0]eq '/')}BEGIN {*_same=IS_WIN32()? sub {lc($_[0])eq lc($_[1])}: sub {$_[0]eq $_[1]}}my%MODEBITS=(om=>0007,gm=>0070,um=>0700);{my$m=0;$MODEBITS{$_}=(1 << $m++)for qw/ox ow or gx gw gr ux uw ur/};sub _symbolic_chmod {my ($mode,$symbolic)=@_;for my$clause (split /,\s*/,$symbolic){if ($clause =~ m{\A([augo]+)([=+-])([rwx]+)\z}){my ($who,$action,$perms)=($1,$2,$3);$who =~ s/a/ugo/g;for my$w (split //,$who){my$p=0;$p |= $MODEBITS{"$w$_"}for split //,$perms;if ($action eq '='){$mode=($mode & ~$MODEBITS{"${w}m"})| $p}else {$mode=$action eq "+" ? ($mode | $p): ($mode & ~$p)}}}else {Carp::croak("Invalid mode clause '$clause' for chmod()")}}return$mode}{package flock;use warnings::register}my$WARNED_NO_FLOCK=0;sub _throw {my ($self,$function,$file,$msg)=@_;if ($function =~ /^flock/ && $! =~ /operation not supported|function not implemented/i &&!warnings::fatal_enabled('flock')){if (!$WARNED_NO_FLOCK){warnings::warn(flock=>"Flock not available: '$!': continuing in unsafe mode");$WARNED_NO_FLOCK++}}else {$msg=$! unless defined$msg;Path::Tiny::Error->throw($function,(defined$file ? $file : $self->[PATH]),$msg)}return}sub _get_args {my ($raw,@valid)=@_;if (defined($raw)&& ref($raw)ne 'HASH'){my (undef,undef,undef,$called_as)=caller(1);$called_as =~ s{^.*::}{};Carp::croak("Options for $called_as must be a hash reference")}my$cooked={};for my$k (@valid){$cooked->{$k}=delete$raw->{$k}if exists$raw->{$k}}if (keys %$raw){my (undef,undef,undef,$called_as)=caller(1);$called_as =~ s{^.*::}{};Carp::croak("Invalid option(s) for $called_as: " .join(", ",keys %$raw))}return$cooked}sub path {my$path=shift;Carp::croak("Path::Tiny paths require defined, positive-length parts")unless 1 + @_==grep {defined && length}$path,@_;if (!@_ && ref($path)eq __PACKAGE__ &&!$path->[TEMP]){return$path}$path="$path";if (IS_WIN32()){$path=_win32_vol($path,$1)if$path =~ m{^($DRV_VOL)(?:$NOTSLASH|\z)};$path .= "/" if$path =~ m{^$UNC_VOL\z}}if (@_){$path .= (_is_root($path)? "" : "/").join("/",@_)}my$cpath=$path=File::Spec->canonpath($path);$path =~ tr[\\][/] if IS_WIN32();$path="/" if$path eq '/..';$path .= "/" if IS_WIN32()&& $path =~ m{^$UNC_VOL\z};if (_is_root($path)){$path =~ s{/?\z}{/}}else {$path =~ s{/\z}{}}if ($path =~ m{^(~[^/]*).*}){require File::Glob;my ($homedir)=File::Glob::bsd_glob($1);$homedir =~ tr[\\][/] if IS_WIN32();$path =~ s{^(~[^/]*)}{$homedir}}bless [$path,$cpath ],__PACKAGE__}sub new {shift;path(@_)}sub cwd {require Cwd;return path(Cwd::getcwd())}sub rootdir {path(File::Spec->rootdir)}sub tempfile {shift if @_ && $_[0]eq 'Path::Tiny';my$opts=(@_ && ref $_[0]eq 'HASH')? shift @_ : {};$opts=_get_args($opts,qw/realpath/);my ($maybe_template,$args)=_parse_file_temp_args(@_);$args->{TEMPLATE}=$maybe_template->[0]if @$maybe_template;require File::Temp;my$temp=File::Temp->new(TMPDIR=>1,%$args);close$temp;my$self=$opts->{realpath}? path($temp)->realpath : path($temp)->absolute;$self->[TEMP]=$temp;return$self}sub tempdir {shift if @_ && $_[0]eq 'Path::Tiny';my$opts=(@_ && ref $_[0]eq 'HASH')? shift @_ : {};$opts=_get_args($opts,qw/realpath/);my ($maybe_template,$args)=_parse_file_temp_args(@_);require File::Temp;my$temp=File::Temp->newdir(@$maybe_template,TMPDIR=>1,%$args);my$self=$opts->{realpath}? path($temp)->realpath : path($temp)->absolute;$self->[TEMP]=$temp;$temp->{REALNAME}=$self->[CANON]if IS_WIN32;return$self}sub _parse_file_temp_args {my$leading_template=(scalar(@_)% 2==1 ? shift(@_): '');my%args=@_;%args=map {uc($_),$args{$_}}keys%args;my@template=(exists$args{TEMPLATE}? delete$args{TEMPLATE}: $leading_template ? $leading_template : ());return (\@template,\%args)}sub _splitpath {my ($self)=@_;@{$self}[VOL,DIR,FILE ]=File::Spec->splitpath($self->[PATH])}sub _resolve_symlinks {my ($self)=@_;my$new=$self;my ($count,%seen)=0;while (-l $new->[PATH]){if ($seen{$new->[PATH]}++){$self->_throw('readlink',$self->[PATH],"symlink loop detected")}if (++$count > 100){$self->_throw('readlink',$self->[PATH],"maximum symlink depth exceeded")}my$resolved=readlink$new->[PATH]or $new->_throw('readlink',$new->[PATH]);$resolved=path($resolved);$new=$resolved->is_absolute ? $resolved : $new->sibling($resolved)}return$new}sub absolute {my ($self,$base)=@_;if (IS_WIN32){return$self if length$self->volume;if ($self->is_absolute){require Cwd;my ($drv)=Win32::GetCwd()=~ /^($DRV_VOL | $UNC_VOL)/x;return path($drv .$self->[PATH])}}else {return$self if$self->is_absolute}require Cwd;return path(Cwd::getcwd(),$_[0]->[PATH])unless defined$base;$base=path($base);return path(($base->is_absolute ? $base : $base->absolute),$_[0]->[PATH])}sub append {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$mode=$args->{truncate}? ">" : ">>";my$fh=$self->filehandle({locked=>1 },$mode,$binmode);print {$fh}map {ref eq 'ARRAY' ? @$_ : $_}@data;close$fh or $self->_throw('close')}sub append_raw {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);$args->{binmode}=':unix';append($self,$args,@data)}sub append_utf8 {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode truncate/);if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){$args->{binmode}=":unix";append($self,$args,map {Unicode::UTF8::encode_utf8($_)}@data)}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$args->{binmode}=":unix:utf8_strict";append($self,$args,@data)}else {$args->{binmode}=":unix:encoding(UTF-8)";append($self,$args,@data)}}sub assert {my ($self,$assertion)=@_;return$self unless$assertion;if (ref$assertion eq 'CODE'){local $_=$self;$assertion->()or Path::Tiny::Error->throw("assert",$self->[PATH],"failed assertion")}else {Carp::croak("argument to assert must be a code reference argument")}return$self}sub basename {my ($self,@suffixes)=@_;$self->_splitpath unless defined$self->[FILE];my$file=$self->[FILE];for my$s (@suffixes){my$re=ref($s)eq 'Regexp' ? qr/$s\z/ : qr/\Q$s\E\z/;last if$file =~ s/$re//}return$file}sub canonpath {$_[0]->[CANON]}sub cached_temp {my$self=shift;$self->_throw("cached_temp",$self,"has no cached File::Temp object")unless defined$self->[TEMP];return$self->[TEMP]}sub child {my ($self,@parts)=@_;return path($self->[PATH],@parts)}sub children {my ($self,$filter)=@_;my$dh;opendir$dh,$self->[PATH]or $self->_throw('opendir');my@children=readdir$dh;closedir$dh or $self->_throw('closedir');if (not defined$filter){@children=grep {$_ ne '.' && $_ ne '..'}@children}elsif ($filter && ref($filter)eq 'Regexp'){@children=grep {$_ ne '.' && $_ ne '..' && $_ =~ $filter}@children}else {Carp::croak("Invalid argument '$filter' for children()")}return map {path($self->[PATH],$_)}@children}sub chmod {my ($self,$new_mode)=@_;my$mode;if ($new_mode =~ /\d/){$mode=($new_mode =~ /^0/ ? oct($new_mode): $new_mode)}elsif ($new_mode =~ /[=+-]/){$mode=_symbolic_chmod($self->stat->mode & 07777,$new_mode)}else {Carp::croak("Invalid mode argument '$new_mode' for chmod()")}CORE::chmod($mode,$self->[PATH])or $self->_throw("chmod");return 1}sub copy {my ($self,$dest)=@_;require File::Copy;File::Copy::copy($self->[PATH],$dest)or Carp::croak("copy failed for $self to $dest: $!");return -d $dest ? path($dest,$self->basename): path($dest)}sub digest {my ($self,@opts)=@_;my$args=(@opts && ref$opts[0]eq 'HASH')? shift@opts : {};$args=_get_args($args,qw/chunk_size/);unshift@opts,'SHA-256' unless@opts;require Digest;my$digest=Digest->new(@opts);if ($args->{chunk_size}){my$fh=$self->filehandle({locked=>1 },"<",":unix");my$buf;$digest->add($buf)while read$fh,$buf,$args->{chunk_size}}else {$digest->add($self->slurp_raw)}return$digest->hexdigest}sub dirname {my ($self)=@_;$self->_splitpath unless defined$self->[DIR];return length$self->[DIR]? $self->[DIR]: "."}sub edit {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/binmode/);Carp::croak("Callback for edit() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';local $_=$self->slurp(exists($args->{binmode})? {binmode=>$args->{binmode}}: ());$cb->();$self->spew($args,$_);return}sub edit_utf8 {my ($self,$cb)=@_;Carp::croak("Callback for edit_utf8() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';local $_=$self->slurp_utf8;$cb->();$self->spew_utf8($_);return}sub edit_raw {$_[2]={binmode=>":unix" };goto&edit}sub edit_lines {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/binmode/);Carp::croak("Callback for edit_lines() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$resolved_path=$self->_resolve_symlinks;my$temp=path($resolved_path .$$ .int(rand(2**31)));my$temp_fh=$temp->filehandle({exclusive=>1,locked=>1 },">",$binmode);my$in_fh=$self->filehandle({locked=>1 },'<',$binmode);local $_;while (<$in_fh>){$cb->();$temp_fh->print($_)}close$temp_fh or $self->_throw('close',$temp);close$in_fh or $self->_throw('close');return$temp->move($resolved_path)}sub edit_lines_raw {$_[2]={binmode=>":unix" };goto&edit_lines}sub edit_lines_utf8 {$_[2]={binmode=>":raw:encoding(UTF-8)" };goto&edit_lines}sub exists {-e $_[0]->[PATH]}sub is_file {-e $_[0]->[PATH]&&!-d _}sub is_dir {-d $_[0]->[PATH]}sub filehandle {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked exclusive/);$args->{locked}=1 if$args->{exclusive};my ($opentype,$binmode)=@args;$opentype="<" unless defined$opentype;Carp::croak("Invalid file mode '$opentype'")unless grep {$opentype eq $_}qw/< +< > +> >> +>>/;$binmode=((caller(0))[10]|| {})->{'open' .substr($opentype,-1,1)}unless defined$binmode;$binmode="" unless defined$binmode;my ($fh,$lock,$trunc);if ($HAS_FLOCK && $args->{locked}&&!$ENV{PERL_PATH_TINY_NO_FLOCK}){require Fcntl;if (grep {$opentype eq $_}qw(> +>)){my$flags=$opentype eq ">" ? Fcntl::O_WRONLY(): Fcntl::O_RDWR();$flags |= Fcntl::O_CREAT();$flags |= Fcntl::O_EXCL()if$args->{exclusive};sysopen($fh,$self->[PATH],$flags)or $self->_throw("sysopen");if ($binmode =~ s/^:unix//){binmode($fh,":raw")or $self->_throw("binmode (:raw)");while (1 < (my$layers=()=PerlIO::get_layers($fh,output=>1))){binmode($fh,":pop")or $self->_throw("binmode (:pop)")}}if (length$binmode){binmode($fh,$binmode)or $self->_throw("binmode ($binmode)")}$lock=Fcntl::LOCK_EX();$trunc=1}elsif ($^O eq 'aix' && $opentype eq "<"){if (-w $self->[PATH]){$opentype="+<";$lock=Fcntl::LOCK_EX()}}else {$lock=$opentype eq "<" ? Fcntl::LOCK_SH(): Fcntl::LOCK_EX()}}unless ($fh){my$mode=$opentype .$binmode;open$fh,$mode,$self->[PATH]or $self->_throw("open ($mode)")}do {flock($fh,$lock)or $self->_throw("flock ($lock)")}if$lock;do {truncate($fh,0)or $self->_throw("truncate")}if$trunc;return$fh}sub is_absolute {substr($_[0]->dirname,0,1)eq '/'}sub is_relative {substr($_[0]->dirname,0,1)ne '/'}sub is_rootdir {my ($self)=@_;$self->_splitpath unless defined$self->[DIR];return$self->[DIR]eq '/' && $self->[FILE]eq ''}sub iterator {my$self=shift;my$args=_get_args(shift,qw/recurse follow_symlinks/);my@dirs=$self;my$current;return sub {my$next;while (@dirs){if (ref$dirs[0]eq 'Path::Tiny'){if (!-r $dirs[0]){shift@dirs and next}$current=$dirs[0];my$dh;opendir($dh,$current->[PATH])or $self->_throw('opendir',$current->[PATH]);$dirs[0]=$dh;if (-l $current->[PATH]&&!$args->{follow_symlinks}){shift@dirs and next}}while (defined($next=readdir$dirs[0])){next if$next eq '.' || $next eq '..';my$path=$current->child($next);push@dirs,$path if$args->{recurse}&& -d $path &&!(!$args->{follow_symlinks}&& -l $path);return$path}shift@dirs}return}}sub lines {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open<'}unless defined$binmode;my$fh=$self->filehandle({locked=>1 },"<",$binmode);my$chomp=$args->{chomp};if ($args->{count}){my ($counter,$mod,@result)=(0,abs($args->{count}));while (my$line=<$fh>){$line =~ s/(?:\x{0d}?\x{0a}|\x{0d})\z// if$chomp;$result[$counter++ ]=$line;last if$counter==$args->{count};$counter %= $mod}splice(@result,0,0,splice(@result,$counter))if@result==$mod && $counter % $mod;return@result}elsif ($chomp){return map {s/(?:\x{0d}?\x{0a}|\x{0d})\z//;$_}<$fh>}else {return wantarray ? <$fh> : (my$count=()=<$fh>)}}sub lines_raw {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);if ($args->{chomp}&&!$args->{count}){return split /\n/,slurp_raw($self)}else {$args->{binmode}=":raw";return lines($self,$args)}}my$CRLF=qr/(?:\x{0d}?\x{0a}|\x{0d})/;sub lines_utf8 {my$self=shift;my$args=_get_args(shift,qw/binmode chomp count/);if ((defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU()))&& $args->{chomp}&&!$args->{count}){my$slurp=slurp_utf8($self);$slurp =~ s/$CRLF\z//;return split$CRLF,$slurp,-1}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$args->{binmode}=":unix:utf8_strict";return lines($self,$args)}else {$args->{binmode}=":raw:encoding(UTF-8)";return lines($self,$args)}}sub mkpath {my ($self,$args)=@_;$args={}unless ref$args eq 'HASH';my$err;$args->{error}=\$err unless defined$args->{error};require File::Path;my@dirs=File::Path::make_path($self->[PATH],$args);if ($err && @$err){my ($file,$message)=%{$err->[0]};Carp::croak("mkpath failed for $file: $message")}return@dirs}sub move {my ($self,$dst)=@_;return rename($self->[PATH],$dst)|| $self->_throw('rename',$self->[PATH]."' -> '$dst")}my%opens=(opena=>">>",openr=>"<",openw=>">",openrw=>"+<");while (my ($k,$v)=each%opens){no strict 'refs';*{$k}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);my ($binmode)=@args;$binmode=((caller(0))[10]|| {})->{'open' .substr($v,-1,1)}unless defined$binmode;$self->filehandle($args,$v,$binmode)};*{$k ."_raw"}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);$self->filehandle($args,$v,":raw")};*{$k ."_utf8"}=sub {my ($self,@args)=@_;my$args=(@args && ref$args[0]eq 'HASH')? shift@args : {};$args=_get_args($args,qw/locked/);$self->filehandle($args,$v,":raw:encoding(UTF-8)")}}sub parent {my ($self,$level)=@_;$level=1 unless defined$level && $level > 0;$self->_splitpath unless defined$self->[FILE];my$parent;if (length$self->[FILE]){if ($self->[FILE]eq '.' || $self->[FILE]eq ".."){$parent=path($self->[PATH]."/..")}else {$parent=path(_non_empty($self->[VOL].$self->[DIR]))}}elsif (length$self->[DIR]){if ($self->[DIR]=~ m{(?:^\.\./|/\.\./|/\.\.\z)}){$parent=path($self->[VOL].$self->[DIR]."/..")}else {(my$dir=$self->[DIR])=~ s{/[^\/]+/\z}{/};$parent=path($self->[VOL].$dir)}}else {$parent=path(_non_empty($self->[VOL]))}return$level==1 ? $parent : $parent->parent($level - 1)}sub _non_empty {my ($string)=shift;return ((defined($string)&& length($string))? $string : ".")}sub realpath {my$self=shift;$self=$self->_resolve_symlinks;require Cwd;$self->_splitpath if!defined$self->[FILE];my$check_parent=length$self->[FILE]&& $self->[FILE]ne '.' && $self->[FILE]ne '..';my$realpath=eval {local$SIG{__WARN__}=sub {};Cwd::realpath($check_parent ? $self->parent->[PATH]: $self->[PATH])};$self->_throw("resolving realpath")unless defined$realpath && length$realpath && -e $realpath;return ($check_parent ? path($realpath,$self->[FILE]): path($realpath))}sub relative {my ($self,$base)=@_;$base=path(defined$base && length$base ? $base : '.');$self=$self->absolute if$self->is_relative;$base=$base->absolute if$base->is_relative;$self=$self->absolute if!length$self->volume && length$base->volume;$base=$base->absolute if length$self->volume &&!length$base->volume;if (!_same($self->volume,$base->volume)){Carp::croak("relative() can't cross volumes: '$self' vs '$base'")}return path(".")if _same($self->[PATH],$base->[PATH]);if ($base->subsumes($self)){$base="" if$base->is_rootdir;my$relative="$self";$relative =~ s{\A\Q$base/}{};return path($relative)}my (@common,@self_parts,@base_parts);@base_parts=split /\//,$base->_just_filepath;if ($self->is_rootdir){@common=("");shift@base_parts}else {@self_parts=split /\//,$self->_just_filepath;while (@self_parts && @base_parts && _same($self_parts[0],$base_parts[0])){push@common,shift@base_parts;shift@self_parts}}if (my$new_base=$self->_resolve_between(\@common,\@base_parts)){return$self->relative($new_base)}my@new_path=(("..")x (0+ @base_parts),@self_parts);return path(@new_path)}sub _just_filepath {my$self=shift;my$self_vol=$self->volume;return "$self" if!length$self_vol;(my$self_path="$self")=~ s{\A\Q$self_vol}{};return$self_path}sub _resolve_between {my ($self,$common,$base)=@_;my$path=$self->volume .join("/",@$common);my$changed=0;for my$p (@$base){$path .= "/$p";if ($p eq '..'){$changed=1;if (-e $path){$path=path($path)->realpath->[PATH]}else {$path =~ s{/[^/]+/..\z}{/}}}if (-l $path){$changed=1;$path=path($path)->realpath->[PATH]}}return$changed ? path($path): undef}sub remove {my$self=shift;return 0 if!-e $self->[PATH]&&!-l $self->[PATH];return unlink($self->[PATH])|| $self->_throw('unlink')}sub remove_tree {my ($self,$args)=@_;return 0 if!-e $self->[PATH]&&!-l $self->[PATH];$args={}unless ref$args eq 'HASH';my$err;$args->{error}=\$err unless defined$args->{error};$args->{safe}=1 unless defined$args->{safe};require File::Path;my$count=File::Path::remove_tree($self->[PATH],$args);if ($err && @$err){my ($file,$message)=%{$err->[0]};Carp::croak("remove_tree failed for $file: $message")}return$count}sub sibling {my$self=shift;return path($self->parent->[PATH],@_)}sub slurp {my$self=shift;my$args=_get_args(shift,qw/binmode/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open<'}unless defined$binmode;my$fh=$self->filehandle({locked=>1 },"<",$binmode);if ((defined($binmode)? $binmode : "")eq ":unix" and my$size=-s $fh){my$buf;read$fh,$buf,$size;return$buf}else {local $/;return scalar <$fh>}}sub slurp_raw {$_[1]={binmode=>":unix" };goto&slurp}sub slurp_utf8 {if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){return Unicode::UTF8::decode_utf8(slurp($_[0],{binmode=>":unix" }))}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){$_[1]={binmode=>":unix:utf8_strict" };goto&slurp}else {$_[1]={binmode=>":raw:encoding(UTF-8)" };goto&slurp}}sub spew {my ($self,@data)=@_;my$args=(@data && ref$data[0]eq 'HASH')? shift@data : {};$args=_get_args($args,qw/binmode/);my$binmode=$args->{binmode};$binmode=((caller(0))[10]|| {})->{'open>'}unless defined$binmode;my$resolved_path=$self->_resolve_symlinks;my$temp=path($resolved_path .$$ .int(rand(2**31)));my$fh=$temp->filehandle({exclusive=>1,locked=>1 },">",$binmode);print {$fh}map {ref eq 'ARRAY' ? @$_ : $_}@data;close$fh or $self->_throw('close',$temp->[PATH]);return$temp->move($resolved_path)}sub spew_raw {splice @_,1,0,{binmode=>":unix" };goto&spew}sub spew_utf8 {if (defined($HAS_UU)? $HAS_UU : ($HAS_UU=_check_UU())){my$self=shift;spew($self,{binmode=>":unix" },map {Unicode::UTF8::encode_utf8($_)}map {ref eq 'ARRAY' ? @$_ : $_}@_)}elsif (defined($HAS_PU)? $HAS_PU : ($HAS_PU=_check_PU())){splice @_,1,0,{binmode=>":unix:utf8_strict" };goto&spew}else {splice @_,1,0,{binmode=>":unix:encoding(UTF-8)" };goto&spew}}sub stat {my$self=shift;require File::stat;return File::stat::stat($self->[PATH])|| $self->_throw('stat')}sub lstat {my$self=shift;require File::stat;return File::stat::lstat($self->[PATH])|| $self->_throw('lstat')}sub stringify {$_[0]->[PATH]}sub subsumes {my$self=shift;Carp::croak("subsumes() requires a defined, positive-length argument")unless defined $_[0];my$other=path(shift);if ($self->is_absolute &&!$other->is_absolute){$other=$other->absolute}elsif ($other->is_absolute &&!$self->is_absolute){$self=$self->absolute}if (length$self->volume &&!length$other->volume){$other=$other->absolute}elsif (length$other->volume &&!length$self->volume){$self=$self->absolute}if ($self->[PATH]eq '.'){return!!1}elsif ($self->is_rootdir){return$other->[PATH]=~ m{^\Q$self->[PATH]\E}}else {return$other->[PATH]=~ m{^\Q$self->[PATH]\E(?:/|\z)}}}sub touch {my ($self,$epoch)=@_;if (!-e $self->[PATH]){my$fh=$self->openw;close$fh or $self->_throw('close')}if (defined$epoch){utime$epoch,$epoch,$self->[PATH]or $self->_throw("utime ($epoch)")}else {utime undef,undef,$self->[PATH]or $self->_throw("utime ()")}return$self}sub touchpath {my ($self)=@_;my$parent=$self->parent;$parent->mkpath unless$parent->exists;$self->touch}sub visit {my$self=shift;my$cb=shift;my$args=_get_args(shift,qw/recurse follow_symlinks/);Carp::croak("Callback for visit() must be a code reference")unless defined($cb)&& ref($cb)eq 'CODE';my$next=$self->iterator($args);my$state={};while (my$file=$next->()){local $_=$file;my$r=$cb->($file,$state);last if ref($r)eq 'SCALAR' &&!$$r}return$state}sub volume {my ($self)=@_;$self->_splitpath unless defined$self->[VOL];return$self->[VOL]}package Path::Tiny::Error;our@CARP_NOT=qw/Path::Tiny/;use overload (q{""}=>sub {(shift)->{msg}},fallback=>1);sub throw {my ($class,$op,$file,$err)=@_;chomp(my$trace=Carp::shortmess);my$msg="Error $op on '$file': $err$trace\n";die bless {op=>$op,file=>$file,err=>$err,msg=>$msg },$class}1;
PATH_TINY
$fatpacked{"Proc/Find/Parents.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PROC_FIND_PARENTS';
PROC_FIND_PARENTS
$fatpacked{"Term/Detect/Software.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TERM_DETECT_SOFTWARE';
- package Term::Detect::Software;our$DATE='2019-08-21';our$VERSION='0.222';use 5.010001;use strict;use warnings;use experimental 'smartmatch';require Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(detect_terminal detect_terminal_cached);my$dt_cache;sub detect_terminal_cached {if (!$dt_cache){$dt_cache=detect_terminal(@_)}$dt_cache}sub detect_terminal {my@dbg;my$info={_debug_info=>\@dbg};DETECT: {unless (defined$ENV{TERM}){push@dbg,"skip: TERM env undefined";$info->{emulator_engine}='';$info->{emulator_software}='';last DETECT}if ($ENV{KONSOLE_DBUS_SERVICE}|| $ENV{KONSOLE_DBUS_SESSION}){push@dbg,"detect: konsole via KONSOLE_DBUS_{SERVICE,SESSION} env";$info->{emulator_engine}='konsole';$info->{color_depth}=2**24;$info->{default_bgcolor}='000000';$info->{unicode}=1;$info->{box_chars}=1;last DETECT}if ($ENV{XTERM_VERSION}){push@dbg,"detect: xterm via XTERM_VERSION env";$info->{emulator_engine}='xterm';$info->{color_depth}=256;$info->{default_bgcolor}='ffffff';$info->{unicode}=0;$info->{box_chars}=1;last DETECT}if ($ENV{TERM}eq 'xterm' && ($ENV{OSTYPE}// '')eq 'cygwin'){push@dbg,"detect: xterm via TERM env (cygwin)";$info->{emulator_engine}='cygwin';$info->{color_depth}=16;$info->{default_bgcolor}='000000';$info->{unicode}=0;$info->{box_chars}=1;last DETECT}if ($ENV{TERM}eq 'linux'){push@dbg,"detect: linux via TERM env";$info->{emulator_engine}='linux';$info->{color_depth}=16;$info->{default_bgcolor}='000000';$info->{unicode}=0;$info->{box_chars}=0;last DETECT}my$gnome_terminal_terms=[qw/gnome-terminal guake xfce4-terminal mlterm lxterminal/];my$set_gnome_terminal_term=sub {$info->{emulator_software}=$_[0];$info->{emulator_engine}='gnome-terminal';$info->{color_depth}=$_[0]=~ /xfce4/ ? 16 : 256;$info->{unicode}=1;if ($_[0]~~ [qw/mlterm/]){$info->{default_bgcolor}='ffffff'}else {$info->{default_bgcolor}='000000'}$info->{box_chars}=1};if (($ENV{COLORTERM}// '')~~ $gnome_terminal_terms){push@dbg,"detect: gnome-terminal via COLORTERM";$set_gnome_terminal_term->($ENV{COLORTERM});last DETECT}if ($ENV{TERM}eq 'dumb' && $ENV{windir}){push@dbg,"detect: windows via TERM & windir env";$info->{emulator_software}='windows';$info->{emulator_engine}='windows';$info->{color_depth}=16;$info->{unicode}=0;$info->{default_bgcolor}='000000';$info->{box_chars}=0;last DETECT}if ($ENV{TERM}eq 'dumb'){push@dbg,"detect: dumb via TERM env";$info->{emulator_software}='dumb';$info->{emulator_engine}='dumb';$info->{color_depth}=0;$info->{default_bgcolor}='000000';$info->{box_chars}=0;last DETECT}{last if $^O =~ /Win/;require Proc::Find::Parents;my$ppids=Proc::Find::Parents::get_parent_processes();unless (defined$ppids){push@dbg,"skip: get_parent_processes returns undef";last}my$proc=@$ppids >= 1 ? $ppids->[1]{name}: '';if ($proc ~~ $gnome_terminal_terms){push@dbg,"detect: gnome-terminal via procname ($proc)";$set_gnome_terminal_term->($proc);last DETECT}elsif ($proc ~~ [qw/rxvt mrxvt/]){push@dbg,"detect: rxvt via procname ($proc)";$info->{emulator_software}=$proc;$info->{emulator_engine}='rxvt';$info->{color_depth}=16;$info->{unicode}=0;$info->{default_bgcolor}='d6d2d0';$info->{box_chars}=1;last DETECT}elsif ($proc eq 'st' && $ENV{TERM}eq 'xterm-256color'){push@dbg,"detect: st via procname";$info->{emulator_software}='st';$info->{emulator_engine}='st';$info->{color_depth}=256;$info->{unicode}=1;$info->{default_bgcolor}='000000';$info->{box_chars}=1;last DETECT}elsif ($proc ~~ [qw/pterm/]){push@dbg,"detect: pterm via procname ($proc)";$info->{emulator_software}=$proc;$info->{emulator_engine}='putty';$info->{color_depth}=256;$info->{unicode}=0;$info->{default_bgcolor}='000000';last DETECT}elsif ($proc ~~ [qw/xvt/]){push@dbg,"detect: xvt via procname ($proc)";$info->{emulator_software}=$proc;$info->{emulator_engine}='xvt';$info->{color_depth}=0;$info->{unicode}=0;$info->{default_bgcolor}='d6d2d0';last DETECT}}{unless (exists$info->{color_depth}){if ($ENV{TERM}=~ /256color/){push@dbg,"detect color_depth: 256 via TERM env";$info->{color_depth}=256}else {require File::Which;if (File::Which::which("tput")){my$res=`tput colors` + 0;push@dbg,"detect color_depth: $res via tput";$res=16 if$res==8;$info->{color_depth}=$res}}}$info->{emulator_software}//= '(generic)';$info->{emulator_engine}//= '(generic)';$info->{unicode}//= 0;$info->{color_depth}//= 0;$info->{box_chars}//= 0;$info->{default_bgcolor}//= '000000'}}if ($ENV{INSIDE_EMACS}){$info->{inside_emacs}=1;$info->{box_chars}=0}$info}1;
+ package Term::Detect::Software;our$AUTHORITY='cpan:PERLANCAR';our$DATE='2020-07-10';our$DIST='Term-Detect-Software';our$VERSION='0.223';use 5.010001;use strict;use warnings;use experimental 'smartmatch';require Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(detect_terminal detect_terminal_cached);my$dt_cache;sub detect_terminal_cached {if (!$dt_cache){$dt_cache=detect_terminal(@_)}$dt_cache}sub detect_terminal {my@dbg;my$info={_debug_info=>\@dbg};DETECT: {unless (defined$ENV{TERM}){push@dbg,"skip: TERM env undefined";$info->{emulator_engine}='';$info->{emulator_software}='';last DETECT}if ($ENV{KONSOLE_DBUS_SERVICE}|| $ENV{KONSOLE_DBUS_SESSION}){push@dbg,"detect: konsole via KONSOLE_DBUS_{SERVICE,SESSION} env";$info->{emulator_engine}='konsole';$info->{color_depth}=2**24;$info->{default_bgcolor}='000000';$info->{unicode}=1;$info->{box_chars}=1;last DETECT}if ($ENV{XTERM_VERSION}){push@dbg,"detect: xterm via XTERM_VERSION env";$info->{emulator_engine}='xterm';$info->{color_depth}=256;$info->{default_bgcolor}='ffffff';$info->{unicode}=0;$info->{box_chars}=1;last DETECT}if ($ENV{TERM}eq 'xterm' && ($ENV{OSTYPE}// '')eq 'cygwin'){push@dbg,"detect: xterm via TERM env (cygwin)";$info->{emulator_engine}='cygwin';$info->{color_depth}=16;$info->{default_bgcolor}='000000';$info->{unicode}=0;$info->{box_chars}=1;last DETECT}if ($ENV{TERM}eq 'linux'){push@dbg,"detect: linux via TERM env";$info->{emulator_engine}='linux';$info->{color_depth}=16;$info->{default_bgcolor}='000000';$info->{unicode}=0;$info->{box_chars}=0;last DETECT}my$gnome_terminal_terms=[qw/gnome-terminal guake xfce4-terminal mlterm lxterminal/];my$set_gnome_terminal_term=sub {$info->{emulator_software}=$_[0];$info->{emulator_engine}='gnome-terminal';$info->{color_depth}=$_[0]=~ /xfce4/ ? 16 : 256;$info->{unicode}=1;if ($_[0]~~ [qw/mlterm/]){$info->{default_bgcolor}='ffffff'}else {$info->{default_bgcolor}='000000'}$info->{box_chars}=1};if (($ENV{COLORTERM}// '')~~ $gnome_terminal_terms){push@dbg,"detect: gnome-terminal via COLORTERM";$set_gnome_terminal_term->($ENV{COLORTERM});last DETECT}if ($ENV{TERM}eq 'dumb' && $ENV{windir}){push@dbg,"detect: windows via TERM & windir env";$info->{emulator_software}='windows';$info->{emulator_engine}='windows';$info->{color_depth}=16;$info->{unicode}=0;$info->{default_bgcolor}='000000';$info->{box_chars}=0;last DETECT}if ($ENV{TERM}eq 'dumb'){push@dbg,"detect: dumb via TERM env";$info->{emulator_software}='dumb';$info->{emulator_engine}='dumb';$info->{color_depth}=0;$info->{default_bgcolor}='000000';$info->{box_chars}=0;last DETECT}{last if $^O =~ /Win/;require Proc::Find::Parents;my$ppids=Proc::Find::Parents::get_parent_processes();unless (defined$ppids){push@dbg,"skip: get_parent_processes returns undef";last}my$proc=@$ppids >= 2 ? $ppids->[1]{name}: '';if ($proc ~~ $gnome_terminal_terms){push@dbg,"detect: gnome-terminal via procname ($proc)";$set_gnome_terminal_term->($proc);last DETECT}elsif ($proc ~~ [qw/rxvt mrxvt/]){push@dbg,"detect: rxvt via procname ($proc)";$info->{emulator_software}=$proc;$info->{emulator_engine}='rxvt';$info->{color_depth}=16;$info->{unicode}=0;$info->{default_bgcolor}='d6d2d0';$info->{box_chars}=1;last DETECT}elsif ($proc eq 'st' && $ENV{TERM}eq 'xterm-256color'){push@dbg,"detect: st via procname";$info->{emulator_software}='st';$info->{emulator_engine}='st';$info->{color_depth}=256;$info->{unicode}=1;$info->{default_bgcolor}='000000';$info->{box_chars}=1;last DETECT}elsif ($proc ~~ [qw/pterm/]){push@dbg,"detect: pterm via procname ($proc)";$info->{emulator_software}=$proc;$info->{emulator_engine}='putty';$info->{color_depth}=256;$info->{unicode}=0;$info->{default_bgcolor}='000000';last DETECT}elsif ($proc ~~ [qw/xvt/]){push@dbg,"detect: xvt via procname ($proc)";$info->{emulator_software}=$proc;$info->{emulator_engine}='xvt';$info->{color_depth}=0;$info->{unicode}=0;$info->{default_bgcolor}='d6d2d0';last DETECT}}{unless (exists$info->{color_depth}){if ($ENV{TERM}=~ /256color/){push@dbg,"detect color_depth: 256 via TERM env";$info->{color_depth}=256}else {require File::Which;if (File::Which::which("tput")){my$res=`tput colors` + 0;push@dbg,"detect color_depth: $res via tput";$res=16 if$res==8;$info->{color_depth}=$res}}}$info->{emulator_software}//= '(generic)';$info->{emulator_engine}//= '(generic)';$info->{unicode}//= 0;$info->{color_depth}//= 0;$info->{box_chars}//= 0;$info->{default_bgcolor}//= '000000'}}if ($ENV{INSIDE_EMACS}){$info->{inside_emacs}=1;$info->{box_chars}=0}$info}1;
TERM_DETECT_SOFTWARE
+$fatpacked{"Test/File/Codeowners.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEST_FILE_CODEOWNERS';
+ package Test::File::Codeowners;use warnings;use strict;use Encode qw(encode);use File::Codeowners::Util qw(find_nearest_codeowners git_ls_files git_toplevel);use File::Codeowners;use Test::Builder;our$VERSION='0.51';my$Test=Test::Builder->new;sub import {my$self=shift;my$caller=caller;no strict 'refs';*{$caller.'::codeowners_syntax_ok'}=\&codeowners_syntax_ok;*{$caller.'::codeowners_git_files_ok'}=\&codeowners_git_files_ok;$Test->exported_to($caller);$Test->plan(@_)}sub codeowners_syntax_ok {my$filepath=shift || find_nearest_codeowners();eval {File::Codeowners->parse($filepath)};my$err=$@;$Test->ok(!$err,"Check syntax: $filepath");$Test->diag($err)if$err}sub codeowners_git_files_ok {my$filepath=shift || find_nearest_codeowners();$Test->subtest('codeowners_git_files_ok'=>sub {my$codeowners=eval {File::Codeowners->parse($filepath)};if (my$err=$@){$Test->plan(tests=>1);$Test->ok(0,"Parse $filepath");$Test->diag($err);return}my ($proc,@files)=git_ls_files(git_toplevel());$Test->plan($proc->wait==0 ? (tests=>scalar@files): (skip_all=>'git ls-files failed'));for my$filepath (@files){my$msg=encode('UTF-8',"Check file: $filepath");my$match=$codeowners->match($filepath);my$is_unowned=$codeowners->is_unowned($filepath);if (!$match &&!$is_unowned){$Test->ok(0,$msg);$Test->diag("File is unowned\n")}elsif ($match && $is_unowned){$Test->ok(0,$msg);$Test->diag("File is owned but listed as unowned\n")}else {$Test->ok(1,$msg)}}})}1;
+TEST_FILE_CODEOWNERS
+
$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
TEXT_GITIGNORE
$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;
+ package Text::Table::Any;our$AUTHORITY='cpan:PERLANCAR';our$DATE='2021-03-03';our$DIST='Text-Table-Any';our$VERSION='0.102';our@BACKENDS=qw(Term::TablePrint Text::ANSITable Text::ASCIITable Text::FormatTable Text::MarkdownTable Text::Table Text::Table::ASV Text::Table::CSV Text::Table::HTML Text::Table::HTML::DataTables Text::Table::LTSV Text::Table::Manifold Text::Table::More Text::Table::Org Text::Table::Paragraph Text::Table::Sprintf Text::Table::Tiny Text::Table::TinyBorderStyle Text::Table::TinyColor Text::Table::TinyColorWide Text::Table::TinyWide Text::Table::TSV Text::Table::XLSX Text::TabularDisplay Text::UnicodeBox::Table);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::Sprintf';my$header_row=$params{header_row}// 1;my$separate_rows=$params{separate_rows}// 0;if ($backend eq 'Text::Table::Tiny'){require Text::Table::Tiny;return Text::Table::Tiny::table(rows=>$rows,header_row=>$header_row,separate_rows=>$separate_rows,)."\n"}elsif ($backend eq 'Text::Table::TinyBorderStyle'){require Text::Table::TinyBorderStyle;return Text::Table::TinyBorderStyle::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::More'){require Text::Table::More;return Text::Table::More::generate_table(rows=>$rows,header_row=>$header_row,separate_rows=>$separate_rows,)."\n"}elsif ($backend eq 'Text::Table::Sprintf'){require Text::Table::Sprintf;return Text::Table::Sprintf::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=>'ASCII::SingleLine',);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}$t->show_row_separator(1)if$separate_rows;return$t->draw}elsif ($backend eq 'Text::Table::Manifold'){require Text::Table::Manifold;my$t=Text::Table::Manifold->new;if ($header_row){$t->headers($rows->[0]);$t->data([@{$rows}[1 .. $#{$rows}]])}else {$t->headers([map {"col$_"}0..$#{$rows->[0]}]);$t->data($rows)}return join("\n",@{$t->render(padding=>1)})."\n"}elsif ($backend eq 'Text::UnicodeBox::Table'){require Text::UnicodeBox::Table;my$t=Text::UnicodeBox::Table->new;if ($header_row){$t->add_header(@{$rows->[0]});$t->add_row(@{$rows->[$_]})for 1 .. $#{$rows}}else {$t->add_header(map {"col$_"}0..$#{$rows->[0]});$t->add_row(@{$rows->[$_]})for 0 .. $#{$rows}}return$t->render}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{"Text/Table/Sprintf.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE_SPRINTF';
+ package Text::Table::Sprintf;our$AUTHORITY='cpan:PERLANCAR';our$DATE='2020-08-10';our$DIST='Text-Table-Sprintf';our$VERSION='0.001';sub table {my%params=@_;my$rows=$params{rows}or die "Must provide rows!";return "" unless @$rows;my@widths;for my$row (@$rows){for (0..$#{$row}){my$len=length$row->[$_];$widths[$_]=$len if!defined$widths[$_]|| $widths[$_]< $len}}my$rowfmt=join("",(map {($_ ? "" : "|")." %-$widths[$_]s |"}0..$#widths),"\n");my$line=join("",(map {($_ ? "" : "+").("-" x ($widths[$_]+2))."+"}0..$#widths),"\n");my$tblfmt;if ($params{header_row}){$tblfmt=join("",$line,$rowfmt,$line,(map {$rowfmt}1..@$rows-1),$line,)}else {$tblfmt=join("",$line,(map {$rowfmt}1..@$rows),$line,)}sprintf$tblfmt,map {@$_}@$rows}1;
+TEXT_TABLE_SPRINTF
$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_TYPES
$fatpacked{"experimental.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPERIMENTAL';
- package experimental;$experimental::VERSION='0.021';use strict;use warnings;use version ();BEGIN {eval {require feature}};use Carp qw/croak carp/;my%warnings=map {$_=>1}grep {/^experimental::/}keys%warnings::Offsets;my%features=map {$_=>1}$] > 5.015006 ? keys%feature::feature : do {my@features;if ($] >= 5.010){push@features,qw/switch say state/;push@features,'unicode_strings' if $] > 5.011002}@features};my%min_version=(array_base=>'5',autoderef=>'5.14.0',bitwise=>'5.22.0',const_attr=>'5.22.0',current_sub=>'5.16.0',declared_refs=>'5.26.0',evalbytes=>'5.16.0',fc=>'5.16.0',isa=>'5.31.7',lexical_topic=>'5.10.0',lexical_subs=>'5.18.0',postderef=>'5.20.0',postderef_qq=>'5.20.0',refaliasing=>'5.22.0',regex_sets=>'5.18.0',say=>'5.10.0',smartmatch=>'5.10.0',signatures=>'5.20.0',state=>'5.10.0',switch=>'5.10.0',unicode_eval=>'5.16.0',unicode_strings=>'5.12.0',);my%removed_in_version=(array_base=>'5.29.4',autoderef=>'5.23.1',lexical_topic=>'5.23.4',);$_=version->new($_)for values%min_version;$_=version->new($_)for values%removed_in_version;my%additional=(postderef=>['postderef_qq'],switch=>['smartmatch'],declared_refs=>['refaliasing'],);sub _enable {my$pragma=shift;if ($warnings{"experimental::$pragma"}){warnings->unimport("experimental::$pragma");feature->import($pragma)if exists$features{$pragma};_enable(@{$additional{$pragma}})if$additional{$pragma}}elsif ($features{$pragma}){feature->import($pragma);_enable(@{$additional{$pragma}})if$additional{$pragma}}elsif (not exists$min_version{$pragma}){croak "Can't enable unknown feature $pragma"}elsif ($] < $min_version{$pragma}){my$stable=$min_version{$pragma};if ($stable->{version}[1]% 2){$stable=version->new("5.".($stable->{version}[1]+1).'.0')}croak "Need perl $stable or later for feature $pragma"}elsif ($] >= ($removed_in_version{$pragma}|| 7)){croak "Experimental feature $pragma has been removed from perl in version $removed_in_version{$pragma}"}}sub import {my ($self,@pragmas)=@_;for my$pragma (@pragmas){_enable($pragma)}return}sub _disable {my$pragma=shift;if ($warnings{"experimental::$pragma"}){warnings->import("experimental::$pragma");feature->unimport($pragma)if exists$features{$pragma};_disable(@{$additional{$pragma}})if$additional{$pragma}}elsif ($features{$pragma}){feature->unimport($pragma);_disable(@{$additional{$pragma}})if$additional{$pragma}}elsif (not exists$min_version{$pragma}){carp "Can't disable unknown feature $pragma, ignoring"}}sub unimport {my ($self,@pragmas)=@_;for my$pragma (@pragmas){_disable($pragma)}return}1;
+ package experimental;$experimental::VERSION='0.022';use strict;use warnings;use version ();BEGIN {eval {require feature}};use Carp qw/croak carp/;my%warnings=map {$_=>1}grep {/^experimental::/}keys%warnings::Offsets;my%features=map {$_=>1}$] > 5.015006 ? keys%feature::feature : do {my@features;if ($] >= 5.010){push@features,qw/switch say state/;push@features,'unicode_strings' if $] > 5.011002}@features};my%min_version=(array_base=>'5',autoderef=>'5.14.0',bitwise=>'5.22.0',const_attr=>'5.22.0',current_sub=>'5.16.0',declared_refs=>'5.26.0',evalbytes=>'5.16.0',fc=>'5.16.0',isa=>'5.31.7',lexical_topic=>'5.10.0',lexical_subs=>'5.18.0',postderef=>'5.20.0',postderef_qq=>'5.20.0',refaliasing=>'5.22.0',regex_sets=>'5.18.0',say=>'5.10.0',smartmatch=>'5.10.0',signatures=>'5.20.0',state=>'5.10.0',switch=>'5.10.0',unicode_eval=>'5.16.0',unicode_strings=>'5.12.0',);my%removed_in_version=(array_base=>'5.29.4',autoderef=>'5.23.1',lexical_topic=>'5.23.4',);$_=version->new($_)for values%min_version;$_=version->new($_)for values%removed_in_version;my%additional=(postderef=>['postderef_qq'],switch=>['smartmatch'],declared_refs=>['refaliasing'],);sub _enable {my$pragma=shift;if ($warnings{"experimental::$pragma"}){warnings->unimport("experimental::$pragma");feature->import($pragma)if exists$features{$pragma};_enable(@{$additional{$pragma}})if$additional{$pragma}}elsif ($features{$pragma}){feature->import($pragma);_enable(@{$additional{$pragma}})if$additional{$pragma}}elsif (not exists$min_version{$pragma}){croak "Can't enable unknown feature $pragma"}elsif ($] < $min_version{$pragma}){my$stable=$min_version{$pragma};if ($stable->{version}[1]% 2){$stable=version->new("5.".($stable->{version}[1]+1).'.0')}croak "Need perl $stable or later for feature $pragma"}elsif ($] >= ($removed_in_version{$pragma}|| 7)){croak "Experimental feature $pragma has been removed from perl in version $removed_in_version{$pragma}"}}sub import {my ($self,@pragmas)=@_;for my$pragma (@pragmas){_enable($pragma)}return}sub _disable {my$pragma=shift;if ($warnings{"experimental::$pragma"}){warnings->import("experimental::$pragma");feature->unimport($pragma)if exists$features{$pragma};_disable(@{$additional{$pragma}})if$additional{$pragma}}elsif ($features{$pragma}){feature->unimport($pragma);_disable(@{$additional{$pragma}})if$additional{$pragma}}elsif (not exists$min_version{$pragma}){carp "Can't disable unknown feature $pragma, ignoring"}}sub unimport {my ($self,@pragmas)=@_;for my$pragma (@pragmas){_disable($pragma)}return}1;
EXPERIMENTAL
s/^ //mg for values %fatpacked;
use App::Codeowners;
-our $VERSION = '0.49'; # VERSION
+our $VERSION = '0.50'; # VERSION
App::Codeowners->main(@ARGV);
=head1 VERSION
-version 0.49
+version 0.50
=head1 SYNOPSIS
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2019 by Charles McGarvey.
+This software is copyright (c) 2021 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.
projects / chaz / git-codeowners / commitdiff
