]> Dogcows Code - chaz/git-codeowners/blob - git-codeowners
Release 0.41
[chaz/git-codeowners] / git-codeowners
1 #!/usr/bin/env perl
2 # ABSTRACT: A tool for managing CODEOWNERS files
3 # PODNAME: git-codeowners
4
5
6
7 # This chunk of stuff was generated by App::FatPacker. To find the original
8 # file's code, look for the end of this BEGIN block or the string 'FATPACK'
9 BEGIN {
10 my %fatpacked;
11
12 $fatpacked{"App/Codeowners.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS';
13 package App::Codeowners;use v5.10.1;use utf8;use warnings;use strict;use App::Codeowners::Options;use App::Codeowners::Util qw(find_codeowners_in_directory run_git git_ls_files git_toplevel stringf);use Color::ANSI::Util qw(ansifg ansi_reset);use Encode qw(encode);use File::Codeowners;use Path::Tiny;our$VERSION='0.41';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";$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 ($cdup)=run_git(qw{rev-parse --show-cdup});my@results;my$filepaths=git_ls_files('.',$opts->args)or die "Cannot list files\n";for my$filepath (@$filepaths){my$match=$codeowners->match(path($filepath)->relative($cdup));push@results,[$filepath,$match->{owners},$opts->{project}? $match->{project}: (),]}_format(format=>$opts->{format}|| ' * %-50F %O',out=>*STDOUT,headers=>[qw(File Owner),$opts->{project}? 'Project' : ()],rows=>\@results,)}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});_format(format=>$opts->{format}|| '%O',out=>*STDOUT,headers=>[qw(Owner)],rows=>[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});_format(format=>$opts->{format}|| '%T',out=>*STDOUT,headers=>[qw(Pattern)],rows=>[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$git_files=git_ls_files($repopath);if (@$git_files){$codeowners->clear_unowned;$codeowners->add_unowned(grep {!$codeowners->match($_)}@$git_files)}}$codeowners->write_to_filepath($path);print STDERR "Wrote $path\n"}sub _format {my%args=@_;my$format=$args{format}|| 'table';my$fh=$args{out}|| *STDOUT;my$headers=$args{headers}|| [];my$rows=$args{rows}|| [];if ($format eq 'table'){eval {require Text::Table::Any}or die "Missing dependency: Text::Table::Any\n";my$table=Text::Table::Any::table(header_row=>1,rows=>[$headers,map {[map {_stringify($_)}@$_]}@$rows],backend=>$ENV{PERL_TEXT_TABLE},);print {$fh}encode('UTF-8',$table)}elsif ($format =~ /^json(:pretty)?$/){my$pretty=!!$1;eval {require JSON::MaybeXS}or die "Missing dependency: JSON::MaybeXS\n";my$json=JSON::MaybeXS->new(canonical=>1,utf8=>1,pretty=>$pretty);my$data=_combine_headers_rows($headers,$rows);print {$fh}$json->encode($data)}elsif ($format =~ /^([ct])sv$/){my$sep=$1 eq 'c' ? ',' : "\t";eval {require Text::CSV}or die "Missing dependency: Text::CSV\n";my$csv=Text::CSV->new({binary=>1,eol=>$/,sep=>$sep});$csv->print($fh,$headers);$csv->print($fh,[map {encode('UTF-8',_stringify($_))}@$_])for @$rows}elsif ($format =~ /^ya?ml$/){eval {require YAML}or die "Missing dependency: YAML\n";my$data=_combine_headers_rows($headers,$rows);print {$fh}encode('UTF-8',YAML::Dump($data))}else {my$data=_combine_headers_rows($headers,$rows);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;my$owner_color=sub {my$owner=shift or return;$owner_colors{$owner}||= do {$num=($num + 1)% scalar@contrasting_colors;$contrasting_colors[$num]}};my%filter=(quote=>sub {local $_=$_[0];s/"/\"/s;"\"$_\""},);my$create_filterer=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 || ''}};for my$row (@$data){my%info=(F=>$create_filterer->($row->{File},undef),O=>$create_filterer->($row->{Owner},$owner_color),P=>$create_filterer->($row->{Project},undef),T=>$create_filterer->($row->{Pattern},undef),);my$text=stringf($format,%info);print {$fh}encode('UTF-8',$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 _colored {my$text=shift;my$rgb=shift or return$text;return$text if$ENV{NO_COLOR};$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 _combine_headers_rows {my$headers=shift;my$rows=shift;my@new_rows;for my$row (@$rows){push@new_rows,(my$new_row={});for (my$i=0;$i < @$headers;++$i){$new_row->{$headers->[$i]}=$row->[$i]}}return \@new_rows}sub _stringify {my$item=shift;return ref($item)eq 'ARRAY' ? join(',',@$item): $item}1;
14 This file shows mappings between subdirs/files and the individuals and
15 teams who own them. You can read this file yourself or use tools to query it,
16 so you can quickly determine who to speak with or send pull requests to. ❤️
17
18 Simply write a gitignore pattern followed by one or more names/emails/groups.
19 Examples:
20 /project_a/** @team1
21 *.js @harry @javascript-cabal
22 END
23 APP_CODEOWNERS
24
25 $fatpacked{"App/Codeowners/Options.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_OPTIONS';
26 package App::Codeowners::Options;use warnings;use strict;use Getopt::Long 2.39 ();use Path::Tiny;use Pod::Usage;our$VERSION='0.41';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'=>'',},'show'=>{'project!'=>1,},'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=@_;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)])}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;
27 # git-codeowners - Bash completion
28 # To use, eval this code:
29 # eval "$(git-codeowners --shell-completion)"
30 # This will work without the bash-completion package, but handling of colons
31 # in the completion word will work better with bash-completion installed and
32 # enabled.
33 _git_codeowners() {
34 local cur words cword
35 if declare -f _get_comp_words_by_ref >/dev/null
36 then
37 _get_comp_words_by_ref -n : cur cword words
38 else
39 words=("${COMP_WORDS[@]}")
40 cword=${COMP_CWORD}
41 cur=${words[cword]}
42 fi
43 local IFS=$'\n'
44 COMPREPLY=($(CODEOWNERS_COMPLETIONS=1 CWORD="$cword" CUR="$cur" ${words[@]}))
45 # COMPREPLY=($(${words[0]} --completions "$cword" "${words[@]}"))
46 if [[ "$?" -eq 9 ]]
47 then
48 COMPREPLY=($(compgen -A "${COMPREPLY[0]}" -- "$cur"))
49 fi
50 declare -f __ltrim_colon_completions >/dev/null && \
51 __ltrim_colon_completions "$cur"
52 return 0
53 }
54 complete -F _git_codeowners git-codeowners
55 END
56 APP_CODEOWNERS_OPTIONS
57
58 $fatpacked{"App/Codeowners/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_CODEOWNERS_UTIL';
59 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_git stringf unbackslash);our$VERSION='0.41';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_git {my@cmd=('git',@_);require IPC::Open2;my ($child_in,$child_out);my$pid=IPC::Open2::open2($child_out,$child_in,@cmd);close($child_in);binmode($child_out,':encoding(UTF-8)');chomp(my@lines=<$child_out>);waitpid($pid,0);return if $?!=0;return@lines}sub git_ls_files {my$dir=shift || '.';my@files=run_git('-C',$dir,qw{ls-files},@_);return undef if!@files;for my$file (@files){next if$file !~ /^"(.+)"$/;$file=$1;$file=unbackslash($file);$file=decode('UTF-8',$file)}return \@files}sub git_toplevel {my$dir=shift || '.';my ($path)=run_git('-C',$dir,qw{rev-parse --show-toplevel});return if!$path;return path($path)}sub colorstrip {my$str=shift || '';$str =~ s/\e\[[\d;]*m//g;return$str}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/
60 (% # leading '%'
61 (-)? # left-align, rather than right
62 (\d*)? # (optional) minimum field width
63 (?:\.(\d*))? # (optional) maximum field width
64 (\{.*?\})? # (optional) stuff inside
65 (\S) # actual format character
66 )/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}1;
67 APP_CODEOWNERS_UTIL
68
69 $fatpacked{"Color/ANSI/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COLOR_ANSI_UTIL';
70 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;
71
72 Returns 6-hexdigit, e.g. 'ff00cc'.
73
74 _
75
76 Autodetect terminal capability and can return either empty string, 16-color,
77 256-color, or 24bit-code.
78
79 Color depth used is determined by `COLOR_DEPTH` environment setting or from
80 <pm:Term::Detect::Software> if that module is available. In other words, this
81 function automatically chooses rgb_to_ansi{24b,256,16}_fg_code().
82
83 _
84
85 Autodetect terminal capability and can return either empty string, 16-color,
86 256-color, or 24bit-code.
87
88 Which color depth used is determined by `COLOR_DEPTH` environment setting or
89 from <pm:Term::Detect::Software> if that module is available). In other words,
90 this function automatically chooses rgb_to_ansi{24b,256,16}_bg_code().
91
92 _
93 COLOR_ANSI_UTIL
94
95 $fatpacked{"Color/RGB/Util.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'COLOR_RGB_UTIL';
96 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;
97 COLOR_RGB_UTIL
98
99 $fatpacked{"File/Codeowners.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_CODEOWNERS';
100 package File::Codeowners;use v5.10.1;use warnings;use strict;use Encode qw(encode);use Path::Tiny;use Scalar::Util qw(openhandle);use Text::Gitignore qw(build_gitignore_matcher);our$VERSION='0.41';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;if ($comment =~ /^\h*Project:\h*(.+?)\h*$/i){$current_project=$1 || undef}$lines[$lineno]={comment=>$comment,}}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)});for my$line (@{$self->write_to_array}){print$fh "$line\n"}}sub write_to_string {my$self=shift;my$str=join("\n",@{$self->write_to_array})."\n";return \$str}sub write_to_array {my$self=shift;my$charset=shift // 'UTF-8';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 ($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 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;for my$line (@{$self->_lines}){next if!$line->{pattern};next if$pattern ne $line->{pattern};$line->{owners}=[@$owners]}}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}}1;
101 FILE_CODEOWNERS
102
103 $fatpacked{"File/Which.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_WHICH';
104 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;
105 FILE_WHICH
106
107 $fatpacked{"Getopt/Long.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'GETOPT_LONG';
108 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;^
109 (
110 # Option name
111 (?: \w+[-\w]* )
112 # Aliases
113 (?: \| (?: . [^|!+=:]* )? )*
114 )?
115 (
116 # Either modifiers ...
117 [!+]
118 |
119 # ... or a value/dest/repeat specification
120 [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
121 |
122 # ... or an optional-with-default spec
123 : (?: -?\d+ | \+ ) [@%]?
124 )?
125 $;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;
126 GETOPT_LONG
127
128 $fatpacked{"JSON/MaybeXS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_MAYBEXS';
129 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;
130 JSON_MAYBEXS
131
132 $fatpacked{"JSON/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP';
133 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/
134 sub $name {
135 my \$enable = defined \$_[1] ? \$_[1] : 1;
136
137 if (\$enable) {
138 \$_[0]->{PROPS}->[$property_id] = 1;
139 }
140 else {
141 \$_[0]->{PROPS}->[$property_id] = 0;
142 }
143
144 \$_[0];
145 }
146
147 sub get_$name {
148 \$_[0]->{PROPS}->[$property_id] ? 1 : '';
149 }
150 /}}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 =~ /^(?:
151 [\x00-\x7F]
152 |[\xC2-\xDF][\x80-\xBF]
153 |[\xE0][\xA0-\xBF][\x80-\xBF]
154 |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
155 |[\xED][\x80-\x9F][\x80-\xBF]
156 |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
157 |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
158 |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
159 |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
160 )$/x)? $is_valid_utf8 : ''}sub decode_error {my$error=shift;my$no_rep=shift;my$str=defined$text ? substr($text,$at): '';my$mess='';my$type='U*';if (OLD_PERL){my$type=$] < 5.006 ? 'C*' : utf8::is_utf8($str)? 'U*' : 'C*' }for my$c (unpack($type,$str)){$mess .= $c==0x07 ? '\a' : $c==0x09 ? '\t' : $c==0x0a ? '\n' : $c==0x0d ? '\r' : $c==0x0c ? '\f' : $c < 0x20 ? sprintf('\x{%x}',$c): $c==0x5c ? '\\\\' : $c < 0x80 ? chr($c): sprintf('\x{%x}',$c);if (length$mess >= 20){$mess .= '...';last}}unless (length$mess){$mess='(end of string)'}Carp::croak ($no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")")}sub _json_object_hook {my$o=$_[0];my@ks=keys %{$o};if ($cb_sk_object and @ks==1 and exists$cb_sk_object->{$ks[0]}and ref$cb_sk_object->{$ks[0]}){my@val=$cb_sk_object->{$ks[0]}->($o->{$ks[0]});if (@val==0){return$o}elsif (@val==1){return$val[0]}else {Carp::croak("filter_json_single_key_object callbacks must not return more than one scalar")}}my@val=$cb_object->($o)if ($cb_object);if (@val==0){return$o}elsif (@val==1){return$val[0]}else {Carp::croak("filter_json_object callbacks must not return more than one scalar")}}sub PP_decode_box {{text=>$text,at=>$at,ch=>$ch,len=>$len,depth=>$depth,encoding=>$encoding,is_valid_utf8=>$is_valid_utf8,}}}sub _decode_surrogates {my$uni=0x10000 + (hex($_[0])- 0xD800)* 0x400 + (hex($_[1])- 0xDC00);my$un=pack('U*',$uni);utf8::encode($un);return$un}sub _decode_unicode {my$un=pack('U',hex shift);utf8::encode($un);return$un}BEGIN {unless (defined&utf8::is_utf8){require Encode;*utf8::is_utf8=*Encode::is_utf8}if (!OLD_PERL){*JSON::PP::JSON_PP_encode_ascii=\&_encode_ascii;*JSON::PP::JSON_PP_encode_latin1=\&_encode_latin1;*JSON::PP::JSON_PP_decode_surrogates=\&_decode_surrogates;*JSON::PP::JSON_PP_decode_unicode=\&_decode_unicode;if ($] < 5.008003){package JSON::PP;require subs;subs->import('join');eval q|
161 sub join {
162 return '' if (@_ < 2);
163 my $j = shift;
164 my $str = shift;
165 for (@_) { $str .= $j . $_; }
166 return $str;
167 }
168 |}}sub JSON::PP::incr_parse {local$Carp::CarpLevel=1;($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_parse(@_)}sub JSON::PP::incr_skip {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_skip}sub JSON::PP::incr_reset {($_[0]->{_incr_parser}||= JSON::PP::IncrParser->new)->incr_reset}eval q{
169 sub JSON::PP::incr_text : lvalue {
170 $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;
171
172 if ( $_[0]->{_incr_parser}->{incr_pos} ) {
173 Carp::croak("incr_text cannot be called when the incremental parser already started parsing");
174 }
175 $_[0]->{_incr_parser}->{incr_text};
176 }
177 } if ($] >= 5.006)}BEGIN {eval 'require Scalar::Util';unless($@){*JSON::PP::blessed=\&Scalar::Util::blessed;*JSON::PP::reftype=\&Scalar::Util::reftype;*JSON::PP::refaddr=\&Scalar::Util::refaddr}else{eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';*JSON::PP::blessed=sub {local($@,$SIG{__DIE__},$SIG{__WARN__});ref($_[0])? eval {$_[0]->a_sub_not_likely_to_be_here}: undef};require B;my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP);*JSON::PP::reftype=sub {my$r=shift;return undef unless length(ref($r));my$t=ref(B::svref_2object($r));return exists$tmap{$t}? $tmap{$t}: length(ref($$r))? 'REF' : 'SCALAR'};*JSON::PP::refaddr=sub {return undef unless length(ref($_[0]));my$addr;if(defined(my$pkg=blessed($_[0]))){$addr .= bless $_[0],'Scalar::Util::Fake';bless $_[0],$pkg}else {$addr .= $_[0]}$addr =~ /0x(\w+)/;local $^W;hex($1)}}}$JSON::PP::true=do {bless \(my$dummy=1),"JSON::PP::Boolean"};$JSON::PP::false=do {bless \(my$dummy=0),"JSON::PP::Boolean"};sub is_bool {blessed $_[0]and ($_[0]->isa("JSON::PP::Boolean")or $_[0]->isa("Types::Serialiser::BooleanBase")or $_[0]->isa("JSON::XS::Boolean"))}sub true {$JSON::PP::true}sub false {$JSON::PP::false}sub null {undef}package JSON::PP::IncrParser;use strict;use constant INCR_M_WS=>0;use constant INCR_M_STR=>1;use constant INCR_M_BS=>2;use constant INCR_M_JSON=>3;use constant INCR_M_C0=>4;use constant INCR_M_C1=>5;use constant INCR_M_TFN=>6;use constant INCR_M_NUM=>7;$JSON::PP::IncrParser::VERSION='1.01';sub new {my ($class)=@_;bless {incr_nest=>0,incr_text=>undef,incr_pos=>0,incr_mode=>0,},$class}sub incr_parse {my ($self,$coder,$text)=@_;$self->{incr_text}='' unless (defined$self->{incr_text});if (defined$text){if (utf8::is_utf8($text)and!utf8::is_utf8($self->{incr_text})){utf8::upgrade($self->{incr_text});utf8::decode($self->{incr_text})}$self->{incr_text}.= $text}if (defined wantarray){my$max_size=$coder->get_max_size;my$p=$self->{incr_pos};my@ret;{do {unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){$self->_incr_parse($coder);if ($max_size and $self->{incr_pos}> $max_size){Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size")}unless ($self->{incr_nest}<= 0 and $self->{incr_mode}==INCR_M_JSON){if ($self->{incr_mode}==INCR_M_WS and $self->{incr_pos}){$self->{incr_pos}=0;$self->{incr_text}=''}last}}my ($obj,$offset)=$coder->PP_decode_json($self->{incr_text},0x00000001);push@ret,$obj;use bytes;$self->{incr_text}=substr($self->{incr_text},$offset || 0);$self->{incr_pos}=0;$self->{incr_nest}=0;$self->{incr_mode}=0;last unless wantarray}while (wantarray)}if (wantarray){return@ret}else {return defined$ret[0]? $ret[0]: undef}}}sub _incr_parse {my ($self,$coder)=@_;my$text=$self->{incr_text};my$len=length$text;my$p=$self->{incr_pos};INCR_PARSE: while ($len > $p){my$s=substr($text,$p,1);last INCR_PARSE unless defined$s;my$mode=$self->{incr_mode};if ($mode==INCR_M_WS){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if (ord($s)> 0x20){if ($s eq '#'){$self->{incr_mode}=INCR_M_C0;redo INCR_PARSE}else {$self->{incr_mode}=INCR_M_JSON;redo INCR_PARSE}}$p++}}elsif ($mode==INCR_M_BS){$p++;$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($mode==INCR_M_C0 or $mode==INCR_M_C1){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq "\n"){$self->{incr_mode}=$self->{incr_mode}==INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;last}$p++}next}elsif ($mode==INCR_M_TFN){while ($len > $p){$s=substr($text,$p++,1);next if defined$s and $s =~ /[rueals]/;last}$p--;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($mode==INCR_M_NUM){while ($len > $p){$s=substr($text,$p++,1);next if defined$s and $s =~ /[0-9eE.+\-]/;last}$p--;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($mode==INCR_M_STR){while ($len > $p){$s=substr($text,$p,1);last INCR_PARSE unless defined$s;if ($s eq '"'){$p++;$self->{incr_mode}=INCR_M_JSON;last INCR_PARSE unless$self->{incr_nest};redo INCR_PARSE}elsif ($s eq '\\'){$p++;if (!defined substr($text,$p,1)){$self->{incr_mode}=INCR_M_BS;last INCR_PARSE}}$p++}}elsif ($mode==INCR_M_JSON){while ($len > $p){$s=substr($text,$p++,1);if ($s eq "\x00"){$p--;last INCR_PARSE}elsif ($s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20"){if (!$self->{incr_nest}){$p--;last INCR_PARSE}next}elsif ($s eq 't' or $s eq 'f' or $s eq 'n'){$self->{incr_mode}=INCR_M_TFN;redo INCR_PARSE}elsif ($s =~ /^[0-9\-]$/){$self->{incr_mode}=INCR_M_NUM;redo INCR_PARSE}elsif ($s eq '"'){$self->{incr_mode}=INCR_M_STR;redo INCR_PARSE}elsif ($s eq '[' or $s eq '{'){if (++$self->{incr_nest}> $coder->get_max_depth){Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')}next}elsif ($s eq ']' or $s eq '}'){if (--$self->{incr_nest}<= 0){last INCR_PARSE}}elsif ($s eq '#'){$self->{incr_mode}=INCR_M_C1;redo INCR_PARSE}}}}$self->{incr_pos}=$p;$self->{incr_parsing}=$p ? 1 : 0}sub incr_text {if ($_[0]->{incr_pos}){Carp::croak("incr_text cannot be called when the incremental parser already started parsing")}$_[0]->{incr_text}}sub incr_skip {my$self=shift;$self->{incr_text}=substr($self->{incr_text},$self->{incr_pos});$self->{incr_pos}=0;$self->{incr_mode}=0;$self->{incr_nest}=0}sub incr_reset {my$self=shift;$self->{incr_text}=undef;$self->{incr_pos}=0;$self->{incr_mode}=0;$self->{incr_nest}=0}1;
178 JSON_PP
179
180 $fatpacked{"JSON/PP/Boolean.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'JSON_PP_BOOLEAN';
181 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;
182 JSON_PP_BOOLEAN
183
184 $fatpacked{"Path/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_TINY';
185 use 5.008001;use strict;use warnings;package Path::Tiny;our$VERSION='0.108';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;
186 PATH_TINY
187
188 $fatpacked{"Proc/Find/Parents.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PROC_FIND_PARENTS';
189 package Proc::Find::Parents;our$DATE='2018-01-17';our$VERSION='0.631';use 5.010001;use strict;use warnings;require Exporter;our@ISA=qw(Exporter);our@EXPORT_OK=qw(get_parent_processes);sub get_parent_processes {my ($pid,$opts)=@_;$pid //= $$;$opts //= {};my%proc;if (($opts->{method}// 'proctable')eq 'pstree'){my@lines=`pstree -pAl`;return undef unless@lines;my@p;for (@lines){my$i=0;while (/(?: (\s*(?:\|-?|`-)) | (.+?)\((\d+)\) )
190 (?: -[+-]- )?/gx){unless ($1){my$p={name=>$2,pid=>$3};$p[$i]=$p;$p->{ppid}=$p[$i-1]{pid}if$i > 0;$proc{$3}=$p}$i++}}}else {eval {require Proc::ProcessTable};return undef if $@;state$pt=Proc::ProcessTable->new;for my$p (@{$pt->table}){$proc{$p->{pid}}={name=>$p->{fname},cmdline=>$p->{cmndline},pid=>$p->{pid},ppid=>$p->{ppid},uid=>$p->{uid},gid=>$p->{gid},pgrp=>$p->{pgrp},sess=>$p->{sess},sgid=>$p->{sgid},euid=>$p->{euid},egid=>$p->{egid},ttydev=>$p->{ttydev},ttynum=>$p->{ttynum},}}}my@p=();my$cur_pid=$pid;while (1){return if!$proc{$cur_pid};$proc{$cur_pid}{name}=$1 if$proc{$cur_pid}{name}=~ /\A\{(.+)\}\z/;push@p,$proc{$cur_pid};$cur_pid=$proc{$cur_pid}{ppid};last unless$cur_pid}shift@p;\@p}1;
191 PROC_FIND_PARENTS
192
193 $fatpacked{"Term/ANSIColor.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TERM_ANSICOLOR';
194 package Term::ANSIColor;use 5.006;use strict;use warnings;use Exporter ();our (@EXPORT,@EXPORT_OK,%EXPORT_TAGS,@ISA,$VERSION);our$AUTOLOAD;BEGIN {$VERSION='4.06';my@colorlist=qw(CLEAR RESET BOLD DARK FAINT ITALIC UNDERLINE UNDERSCORE BLINK REVERSE CONCEALED BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE ON_BLACK ON_RED ON_GREEN ON_YELLOW ON_BLUE ON_MAGENTA ON_CYAN ON_WHITE BRIGHT_BLACK BRIGHT_RED BRIGHT_GREEN BRIGHT_YELLOW BRIGHT_BLUE BRIGHT_MAGENTA BRIGHT_CYAN BRIGHT_WHITE ON_BRIGHT_BLACK ON_BRIGHT_RED ON_BRIGHT_GREEN ON_BRIGHT_YELLOW ON_BRIGHT_BLUE ON_BRIGHT_MAGENTA ON_BRIGHT_CYAN ON_BRIGHT_WHITE);my@colorlist256=((map {("ANSI$_","ON_ANSI$_")}0 .. 255),(map {("GREY$_","ON_GREY$_")}0 .. 23),);for my$r (0 .. 5){for my$g (0 .. 5){push(@colorlist256,map {("RGB$r$g$_","ON_RGB$r$g$_")}0 .. 5)}}@ISA=qw(Exporter);@EXPORT=qw(color colored);@EXPORT_OK=qw(uncolor colorstrip colorvalid coloralias);%EXPORT_TAGS=(constants=>\@colorlist,constants256=>\@colorlist256,pushpop=>[@colorlist,qw(PUSHCOLOR POPCOLOR LOCALCOLOR)],);Exporter::export_ok_tags('pushpop','constants256')}our$AUTOLOCAL;our$AUTORESET;our$EACHLINE;our%ATTRIBUTES=('clear'=>0,'reset'=>0,'bold'=>1,'dark'=>2,'faint'=>2,'italic'=>3,'underline'=>4,'underscore'=>4,'blink'=>5,'reverse'=>7,'concealed'=>8,'black'=>30,'on_black'=>40,'red'=>31,'on_red'=>41,'green'=>32,'on_green'=>42,'yellow'=>33,'on_yellow'=>43,'blue'=>34,'on_blue'=>44,'magenta'=>35,'on_magenta'=>45,'cyan'=>36,'on_cyan'=>46,'white'=>37,'on_white'=>47,'bright_black'=>90,'on_bright_black'=>100,'bright_red'=>91,'on_bright_red'=>101,'bright_green'=>92,'on_bright_green'=>102,'bright_yellow'=>93,'on_bright_yellow'=>103,'bright_blue'=>94,'on_bright_blue'=>104,'bright_magenta'=>95,'on_bright_magenta'=>105,'bright_cyan'=>96,'on_bright_cyan'=>106,'bright_white'=>97,'on_bright_white'=>107,);for my$code (0 .. 15){$ATTRIBUTES{"ansi$code"}="38;5;$code";$ATTRIBUTES{"on_ansi$code"}="48;5;$code"}for my$r (0 .. 5){for my$g (0 .. 5){for my$b (0 .. 5){my$code=16 + (6 * 6 * $r)+ (6 * $g)+ $b;$ATTRIBUTES{"rgb$r$g$b"}="38;5;$code";$ATTRIBUTES{"on_rgb$r$g$b"}="48;5;$code"}}}for my$n (0 .. 23){my$code=$n + 232;$ATTRIBUTES{"grey$n"}="38;5;$code";$ATTRIBUTES{"on_grey$n"}="48;5;$code"}our%ATTRIBUTES_R;for my$attr (reverse sort keys%ATTRIBUTES){$ATTRIBUTES_R{$ATTRIBUTES{$attr}}=$attr}for my$code (16 .. 255){$ATTRIBUTES{"ansi$code"}="38;5;$code";$ATTRIBUTES{"on_ansi$code"}="48;5;$code"}our%ALIASES;if (exists$ENV{ANSI_COLORS_ALIASES}){my$spec=$ENV{ANSI_COLORS_ALIASES};$spec =~ s{\s+}{}xmsg;for my$definition (split m{,}xms,$spec){my ($new,$old)=split m{=}xms,$definition,2;if (!$new ||!$old){warn qq{Bad color mapping "$definition"}}else {my$result=eval {coloralias($new,$old)};if (!$result){my$error=$@;$error =~ s{ [ ] at [ ] .* }{}xms;warn qq{$error in "$definition"}}}}}our@COLORSTACK;sub croak {my (@args)=@_;require Carp;Carp::croak(@args)}sub AUTOLOAD {my ($sub,$attr)=$AUTOLOAD =~ m{
195 \A ( [a-zA-Z0-9:]* :: ([A-Z0-9_]+) ) \z
196 }xms;if (!($attr && defined($ATTRIBUTES{lc$attr }))){croak("undefined subroutine &$AUTOLOAD called")}if ($ENV{ANSI_COLORS_DISABLED}){return join(q{},@_)}$AUTOLOAD=$sub;my$escape="\e[" .$ATTRIBUTES{lc$attr }.'m';my$eval_err=$@;my$eval_result=eval qq{
197 sub $AUTOLOAD {
198 if (\$ENV{ANSI_COLORS_DISABLED}) {
199 return join(q{}, \@_);
200 } elsif (\$AUTOLOCAL && \@_) {
201 return PUSHCOLOR('$escape') . join(q{}, \@_) . POPCOLOR;
202 } elsif (\$AUTORESET && \@_) {
203 return '$escape' . join(q{}, \@_) . "\e[0m";
204 } else {
205 return '$escape' . join(q{}, \@_);
206 }
207 }
208 1;
209 };if (!$eval_result){die "failed to generate constant $attr: $@"}$@=$eval_err;goto &$AUTOLOAD}sub PUSHCOLOR {my (@text)=@_;my$text=join(q{},@text);my ($color)=$text =~ m{ \A ( (?:\e\[ [\d;]+ m)+ ) }xms;if (@COLORSTACK){$color=$COLORSTACK[-1].$color}push(@COLORSTACK,$color);return$text}sub POPCOLOR {my (@text)=@_;pop(@COLORSTACK);if (@COLORSTACK){return$COLORSTACK[-1].join(q{},@text)}else {return RESET(@text)}}sub LOCALCOLOR {my (@text)=@_;return PUSHCOLOR(join(q{},@text)).POPCOLOR()}sub color {my (@codes)=@_;@codes=map {split}@codes;if ($ENV{ANSI_COLORS_DISABLED}){return q{}}my$attribute=q{};for my$code (@codes){$code=lc($code);if (defined($ATTRIBUTES{$code})){$attribute .= $ATTRIBUTES{$code}.q{;}}elsif (defined($ALIASES{$code})){$attribute .= $ALIASES{$code}.q{;}}else {croak("Invalid attribute name $code")}}chop($attribute);return ($attribute ne q{})? "\e[${attribute}m" : undef}sub uncolor {my (@escapes)=@_;my (@nums,@result);for my$escape (@escapes){$escape =~ s{ \A \e\[ }{}xms;$escape =~ s{ m \z } {}xms;my ($attrs)=$escape =~ m{ \A ((?:\d+;)* \d*) \z }xms;if (!defined($attrs)){croak("Bad escape sequence $escape")}push(@nums,$attrs =~ m{ ( 0*[34]8;0*5;\d+ | \d+ ) (?: ; | \z ) }xmsg)}for my$num (@nums){$num =~ s{ ( \A | ; ) 0+ (\d) }{$1$2}xmsg;my$name=$ATTRIBUTES_R{$num};if (!defined($name)){croak("No name for escape sequence $num")}push(@result,$name)}return@result}sub colored {my ($first,@rest)=@_;my ($string,@codes);if (ref($first)&& ref($first)eq 'ARRAY'){@codes=@{$first};$string=join(q{},@rest)}else {$string=$first;@codes=@rest}if ($ENV{ANSI_COLORS_DISABLED}){return$string}my$attr=color(@codes);if (defined($EACHLINE)){my@text=map {($_ ne $EACHLINE)? $attr .$_ ."\e[0m" : $_}grep {length > 0}split(m{ (\Q$EACHLINE\E) }xms,$string);return join(q{},@text)}else {return$attr .$string ."\e[0m"}}sub coloralias {my ($alias,$color)=@_;if (!defined($color)){if (!exists$ALIASES{$alias}){return}else {return$ATTRIBUTES_R{$ALIASES{$alias}}}}if ($alias !~ m{ \A [a-zA-Z0-9._-]+ \z }xms){croak(qq{Invalid alias name "$alias"})}elsif ($ATTRIBUTES{$alias}){croak(qq{Cannot alias standard color "$alias"})}elsif (!exists$ATTRIBUTES{$color}){croak(qq{Invalid attribute name "$color"})}$ALIASES{$alias}=$ATTRIBUTES{$color};return$color}sub colorstrip {my (@string)=@_;for my$string (@string){$string =~ s{ \e\[ [\d;]* m }{}xmsg}return wantarray ? @string : join(q{},@string)}sub colorvalid {my (@codes)=@_;@codes=map {split(q{ },lc)}@codes;for my$code (@codes){if (!(defined($ATTRIBUTES{$code})|| defined($ALIASES{$code}))){return}}return 1}1;
210 TERM_ANSICOLOR
211
212 $fatpacked{"Term/Detect/Software.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TERM_DETECT_SOFTWARE';
213 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;
214 TERM_DETECT_SOFTWARE
215
216 $fatpacked{"Text/Aligner.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_ALIGNER';
217 package Text::Aligner;use strict;use warnings;use 5.008;BEGIN {use Exporter ();use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);$VERSION='0.13';@ISA=qw (Exporter);@EXPORT=qw ();@EXPORT_OK=qw ( align);%EXPORT_TAGS=()}sub align ($@) {my$ali=Text::Aligner->new(shift);$ali->_alloc(map ref eq 'SCALAR' ? $$_ : $_,@_);if (defined wantarray){my@just=map$ali->_justify(ref eq 'SCALAR' ? $$_ : $_),@_;return@just if wantarray;return join "\n",@just,''}else {for (@_){$_=$ali->_justify($_)for ref eq 'SCALAR' ? $$_ : $_}}}sub _new {my$class=shift;my ($width,$pos)=@_;bless {width=>$width,pos=>$pos,left=>Text::Aligner::MaxKeeper->new,right=>Text::Aligner::MaxKeeper->new,},$class}sub new {my ($class,$spec)=@_;$spec ||= 0;my$al;if (!ref($spec)and $spec =~ s/^auto/num/){$al=Text::Aligner::Auto->_new($spec)}else {$al=$class->_new(_compile_alispec($spec))}$al}sub _measure0 {my$al=shift;my$obj=shift;$obj='' unless defined$obj;my ($w,$p);if (ref$obj){($w,$p)=($obj->$al->{width}->(),$obj->$al->{pos}->())}else {($w,$p)=($al->{width}->($obj),$al->{pos}->($obj))}$_ ||= 0 for$w,$p;($p,$w - $p)}use Term::ANSIColor 2.02;sub _measure {my$al=shift;my$obj=shift;$obj='' unless defined$obj;my ($wmeth,$pmeth)=@{$al}{qw(width pos)};$obj=Term::ANSIColor::colorstrip($obj)unless ref$obj;my$w=ref$wmeth ? $wmeth->($obj): $obj->$wmeth;my$p=ref$pmeth ? $pmeth->($obj): $obj->$pmeth;$_ ||= 0 for$w,$p;($p,$w - $p)}sub _status {my@lr=($_[0]->{left}->max,$_[0]->{right}->max);return unless defined($lr[0])and defined($lr[1]);@lr}sub _alloc {my$al=shift;for (@_){my ($l,$r)=$al->_measure($_);$al->{left}->remember($l);$al->{right}->remember($r)}$al}sub _forget {my$al=shift;for (map defined()? $_ : '',@_){my ($l,$r)=$al->_measure($_);$al->{left}->forget($l);$al->{right}->forget($r)}$al}sub _spaces {my ($repeat_count)=@_;return (($repeat_count > 0)? (' ' x $repeat_count): '')}sub _justify {my$al=shift;my$str=shift;$str .= '';my ($l_pad,$r_pad)=$al->_padding($str);substr($str,0,-$l_pad)='' if$l_pad < 0;substr($str,$r_pad)='' if$r_pad < 0;return _spaces($l_pad).$str ._spaces($r_pad)}sub _padding {my$al=shift;my$str=shift;my ($this_l,$this_r)=$al->_measure($str);my ($l_pad,$r_pad)=(0,0);if ($al->_status){($l_pad,$r_pad)=$al->_status;$l_pad -= $this_l;$r_pad -= $this_r}($l_pad,$r_pad)}sub _compile_alispec {my$width=sub {length shift};my$pos;local $_=shift || '';if (ref()eq 'Regexp'){my$regex=$_;$pos=sub {local $_=shift;return m/$regex/ ? $-[0]: length}}else {s/^left/0/;s/^center/0.5/;s/^right/1/;if (_is_number($_)){my$proportion=$_;$pos=sub {int($proportion*length shift)}}elsif ($_ =~ /^(?:num|point)(?:\((.*))?/){my$point=defined $1 ? $1 : '';$point =~ s/\)$//;length$point or $point='.';$pos=sub {index(shift().$point,$point)}}else {$pos=sub {0}}}($width,$pos)}sub _is_number {my ($x)=@_;return 0 unless defined$x;return 0 if$x !~ /\d/;return 1 if$x =~ /^-?\d+\.?\d*$/;$x=Term::ANSIColor::colorstrip($x);$x =~ /^-?\d+\.?\d*$/}package Text::Aligner::Auto;sub _new {my$class=shift;my$numspec=shift;bless {num=>Text::Aligner->new('num'),other=>Text::Aligner->new,},$class}sub _alloc {my$aa=shift;my@num=grep _is_number($_),@_;my@other=grep!_is_number($_),@_;$aa->{num}->_alloc(@num);$aa->{other}->_alloc(@other);$aa}sub _forget {my$aa=shift;$aa->{num}->_forget(grep _is_number($_),@_);$aa->{other}->_forget(grep!_is_number($_),@_);$aa}sub _justify {my ($aa,$str)=@_;$str=$aa->{_is_number($str)? 'num' : 'other'}->_justify($str);my$combi=Text::Aligner->new;$combi->_alloc($aa->{num}->_justify(''))if$aa->{num}->_status;$combi->_alloc($aa->{other}->_justify(''))if$aa->{other}->_status;$combi->_justify($str)}BEGIN {*_is_number=\ &Text::Aligner::_is_number}package Text::Aligner::MaxKeeper;sub new {bless {max=>undef,seen=>{},},shift}sub max {$_[0]->{max}}sub remember {my ($mk,$val)=@_;_to_max($mk->{max},$val);$mk->{seen}->{$val}++;$mk}sub forget {my ($mk,$val)=@_;if (exists$mk->{seen}->{$val}){my$seen=$mk->{seen};unless (--$seen->{$val}){delete$seen->{$val};if ($mk->{max}==$val){undef$mk->{max};_to_max($mk->{max},keys %$seen)}}}$mk}sub _to_max {my$var=\ shift;defined $_ and (not defined $$var or $$var < $_)and $$var=$_ for @_;$$var}1;
218 TEXT_ALIGNER
219
220 $fatpacked{"Text/CSV.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_CSV';
221 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;
222 TEXT_CSV
223
224 $fatpacked{"Text/CSV_PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_CSV_PP';
225 package Text::CSV_PP;require 5.006001;use strict;use Exporter ();use vars qw($VERSION @ISA @EXPORT_OK);use Carp;$VERSION='2.00';@ISA=qw(Exporter);@EXPORT_OK=qw(csv);sub PV {0}sub IV {1}sub NV {2}sub IS_QUOTED () {0x0001}sub IS_BINARY () {0x0002}sub IS_ERROR () {0x0004}sub IS_MISSING () {0x0010}sub HOOK_ERROR () {0x0001}sub HOOK_AFTER_PARSE () {0x0002}sub HOOK_BEFORE_PRINT () {0x0004}sub useIO_EOF () {0x0010}my$ERRORS={1000=>"INI - constructor failed",1001=>"INI - sep_char is equal to quote_char or escape_char",1002=>"INI - allow_whitespace with escape_char or quote_char SP or TAB",1003=>"INI - \\r or \\n in main attr not allowed",1004=>"INI - callbacks should be undef or a hashref",1005=>"INI - EOL too long",1006=>"INI - SEP too long",1007=>"INI - QUOTE too long",1008=>"INI - SEP undefined",1010=>"INI - the header is empty",1011=>"INI - the header contains more than one valid separator",1012=>"INI - the header contains an empty field",1013=>"INI - the header contains nun-unique fields",1014=>"INI - header called on undefined stream",1500=>"PRM - Invalid/unsupported arguments(s)",1501=>"PRM - The key attribute is passed as an unsupported type",1502=>"PRM - The value attribute is passed without the key attribute",1503=>"PRM - The value attribute is passed as an unsupported type",2010=>"ECR - QUO char inside quotes followed by CR not part of EOL",2011=>"ECR - Characters after end of quoted field",2012=>"EOF - End of data in parsing input stream",2013=>"ESP - Specification error for fragments RFC7111",2014=>"ENF - Inconsistent number of fields",2021=>"EIQ - NL char inside quotes, binary off",2022=>"EIQ - CR char inside quotes, binary off",2023=>"EIQ - QUO character not allowed",2024=>"EIQ - EOF cannot be escaped, not even inside quotes",2025=>"EIQ - Loose unescaped escape",2026=>"EIQ - Binary character inside quoted field, binary off",2027=>"EIQ - Quoted field not terminated",2030=>"EIF - NL char inside unquoted verbatim, binary off",2031=>"EIF - CR char is first char of field, not part of EOL",2032=>"EIF - CR char inside unquoted, not part of EOL",2034=>"EIF - Loose unescaped quote",2035=>"EIF - Escaped EOF in unquoted field",2036=>"EIF - ESC error",2037=>"EIF - Binary character in unquoted field, binary off",2110=>"ECB - Binary character in Combine, binary off",2200=>"EIO - print to IO failed. See errno",3001=>"EHR - Unsupported syntax for column_names ()",3002=>"EHR - getline_hr () called before column_names ()",3003=>"EHR - bind_columns () and column_names () fields count mismatch",3004=>"EHR - bind_columns () only accepts refs to scalars",3006=>"EHR - bind_columns () did not pass enough refs for parsed fields",3007=>"EHR - bind_columns needs refs to writable scalars",3008=>"EHR - unexpected error in bound fields",3009=>"EHR - print_hr () called before column_names ()",3010=>"EHR - print_hr () called with invalid arguments",4001=>"PRM - The key does not exist as field in the data",0=>"",};BEGIN {if ($] < 5.006){$INC{'bytes.pm'}=1 unless$INC{'bytes.pm'};no strict 'refs';*{"utf8::is_utf8"}=sub {0};*{"utf8::decode"}=sub {}}elsif ($] < 5.008){no strict 'refs';*{"utf8::is_utf8"}=sub {0};*{"utf8::decode"}=sub {};*{"utf8::encode"}=sub {}}elsif (!defined&utf8::is_utf8){require Encode;*utf8::is_utf8=*Encode::is_utf8}eval q| require Scalar::Util |;if ($@){eval q| require B |;if ($@){Carp::croak $@}else {my%tmap=qw(B::NULL SCALAR B::HV HASH B::AV ARRAY B::CV CODE B::IO IO B::GV GLOB B::REGEXP REGEXP);*Scalar::Util::reftype=sub (\$) {my$r=shift;return undef unless length(ref($r));my$t=ref(B::svref_2object($r));return exists$tmap{$t}? $tmap{$t}: length(ref($$r))? 'REF' : 'SCALAR'};*Scalar::Util::readonly=sub (\$) {my$b=B::svref_2object($_[0]);$b->FLAGS & 0x00800000}}}}sub version {return$VERSION}my%def_attr=(eol=>'',sep_char=>',',quote_char=>'"',escape_char=>'"',binary=>0,decode_utf8=>1,auto_diag=>0,diag_verbose=>0,strict=>0,blank_is_undef=>0,empty_is_undef=>0,allow_whitespace=>0,allow_loose_quotes=>0,allow_loose_escapes=>0,allow_unquoted_escape=>0,always_quote=>0,quote_empty=>0,quote_space=>1,quote_binary=>1,escape_null=>1,keep_meta_info=>0,verbatim=>0,formula=>0,undef_str=>undef,types=>undef,callbacks=>undef,_EOF=>0,_RECNO=>0,_STATUS=>undef,_FIELDS=>undef,_FFLAGS=>undef,_STRING=>undef,_ERROR_INPUT=>undef,_COLUMN_NAMES=>undef,_BOUND_COLUMNS=>undef,_AHEAD=>undef,ENCODING=>undef,);my%attr_alias=(quote_always=>"always_quote",verbose_diag=>"diag_verbose",quote_null=>"escape_null",escape=>"escape_char",);my$last_new_error=Text::CSV_PP->SetDiag(0);my$last_error;sub _unhealthy_whitespace {my ($self,$aw)=@_;$aw or return 0;my$quo=$self->{quote};defined$quo && length ($quo)or $quo=$self->{quote_char};my$esc=$self->{escape_char};defined$quo && $quo =~ m/^[ \t]/ and return 1002;defined$esc && $esc =~ m/^[ \t]/ and return 1002;return 0}sub _check_sanity {my$self=shift;my$eol=$self->{eol};my$sep=$self->{sep};defined$sep && length ($sep)or $sep=$self->{sep_char};my$quo=$self->{quote};defined$quo && length ($quo)or $quo=$self->{quote_char};my$esc=$self->{escape_char};$sep ne "" or return 1008;length ($sep)> 16 and return 1006;$sep =~ m/[\r\n]/ and return 1003;if (defined$quo){$quo eq $sep and return 1001;length ($quo)> 16 and return 1007;$quo =~ m/[\r\n]/ and return 1003}if (defined$esc){$esc eq $sep and return 1001;$esc =~ m/[\r\n]/ and return 1003}if (defined$eol){length ($eol)> 16 and return 1005}return _unhealthy_whitespace ($self,$self->{allow_whitespace})}sub known_attributes {sort grep!m/^_/=>"sep","quote",keys%def_attr}sub new {$last_new_error=Text::CSV_PP->SetDiag(1000,'usage: my $csv = Text::CSV_PP->new ([{ option => value, ... }]);');my$proto=shift;my$class=ref ($proto)|| $proto or return;@_ > 0 && ref $_[0]ne "HASH" and return;my$attr=shift || {};my%attr=map {my$k=m/^[a-zA-Z]\w+$/ ? lc $_ : $_;exists$attr_alias{$k}and $k=$attr_alias{$k};$k=>$attr->{$_}}keys %$attr;my$sep_aliased=0;if (exists$attr{sep}){$attr{sep_char}=delete$attr{sep};$sep_aliased=1}my$quote_aliased=0;if (exists$attr{quote}){$attr{quote_char}=delete$attr{quote};$quote_aliased=1}exists$attr{formula_handling}and $attr{formula}=delete$attr{formula_handling};exists$attr{formula}and $attr{formula}=_supported_formula (undef,$attr{formula});for (keys%attr){if (m/^[a-z]/ && exists$def_attr{$_}){defined$attr{$_}&& m/_char$/ and utf8::decode ($attr{$_});next}$last_new_error=Text::CSV_PP->SetDiag(1000,"INI - Unknown attribute '$_'");$attr{auto_diag}and error_diag ();return}if ($sep_aliased){my@b=unpack "U0C*",$attr{sep_char};if (@b > 1){$attr{sep}=$attr{sep_char};$attr{sep_char}="\0"}else {$attr{sep}=undef}}if ($quote_aliased and defined$attr{quote_char}){my@b=unpack "U0C*",$attr{quote_char};if (@b > 1){$attr{quote}=$attr{quote_char};$attr{quote_char}="\0"}else {$attr{quote}=undef}}my$self={%def_attr,%attr };if (my$ec=_check_sanity ($self)){$last_new_error=Text::CSV_PP->SetDiag($ec);$attr{auto_diag}and error_diag ();return}if (defined$self->{callbacks}&& ref$self->{callbacks}ne "HASH"){Carp::carp "The 'callbacks' attribute is set but is not a hash: ignored\n";$self->{callbacks}=undef}$last_new_error=Text::CSV_PP->SetDiag(0);defined $\ &&!exists$attr{eol}and $self->{eol}=$\;bless$self,$class;defined$self->{types}and $self->types ($self->{types});$self}my%_cache_id=(quote_char=>0,escape_char=>1,sep_char=>2,sep=>39,binary=>3,keep_meta_info=>4,always_quote=>5,allow_loose_quotes=>6,allow_loose_escapes=>7,allow_unquoted_escape=>8,allow_whitespace=>9,blank_is_undef=>10,eol=>11,quote=>15,verbatim=>22,empty_is_undef=>23,auto_diag=>24,diag_verbose=>33,quote_space=>25,quote_empty=>37,quote_binary=>32,escape_null=>31,decode_utf8=>35,_has_ahead=>30,_has_hooks=>36,_is_bound=>26,formula=>38,strict=>42,undef_str=>46,);my%_hidden_cache_id=qw(sep_len 38 eol_len 12 eol_is_cr 13 quo_len 16 has_error_input 34);my%_reverse_cache_id=(map({$_cache_id{$_}=>$_}keys%_cache_id),map({$_hidden_cache_id{$_}=>$_}keys%_hidden_cache_id),);sub _set_attr_C {my ($self,$name,$val,$ec)=@_;defined$val or $val=0;utf8::decode ($val);$self->{$name}=$val;$ec=_check_sanity ($self)and croak ($self->SetDiag ($ec));$self->_cache_set ($_cache_id{$name},$val)}sub _set_attr_X {my ($self,$name,$val)=@_;defined$val or $val=0;$self->{$name}=$val;$self->_cache_set ($_cache_id{$name},0 + $val)}sub _set_attr_N {my ($self,$name,$val)=@_;$self->{$name}=$val;$self->_cache_set ($_cache_id{$name},0 + $val)}sub quote_char {my$self=shift;if (@_){$self->_set_attr_C ("quote_char",shift);$self->_cache_set ($_cache_id{quote},"")}$self->{quote_char}}sub quote {my$self=shift;if (@_){my$quote=shift;defined$quote or $quote="";utf8::decode ($quote);my@b=unpack "U0C*",$quote;if (@b > 1){@b > 16 and croak ($self->SetDiag (1007));$self->quote_char ("\0")}else {$self->quote_char ($quote);$quote=""}$self->{quote}=$quote;my$ec=_check_sanity ($self);$ec and croak ($self->SetDiag ($ec));$self->_cache_set ($_cache_id{quote},$quote)}my$quote=$self->{quote};defined$quote && length ($quote)? $quote : $self->{quote_char}}sub escape_char {my$self=shift;if (@_){my$ec=shift;$self->_set_attr_C ("escape_char",$ec);$ec or $self->_set_attr_X ("escape_null",0)}$self->{escape_char}}sub sep_char {my$self=shift;if (@_){$self->_set_attr_C ("sep_char",shift);$self->_cache_set ($_cache_id{sep},"")}$self->{sep_char}}sub sep {my$self=shift;if (@_){my$sep=shift;defined$sep or $sep="";utf8::decode ($sep);my@b=unpack "U0C*",$sep;if (@b > 1){@b > 16 and croak ($self->SetDiag (1006));$self->sep_char ("\0")}else {$self->sep_char ($sep);$sep=""}$self->{sep}=$sep;my$ec=_check_sanity ($self);$ec and croak ($self->SetDiag ($ec));$self->_cache_set ($_cache_id{sep},$sep)}my$sep=$self->{sep};defined$sep && length ($sep)? $sep : $self->{sep_char}}sub eol {my$self=shift;if (@_){my$eol=shift;defined$eol or $eol="";length ($eol)> 16 and croak ($self->SetDiag (1005));$self->{eol}=$eol;$self->_cache_set ($_cache_id{eol},$eol)}$self->{eol}}sub always_quote {my$self=shift;@_ and $self->_set_attr_X ("always_quote",shift);$self->{always_quote}}sub quote_space {my$self=shift;@_ and $self->_set_attr_X ("quote_space",shift);$self->{quote_space}}sub quote_empty {my$self=shift;@_ and $self->_set_attr_X ("quote_empty",shift);$self->{quote_empty}}sub escape_null {my$self=shift;@_ and $self->_set_attr_X ("escape_null",shift);$self->{escape_null}}sub quote_null {goto&escape_null}sub quote_binary {my$self=shift;@_ and $self->_set_attr_X ("quote_binary",shift);$self->{quote_binary}}sub binary {my$self=shift;@_ and $self->_set_attr_X ("binary",shift);$self->{binary}}sub strict {my$self=shift;@_ and $self->_set_attr_X ("strict",shift);$self->{strict}}sub _SetDiagInfo {my ($self,$err,$msg)=@_;$self->SetDiag ($err);my$em=$self->error_diag;$em =~ s/^\d+$// and $msg =~ s/^/# /;my$sep=$em =~ m/[;\n]$/ ? "\n\t" : ": ";join$sep=>grep m/\S\S\S/=>$em,$msg}sub _supported_formula {my ($self,$f)=@_;defined$f or return 5;$f =~ m/^(?: 0 | none )$/xi ? 0 : $f =~ m/^(?: 1 | die )$/xi ? 1 : $f =~ m/^(?: 2 | croak )$/xi ? 2 : $f =~ m/^(?: 3 | diag )$/xi ? 3 : $f =~ m/^(?: 4 | empty | )$/xi ? 4 : $f =~ m/^(?: 5 | undef )$/xi ? 5 : do {$self ||= "Text::CSV_PP";croak ($self->_SetDiagInfo (1500,"formula-handling '$f' is not supported"))}}sub formula {my$self=shift;@_ and $self->_set_attr_N ("formula",_supported_formula ($self,shift));[qw(none die croak diag empty undef)]->[_supported_formula ($self,$self->{formula})]}sub formula_handling {my$self=shift;$self->formula (@_)}sub decode_utf8 {my$self=shift;@_ and $self->_set_attr_X ("decode_utf8",shift);$self->{decode_utf8}}sub keep_meta_info {my$self=shift;if (@_){my$v=shift;!defined$v || $v eq "" and $v=0;$v =~ m/^[0-9]/ or $v=lc$v eq "false" ? 0 : 1;$self->_set_attr_X ("keep_meta_info",$v)}$self->{keep_meta_info}}sub allow_loose_quotes {my$self=shift;@_ and $self->_set_attr_X ("allow_loose_quotes",shift);$self->{allow_loose_quotes}}sub allow_loose_escapes {my$self=shift;@_ and $self->_set_attr_X ("allow_loose_escapes",shift);$self->{allow_loose_escapes}}sub allow_whitespace {my$self=shift;if (@_){my$aw=shift;_unhealthy_whitespace ($self,$aw)and croak ($self->SetDiag (1002));$self->_set_attr_X ("allow_whitespace",$aw)}$self->{allow_whitespace}}sub allow_unquoted_escape {my$self=shift;@_ and $self->_set_attr_X ("allow_unquoted_escape",shift);$self->{allow_unquoted_escape}}sub blank_is_undef {my$self=shift;@_ and $self->_set_attr_X ("blank_is_undef",shift);$self->{blank_is_undef}}sub empty_is_undef {my$self=shift;@_ and $self->_set_attr_X ("empty_is_undef",shift);$self->{empty_is_undef}}sub verbatim {my$self=shift;@_ and $self->_set_attr_X ("verbatim",shift);$self->{verbatim}}sub undef_str {my$self=shift;if (@_){my$v=shift;$self->{undef_str}=defined$v ? "$v" : undef;$self->_cache_set ($_cache_id{undef_str},$self->{undef_str})}$self->{undef_str}}sub auto_diag {my$self=shift;if (@_){my$v=shift;!defined$v || $v eq "" and $v=0;$v =~ m/^[0-9]/ or $v=lc$v eq "false" ? 0 : 1;$self->_set_attr_X ("auto_diag",$v)}$self->{auto_diag}}sub diag_verbose {my$self=shift;if (@_){my$v=shift;!defined$v || $v eq "" and $v=0;$v =~ m/^[0-9]/ or $v=lc$v eq "false" ? 0 : 1;$self->_set_attr_X ("diag_verbose",$v)}$self->{diag_verbose}}sub status {$_[0]->{_STATUS}}sub eof {$_[0]->{_EOF}}sub types {my$self=shift;if (@_){if (my$types=shift){$self->{'_types'}=join("",map{chr($_)}@$types);$self->{'types'}=$types}else {delete$self->{'types'};delete$self->{'_types'};undef}}else {$self->{'types'}}}sub callbacks {my$self=shift;if (@_){my$cb;my$hf=0x00;if (defined $_[0]){grep {!defined}@_ and croak ($self->SetDiag (1004));$cb=@_==1 && ref $_[0]eq "HASH" ? shift : @_ % 2==0 ? {@_ }: croak ($self->SetDiag (1004));for my$cbk (keys %$cb){$cbk =~ m/^[\w.]+$/ && ref$cb->{$cbk}eq "CODE" or croak ($self->SetDiag (1004))}exists$cb->{error}and $hf |= 0x01;exists$cb->{after_parse}and $hf |= 0x02;exists$cb->{before_print}and $hf |= 0x04}elsif (@_ > 1){croak ($self->SetDiag (1004))}$self->_set_attr_X ("_has_hooks",$hf);$self->{callbacks}=$cb}$self->{callbacks}}sub error_diag {my$self=shift;my@diag=(0 + $last_new_error,$last_new_error,0,0,0);if ($self && ref$self && UNIVERSAL::isa ($self,__PACKAGE__)&& exists$self->{_ERROR_DIAG}){$diag[0]=0 + $self->{_ERROR_DIAG};$diag[1]=$self->{_ERROR_DIAG};$diag[2]=1 + $self->{_ERROR_POS}if exists$self->{_ERROR_POS};$diag[3]=$self->{_RECNO};$diag[4]=$self->{_ERROR_FLD}if exists$self->{_ERROR_FLD};$diag[0]&& $self->{callbacks}&& $self->{callbacks}{error}and return$self->{callbacks}{error}->(@diag)}my$context=wantarray;unless (defined$context){if ($diag[0]&& $diag[0]!=2012){my$msg="# CSV_PP ERROR: $diag[0] - $diag[1] \@ rec $diag[3] pos $diag[2]\n";$diag[4]and $msg =~ s/$/ field $diag[4]/;unless ($self && ref$self){warn$msg;return}if ($self->{diag_verbose}and $self->{_ERROR_INPUT}){$msg .= "$self->{_ERROR_INPUT}'\n";$msg .= " " x ($diag[2]- 1);$msg .= "^\n"}my$lvl=$self->{auto_diag};if ($lvl < 2){my@c=caller (2);if (@c >= 11 && $c[10]&& ref$c[10]eq "HASH"){my$hints=$c[10];(exists$hints->{autodie}&& $hints->{autodie}or exists$hints->{"guard Fatal"}&& !exists$hints->{"no Fatal"})and $lvl++}}$lvl > 1 ? die$msg : warn$msg}return}return$context ? @diag : $diag[1]}sub record_number {return shift->{_RECNO}}*string=\&_string;sub _string {defined $_[0]->{_STRING}? ${$_[0]->{_STRING}}: undef}*fields=\&_fields;sub _fields {ref($_[0]->{_FIELDS})? @{$_[0]->{_FIELDS}}: undef}sub meta_info {$_[0]->{_FFLAGS}? @{$_[0]->{_FFLAGS}}: undef}sub is_quoted {return unless (defined $_[0]->{_FFLAGS});return if($_[1]=~ /\D/ or $_[1]< 0 or $_[1]> $#{$_[0]->{_FFLAGS}});$_[0]->{_FFLAGS}->[$_[1]]& IS_QUOTED ? 1 : 0}sub is_binary {return unless (defined $_[0]->{_FFLAGS});return if($_[1]=~ /\D/ or $_[1]< 0 or $_[1]> $#{$_[0]->{_FFLAGS}});$_[0]->{_FFLAGS}->[$_[1]]& IS_BINARY ? 1 : 0}sub is_missing {my ($self,$idx,$val)=@_;return unless$self->{keep_meta_info};$idx < 0 ||!ref$self->{_FFLAGS}and return;$idx >= @{$self->{_FFLAGS}}and return 1;$self->{_FFLAGS}[$idx]& IS_MISSING ? 1 : 0}*combine=\&_combine;sub _combine {my ($self,@fields)=@_;my$str="";$self->{_FIELDS}=\@fields;$self->{_STATUS}=(@fields > 0)&& $self->__combine(\$str,\@fields,0);$self->{_STRING}=\$str;$self->{_STATUS}}*parse=\&_parse;sub _parse {my ($self,$str)=@_;ref$str and croak ($self->SetDiag (1500));my$fields=[];my$fflags=[];$self->{_STRING}=\$str;if (defined$str && $self->__parse ($fields,$fflags,$str,0)){$self->{_FIELDS}=$fields;$self->{_FFLAGS}=$fflags;$self->{_STATUS}=1}else {$self->{_FIELDS}=undef;$self->{_FFLAGS}=undef;$self->{_STATUS}=0}$self->{_STATUS}}sub column_names {my ($self,@columns)=@_;@columns or return defined$self->{_COLUMN_NAMES}? @{$self->{_COLUMN_NAMES}}: ();@columns==1 &&!defined$columns[0]and return$self->{_COLUMN_NAMES}=undef;if (@columns==1 && ref$columns[0]eq "ARRAY"){@columns=@{$columns[0]}}elsif (join "",map {defined $_ ? ref $_ : ""}@columns){croak$self->SetDiag(3001)}if ($self->{_BOUND_COLUMNS}&& @columns!=@{$self->{_BOUND_COLUMNS}}){croak$self->SetDiag(3003)}$self->{_COLUMN_NAMES}=[map {defined $_ ? $_ : "\cAUNDEF\cA"}@columns ];@{$self->{_COLUMN_NAMES}}}sub header {my ($self,$fh,@args)=@_;$fh or croak ($self->SetDiag (1014));my (@seps,%args);for (@args){if (ref $_ eq "ARRAY"){push@seps,@$_;next}if (ref $_ eq "HASH"){%args=%$_;next}croak (q{usage: $csv->header ($fh, [ seps ], { options })})}defined$args{munge}&&!defined$args{munge_column_names}and $args{munge_column_names}=$args{munge};defined$args{detect_bom}or $args{detect_bom}=1;defined$args{set_column_names}or $args{set_column_names}=1;defined$args{munge_column_names}or $args{munge_column_names}="lc";$self->{_RECNO}=0;$self->{_AHEAD}=undef;$self->{_COLUMN_NAMES}=undef if$args{set_column_names};$self->{_BOUND_COLUMNS}=undef if$args{set_column_names};$self->_cache_set($_cache_id{'_has_ahead'},0);if (defined$args{sep_set}){ref$args{sep_set}eq "ARRAY" or croak ($self->_SetDiagInfo (1500,"sep_set should be an array ref"));@seps=@{$args{sep_set}}}$^O eq "MSWin32" and binmode$fh;my$hdr=<$fh>;defined$hdr && $hdr ne "" or croak ($self->SetDiag (1010));my%sep;@seps or @seps=(",",";");for my$sep (@seps){index ($hdr,$sep)>= 0 and $sep{$sep}++}keys%sep >= 2 and croak ($self->SetDiag (1011));$self->sep (keys%sep);my$enc="";if ($args{detect_bom}){if ($hdr =~ s/^\x00\x00\xfe\xff//){$enc="utf-32be"}elsif ($hdr =~ s/^\xff\xfe\x00\x00//){$enc="utf-32le"}elsif ($hdr =~ s/^\xfe\xff//){$enc="utf-16be"}elsif ($hdr =~ s/^\xff\xfe//){$enc="utf-16le"}elsif ($hdr =~ s/^\xef\xbb\xbf//){$enc="utf-8"}elsif ($hdr =~ s/^\xf7\x64\x4c//){$enc="utf-1"}elsif ($hdr =~ s/^\xdd\x73\x66\x73//){$enc="utf-ebcdic"}elsif ($hdr =~ s/^\x0e\xfe\xff//){$enc="scsu"}elsif ($hdr =~ s/^\xfb\xee\x28//){$enc="bocu-1"}elsif ($hdr =~ s/^\x84\x31\x95\x33//){$enc="gb-18030"}elsif ($hdr =~ s/^\x{feff}//){$enc=""}$self->{ENCODING}=uc$enc;$hdr eq "" and croak ($self->SetDiag (1010));if ($enc){if ($enc =~ m/([13]).le$/){my$l=0 + $1;my$x;$hdr .= "\0" x $l;read$fh,$x,$l}if ($enc ne "utf-8"){require Encode;$hdr=Encode::decode ($enc,$hdr)}binmode$fh,":encoding($enc)"}}my ($ahead,$eol);if ($hdr =~ s/^([^\r\n]+)([\r\n]+)([^\r\n].+)\z/$1/s){$eol=$2;$ahead=$3}$args{munge_column_names}eq "lc" and $hdr=lc$hdr;$args{munge_column_names}eq "uc" and $hdr=uc$hdr;my$hr=\$hdr;open my$h,"<",$hr or croak ($self->SetDiag (1010));my$row=$self->getline ($h)or croak;close$h;if ($ahead){$self->_cache_set ($_cache_id{_has_ahead},1);$self->{_AHEAD}=$ahead;$eol =~ m/^\r([^\n]|\z)/ and $self->eol ($eol)}my@hdr=@$row;ref$args{munge_column_names}eq "CODE" and @hdr=map {$args{munge_column_names}->($_)}@hdr;ref$args{munge_column_names}eq "HASH" and @hdr=map {$args{munge_column_names}->{$_}|| $_}@hdr;my%hdr;$hdr{$_}++ for@hdr;exists$hdr{""}and croak ($self->SetDiag (1012));unless (keys%hdr==@hdr){croak ($self->_SetDiagInfo (1013,join ", "=>map {"$_ ($hdr{$_})"}grep {$hdr{$_}> 1}keys%hdr))}$args{set_column_names}and $self->column_names (@hdr);wantarray ? @hdr : $self}sub bind_columns {my ($self,@refs)=@_;@refs or return defined$self->{_BOUND_COLUMNS}? @{$self->{_BOUND_COLUMNS}}: undef;@refs==1 &&!defined$refs[0]and return$self->{_BOUND_COLUMNS}=undef;if ($self->{_COLUMN_NAMES}&& @refs!=@{$self->{_COLUMN_NAMES}}){croak$self->SetDiag(3003)}if (grep {ref $_ ne "SCALAR"}@refs){croak$self->SetDiag(3004)}$self->_set_attr_N("_is_bound",scalar@refs);$self->{_BOUND_COLUMNS}=[@refs ];@refs}sub getline_hr {my ($self,@args,%hr)=@_;$self->{_COLUMN_NAMES}or croak ($self->SetDiag (3002));my$fr=$self->getline (@args)or return;if (ref$self->{_FFLAGS}){$self->{_FFLAGS}[$_]=IS_MISSING for (@$fr ? $#{$fr}+ 1 : 0).. $#{$self->{_COLUMN_NAMES}};@$fr==1 && (!defined$fr->[0]|| $fr->[0]eq "")and $self->{_FFLAGS}[0]||= IS_MISSING}@hr{@{$self->{_COLUMN_NAMES}}}=@$fr;\%hr}sub getline_hr_all {my ($self,$io,@args)=@_;unless ($self->{_COLUMN_NAMES}){croak$self->SetDiag(3002)}my@cn=@{$self->{_COLUMN_NAMES}};return [map {my%h;@h{@cn }=@$_;\%h}@{$self->getline_all($io,@args)}]}sub say {my ($self,$io,@f)=@_;my$eol=$self->eol;$eol eq "" and $self->eol ($\ || $/);my$state=$self->print ($io,@f==1 &&!defined$f[0]? undef : @f);$self->eol ($eol);return$state}sub print_hr {my ($self,$io,$hr)=@_;$self->{_COLUMN_NAMES}or croak($self->SetDiag(3009));ref$hr eq "HASH" or croak($self->SetDiag(3010));$self->print ($io,[map {$hr->{$_}}$self->column_names ])}sub fragment {my ($self,$io,$spec)=@_;my$qd=qr{\s* [0-9]+ \s* }x;my$qs=qr{\s* (?: [0-9]+ | \* ) \s*}x;my$qr=qr{$qd (?: - $qs )?}x;my$qc=qr{$qr (?: ; $qr )*}x;defined$spec && $spec =~ m{^ \s*
226 \x23 ? \s* # optional leading #
227 ( row | col | cell ) \s* =
228 ( $qc # for row and col
229 | $qd , $qd (?: - $qs , $qs)? # for cell (ranges)
230 (?: ; $qd , $qd (?: - $qs , $qs)? )* # and cell (range) lists
231 ) \s* $}xi or croak ($self->SetDiag (2013));my ($type,$range)=(lc $1,$2);my@h=$self->column_names ();my@c;if ($type eq "cell"){my@spec;my$min_row;my$max_row=0;for (split m/\s*;\s*/=>$range){my ($tlr,$tlc,$brr,$brc)=(m{
232 ^ \s* ([0-9]+ ) \s* , \s* ([0-9]+ ) \s*
233 (?: - \s* ([0-9]+ | \*) \s* , \s* ([0-9]+ | \*) \s* )?
234 $}x)or croak ($self->SetDiag (2013));defined$brr or ($brr,$brc)=($tlr,$tlc);$tlr==0 || $tlc==0 || ($brr ne "*" && ($brr==0 || $brr < $tlr))|| ($brc ne "*" && ($brc==0 || $brc < $tlc))and croak ($self->SetDiag (2013));$tlc--;$brc-- unless$brc eq "*";defined$min_row or $min_row=$tlr;$tlr < $min_row and $min_row=$tlr;$brr eq "*" || $brr > $max_row and $max_row=$brr;push@spec,[$tlr,$tlc,$brr,$brc ]}my$r=0;while (my$row=$self->getline ($io)){++$r < $min_row and next;my%row;my$lc;for my$s (@spec){my ($tlr,$tlc,$brr,$brc)=@$s;$r < $tlr || ($brr ne "*" && $r > $brr)and next;!defined$lc || $tlc < $lc and $lc=$tlc;my$rr=$brc eq "*" ? $#$row : $brc;$row{$_}=$row->[$_]for$tlc .. $rr}push@c,[@row{sort {$a <=> $b}keys%row }];if (@h){my%h;@h{@h}=@{$c[-1]};$c[-1]=\%h}$max_row ne "*" && $r==$max_row and last}return \@c}my@r;my$eod=0;for (split m/\s*;\s*/=>$range){my ($from,$to)=m/^\s* ([0-9]+) (?: \s* - \s* ([0-9]+ | \* ))? \s* $/x or croak ($self->SetDiag (2013));$to ||= $from;$to eq "*" and ($to,$eod)=($from,1);$from <= 0 || $to < $from and croak ($self->SetDiag (2013));$r[$_]=1 for$from .. $to}my$r=0;$type eq "col" and shift@r;$_ ||= 0 for@r;while (my$row=$self->getline ($io)){$r++;if ($type eq "row"){if (($r > $#r && $eod)|| $r[$r]){push@c,$row;if (@h){my%h;@h{@h}=@{$c[-1]};$c[-1]=\%h}}next}push@c,[map {($_ > $#r && $eod)|| $r[$_]? $row->[$_]: ()}0..$#$row ];if (@h){my%h;@h{@h}=@{$c[-1]};$c[-1]=\%h}}return \@c}my$csv_usage=q{usage: my $aoa = csv (in => $file);};sub _csv_attr {my%attr=(@_==1 && ref $_[0]eq "HASH" ? %{$_[0]}: @_)or croak;$attr{binary}=1;my$enc=delete$attr{enc}|| delete$attr{encoding}|| "";$enc eq "auto" and ($attr{detect_bom},$enc)=(1,"");$enc =~ m/^[-\w.]+$/ and $enc=":encoding($enc)";my$fh;my$sink=0;my$cls=0;my$in=delete$attr{in}|| delete$attr{file}or croak$csv_usage;my$out=exists$attr{out}&&!$attr{out}? \"skip" : delete$attr{out}|| delete$attr{file};ref$in eq "CODE" || ref$in eq "ARRAY" and $out ||= \*STDOUT;$in && $out &&!ref$in &&!ref$out and croak join "\n"=>qq{Cannot use a string for both in and out. Instead use:},qq{ csv (in => csv (in => "$in"), out => "$out");\n};if ($out){if ((ref$out and "SCALAR" ne ref$out)or "GLOB" eq ref \$out){$fh=$out}elsif (ref$out and "SCALAR" eq ref$out and defined $$out and $$out eq "skip"){delete$attr{out};$sink=1}else {open$fh,">",$out or croak "$out: $!";$cls=1}if ($fh){$enc and binmode$fh,$enc;unless (defined$attr{eol}){my@layers=eval {PerlIO::get_layers ($fh)};$attr{eol}=(grep m/crlf/=>@layers)? "\n" : "\r\n"}}}if (ref$in eq "CODE" or ref$in eq "ARRAY"){}elsif (ref$in eq "SCALAR"){open$fh,"<",$in or croak "Cannot open from SCALAR using PerlIO";$cls=1}elsif (ref$in or "GLOB" eq ref \$in){if (!ref$in && $] < 5.008005){$fh=\*$in}else {$fh=$in}}else {open$fh,"<$enc",$in or croak "$in: $!";$cls=1}$fh || $sink or croak qq{No valid source passed. "in" is required};my$hdrs=delete$attr{headers};my$frag=delete$attr{fragment};my$key=delete$attr{key};my$val=delete$attr{value};my$kh=delete$attr{keep_headers}|| delete$attr{keep_column_names}|| delete$attr{kh};my$cbai=delete$attr{callbacks}{after_in}|| delete$attr{after_in}|| delete$attr{callbacks}{after_parse}|| delete$attr{after_parse};my$cbbo=delete$attr{callbacks}{before_out}|| delete$attr{before_out};my$cboi=delete$attr{callbacks}{on_in}|| delete$attr{on_in};my$hd_s=delete$attr{sep_set}|| delete$attr{seps};my$hd_b=delete$attr{detect_bom}|| delete$attr{bom};my$hd_m=delete$attr{munge}|| delete$attr{munge_column_names};my$hd_c=delete$attr{set_column_names};for ([quo=>"quote" ],[esc=>"escape" ],[escape=>"escape_char" ],){my ($f,$t)=@$_;exists$attr{$f}and!exists$attr{$t}and $attr{$t}=delete$attr{$f}}my$fltr=delete$attr{filter};my%fltr=(not_blank=>sub {@{$_[1]}> 1 or defined $_[1][0]&& $_[1][0]ne ""},not_empty=>sub {grep {defined && $_ ne ""}@{$_[1]}},filled=>sub {grep {defined && m/\S/}@{$_[1]}},);defined$fltr &&!ref$fltr && exists$fltr{$fltr}and $fltr={0=>$fltr{$fltr}};ref$fltr eq "CODE" and $fltr={0=>$fltr };ref$fltr eq "HASH" or $fltr=undef;exists$attr{formula}and $attr{formula}=_supported_formula (undef,$attr{formula});defined$attr{auto_diag}or $attr{auto_diag}=1;defined$attr{escape_null}or $attr{escape_null}=0;my$csv=delete$attr{csv}|| Text::CSV_PP->new (\%attr)or croak$last_new_error;return {csv=>$csv,attr=>{%attr },fh=>$fh,cls=>$cls,in=>$in,sink=>$sink,out=>$out,enc=>$enc,hdrs=>$hdrs,key=>$key,val=>$val,kh=>$kh,frag=>$frag,fltr=>$fltr,cbai=>$cbai,cbbo=>$cbbo,cboi=>$cboi,hd_s=>$hd_s,hd_b=>$hd_b,hd_m=>$hd_m,hd_c=>$hd_c,}}sub csv {@_ && (ref $_[0]eq __PACKAGE__ or ref $_[0]eq 'Text::CSV')and splice @_,0,0,"csv";@_ or croak$csv_usage;my$c=_csv_attr (@_);my ($csv,$in,$fh,$hdrs)=@{$c}{"csv","in","fh","hdrs"};my%hdr;if (ref$hdrs eq "HASH"){%hdr=%$hdrs;$hdrs="auto"}if ($c->{out}&&!$c->{sink}){if (ref$in eq "CODE"){my$hdr=1;while (my$row=$in->($csv)){if (ref$row eq "ARRAY"){$csv->print ($fh,$row);next}if (ref$row eq "HASH"){if ($hdr){$hdrs ||= [map {$hdr{$_}|| $_}keys %$row ];$csv->print ($fh,$hdrs);$hdr=0}$csv->print ($fh,[@{$row}{@$hdrs}])}}}elsif (ref$in->[0]eq "ARRAY"){ref$hdrs and $csv->print ($fh,$hdrs);for (@{$in}){$c->{cboi}and $c->{cboi}->($csv,$_);$c->{cbbo}and $c->{cbbo}->($csv,$_);$csv->print ($fh,$_)}}else {my@hdrs=ref$hdrs ? @{$hdrs}: keys %{$in->[0]};defined$hdrs or $hdrs="auto";ref$hdrs || $hdrs eq "auto" and $csv->print ($fh,[map {$hdr{$_}|| $_}@hdrs ]);for (@{$in}){local%_;*_=$_;$c->{cboi}and $c->{cboi}->($csv,$_);$c->{cbbo}and $c->{cbbo}->($csv,$_);$csv->print ($fh,[@{$_}{@hdrs}])}}$c->{cls}and close$fh;return 1}my@row1;if (defined$c->{hd_s}|| defined$c->{hd_b}|| defined$c->{hd_m}|| defined$c->{hd_c}){my%harg;defined$c->{hd_s}and $harg{set_set}=$c->{hd_s};defined$c->{hd_d}and $harg{detect_bom}=$c->{hd_b};defined$c->{hd_m}and $harg{munge_column_names}=$hdrs ? "none" : $c->{hd_m};defined$c->{hd_c}and $harg{set_column_names}=$hdrs ? 0 : $c->{hd_c};@row1=$csv->header ($fh,\%harg);my@hdr=$csv->column_names;@hdr and $hdrs ||= \@hdr}if ($c->{kh}){ref$c->{kh}eq "ARRAY" or croak ($csv->SetDiag (1501));$hdrs ||= "auto"}my$key=$c->{key};if ($key){!ref$key or ref$key eq "ARRAY" && @$key > 1 or croak ($csv->SetDiag (1501));$hdrs ||= "auto"}my$val=$c->{val};if ($val){$key or croak ($csv->SetDiag (1502));!ref$val or ref$val eq "ARRAY" && @$val > 0 or croak ($csv->SetDiag (1503))}$c->{fltr}&& grep m/\D/=>keys %{$c->{fltr}}and $hdrs ||= "auto";if (defined$hdrs){if (!ref$hdrs){if ($hdrs eq "skip"){$csv->getline ($fh)}elsif ($hdrs eq "auto"){my$h=$csv->getline ($fh)or return;$hdrs=[map {$hdr{$_}|| $_}@$h ]}elsif ($hdrs eq "lc"){my$h=$csv->getline ($fh)or return;$hdrs=[map {lc ($hdr{$_}|| $_)}@$h ]}elsif ($hdrs eq "uc"){my$h=$csv->getline ($fh)or return;$hdrs=[map {uc ($hdr{$_}|| $_)}@$h ]}}elsif (ref$hdrs eq "CODE"){my$h=$csv->getline ($fh)or return;my$cr=$hdrs;$hdrs=[map {$cr->($hdr{$_}|| $_)}@$h ]}$c->{kh}and $hdrs and @{$c->{kh}}=@$hdrs}if ($c->{fltr}){my%f=%{$c->{fltr}};my@hdr;if (ref$hdrs){@hdr=@{$hdrs};for (0 .. $#hdr){exists$f{$hdr[$_]}and $f{$_ + 1}=delete$f{$hdr[$_]}}}$csv->callbacks (after_parse=>sub {my ($CSV,$ROW)=@_;for my$FLD (sort keys%f){local $_=$ROW->[$FLD - 1];local%_;@hdr and @_{@hdr}=@$ROW;$f{$FLD}->($CSV,$ROW)or return \"skip";$ROW->[$FLD - 1]=$_}})}my$frag=$c->{frag};my$ref=ref$hdrs ? do {my@h=$csv->column_names ($hdrs);my%h;$h{$_}++ for@h;exists$h{""}and croak ($csv->SetDiag (1012));unless (keys%h==@h){croak ($csv->_SetDiagInfo (1013,join ", "=>map {"$_ ($h{$_})"}grep {$h{$_}> 1}keys%h))}$frag ? $csv->fragment ($fh,$frag): $key ? do {my ($k,$j,@f)=ref$key ? (undef,@$key): ($key);if (my@mk=grep {!exists$h{$_}}grep {defined}$k,@f){croak ($csv->_SetDiagInfo (4001,join ", "=>@mk))}+{map {my$r=$_;my$K=defined$k ? $r->{$k}: join$j=>@{$r}{@f};($K=>($val ? ref$val ? {map {$_=>$r->{$_}}@$val }: $r->{$val}: $r))}@{$csv->getline_hr_all ($fh)}}}: $csv->getline_hr_all ($fh)}: $frag ? $csv->fragment ($fh,$frag): $csv->getline_all ($fh);if ($ref){@row1 &&!$c->{hd_c}&&!ref$hdrs and unshift @$ref,\@row1}else {Text::CSV_PP->auto_diag}$c->{cls}and close$fh;if ($ref and $c->{cbai}|| $c->{cboi}){for my$r (ref$ref eq "ARRAY" ? @{$ref}: values %{$ref}){local%_;ref$r eq "HASH" and *_=$r;$c->{cbai}and $c->{cbai}->($csv,$r);$c->{cboi}and $c->{cboi}->($csv,$r)}}$c->{sink}and return;defined wantarray or return csv (%{$c->{attr}},in=>$ref,headers=>$hdrs,%{$c->{attr}});return$ref}sub _setup_ctx {my$self=shift;$last_error=undef;my$ctx;if ($self->{_CACHE}){%$ctx=%{$self->{_CACHE}}}else {$ctx->{sep}=',';if (defined$self->{sep_char}){$ctx->{sep}=$self->{sep_char}}if (defined$self->{sep}and $self->{sep}ne ''){use bytes;$ctx->{sep}=$self->{sep};my$sep_len=length($ctx->{sep});$ctx->{sep_len}=$sep_len if$sep_len > 1}$ctx->{quo}='"';if (exists$self->{quote_char}){my$quote_char=$self->{quote_char};if (defined$quote_char and length$quote_char){$ctx->{quo}=$quote_char}else {$ctx->{quo}="\0"}}if (defined$self->{quote}and $self->{quote}ne ''){use bytes;$ctx->{quo}=$self->{quote};my$quote_len=length($ctx->{quo});$ctx->{quo_len}=$quote_len if$quote_len > 1}$ctx->{escape_char}='"';if (exists$self->{escape_char}){my$escape_char=$self->{escape_char};if (defined$escape_char and length$escape_char){$ctx->{escape_char}=$escape_char}else {$ctx->{escape_char}="\0"}}if (defined$self->{eol}){my$eol=$self->{eol};my$eol_len=length($eol);$ctx->{eol}=$eol;$ctx->{eol_len}=$eol_len;if ($eol_len==1 and $eol eq "\015"){$ctx->{eol_is_cr}=1}}$ctx->{undef_flg}=0;if (defined$self->{undef_str}){$ctx->{undef_str}=$self->{undef_str};$ctx->{undef_flg}=3 if utf8::is_utf8($self->{undef_str})}else {$ctx->{undef_str}=undef}if (defined$self->{_types}){$ctx->{types}=$self->{_types};$ctx->{types_len}=length($ctx->{types})}if (defined$self->{_is_bound}){$ctx->{is_bound}=$self->{_is_bound}}if (defined$self->{callbacks}){my$cb=$self->{callbacks};$ctx->{has_hooks}=0;if (defined$cb->{after_parse}and ref$cb->{after_parse}eq 'CODE'){$ctx->{has_hooks}|= HOOK_AFTER_PARSE}if (defined$cb->{before_print}and ref$cb->{before_print}eq 'CODE'){$ctx->{has_hooks}|= HOOK_BEFORE_PRINT}}for (qw/binary decode_utf8 always_quote strict quote_empty allow_loose_quotes allow_loose_escapes allow_unquoted_escape allow_whitespace blank_is_undef empty_is_undef verbatim auto_diag diag_verbose keep_meta_info formula/){$ctx->{$_}=defined$self->{$_}? $self->{$_}: 0}for (qw/quote_space escape_null quote_binary/){$ctx->{$_}=defined$self->{$_}? $self->{$_}: 1}if ($ctx->{escape_char}eq "\0"){$ctx->{escape_null}=0}%{$self->{_CACHE}}=%$ctx}$ctx->{utf8}=0;$ctx->{size}=0;$ctx->{used}=0;if ($ctx->{is_bound}){my$bound=$self->{_BOUND_COLUMNS};if ($bound and ref$bound eq 'ARRAY'){$ctx->{bound}=$bound}else {$ctx->{is_bound}=0}}$ctx->{eol_pos}=-1;$ctx->{eolx}=$ctx->{eol_len}? $ctx->{verbatim}|| $ctx->{eol_len}>= 2 ? 1 : $ctx->{eol}=~ /\A[\015\012]/ ? 0 : 1 : 0;if ($ctx->{sep_len}and $ctx->{sep_len}> 1 and _is_valid_utf8($ctx->{sep})){$ctx->{utf8}=1}if ($ctx->{quo_len}and $ctx->{quo_len}> 1 and _is_valid_utf8($ctx->{quo})){$ctx->{utf8}=1}$ctx}sub _cache_set {my ($self,$idx,$value)=@_;return unless exists$self->{_CACHE};my$cache=$self->{_CACHE};my$key=$_reverse_cache_id{$idx};if (!defined$key){warn (sprintf "Unknown cache index %d ignored\n",$idx)}elsif ($key eq 'sep_char'){$cache->{sep}=$value;$cache->{sep_len}=0}elsif ($key eq 'quote_char'){$cache->{quo}=$value;$cache->{quo_len}=0}elsif ($key eq '_has_ahead'){$cache->{has_ahead}=$value}elsif ($key eq '_has_hooks'){$cache->{has_hooks}=$value}elsif ($key eq '_is_bound'){$cache->{is_bound}=$value}elsif ($key eq 'sep'){use bytes;my$len=bytes::length($value);$cache->{sep}=$value if$len;$cache->{sep_len}=$len==1 ? 0 : $len}elsif ($key eq 'quote'){use bytes;my$len=bytes::length($value);$cache->{quo}=$value if$len;$cache->{quo_len}=$len==1 ? 0 : $len}elsif ($key eq 'eol'){if (defined($value)){$cache->{eol}=$value;$cache->{eol_len}=length($value)}$cache->{eol_is_cr}=$value eq "\015" ? 1 : 0}elsif ($key eq 'undef_str'){if (defined$value){$cache->{undef_str}=$value;$cache->{undef_flg}=3 if utf8::is_utf8($value)}else {$cache->{undef_str}=undef;$cache->{undef_flg}=0}}else {$cache->{$key}=$value}return 1}sub _cache_diag {my$self=shift;unless (exists$self->{_CACHE}){warn ("CACHE: invalid\n");return}my$cache=$self->{_CACHE};warn ("CACHE:\n");$self->__cache_show_char(quote_char=>$cache->{quo});$self->__cache_show_char(escape_char=>$cache->{escape_char});$self->__cache_show_char(sep_char=>$cache->{sep});for (qw/binary decode_utf8 allow_loose_escapes allow_loose_quotes allow_unquoted_escape allow_whitespace always_quote quote_empty quote_space escape_null quote_binary auto_diag diag_verbose formula strict has_error_input blank_is_undef empty_is_undef has_ahead keep_meta_info verbatim has_hooks eol_is_cr eol_len/){$self->__cache_show_byte($_=>$cache->{$_})}$self->__cache_show_str(eol=>$cache->{eol_len},$cache->{eol});$self->__cache_show_byte(sep_len=>$cache->{sep_len});if ($cache->{sep_len}and $cache->{sep_len}> 1){$self->__cache_show_str(sep=>$cache->{sep_len},$cache->{sep})}$self->__cache_show_byte(quo_len=>$cache->{quo_len});if ($cache->{quo_len}and $cache->{quo_len}> 1){$self->__cache_show_str(quote=>$cache->{quo_len},$cache->{quo})}}sub __cache_show_byte {my ($self,$key,$value)=@_;warn (sprintf " %-21s %02x:%3d\n",$key,defined$value ? ord($value): 0,defined$value ? $value : 0)}sub __cache_show_char {my ($self,$key,$value)=@_;my$v=$value;if (defined$value){my@b=unpack "U0C*",$value;$v=pack "U*",$b[0]}warn (sprintf " %-21s %02x:%s\n",$key,defined$v ? ord($v): 0,$self->__pretty_str($v,1))}sub __cache_show_str {my ($self,$key,$len,$value)=@_;warn (sprintf " %-21s %02d:%s\n",$key,$len,$self->__pretty_str($value,$len))}sub __pretty_str {my ($self,$str,$len)=@_;return '' unless defined$str;$str=substr($str,0,$len);$str =~ s/"/\\"/g;$str =~ s/([^\x09\x20-\x7e])/sprintf '\\x{%x}', ord($1)/eg;qq{"$str"}}sub _hook {my ($self,$name,$fields)=@_;return 0 unless$self->{callbacks};my$cb=$self->{callbacks}{$name};return 0 unless$cb && ref$cb eq 'CODE';my (@res)=$cb->($self,$fields);if (@res){return 0 if ref$res[0]eq 'SCALAR' and ${$res[0]}eq "skip"}scalar@res}sub __combine {my ($self,$dst,$fields,$useIO)=@_;my$ctx=$self->_setup_ctx;my ($binary,$quot,$sep,$esc,$quote_space)=@{$ctx}{qw/binary quo sep escape_char quote_space/};if(!defined$quot or $quot eq "\0"){$quot=''}my$re_esc;if ($esc ne '' and $esc ne "\0"){if ($quot ne ''){$re_esc=$self->{_re_comb_escape}->{$quot}->{$esc}||= qr/(\Q$quot\E|\Q$esc\E)/}else {$re_esc=$self->{_re_comb_escape}->{$quot}->{$esc}||= qr/(\Q$esc\E)/}}my$bound=0;my$n=@$fields - 1;if ($n < 0 and $ctx->{is_bound}){$n=$ctx->{is_bound}- 1;$bound=1}my$check_meta=($ctx->{keep_meta_info}>= 10 and @{$self->{_FFLAGS}|| []}>= $n)? 1 : 0;my$must_be_quoted;my@results;for(my$i=0;$i <= $n;$i++){my$v_ref;if ($bound){$v_ref=$self->__bound_field($ctx,$i,1)}else {if (@$fields > $i){$v_ref=\($fields->[$i])}}next unless$v_ref;my$value=$$v_ref;if (!defined$value){if ($ctx->{undef_str}){if ($ctx->{undef_flg}){$ctx->{utf8}=1;$ctx->{binary}=1}push@results,$ctx->{undef_str}}else {push@results,''}next}if (substr($value,0,1)eq '=' && $ctx->{formula}){$value=$self->_formula($ctx,$value,$i);if (!defined$value){push@results,'';next}}$must_be_quoted=$ctx->{always_quote}? 1 : 0;if ($value eq ''){$must_be_quoted++ if$ctx->{quote_empty}or ($check_meta && $self->is_quoted($i))}else {if (utf8::is_utf8$value){$ctx->{utf8}=1;$ctx->{binary}=1}$must_be_quoted++ if$check_meta && $self->is_quoted($i);if (!$must_be_quoted and $quot ne ''){use bytes;$must_be_quoted++ if ($value =~ /\Q$quot\E/)|| ($sep ne '' and $sep ne "\0" and $value =~ /\Q$sep\E/)|| ($esc ne '' and $esc ne "\0" and $value =~ /\Q$esc\E/)|| ($ctx->{quote_binary}&& $value =~ /[\x00-\x1f\x7f-\xa0]/)|| ($ctx->{quote_space}&& $value =~ /[\x09\x20]/)}if (!$ctx->{binary}and $value =~ /[^\x09\x20-\x7E]/){$self->{_ERROR_INPUT}=$value;$self->SetDiag(2110);return 0}if ($re_esc){$value =~ s/($re_esc)/$esc$1/g}if ($ctx->{escape_null}){$value =~ s/\0/${esc}0/g}}if ($must_be_quoted){$value=$quot .$value .$quot}push@results,$value}$$dst=join($sep,@results).(defined$ctx->{eol}? $ctx->{eol}: '');return 1}sub _formula {my ($self,$ctx,$value,$i)=@_;my$fa=$ctx->{formula}or return;if ($fa==1){die "Formulas are forbidden\n"}if ($fa==2){die "Formulas are forbidden\n"}if ($fa==3){my$rec='';if ($ctx->{recno}){$rec=sprintf " in record %lu",$ctx->{recno}+ 1}my$field='';my$column_names=$self->{_COLUMN_NAMES};if (ref$column_names eq 'ARRAY' and @$column_names >= $i - 1){my$column_name=$column_names->[$i - 1];$field=sprintf " (column: '%.100s')",$column_name if defined$column_name}warn sprintf("Field %d%s%s contains formula '%s'\n",$i,$field,$rec,$value);return$value}if ($fa==4){return ''}if ($fa==5){return undef}return}sub print {my ($self,$io,$fields)=@_;require IO::Handle;if (!defined$fields){$fields=[]}elsif(ref($fields)ne 'ARRAY'){Carp::croak("Expected fields to be an array ref")}$self->_hook(before_print=>$fields);my$str="";$self->__combine(\$str,$fields,1)or return '';local $\='';$io->print($str)or $self->_set_error_diag(2200)}sub __parse {my ($self,$fields,$fflags,$src,$useIO)=@_;my$ctx=$self->_setup_ctx;my$state=$self->___parse($ctx,$fields,$fflags,$src,$useIO);if ($state and ($ctx->{has_hooks}|| 0)& HOOK_AFTER_PARSE){$self->_hook(after_parse=>$fields)}return$state ||!$last_error}sub ___parse {my ($self,$ctx,$fields,$fflags,$src,$useIO)=@_;local $/=$ctx->{eol}if$ctx->{eolx}or $ctx->{eol_is_cr};if ($ctx->{useIO}=$useIO){require IO::Handle;$ctx->{tmp}=undef;if ($ctx->{has_ahead}and defined$self->{_AHEAD}){$ctx->{tmp}=$self->{_AHEAD};$ctx->{size}=length$ctx->{tmp};$ctx->{used}=0}}else {$ctx->{tmp}=$src;$ctx->{size}=length$src;$ctx->{used}=0;$ctx->{utf8}=utf8::is_utf8($src)}if ($ctx->{has_error_input}){$self->{_ERROR_INPUT}=undef;$ctx->{has_error_input}=0}my$result=$self->____parse($ctx,$src,$fields,$fflags);$self->{_RECNO}=++($ctx->{recno});$self->{_EOF}='';if ($ctx->{strict}){$ctx->{strict_n}||= $ctx->{fld_idx};if ($ctx->{strict_n}!=$ctx->{fld_idx}){unless ($ctx->{useIO}& useIO_EOF){$self->__parse_error($ctx,2014,$ctx->{used})}$result=undef}}if ($ctx->{useIO}){if (defined$ctx->{tmp}and $ctx->{used}< $ctx->{size}and $ctx->{has_ahead}){$self->{_AHEAD}=substr($ctx->{tmp},$ctx->{used},$ctx->{size}- $ctx->{used})}else {$ctx->{has_ahead}=0;if ($ctx->{useIO}& useIO_EOF){$self->{_EOF}=1}}%{$self->{_CACHE}}=%$ctx;if ($fflags){if ($ctx->{keep_meta_info}){$self->{_FFLAGS}=$fflags}else {undef$fflags}}}else {%{$self->{_CACHE}}=%$ctx}if ($result and $ctx->{types}){my$len=@$fields;for(my$i=0;$i <= $len && $i <= $ctx->{types_len};$i++){my$value=$fields->[$i];next unless defined$value;my$type=ord(substr($ctx->{types},$i,1));if ($type==IV){$fields->[$i]=int($value)}elsif ($type==NV){$fields->[$i]=$value + 0.0}}}$result}sub ____parse {my ($self,$ctx,$src,$fields,$fflags)=@_;my ($quot,$sep,$esc,$eol)=@{$ctx}{qw/quo sep escape_char eol/};utf8::encode($sep)if!$ctx->{utf8}and $ctx->{sep_len};utf8::encode($quot)if!$ctx->{utf8}and $ctx->{quo_len};utf8::encode($eol)if!$ctx->{utf8}and $ctx->{eol_len};my$seenSomething=0;my$waitingForField=1;my ($value,$v_ref);$ctx->{fld_idx}=my$fnum=0;$ctx->{flag}=0;my$re_str=join '|',map({$_ eq "\0" ? '[\\0]' : quotemeta($_)}sort {length$b <=> length$a}grep {defined $_ and $_ ne ''}$sep,$quot,$esc,$eol),"\015","\012","\x09"," ";$ctx->{_re}=qr/$re_str/;my$re=qr/$re_str|[^\x09\x20-\x7E]|$/;LOOP: while($self->__get_from_src($ctx,$src)){while($ctx->{tmp}=~ /\G(.*?)($re)/gs){my ($hit,$c)=($1,$2);$ctx->{used}=pos($ctx->{tmp});if (!$waitingForField and $c eq '' and $hit ne '' and $ctx->{useIO}and!($ctx->{useIO}& useIO_EOF)){$self->{_AHEAD}=$hit;$ctx->{has_ahead}=1;$ctx->{has_leftover}=1;last}last if$seenSomething and $hit eq '' and $c eq '';if (!$v_ref){if ($ctx->{is_bound}){$v_ref=$self->__bound_field($ctx,$fnum,0)}else {$value='';$v_ref=\$value}$fnum++;return unless$v_ref;$ctx->{flag}=0;$ctx->{fld_idx}++}$seenSomething=1;if (defined$hit and $hit ne ''){if ($waitingForField){$waitingForField=0}if ($hit =~ /[^\x09\x20-\x7E]/){$ctx->{flag}|= IS_BINARY}$$v_ref .= $hit}RESTART: if (defined$c and defined$sep and $c eq $sep){if ($waitingForField){if ($ctx->{blank_is_undef}or $ctx->{empty_is_undef}){$$v_ref=undef}else {$$v_ref=""}unless ($ctx->{is_bound}){push @$fields,$$v_ref}$v_ref=undef;if ($ctx->{keep_meta_info}and $fflags){push @$fflags,$ctx->{flag}}}elsif ($ctx->{flag}& IS_QUOTED){$$v_ref .= $c}else {$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);$v_ref=undef;$waitingForField=1}}elsif (defined$c and defined$quot and $quot ne "\0" and $c eq $quot){if ($waitingForField){$ctx->{flag}|= IS_QUOTED;$waitingForField=0;next}if ($ctx->{flag}& IS_QUOTED){my$quoesc=0;my$c2=$self->__get($ctx);if ($ctx->{allow_whitespace}){while($self->__is_whitespace($ctx,$c2)){if ($ctx->{allow_loose_quotes}and!(defined$esc and $c2 eq $esc)){$$v_ref .= $c;$c=$c2}$c2=$self->__get($ctx)}}if (!defined$c2){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}if (defined$c2 and defined$sep and $c2 eq $sep){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);$v_ref=undef;$waitingForField=1;next}if (defined$c2 and ($c2 eq "\012" or (defined$eol and $c2 eq $eol))){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}if (defined$esc and $c eq $esc){$quoesc=1;if (defined$c2 and $c2 eq '0'){$$v_ref .= "\0";next}if (defined$c2 and defined$quot and $c2 eq $quot){if ($ctx->{utf8}){$ctx->{flag}|= IS_BINARY}$$v_ref .= $c2;next}if ($ctx->{allow_loose_escapes}and defined$c2 and $c2 ne "\015"){$$v_ref .= $c;$c=$c2;goto RESTART}}if (defined$c2 and $c2 eq "\015"){if ($ctx->{eol_is_cr}){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}my$c3=$self->__get($ctx);if (defined$c3 and $c3 eq "\012"){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}if ($ctx->{useIO}and!$ctx->{eol_len}and $c3 !~ /[^\x09\x20-\x7E]/){$self->__set_eol_is_cr($ctx);$ctx->{used}--;$ctx->{has_ahead}=1;$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}$self->__parse_error($ctx,$quoesc ? 2023 : 2010,$ctx->{used}- 2);return}if ($ctx->{allow_loose_quotes}and!$quoesc){$$v_ref .= $c;$c=$c2;goto RESTART}if ($quoesc){$ctx->{used}--;$self->__error_inside_quotes($ctx,2023);return}$self->__error_inside_quotes($ctx,2011);return}if ($ctx->{allow_loose_quotes}){$ctx->{flag}|= IS_ERROR;$$v_ref .= $c}else {$self->__error_inside_field($ctx,2034);return}}elsif (defined$c and defined$esc and $esc ne "\0" and $c eq $esc){if ($waitingForField){$waitingForField=0;if ($ctx->{allow_unquoted_escape}){my$c2=$self->__get($ctx);$$v_ref="";if (!defined$c2){$ctx->{used}--;$self->__error_inside_field($ctx,2035);return}if ($c2 eq '0'){$$v_ref .= "\0"}elsif ((defined$quot and $c2 eq $quot)or (defined$sep and $c2 eq $sep)or (defined$esc and $c2 eq $esc)or $ctx->{allow_loose_escapes}){if ($ctx->{utf8}){$ctx->{flag}|= IS_BINARY}$$v_ref .= $c2}else {$self->__parse_inside_quotes($ctx,2025);return}}}elsif ($ctx->{flag}& IS_QUOTED){my$c2=$self->__get($ctx);if (!defined$c2){$ctx->{used}--;$self->__error_inside_quotes($ctx,2024);return}if ($c2 eq '0'){$$v_ref .= "\0"}elsif ((defined$quot and $c2 eq $quot)or (defined$sep and $c2 eq $sep)or (defined$esc and $c2 eq $esc)or $ctx->{allow_loose_escapes}){if ($ctx->{utf8}){$ctx->{flag}|= IS_BINARY}$$v_ref .= $c2}else {$ctx->{used}--;$self->__error_inside_quotes($ctx,2025);return}}elsif ($v_ref){my$c2=$self->__get($ctx);if (!defined$c2){$ctx->{used}--;$self->__error_inside_field($ctx,2035);return}$$v_ref .= $c2}else {$self->__error_inside_field($ctx,2036);return}}elsif (defined$c and ($c eq "\012" or $c eq '' or (defined$eol and $c eq $eol and $eol ne "\015"))){EOLX: if ($waitingForField){if ($ctx->{blank_is_undef}or $ctx->{empty_is_undef}){$$v_ref=undef}else {$$v_ref=""}unless ($ctx->{is_bound}){push @$fields,$$v_ref}if ($ctx->{keep_meta_info}and $fflags){push @$fflags,$ctx->{flag}}return 1}if ($ctx->{flag}& IS_QUOTED){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}){$self->__error_inside_quotes($ctx,2021);return}$$v_ref .= $c}elsif ($ctx->{verbatim}){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}){$self->__error_inside_field($ctx,2030);return}$$v_ref .= $c unless$ctx->{eol}eq $c and $ctx->{useIO}}else {if (!$ctx->{recno}and $ctx->{fld_idx}==1 and $ctx->{useIO}and $hit =~ /^sep=(.{1,16})$/i){$ctx->{sep}=$1;use bytes;my$len=length$ctx->{sep};if ($len <= 16){$ctx->{sep_len}=$len==1 ? 0 : $len;return$self->____parse($ctx,$src,$fields,$fflags)}}$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}}elsif (defined$c and $c eq "\015" and!$ctx->{verbatim}){if ($waitingForField){$waitingForField=0;if ($ctx->{eol_is_cr}){$c="\012";goto RESTART}my$c2=$self->__get($ctx);if (!defined$c2){$c=undef;goto RESTART}if ($c2 eq "\012"){$c=$c2;goto RESTART}if ($ctx->{useIO}and!$ctx->{eol_len}and $c2 !~ /[^\x09\x20-\x7E]/){$self->__set_eol_is_cr($ctx);$ctx->{used}--;$ctx->{has_ahead}=1;$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}$ctx->{used}--;$self->__error_inside_field($ctx,2031);return}if ($ctx->{flag}& IS_QUOTED){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}){$self->__error_inside_quotes($ctx,2022);return}$$v_ref .= $c}else {if ($ctx->{eol_is_cr}){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}my$c2=$self->__get($ctx);if (defined$c2 and $c2 eq "\012"){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}if ($ctx->{useIO}and!$ctx->{eol_len}and $c2 !~ /[^\x09\x20-\x7E]/){$self->__set_eol_is_cr($ctx);$ctx->{used}--;$ctx->{has_ahead}=1;$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum);return 1}$self->__error_inside_field($ctx,2032);return}}else {if ($ctx->{eolx}and $c eq $eol){$c='';goto EOLX}if ($waitingForField){if ($ctx->{allow_whitespace}and $self->__is_whitespace($ctx,$c)){do {$c=$self->__get($ctx);last if!defined$c}while$self->__is_whitespace($ctx,$c);goto RESTART}$waitingForField=0;goto RESTART}if ($ctx->{flag}& IS_QUOTED){if (!defined$c or $c =~ /[^\x09\x20-\x7E]/){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}or $ctx->{utf8}){$self->__error_inside_quotes($ctx,2026);return}}$$v_ref .= $c}else {if (!defined$c or $c =~ /[^\x09\x20-\x7E]/){$ctx->{flag}|= IS_BINARY;unless ($ctx->{binary}or $ctx->{utf8}){$self->__error_inside_field($ctx,2037);return}}$$v_ref .= $c}}last LOOP if$ctx->{useIO}and $ctx->{verbatim}and $ctx->{used}==$ctx->{size}}}if ($waitingForField){if ($seenSomething or!$ctx->{useIO}){if (!$v_ref){if ($ctx->{is_bound}){$v_ref=$self->__bound_field($ctx,$fnum,0)}else {$value='';$v_ref=\$value}$fnum++;return unless$v_ref;$ctx->{flag}=0;$ctx->{fld_idx}++}if ($ctx->{blank_is_undef}or $ctx->{empty_is_undef}){$$v_ref=undef}else {$$v_ref=""}unless ($ctx->{is_bound}){push @$fields,$$v_ref}if ($ctx->{keep_meta_info}and $fflags){push @$fflags,$ctx->{flag}}return 1}$self->SetDiag(2012);return}if ($ctx->{flag}& IS_QUOTED){$self->__error_inside_quotes($ctx,2027);return}if ($v_ref){$self->__push_value($ctx,$v_ref,$fields,$fflags,$ctx->{flag},$fnum)}return 1}sub __get_from_src {my ($self,$ctx,$src)=@_;return 1 if defined$ctx->{tmp}and $ctx->{used}<= 0;return 1 if$ctx->{used}< $ctx->{size};return unless$ctx->{useIO};my$res=$src->getline;if (defined$res){if ($ctx->{has_ahead}){$ctx->{tmp}=$self->{_AHEAD};$ctx->{tmp}.= $ctx->{eol}if$ctx->{eol_len};$ctx->{tmp}.= $res;$ctx->{has_ahead}=0}else {$ctx->{tmp}=$res}if ($ctx->{size}=length$ctx->{tmp}){$ctx->{used}=-1;$ctx->{utf8}=1 if utf8::is_utf8($ctx->{tmp});pos($ctx->{tmp})=0;return 1}}elsif (delete$ctx->{has_leftover}){$ctx->{tmp}=$self->{_AHEAD};$ctx->{has_ahead}=0;$ctx->{useIO}|= useIO_EOF;if ($ctx->{size}=length$ctx->{tmp}){$ctx->{used}=-1;$ctx->{utf8}=1 if utf8::is_utf8($ctx->{tmp});pos($ctx->{tmp})=0;return 1}}$ctx->{tmp}='' unless defined$ctx->{tmp};$ctx->{useIO}|= useIO_EOF;return}sub __set_eol_is_cr {my ($self,$ctx)=@_;$ctx->{eol}="\015";$ctx->{eol_is_cr}=1;$ctx->{eol_len}=1;%{$self->{_CACHE}}=%$ctx;$self->{eol}=$ctx->{eol}}sub __bound_field {my ($self,$ctx,$i,$keep)=@_;if ($i >= $ctx->{is_bound}){$self->SetDiag(3006);return}if (ref$ctx->{bound}eq 'ARRAY'){my$ref=$ctx->{bound}[$i];if (ref$ref){if ($keep){return$ref}unless (Scalar::Util::readonly($$ref)){$$ref="";return$ref}}}$self->SetDiag(3008);return}sub __get {my ($self,$ctx)=@_;return unless defined$ctx->{used};return if$ctx->{used}>= $ctx->{size};my$pos=pos($ctx->{tmp});if ($ctx->{tmp}=~ /\G($ctx->{_re}|.)/gs){my$c=$1;if ($c =~ /[^\x09\x20-\x7e]/){$ctx->{flag}|= IS_BINARY}$ctx->{used}=pos($ctx->{tmp});return$c}else {pos($ctx->{tmp})=$pos;return}}sub __error_inside_quotes {my ($self,$ctx,$error)=@_;$self->__parse_error($ctx,$error,$ctx->{used}- 1)}sub __error_inside_field {my ($self,$ctx,$error)=@_;$self->__parse_error($ctx,$error,$ctx->{used}- 1)}sub __parse_error {my ($self,$ctx,$error,$pos)=@_;$self->{_ERROR_POS}=$pos;$self->{_ERROR_FLD}=$ctx->{fld_idx};$self->{_ERROR_INPUT}=$ctx->{tmp}if$ctx->{tmp};$self->SetDiag($error);return}sub __is_whitespace {my ($self,$ctx,$c)=@_;return unless defined$c;return ((!defined$ctx->{sep}or $c ne $ctx->{sep})&& (!defined$ctx->{quo}or $c ne $ctx->{quo})&& (!defined$ctx->{escape_char}or $c ne $ctx->{escape_char})&& ($c eq " " or $c eq "\t"))}sub __push_value {my ($self,$ctx,$v_ref,$fields,$fflags,$flag,$fnum)=@_;utf8::encode($$v_ref)if$ctx->{utf8};if ($ctx->{formula}&& $$v_ref && substr($$v_ref,0,1)eq '='){my$value=$self->_formula($ctx,$$v_ref,$fnum);push @$fields,defined$value ? $value : undef;return}if ((!defined $$v_ref or $$v_ref eq '')and ($ctx->{empty_is_undef}or (!($flag & IS_QUOTED)and $ctx->{blank_is_undef}))){$$v_ref=undef}else {if ($ctx->{allow_whitespace}&&!($flag & IS_QUOTED)){$$v_ref =~ s/[ \t]+$//}if ($flag & IS_BINARY and $ctx->{decode_utf8}and ($ctx->{utf8}|| _is_valid_utf8($$v_ref))){utf8::decode($$v_ref)}}unless ($ctx->{is_bound}){push @$fields,$$v_ref}if ($ctx->{keep_meta_info}and $fflags){push @$fflags,$flag}}sub getline {my ($self,$io)=@_;my (@fields,@fflags);my$res=$self->__parse(\@fields,\@fflags,$io,1);$res ? \@fields : undef}sub getline_all {my ($self,$io,$offset,$len)=@_;my$ctx=$self->_setup_ctx;my$tail=0;my$n=0;$offset ||= 0;if ($offset < 0){$tail=-$offset;$offset=-1}my (@row,@list);while ($self->___parse($ctx,\@row,undef,$io,1)){$ctx=$self->_setup_ctx;if ($offset > 0){$offset--;@row=();next}if ($n++ >= $tail and $tail){shift@list;$n--}if (($ctx->{has_hooks}|| 0)& HOOK_AFTER_PARSE){unless ($self->_hook(after_parse=>\@row)){@row=();next}}push@list,[@row];@row=();last if defined$len && $n >= $len and $offset >= 0}if (defined$len && $n > $len){@list=splice(@list,0,$len)}return \@list}sub _is_valid_utf8 {return ($_[0]=~ /^(?:
235 [\x00-\x7F]
236 |[\xC2-\xDF][\x80-\xBF]
237 |[\xE0][\xA0-\xBF][\x80-\xBF]
238 |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
239 |[\xED][\x80-\x9F][\x80-\xBF]
240 |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
241 |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
242 |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
243 |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
244 )+$/x)? 1 : 0}sub _set_error_diag {my ($self,$error,$pos)=@_;$self->SetDiag($error);if (defined$pos){$_[0]->{_ERROR_POS}=$pos}return}sub error_input {my$self=shift;if ($self and ((Scalar::Util::reftype($self)|| '')eq 'HASH' or (ref$self)=~ /^Text::CSV/)){return$self->{_ERROR_INPUT}}return}sub _sv_diag {my ($self,$error)=@_;bless [$error,$ERRORS->{$error}],'Text::CSV::ErrorDiag'}sub _set_diag {my ($self,$ctx,$error)=@_;$last_error=$self->_sv_diag($error);$self->{_ERROR_DIAG}=$last_error;if ($error==0){$self->{_ERROR_POS}=0;$self->{_ERROR_FLD}=0;$self->{_ERROR_INPUT}=undef;$ctx->{has_error_input}=0}if ($error==2012){$self->{_EOF}=1}if ($ctx->{auto_diag}){$self->error_diag}return$last_error}sub SetDiag {my ($self,$error,$errstr)=@_;my$res;if (ref$self){my$ctx=$self->_setup_ctx;$res=$self->_set_diag($ctx,$error)}else {$res=$self->_sv_diag($error)}if (defined$errstr){$res->[1]=$errstr}$res}package Text::CSV::ErrorDiag;use strict;use overload ('""'=>\&stringify,'+'=>\&numeric,'-'=>\&numeric,'*'=>\&numeric,'/'=>\&numeric,fallback=>1,);sub numeric {my ($left,$right)=@_;return ref$left ? $left->[0]: $right->[0]}sub stringify {$_[0]->[1]}1;
245 TEXT_CSV_PP
246
247 $fatpacked{"Text/Gitignore.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_GITIGNORE';
248 package Text::Gitignore;use strict;use warnings;use base 'Exporter';our@EXPORT_OK=qw(match_gitignore build_gitignore_matcher);our$VERSION="0.02";sub match_gitignore {my ($patterns,@paths)=@_;my$matcher=build_gitignore_matcher($patterns);my@matched;for my$path (@paths){push@matched,$path if$matcher->($path)}return@matched}sub build_gitignore_matcher {my ($patterns)=@_;$patterns=[$patterns]unless ref$patterns eq 'ARRAY';$patterns=[grep {!/^#/}@$patterns ];for my$pattern (@$patterns){$pattern =~ s{(?!\\)\s+$}{};$pattern =~ s{^\\#}{#}}$patterns=[grep {length $_}@$patterns ];my$build_pattern=sub {my ($pattern)=@_;$pattern=quotemeta$pattern;$pattern =~ s{\\\*\\\*\\/}{.*}g;$pattern =~ s{\\\*\\\*}{.*}g;$pattern =~ s{\\\*}{[^/]*}g;$pattern =~ s{\\\?}{[^/]}g;$pattern =~ s{^\\\/}{^};$pattern =~ s{\\\[(.*?)\\\]}{
249 '[' . do { my $c = $1; $c =~ s{^\\!}{} ? '^' : '' }
250 . do { my $c = $1; $c =~ s/\\\-/\-/; $c }
251 . ']'
252 }eg;$pattern .= '$' unless$pattern =~ m{\/$};return$pattern};my@patterns_re;for my$pattern (@$patterns){if ($pattern =~ m/^!/){my$re=$build_pattern->(substr$pattern,1);push@patterns_re,{re=>$re,negative=>1 }}else {$pattern =~ s{^\\!}{!};push@patterns_re,{re=>$build_pattern->($pattern)}}}my@negatives=grep {/^!/}@$patterns;return sub {my$path=shift;my$match=0;for my$pattern (@patterns_re){my$re=$pattern->{re};next if$match &&!$pattern->{negative};if ($pattern->{negative}){if ($path =~ m/$re/){$match=0}}else {$match=!!($path =~ m/$re/);if ($match &&!@negatives){return$match}}}return$match}}1;
253 TEXT_GITIGNORE
254
255 $fatpacked{"Text/Table.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE';
256 package Text::Table;use strict;use warnings;use 5.008;use List::Util qw(sum max);use Text::Aligner qw(align);our$VERSION='1.133';use overload (bool=>sub {return 1},'""'=>'stringify',);sub _is_sep {my$datum=shift;return (defined($datum)and ((ref($datum)eq 'SCALAR')or (ref($datum)eq 'HASH' and $datum->{is_sep})))}sub _get_sep_title_body {my$sep=shift;return +(ref($sep)eq 'HASH')? @{$sep}{qw(title body)}: split(/\n/,${$sep},-1)}sub _parse_sep {my$sep=shift;if (!defined($sep)){$sep=''}my ($title,$body)=_get_sep_title_body($sep);if (!defined($body)){$body=$title}($title,$body)=align('left',$title,$body);return {is_sep=>1,title=>$title,body=>$body,}}sub _default_if_empty {my ($ref,$default)=@_;if (!(defined($$ref)&& length($$ref))){$$ref=$default}return}sub _is_align {my$align=shift;return$align =~ /\A(?:left|center|right)/}sub _parse_spec {my$spec=shift;if (!defined($spec)){$spec=''}my$alispec=qr/^ *(?:left|center|right|num|point|auto)/;my ($title,$align,$align_title,$align_title_lines,$sample);if (ref ($spec)eq 'HASH'){($title,$align,$align_title,$align_title_lines,$sample)=@{$spec}{qw(title align align_title align_title_lines sample)}}else {my$alispec=qr/&(.*)/;if ($spec =~ $alispec){($title,$align,$sample)=($spec =~ /(.*)^$alispec\n?(.*)/sm)}else {$title=$spec}for my$s ($title,$sample){if (defined($s)){chomp($s)}}}for my$x ($title,$sample){if (!defined($x)){$x=[]}elsif (ref($x)ne 'ARRAY'){$x=[split /\n/,$x,-1]}}_default_if_empty(\$align,'auto');unless (ref$align eq 'Regexp' or $align =~ /^(?:left|center|right|num\(?|point\(?|auto)/){_warn("Invalid align specification: '$align', using 'auto'");$align='auto'}_default_if_empty(\$align_title,'left');if (!_is_align($align_title)){_warn("Invalid align_title specification: " ."'$align_title', using 'left'",);$align_title='left'}_default_if_empty(\$align_title_lines,$align_title);if (!_is_align($align_title_lines)){_warn("Invalid align_title_lines specification: " ."'$align_title_lines', using 'left'",);$align_title_lines='left'}return {title=>$title,align=>$align,align_title=>$align_title,align_title_lines=>$align_title_lines,sample=>$sample,}}sub new {my$tb=bless {},shift;return$tb->_entitle([@_ ])}sub _blank {my$self=shift;if (@_){$self->{blank}=shift}return$self->{blank}}sub _cols {my$self=shift;if (@_){$self->{cols}=shift}return$self->{cols}}sub _forms {my$self=shift;if (@_){$self->{forms}=shift}return$self->{forms}}sub _lines {my$self=shift;if (@_){$self->{lines}=shift}return$self->{lines}}sub _spec {my$self=shift;if (@_){$self->{spec}=shift}return$self->{spec}}sub _titles {my$self=shift;if (@_){$self->{titles}=shift}return$self->{titles}}sub _entitle {my ($tb,$sep_list)=@_;my (@seps,@spec);my$sep;for my$sep_item (@{$sep_list}){if (_is_sep ($sep_item)){$sep=_parse_sep($sep_item)}else {push@seps,$sep;push@spec,_parse_spec($sep_item);undef$sep}}push@seps,$sep;my$title_form=_compile_field_format('title',\@seps);my$body_form=_compile_field_format('body',\@seps);my@titles=map {[@{$_->{title}}]}@spec;my$title_height=max(0,map {scalar(@$_)}@titles);for my$title (@titles){push @{$title},('')x ($title_height - @{$title})}for my$t_idx (0 .. $#titles){align($spec[$t_idx]->{align_title_lines},@{$titles[$t_idx]})}$tb->_spec(\@spec);$tb->_cols([map [],1 .. @spec]);$tb->_forms([$title_form,$body_form]);$tb->_titles(\@titles);$tb->_clear_cache;return$tb}sub _compile_format {my$seps=shift;for my$idx (0 .. $#$seps){if (!defined($seps->[$idx])){$seps->[$idx]=($idx==0 or $idx==$#$seps)? '' : q{ }}else {$seps->[$idx]=~ s/%/%%/g}}return join '%s',@$seps}sub _compile_field_format {my ($field,$seps)=@_;return _compile_format([map {defined($_)? $_->{$field}: undef}@$seps])}sub _recover_separators {my$format=shift;my@seps=split /(?<!%)%s/,$format,-1;for my$s (@seps){$s =~ s/%%/%/g}return \@seps}sub select {my$tb=shift;my@args=map$tb->_select_group($_),@_;my@sel=map$tb->_check_index($_),grep!_is_sep($_),@args;for my$arg (@args){if (!_is_sep($arg)){$arg=$tb->_spec->[$arg]}}my$sub=ref($tb)->new(@args);@{$sub->{cols}}=map {[@$_ ]}@{$tb->_cols}[@sel];$sub}sub _select_group {my ($tb,$group)=@_;return$group unless ref$group eq 'ARRAY';GROUP_LOOP: for my$g (@$group){if (_is_sep($g)){next GROUP_LOOP}$tb->_check_index($g);if (grep {$_}@{$tb->_cols->[$g]}){return @$group}return}return}sub _check_index {my$tb=shift;my ($i)=@_;my$n=$tb->n_cols;my$ok=eval {use warnings FATAL=>'numeric';-$n <= $i and $i < $n};_warn("Invalid column index '$_'")if $@ or not $ok;shift}sub _clear_cache {my ($tb)=@_;$tb->_blank(undef());$tb->_lines(undef());return}sub add {my$tb=shift;if (!$tb->n_cols){$tb->_entitle([('')x @_])}for my$row (_transpose([map {[defined()? split(/\n/): '' ]}@_ ])){$tb->_add(@$row)}$tb->_clear_cache;return$tb}sub _add {my$tb=shift;for my$col (@{$tb->_cols}){push @{$col},shift(@_)}$tb->_clear_cache;return$tb}sub load {my$tb=shift;for my$row (@_){if (!defined($row)){$row=''}$tb->add((ref($row)eq 'ARRAY')? (@$row): (split ' ',$row))}$tb}sub clear {my$tb=shift;for my$col (@{$tb->_cols}){$col=[]}$tb->_clear_cache;return$tb}sub n_cols {scalar @{$_[0]->{spec}}}sub title_height {$_[0]->n_cols and scalar @{$_[0]->_titles->[0]}}sub body_height {my ($tb)=@_;return ($tb->n_cols && scalar @{$tb->_cols->[0]})}sub table_height {my$tb=shift;return$tb->title_height + $tb->body_height}BEGIN {*height=\&table_height}sub width {my ($tb)=@_;return$tb->height && (length(($tb->table(0))[0])- 1)}sub _normalize_col_index {my ($tb,$col_index)=@_;$col_index ||= 0;if ($col_index < 0){$col_index += $tb->n_cols}if ($col_index < 0){$col_index=0}elsif ($col_index > $tb->n_cols){$col_index=$tb->n_cols}return$col_index}sub colrange {my ($tb,$proto_col_index)=@_;my$col_index=$tb->_normalize_col_index($proto_col_index);return (0,0)unless$tb->width;my@widths=map {length}@{$tb->_blank},'';@widths=@widths[0 .. $col_index];my$width=pop@widths;my$pos=sum(@widths)|| 0;my$seps_aref=_recover_separators($tb->_forms->[0]);my$sep_sum=0;for my$sep (@$seps_aref[0 .. $col_index]){$sep_sum += length($sep)}return ($pos+$sep_sum,$width)}sub table {my$tb=shift;return$tb->_table_portion($tb->height,0,@_)}sub title {my$tb=shift;return$tb->_table_portion($tb->title_height,0,@_)}sub body {my$tb=shift;return$tb->_table_portion($tb->body_height,$tb->title_height,@_)}sub stringify {my ($tb)=@_;return (scalar ($tb->table()))}sub _table_portion_as_aref {my$tb=shift;my$total=shift;my$offset=shift;my ($from,$n)=(0,$total);if (@_){$from=shift;$n=@_ ? shift : 1}($from,$n)=_limit_range($total,$from,$n);my$limit=$tb->title_height;$from += $offset;return [map$tb->_assemble_line($_ >= $limit,$tb->_table_line($_),0),$from .. $from + $n - 1 ]}sub _table_portion {my$tb=shift;my$lines_aref=$tb->_table_portion_as_aref(@_);return (wantarray ? @$lines_aref : join('',@$lines_aref))}sub _limit_range {my ($total,$from,$n)=@_;$from ||= 0;$from += $total if$from < 0;$n=$total unless defined$n;return (0,0)if$from + $n < 0 or $from >= $total;$from=0 if$from < 0;$n=$total - $from if$n > $total - $from;return($from,$n)}sub _table_line {my ($tb,$idx)=@_;if (!$tb->_lines){$tb->_lines([$tb->_build_table_lines ])}return$tb->_lines->[$idx]}sub _build_table_lines {my$tb=shift;my@cols=map {[map {defined($_)? $_ : ''}@$_ ]}@{$tb->_cols()};for my$col (@cols){push @$col,''}for my$col_idx (0 .. $#cols){push @{$cols[$col_idx]},@{$tb->_spec->[$col_idx]->{sample}}}for my$col_idx (0 .. $#cols){align($tb->_spec->[$col_idx]->{align},@{$cols[$col_idx]})}for my$col (@cols){splice(@{$col},1 + $tb->body_height)}for my$col_idx (0 .. $#cols){unshift @{$cols[$col_idx]},@{$tb->_titles->[$col_idx]}}for my$col_idx (0 .. $#cols){align($tb->_spec->[$col_idx]->{align_title},@{$cols[$col_idx]})}my@blank;for my$col (@cols){push@blank,pop(@$col)}$tb->_blank(\@blank);return _transpose_n($tb->height,\@cols)}sub _transpose_n {my ($n,$cols)=@_;return map {[map {shift @$_}@$cols]}1 .. $n}sub _transpose {my ($cols)=@_;my$m=max (map {scalar(@$_)}@$cols,[]);return _transpose_n($m,$cols)}sub _assemble_line {my ($tb,$in_body,$line_aref,$replace_spaces)=@_;my$format=$tb->_forms->[!!$in_body];if ($replace_spaces){$format =~ s/\s/=/g}return sprintf($format,@$line_aref)."\n"}sub _text_rule {my ($tb,$rule,$char,$alt)=@_;if (defined$alt){$rule =~ s/(.)/$1 eq ' ' ? $char : $alt/ge}else {$rule =~ s/ /$char/g if$char ne ' '}return$rule}sub _rule {my$tb=shift;return + (!$tb->width)? '' : $tb->_positive_width_rule(@_)}sub _positive_width_rule {my ($tb,$in_body,$char,$alt)=@_;my$rule=$tb->_assemble_line($in_body,$tb->_blank,((ref($char)eq "CODE")? 1 : 0),);return$tb->_render_rule($rule,$char,$alt)}sub _render_rule {my ($tb,$rule,$char,$alt)=@_;if (ref($char)eq "CODE"){return$tb->_render_rule_with_callbacks($rule,$char,$alt)}else {_default_if_empty(\$char,' ');return$tb->_text_rule($rule,$char,$alt)}}sub _get_fixed_len_string {my ($s,$len)=@_;$s=substr($s,0,$len);$s .= ' ' x ($len - length($s));return$s}sub _render_rule_with_callbacks {my ($tb,$rule,$char,$alt)=@_;my%callbacks=('char'=>{cb=>$char,idx=>0,},'alt'=>{cb=>$alt,idx=>0,},);my$calc_substitution=sub {my$s=shift;my$len=length($s);my$which=(($s =~ /\A /)? 'char' : 'alt');my$rec=$callbacks{$which};return _get_fixed_len_string(scalar ($rec->{cb}->($rec->{idx}++,$len)),$len,)};$rule =~ s/((.)\2*)/$calc_substitution->($1)/ge;return$rule}sub rule {my$tb=shift;return$tb->_rule(0,@_)}sub body_rule {my$tb=shift;return$tb->_rule(1,@_)}use Carp;{my ($warn,$fatal)=(0,0);sub warnings {my (undef,$toggle)=@_;$toggle ||= 'on';if ($toggle eq 'off'){($warn,$fatal)=(0,0)}elsif ($toggle eq 'fatal'){($warn,$fatal)=(1,1)}else {($warn,$fatal)=(1,0)}return$fatal ? 'fatal' : $warn ? 'on' : 'off'}sub _warn {my$msg=shift;return unless$warn;if ($fatal){croak($msg)}carp($msg);return}}
257 TEXT_TABLE
258
259 $fatpacked{"Text/Table/Any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE_ANY';
260 package Text::Table::Any;our$DATE='2019-02-17';our$VERSION='0.095';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)}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;
261 TEXT_TABLE_ANY
262
263 $fatpacked{"Text/Table/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE_TINY';
264 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;
265 TEXT_TABLE_TINY
266
267 $fatpacked{"YAML.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML';
268 package YAML;our$VERSION='1.29';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,);$LoadBlessed=1;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;
269 YAML
270
271 $fatpacked{"YAML/Any.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_ANY';
272 use strict;use warnings;package YAML::Any;our$VERSION='1.29';use Exporter ();@YAML::Any::ISA='Exporter';@YAML::Any::EXPORT=qw(Dump Load);@YAML::Any::EXPORT_OK=qw(DumpFile LoadFile);my@dump_options=qw(UseCode DumpCode SpecVersion Indent UseHeader UseVersion SortKeys AnchorPrefix UseBlock UseFold CompressSeries InlineSeries UseAliases Purity Stringify);my@load_options=qw(UseCode LoadCode Preserve);my@implementations=qw(YAML::XS YAML::Syck YAML::Old YAML YAML::Tiny);sub import {__PACKAGE__->implementation;goto&Exporter::import}sub Dump {no strict 'refs';no warnings 'once';my$implementation=__PACKAGE__->implementation;for my$option (@dump_options){my$var="$implementation\::$option";my$value=$$var;local $$var;$$var=defined$value ? $value : ${"YAML::$option"}}return &{"$implementation\::Dump"}(@_)}sub DumpFile {no strict 'refs';no warnings 'once';my$implementation=__PACKAGE__->implementation;for my$option (@dump_options){my$var="$implementation\::$option";my$value=$$var;local $$var;$$var=defined$value ? $value : ${"YAML::$option"}}return &{"$implementation\::DumpFile"}(@_)}sub Load {no strict 'refs';no warnings 'once';my$implementation=__PACKAGE__->implementation;for my$option (@load_options){my$var="$implementation\::$option";my$value=$$var;local $$var;$$var=defined$value ? $value : ${"YAML::$option"}}return &{"$implementation\::Load"}(@_)}sub LoadFile {no strict 'refs';no warnings 'once';my$implementation=__PACKAGE__->implementation;for my$option (@load_options){my$var="$implementation\::$option";my$value=$$var;local $$var;$$var=defined$value ? $value : ${"YAML::$option"}}return &{"$implementation\::LoadFile"}(@_)}sub order {return@YAML::Any::_TEST_ORDER if@YAML::Any::_TEST_ORDER;return@implementations}sub implementation {my@order=__PACKAGE__->order;for my$module (@order){my$path=$module;$path =~ s/::/\//g;$path .= '.pm';return$module if exists$INC{$path};eval "require $module; 1" and return$module}croak("YAML::Any couldn't find any of these YAML implementations: @order")}sub croak {require Carp;Carp::croak(@_)}1;
273 YAML_ANY
274
275 $fatpacked{"YAML/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_DUMPER';
276 package YAML::Dumper;use YAML::Mo;extends 'YAML::Dumper::Base';use YAML::Dumper::Base;use YAML::Node;use YAML::Types;use Scalar::Util qw();use B ();use Carp ();use constant KEY=>3;use constant BLESSED=>4;use constant FROMARRAY=>5;use constant VALUE=>"\x07YAML\x07VALUE\x07";my$ESCAPE_CHAR='[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';my$LIT_CHAR='|';sub dump {my$self=shift;$self->stream('');$self->document(0);for my$document (@_){$self->{document}++;$self->transferred({});$self->id_refcnt({});$self->id_anchor({});$self->anchor(1);$self->level(0);$self->offset->[0]=0 - $self->indent_width;$self->_prewalk($document);$self->_emit_header($document);$self->_emit_node($document)}return$self->stream}sub _emit_header {my$self=shift;my ($node)=@_;if (not $self->use_header and $self->document==1){$self->die('YAML_DUMP_ERR_NO_HEADER')unless ref($node)=~ /^(HASH|ARRAY)$/;$self->die('YAML_DUMP_ERR_NO_HEADER')if ref($node)eq 'HASH' and keys(%$node)==0;$self->die('YAML_DUMP_ERR_NO_HEADER')if ref($node)eq 'ARRAY' and @$node==0;$self->headless(1);return}$self->{stream}.= '---';if ($self->use_version){}}sub _prewalk {my$self=shift;my$stringify=$self->stringify;my ($class,$type,$node_id)=$self->node_info(\$_[0],$stringify);if ($type eq 'GLOB'){$self->transferred->{$node_id}=YAML::Type::glob->yaml_dump($_[0]);$self->_prewalk($self->transferred->{$node_id});return}if (ref($_[0])eq 'Regexp'){return}if (not ref $_[0]){$self->{id_refcnt}{$node_id}++ if$self->purity;return}my$value=$_[0];($class,$type,$node_id)=$self->node_info($value,$stringify);return if (ref($value)and not $type);if ($self->transferred->{$node_id}){(undef,undef,$node_id)=(ref$self->transferred->{$node_id})? $self->node_info($self->transferred->{$node_id},$stringify): $self->node_info(\ $self->transferred->{$node_id},$stringify);$self->{id_refcnt}{$node_id}++;return}if ($type eq 'CODE'){$self->transferred->{$node_id}='placeholder';YAML::Type::code->yaml_dump($self->dump_code,$_[0],$self->transferred->{$node_id});($class,$type,$node_id)=$self->node_info(\ $self->transferred->{$node_id},$stringify);$self->{id_refcnt}{$node_id}++;return}if (defined$class){if ($value->can('yaml_dump')){$value=$value->yaml_dump}elsif ($type eq 'SCALAR'){$self->transferred->{$node_id}='placeholder';YAML::Type::blessed->yaml_dump ($_[0],$self->transferred->{$node_id});($class,$type,$node_id)=$self->node_info(\ $self->transferred->{$node_id},$stringify);$self->{id_refcnt}{$node_id}++;return}else {$value=YAML::Type::blessed->yaml_dump($value)}$self->transferred->{$node_id}=$value;(undef,$type,$node_id)=$self->node_info($value,$stringify)}require YAML;if (defined YAML->global_object()->{blessed_map}{$node_id}){$value=YAML->global_object()->{blessed_map}{$node_id};$self->transferred->{$node_id}=$value;($class,$type,$node_id)=$self->node_info($value,$stringify);$self->_prewalk($value);return}if ($type eq 'REF' or $type eq 'SCALAR'){$value=YAML::Type::ref->yaml_dump($value);$self->transferred->{$node_id}=$value;(undef,$type,$node_id)=$self->node_info($value,$stringify)}elsif ($type eq 'GLOB'){my$ref_ynode=$self->transferred->{$node_id}=YAML::Type::ref->yaml_dump($value);my$glob_ynode=$ref_ynode->{&VALUE}=YAML::Type::glob->yaml_dump($$value);(undef,undef,$node_id)=$self->node_info($glob_ynode,$stringify);$self->transferred->{$node_id}=$glob_ynode;$self->_prewalk($glob_ynode);return}return if ++($self->{id_refcnt}{$node_id})> 1;if ($type eq 'HASH'){$self->_prewalk($value->{$_})for keys %{$value};return}elsif ($type eq 'ARRAY'){$self->_prewalk($_)for @{$value};return}$self->warn(<<"...");return}sub _emit_node {my$self=shift;my ($type,$node_id);my$ref=ref($_[0]);if ($ref){if ($ref eq 'Regexp'){$self->_emit(' !!perl/regexp');$self->_emit_str("$_[0]");return}(undef,$type,$node_id)=$self->node_info($_[0],$self->stringify)}else {$type=$ref || 'SCALAR';(undef,undef,$node_id)=$self->node_info(\$_[0],$self->stringify)}my ($ynode,$tag)=('')x 2;my ($value,$context)=(@_,0);if (defined$self->transferred->{$node_id}){$value=$self->transferred->{$node_id};$ynode=ynode($value);if (ref$value){$tag=defined$ynode ? $ynode->tag->short : '';(undef,$type,$node_id)=$self->node_info($value,$self->stringify)}else {$ynode=ynode($self->transferred->{$node_id});$tag=defined$ynode ? $ynode->tag->short : '';$type='SCALAR';(undef,undef,$node_id)=$self->node_info(\ $self->transferred->{$node_id},$self->stringify)}}elsif ($ynode=ynode($value)){$tag=$ynode->tag->short}if ($self->use_aliases){$self->{id_refcnt}{$node_id}||= 0;if ($self->{id_refcnt}{$node_id}> 1){if (defined$self->{id_anchor}{$node_id}){$self->{stream}.= ' *' .$self->{id_anchor}{$node_id}."\n";return}my$anchor=$self->anchor_prefix .$self->{anchor}++;$self->{stream}.= ' &' .$anchor;$self->{id_anchor}{$node_id}=$anchor}}return$self->_emit_str("$value")if ref($value)and not $type;return$self->_emit_scalar($value,$tag)if$type eq 'SCALAR' and $tag;return$self->_emit_str($value)if$type eq 'SCALAR';return$self->_emit_mapping($value,$tag,$node_id,$context)if$type eq 'HASH';return$self->_emit_sequence($value,$tag)if$type eq 'ARRAY';$self->warn('YAML_DUMP_WARN_BAD_NODE_TYPE',$type);return$self->_emit_str("$value")}sub _emit_mapping {my$self=shift;my ($value,$tag,$node_id,$context)=@_;$self->{stream}.= " !$tag" if$tag;my$empty_hash=not(eval {keys %$value});$self->warn('YAML_EMIT_WARN_KEYS',$@)if $@;return ($self->{stream}.= " {}\n")if$empty_hash;if ($context==FROMARRAY and $self->compress_series and not (defined$self->{id_anchor}{$node_id}or $tag or $empty_hash)){$self->{stream}.= ' ';$self->offset->[$self->level+1]=$self->offset->[$self->level]+ 2}else {$context=0;$self->{stream}.= "\n" unless$self->headless && not($self->headless(0));$self->offset->[$self->level+1]=$self->offset->[$self->level]+ $self->indent_width}$self->{level}++;my@keys;if ($self->sort_keys==1){if (ynode($value)){@keys=keys %$value}else {@keys=sort keys %$value}}elsif ($self->sort_keys==2){@keys=sort keys %$value}elsif (ref($self->sort_keys)eq 'ARRAY'){my$i=1;my%order=map {($_,$i++)}@{$self->sort_keys};@keys=sort {(defined$order{$a}and defined$order{$b})? ($order{$a}<=> $order{$b}): ($a cmp $b)}keys %$value}else {@keys=keys %$value}if (exists$value->{&VALUE}){for (my$i=0;$i < @keys;$i++){if ($keys[$i]eq &VALUE){splice(@keys,$i,1);push@keys,&VALUE;last}}}for my$key (@keys){$self->_emit_key($key,$context);$context=0;$self->{stream}.= ':';$self->_emit_node($value->{$key})}$self->{level}--}sub _emit_sequence {my$self=shift;my ($value,$tag)=@_;$self->{stream}.= " !$tag" if$tag;return ($self->{stream}.= " []\n")if @$value==0;$self->{stream}.= "\n" unless$self->headless && not($self->headless(0));if ($self->inline_series and @$value <= $self->inline_series and not (scalar grep {ref or /\n/}@$value)){$self->{stream}=~ s/\n\Z/ /;$self->{stream}.= '[';for (my$i=0;$i < @$value;$i++){$self->_emit_str($value->[$i],KEY);last if$i==$#{$value};$self->{stream}.= ', '}$self->{stream}.= "]\n";return}$self->offset->[$self->level + 1]=$self->offset->[$self->level]+ $self->indent_width;$self->{level}++;for my$val (@$value){$self->{stream}.= ' ' x $self->offset->[$self->level];$self->{stream}.= '-';$self->_emit_node($val,FROMARRAY)}$self->{level}--}sub _emit_key {my$self=shift;my ($value,$context)=@_;$self->{stream}.= ' ' x $self->offset->[$self->level]unless$context==FROMARRAY;$self->_emit_str($value,KEY)}sub _emit_scalar {my$self=shift;my ($value,$tag)=@_;$self->{stream}.= " !$tag";$self->_emit_str($value,BLESSED)}sub _emit {my$self=shift;$self->{stream}.= join '',@_}sub _emit_str {my$self=shift;my$type=$_[1]|| 0;$self->offset->[$self->level + 1]=$self->offset->[$self->level]+ $self->indent_width;$self->{level}++;my$sf=$type==KEY ? '' : ' ';my$sb=$type==KEY ? '? ' : ' ';my$ef=$type==KEY ? '' : "\n";my$eb="\n";while (1){$self->_emit($sf),$self->_emit_plain($_[0]),$self->_emit($ef),last if not defined $_[0];$self->_emit($sf,'=',$ef),last if $_[0]eq VALUE;$self->_emit($sf),$self->_emit_double($_[0]),$self->_emit($ef),last if $_[0]=~ /$ESCAPE_CHAR/;if ($_[0]=~ /\n/){$self->_emit($sb),$self->_emit_block($LIT_CHAR,$_[0]),$self->_emit($eb),last if$self->use_block;Carp::cluck "[YAML] \$UseFold is no longer supported" if$self->use_fold;$self->_emit($sf),$self->_emit_double($_[0]),$self->_emit($ef),last if length $_[0]<= 30;$self->_emit($sf),$self->_emit_double($_[0]),$self->_emit($ef),last if $_[0]!~ /\n\s*\S/;$self->_emit($sb),$self->_emit_block($LIT_CHAR,$_[0]),$self->_emit($eb),last}$self->_emit($sf),$self->_emit_number($_[0]),$self->_emit($ef),last if$self->is_literal_number($_[0]);$self->_emit($sf),$self->_emit_plain($_[0]),$self->_emit($ef),last if$self->is_valid_plain($_[0]);$self->_emit($sf),$self->_emit_double($_[0]),$self->_emit($ef),last if $_[0]=~ /'/;$self->_emit($sf),$self->_emit_single($_[0]),$self->_emit($ef);last}$self->{level}--;return}sub is_literal_number {my$self=shift;return B::svref_2object(\$_[0])->FLAGS & (B::SVp_IOK | B::SVp_NOK)&& 0 + $_[0]eq $_[0]}sub _emit_number {my$self=shift;return$self->_emit_plain($_[0])}sub is_valid_plain {my$self=shift;return 0 unless length $_[0];return 0 if$self->quote_numeric_strings and Scalar::Util::looks_like_number($_[0]);return 0 if $_[0]=~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;return 0 if $_[0]=~ /[\{\[\]\},]/;return 0 if $_[0]=~ /[:\-\?]\s/;return 0 if $_[0]=~ /\s#/;return 0 if $_[0]=~ /\:(\s|$)/;return 0 if $_[0]=~ /[\s\|\>]$/;return 0 if $_[0]eq '-';return 0 if $_[0]eq '=';return 1}sub _emit_block {my$self=shift;my ($indicator,$value)=@_;$self->{stream}.= $indicator;$value =~ /(\n*)\Z/;my$chomp=length $1 ? (length $1 > 1)? '+' : '' : '-';$value='~' if not defined$value;$self->{stream}.= $chomp;$self->{stream}.= $self->indent_width if$value =~ /^\s/;$self->{stream}.= $self->indent($value)}sub _emit_plain {my$self=shift;$self->{stream}.= defined $_[0]? $_[0]: '~'}sub _emit_double {my$self=shift;(my$escaped=$self->escape($_[0]))=~ s/"/\\"/g;$self->{stream}.= qq{"$escaped"}}sub _emit_single {my$self=shift;my$item=shift;$item =~ s{'}{''}g;$self->{stream}.= "'$item'"}sub indent {my$self=shift;my ($text)=@_;return$text unless length$text;$text =~ s/\n\Z//;my$indent=' ' x $self->offset->[$self->level];$text =~ s/^/$indent/gm;$text="\n$text";return$text}my@escapes=qw(\0 \x01 \x02 \x03 \x04 \x05 \x06 \a \x08 \t \n \v \f \r \x0e \x0f \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17 \x18 \x19 \x1a \e \x1c \x1d \x1e \x1f);sub escape {my$self=shift;my ($text)=@_;$text =~ s/\\/\\\\/g;$text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge;return$text}1;
277 YAML::Dumper can't handle dumping this type of data.
278 Please report this to the author.
279
280 id: $node_id
281 type: $type
282 class: $class
283 value: $value
284
285 ...
286 YAML_DUMPER
287
288 $fatpacked{"YAML/Dumper/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_DUMPER_BASE';
289 package YAML::Dumper::Base;use YAML::Mo;use YAML::Node;has spec_version=>default=>sub {'1.0'};has indent_width=>default=>sub {2};has use_header=>default=>sub {1};has use_version=>default=>sub {0};has sort_keys=>default=>sub {1};has anchor_prefix=>default=>sub {''};has dump_code=>default=>sub {0};has use_block=>default=>sub {0};has use_fold=>default=>sub {0};has compress_series=>default=>sub {1};has inline_series=>default=>sub {0};has use_aliases=>default=>sub {1};has purity=>default=>sub {0};has stringify=>default=>sub {0};has quote_numeric_strings=>default=>sub {0};has stream=>default=>sub {''};has document=>default=>sub {0};has transferred=>default=>sub {{}};has id_refcnt=>default=>sub {{}};has id_anchor=>default=>sub {{}};has anchor=>default=>sub {1};has level=>default=>sub {0};has offset=>default=>sub {[]};has headless=>default=>sub {0};has blessed_map=>default=>sub {{}};sub set_global_options {my$self=shift;$self->spec_version($YAML::SpecVersion)if defined$YAML::SpecVersion;$self->indent_width($YAML::Indent)if defined$YAML::Indent;$self->use_header($YAML::UseHeader)if defined$YAML::UseHeader;$self->use_version($YAML::UseVersion)if defined$YAML::UseVersion;$self->sort_keys($YAML::SortKeys)if defined$YAML::SortKeys;$self->anchor_prefix($YAML::AnchorPrefix)if defined$YAML::AnchorPrefix;$self->dump_code($YAML::DumpCode || $YAML::UseCode)if defined$YAML::DumpCode or defined$YAML::UseCode;$self->use_block($YAML::UseBlock)if defined$YAML::UseBlock;$self->use_fold($YAML::UseFold)if defined$YAML::UseFold;$self->compress_series($YAML::CompressSeries)if defined$YAML::CompressSeries;$self->inline_series($YAML::InlineSeries)if defined$YAML::InlineSeries;$self->use_aliases($YAML::UseAliases)if defined$YAML::UseAliases;$self->purity($YAML::Purity)if defined$YAML::Purity;$self->stringify($YAML::Stringify)if defined$YAML::Stringify;$self->quote_numeric_strings($YAML::QuoteNumericStrings)if defined$YAML::QuoteNumericStrings}sub dump {my$self=shift;$self->die('dump() not implemented in this class.')}sub blessed {my$self=shift;my ($ref)=@_;$ref=\$_[0]unless ref$ref;my (undef,undef,$node_id)=YAML::Mo::Object->node_info($ref);$self->{blessed_map}->{$node_id}}sub bless {my$self=shift;my ($ref,$blessing)=@_;my$ynode;$ref=\$_[0]unless ref$ref;my (undef,undef,$node_id)=YAML::Mo::Object->node_info($ref);if (not defined$blessing){$ynode=YAML::Node->new($ref)}elsif (ref$blessing){$self->die()unless ynode($blessing);$ynode=$blessing}else {no strict 'refs';my$transfer=$blessing ."::yaml_dump";$self->die()unless defined &{$transfer};$ynode=&{$transfer}($ref);$self->die()unless ynode($ynode)}$self->{blessed_map}->{$node_id}=$ynode;my$object=ynode($ynode)or $self->die();return$object}1;
290 YAML_DUMPER_BASE
291
292 $fatpacked{"YAML/Error.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_ERROR';
293 package YAML::Error;use YAML::Mo;has 'code';has 'type'=>default=>sub {'Error'};has 'line';has 'document';has 'arguments'=>default=>sub {[]};my ($error_messages,%line_adjust);sub format_message {my$self=shift;my$output='YAML ' .$self->type .': ';my$code=$self->code;if ($error_messages->{$code}){$code=sprintf($error_messages->{$code},@{$self->arguments})}$output .= $code ."\n";$output .= ' Code: ' .$self->code ."\n" if defined$self->code;$output .= ' Line: ' .$self->line ."\n" if defined$self->line;$output .= ' Document: ' .$self->document ."\n" if defined$self->document;return$output}sub error_messages {$error_messages}%$error_messages=map {s/^\s+//;s/\\n/\n/;$_}split "\n",<<'...';%line_adjust=map {($_,1)}qw(YAML_PARSE_ERR_BAD_MAJOR_VERSION YAML_PARSE_WARN_BAD_MINOR_VERSION YAML_PARSE_ERR_TEXT_AFTER_INDICATOR YAML_PARSE_ERR_NO_ANCHOR YAML_PARSE_ERR_MANY_EXPLICIT YAML_PARSE_ERR_MANY_IMPLICIT YAML_PARSE_ERR_MANY_ANCHOR YAML_PARSE_ERR_ANCHOR_ALIAS YAML_PARSE_ERR_BAD_ALIAS YAML_PARSE_ERR_MANY_ALIAS YAML_LOAD_ERR_NO_CONVERT YAML_LOAD_ERR_NO_DEFAULT_VALUE YAML_LOAD_ERR_NON_EMPTY_STRING YAML_LOAD_ERR_BAD_MAP_TO_SEQ YAML_LOAD_ERR_BAD_STR_TO_INT YAML_LOAD_ERR_BAD_STR_TO_DATE YAML_LOAD_ERR_BAD_STR_TO_TIME YAML_LOAD_WARN_DUPLICATE_KEY YAML_PARSE_ERR_INLINE_MAP YAML_PARSE_ERR_INLINE_SEQUENCE YAML_PARSE_ERR_BAD_DOUBLE YAML_PARSE_ERR_BAD_SINGLE YAML_PARSE_ERR_BAD_INLINE_IMPLICIT YAML_PARSE_ERR_BAD_IMPLICIT YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP YAML_LOAD_WARN_BAD_REGEXP_ELEM YAML_LOAD_WARN_REGEXP_CREATE YAML_LOAD_WARN_GLOB_NAME YAML_LOAD_WARN_PARSE_CODE YAML_LOAD_WARN_CODE_DEPARSE YAML_LOAD_WARN_BAD_GLOB_ELEM YAML_PARSE_ERR_ZERO_INDENT);package YAML::Warning;our@ISA='YAML::Error';1;
294 YAML_PARSE_ERR_BAD_CHARS
295 Invalid characters in stream. This parser only supports printable ASCII
296 YAML_PARSE_ERR_BAD_MAJOR_VERSION
297 Can't parse a %s document with a 1.0 parser
298 YAML_PARSE_WARN_BAD_MINOR_VERSION
299 Parsing a %s document with a 1.0 parser
300 YAML_PARSE_WARN_MULTIPLE_DIRECTIVES
301 '%s directive used more than once'
302 YAML_PARSE_ERR_TEXT_AFTER_INDICATOR
303 No text allowed after indicator
304 YAML_PARSE_ERR_NO_ANCHOR
305 No anchor for alias '*%s'
306 YAML_PARSE_ERR_NO_SEPARATOR
307 Expected separator '---'
308 YAML_PARSE_ERR_SINGLE_LINE
309 Couldn't parse single line value
310 YAML_PARSE_ERR_BAD_ANCHOR
311 Invalid anchor
312 YAML_DUMP_ERR_INVALID_INDENT
313 Invalid Indent width specified: '%s'
314 YAML_LOAD_USAGE
315 usage: YAML::Load($yaml_stream_scalar)
316 YAML_PARSE_ERR_BAD_NODE
317 Can't parse node
318 YAML_PARSE_ERR_BAD_EXPLICIT
319 Unsupported explicit transfer: '%s'
320 YAML_DUMP_USAGE_DUMPCODE
321 Invalid value for DumpCode: '%s'
322 YAML_LOAD_ERR_FILE_INPUT
323 Couldn't open %s for input:\n%s
324 YAML_DUMP_ERR_FILE_CONCATENATE
325 Can't concatenate to YAML file %s
326 YAML_DUMP_ERR_FILE_OUTPUT
327 Couldn't open %s for output:\n%s
328 YAML_DUMP_ERR_FILE_OUTPUT_CLOSE
329 Error closing %s:\n%s
330 YAML_DUMP_ERR_NO_HEADER
331 With UseHeader=0, the node must be a plain hash or array
332 YAML_DUMP_WARN_BAD_NODE_TYPE
333 Can't perform serialization for node type: '%s'
334 YAML_EMIT_WARN_KEYS
335 Encountered a problem with 'keys':\n%s
336 YAML_DUMP_WARN_DEPARSE_FAILED
337 Deparse failed for CODE reference
338 YAML_DUMP_WARN_CODE_DUMMY
339 Emitting dummy subroutine for CODE reference
340 YAML_PARSE_ERR_MANY_EXPLICIT
341 More than one explicit transfer
342 YAML_PARSE_ERR_MANY_IMPLICIT
343 More than one implicit request
344 YAML_PARSE_ERR_MANY_ANCHOR
345 More than one anchor
346 YAML_PARSE_ERR_ANCHOR_ALIAS
347 Can't define both an anchor and an alias
348 YAML_PARSE_ERR_BAD_ALIAS
349 Invalid alias
350 YAML_PARSE_ERR_MANY_ALIAS
351 More than one alias
352 YAML_LOAD_ERR_NO_CONVERT
353 Can't convert implicit '%s' node to explicit '%s' node
354 YAML_LOAD_ERR_NO_DEFAULT_VALUE
355 No default value for '%s' explicit transfer
356 YAML_LOAD_ERR_NON_EMPTY_STRING
357 Only the empty string can be converted to a '%s'
358 YAML_LOAD_ERR_BAD_MAP_TO_SEQ
359 Can't transfer map as sequence. Non numeric key '%s' encountered.
360 YAML_DUMP_ERR_BAD_GLOB
361 '%s' is an invalid value for Perl glob
362 YAML_DUMP_ERR_BAD_REGEXP
363 '%s' is an invalid value for Perl Regexp
364 YAML_LOAD_ERR_BAD_MAP_ELEMENT
365 Invalid element in map
366 YAML_LOAD_WARN_DUPLICATE_KEY
367 Duplicate map key '%s' found. Ignoring.
368 YAML_LOAD_ERR_BAD_SEQ_ELEMENT
369 Invalid element in sequence
370 YAML_PARSE_ERR_INLINE_MAP
371 Can't parse inline map
372 YAML_PARSE_ERR_INLINE_SEQUENCE
373 Can't parse inline sequence
374 YAML_PARSE_ERR_BAD_DOUBLE
375 Can't parse double quoted string
376 YAML_PARSE_ERR_BAD_SINGLE
377 Can't parse single quoted string
378 YAML_PARSE_ERR_BAD_INLINE_IMPLICIT
379 Can't parse inline implicit value '%s'
380 YAML_PARSE_ERR_BAD_IMPLICIT
381 Unrecognized implicit value '%s'
382 YAML_PARSE_ERR_INDENTATION
383 Error. Invalid indentation level
384 YAML_PARSE_ERR_INCONSISTENT_INDENTATION
385 Inconsistent indentation level
386 YAML_LOAD_WARN_UNRESOLVED_ALIAS
387 Can't resolve alias *%s
388 YAML_LOAD_WARN_NO_REGEXP_IN_REGEXP
389 No 'REGEXP' element for Perl regexp
390 YAML_LOAD_WARN_BAD_REGEXP_ELEM
391 Unknown element '%s' in Perl regexp
392 YAML_LOAD_WARN_GLOB_NAME
393 No 'NAME' element for Perl glob
394 YAML_LOAD_WARN_PARSE_CODE
395 Couldn't parse Perl code scalar: %s
396 YAML_LOAD_WARN_CODE_DEPARSE
397 Won't parse Perl code unless $YAML::LoadCode is set
398 YAML_EMIT_ERR_BAD_LEVEL
399 Internal Error: Bad level detected
400 YAML_PARSE_WARN_AMBIGUOUS_TAB
401 Amibiguous tab converted to spaces
402 YAML_LOAD_WARN_BAD_GLOB_ELEM
403 Unknown element '%s' in Perl glob
404 YAML_PARSE_ERR_ZERO_INDENT
405 Can't use zero as an indentation width
406 YAML_LOAD_WARN_GLOB_IO
407 Can't load an IO filehandle. Yet!!!
408 ...
409 YAML_ERROR
410
411 $fatpacked{"YAML/Loader.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_LOADER';
412 package YAML::Loader;use YAML::Mo;extends 'YAML::Loader::Base';use YAML::Loader::Base;use YAML::Types;use YAML::Node;use constant LEAF=>1;use constant COLLECTION=>2;use constant VALUE=>"\x07YAML\x07VALUE\x07";use constant COMMENT=>"\x07YAML\x07COMMENT\x07";my$ESCAPE_CHAR='[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f]';my$FOLD_CHAR='>';my$LIT_CHAR='|';my$LIT_CHAR_RX="\\$LIT_CHAR";sub load {my$self=shift;$self->stream($_[0]|| '');return$self->_parse()}sub _parse {my$self=shift;my (%directives,$preface);$self->{stream}=~ s|\015\012|\012|g;$self->{stream}=~ s|\015|\012|g;$self->line(0);$self->die('YAML_PARSE_ERR_BAD_CHARS')if$self->stream =~ /$ESCAPE_CHAR/;$self->{stream}=~ s/(.)\n\Z/$1/s;$self->lines([split /\x0a/,$self->stream,-1]);$self->line(1);$self->_parse_throwaway_comments();$self->document(0);$self->documents([]);$self->zero_indent([]);if (not $self->eos){if ($self->lines->[0]!~ /^---(\s|$)/){unshift @{$self->lines},'---';$self->{line}--}}while (not $self->eos){$self->anchor2node({});$self->{document}++;$self->done(0);$self->level(0);$self->offset->[0]=-1;if ($self->lines->[0]=~ /^---\s*(.*)$/){my@words=split /\s/,$1;%directives=();while (@words){if ($words[0]=~ /^#(\w+):(\S.*)$/){my ($key,$value)=($1,$2);shift(@words);if (defined$directives{$key}){$self->warn('YAML_PARSE_WARN_MULTIPLE_DIRECTIVES',$key,$self->document);next}$directives{$key}=$value}elsif ($words[0]eq ''){shift@words}else {last}}$self->preface(join ' ',@words)}else {$self->die('YAML_PARSE_ERR_NO_SEPARATOR')}if (not $self->done){$self->_parse_next_line(COLLECTION)}if ($self->done){$self->{indent}=-1;$self->content('')}$directives{YAML}||= '1.0';$directives{TAB}||= 'NONE';($self->{major_version},$self->{minor_version})=split /\./,$directives{YAML},2;$self->die('YAML_PARSE_ERR_BAD_MAJOR_VERSION',$directives{YAML})if$self->major_version ne '1';$self->warn('YAML_PARSE_WARN_BAD_MINOR_VERSION',$directives{YAML})if$self->minor_version ne '0';$self->die('Unrecognized TAB policy')unless$directives{TAB}=~ /^(NONE|\d+)(:HARD)?$/;push @{$self->documents},$self->_parse_node()}return wantarray ? @{$self->documents}: $self->documents->[-1]}sub _parse_node {my$self=shift;my$preface=$self->preface;$self->preface('');my ($node,$type,$indicator,$chomp,$parsed_inline)=('')x 5;my ($anchor,$alias,$explicit,$implicit)=('')x 4;($anchor,$alias,$explicit,$implicit,$preface)=$self->_parse_qualifiers($preface);if ($anchor){$self->anchor2node->{$anchor}=CORE::bless [],'YAML-anchor2node'}$self->inline('');while (length$preface){if ($preface =~ s/^($FOLD_CHAR|$LIT_CHAR_RX)//){$indicator=$1;if ($preface =~ s/^([+-])[0-9]*//){$chomp=$1}elsif ($preface =~ s/^[0-9]+([+-]?)//){$chomp=$1}if ($preface =~ s/^(?:\s+#.*$|\s*)$//){}else {$self->die('YAML_PARSE_ERR_TEXT_AFTER_INDICATOR')}}else {$self->inline($preface);$preface=''}}if ($alias){$self->die('YAML_PARSE_ERR_NO_ANCHOR',$alias)unless defined$self->anchor2node->{$alias};if (ref($self->anchor2node->{$alias})ne 'YAML-anchor2node'){$node=$self->anchor2node->{$alias}}else {$node=do {my$sv="*$alias"};push @{$self->anchor2node->{$alias}},[\$node,$self->line]}}elsif (length$self->inline){$node=$self->_parse_inline(1,$implicit,$explicit);$parsed_inline=1;if (length$self->inline){$self->die('YAML_PARSE_ERR_SINGLE_LINE')}}elsif ($indicator eq $LIT_CHAR){$self->{level}++;$node=$self->_parse_block($chomp);$node=$self->_parse_implicit($node)if$implicit;$self->{level}--}elsif ($indicator eq $FOLD_CHAR){$self->{level}++;$node=$self->_parse_unfold($chomp);$node=$self->_parse_implicit($node)if$implicit;$self->{level}--}else {$self->{level}++;$self->offset->[$self->level]||= 0;if ($self->indent==$self->offset->[$self->level]){if ($self->content =~ /^-( |$)/){$node=$self->_parse_seq($anchor)}elsif ($self->content =~ /(^\?|\:( |$))/){$node=$self->_parse_mapping($anchor)}elsif ($preface =~ /^\s*$/){$node=$self->_parse_implicit('')}else {$self->die('YAML_PARSE_ERR_BAD_NODE')}}else {$node=undef}$self->{level}--}$#{$self->offset}=$self->level;if ($explicit){$node=$self->_parse_explicit($node,$explicit)if!$parsed_inline}if ($anchor){if (ref($self->anchor2node->{$anchor})eq 'YAML-anchor2node'){for my$ref (@{$self->anchor2node->{$anchor}}){${$ref->[0]}=$node;$self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',$anchor,$ref->[1])}}$self->anchor2node->{$anchor}=$node}return$node}sub _parse_qualifiers {my$self=shift;my ($preface)=@_;my ($anchor,$alias,$explicit,$implicit,$token)=('')x 5;$self->inline('');while ($preface =~ /^[&*!]/){if ($preface =~ s/^\!(\S+)\s*//){$self->die('YAML_PARSE_ERR_MANY_EXPLICIT')if$explicit;$explicit=$1}elsif ($preface =~ s/^\!\s*//){$self->die('YAML_PARSE_ERR_MANY_IMPLICIT')if$implicit;$implicit=1}elsif ($preface =~ s/^\&([^ ,:]*)\s*//){$token=$1;$self->die('YAML_PARSE_ERR_BAD_ANCHOR')unless$token =~ /^[a-zA-Z0-9_.\/-]+$/;$self->die('YAML_PARSE_ERR_MANY_ANCHOR')if$anchor;$self->die('YAML_PARSE_ERR_ANCHOR_ALIAS')if$alias;$anchor=$token}elsif ($preface =~ s/^\*([^ ,:]*)\s*//){$token=$1;$self->die('YAML_PARSE_ERR_BAD_ALIAS')unless$token =~ /^[a-zA-Z0-9_.\/-]+$/;$self->die('YAML_PARSE_ERR_MANY_ALIAS')if$alias;$self->die('YAML_PARSE_ERR_ANCHOR_ALIAS')if$anchor;$alias=$token}}return ($anchor,$alias,$explicit,$implicit,$preface)}sub _parse_explicit {my$self=shift;my ($node,$explicit)=@_;my ($type,$class);if ($explicit =~ /^\!?perl\/(hash|array|ref|scalar)(?:\:(\w(\w|\:\:)*)?)?$/){($type,$class)=(($1 || ''),($2 || ''));if ($type eq "ref"){$self->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE','XXX',$explicit)unless exists$node->{VALUE()}and scalar(keys %$node)==1;my$value=$node->{VALUE()};$node=\$value}if ($type eq "scalar" and length($class)and!ref($node)){my$value=$node;$node=\$value}if (length($class)and $YAML::LoadBlessed){CORE::bless($node,$class)}return$node}if ($explicit =~ m{^!?perl/(glob|regexp|code)(?:\:(\w(\w|\:\:)*)?)?$}){($type,$class)=(($1 || ''),($2 || ''));my$type_class="YAML::Type::$type";no strict 'refs';if ($type_class->can('yaml_load')){return$type_class->yaml_load($node,$class,$self)}else {$self->die('YAML_LOAD_ERR_NO_CONVERT','XXX',$explicit)}}elsif ($YAML::TagClass->{$explicit}|| $explicit =~ m{^perl/(\@|\$)?([a-zA-Z](\w|::)+)$}){$class=$YAML::TagClass->{$explicit}|| $2;if ($class->can('yaml_load')){require YAML::Node;return$class->yaml_load(YAML::Node->new($node,$explicit))}elsif ($YAML::LoadBlessed){if (ref$node){return CORE::bless$node,$class}else {return CORE::bless \$node,$class}}else {return$node}}elsif (ref$node){require YAML::Node;return YAML::Node->new($node,$explicit)}else {return$node}}sub _parse_mapping {my$self=shift;my ($anchor)=@_;my$mapping=$self->preserve ? YAML::Node->new({}): {};$self->anchor2node->{$anchor}=$mapping;my$key;while (not $self->done and $self->indent==$self->offset->[$self->level]){if ($self->{content}=~ s/^\?\s*//){$self->preface($self->content);$self->_parse_next_line(COLLECTION);$key=$self->_parse_node();$key="$key"}elsif ($self->{content}=~ s/^\=\s*(?=:)//){$key=VALUE}elsif ($self->{content}=~ s/^\=\s*(?=:)//){$key=COMMENT}else {$self->inline($self->content);$key=$self->_parse_inline();$key="$key";$self->content($self->inline);$self->inline('')}unless ($self->{content}=~ s/^:(?:\s+#.*$|\s*)//){$self->die('YAML_LOAD_ERR_BAD_MAP_ELEMENT')}$self->preface($self->content);my$level=$self->level;my$zero_indent=$self->zero_indent;$zero_indent->[$level ]=0;$self->_parse_next_line(COLLECTION);my$value=$self->_parse_node();$#$zero_indent=$level;if (exists$mapping->{$key}){$self->warn('YAML_LOAD_WARN_DUPLICATE_KEY',$key)}else {$mapping->{$key}=$value}}return$mapping}sub _parse_seq {my$self=shift;my ($anchor)=@_;my$seq=[];$self->anchor2node->{$anchor}=$seq;while (not $self->done and $self->indent==$self->offset->[$self->level]){if ($self->content =~ /^-(?: (.*))?$/){$self->preface(defined($1)? $1 : '')}else {if ($self->zero_indent->[$self->level ]){last}$self->die('YAML_LOAD_ERR_BAD_SEQ_ELEMENT')}my$preface=$self->preface;if ($preface =~ m/^ (\s*) ( - (?: \ .* | $ ) ) /x){$self->indent($self->offset->[$self->level]+ 2 + length($1));$self->content($2);$self->level($self->level + 1);$self->offset->[$self->level]=$self->indent;$self->preface('');push @$seq,$self->_parse_seq('');$self->{level}--;$#{$self->offset}=$self->level}elsif ($preface =~ /^ (\s*) ((') (?:''|[^'])*? ' \s* \: (?:\ |$).*) $/x or $preface =~ /^ (\s*) ((") (?:\\\\|[^"])*? " \s* \: (?:\ |$).*) $/x or $preface =~ /^ (\s*) (\?.*$)/x or $preface =~ /^ (\s*) ([^'"\s:#&!\[\]\{\},*|>].*\:(\ .*|$))/x){$self->indent($self->offset->[$self->level]+ 2 + length($1));$self->content($2);$self->level($self->level + 1);$self->offset->[$self->level]=$self->indent;$self->preface('');push @$seq,$self->_parse_mapping('');$self->{level}--;$#{$self->offset}=$self->level}else {$self->_parse_next_line(COLLECTION);push @$seq,$self->_parse_node()}}return$seq}sub _parse_inline {my$self=shift;my ($top,$top_implicit,$top_explicit)=(@_,'','','');$self->{inline}=~ s/^\s*(.*)\s*$/$1/;my ($node,$anchor,$alias,$explicit,$implicit)=('')x 5;($anchor,$alias,$explicit,$implicit,$self->{inline})=$self->_parse_qualifiers($self->inline);if ($anchor){$self->anchor2node->{$anchor}=CORE::bless [],'YAML-anchor2node'}$implicit ||= $top_implicit;$explicit ||= $top_explicit;($top_implicit,$top_explicit)=('','');if ($alias){$self->die('YAML_PARSE_ERR_NO_ANCHOR',$alias)unless defined$self->anchor2node->{$alias};if (ref($self->anchor2node->{$alias})ne 'YAML-anchor2node'){$node=$self->anchor2node->{$alias}}else {$node=do {my$sv="*$alias"};push @{$self->anchor2node->{$alias}},[\$node,$self->line]}}elsif ($self->inline =~ /^\{/){$node=$self->_parse_inline_mapping($anchor)}elsif ($self->inline =~ /^\[/){$node=$self->_parse_inline_seq($anchor)}elsif ($self->inline =~ /^"/){$node=$self->_parse_inline_double_quoted();$node=$self->_unescape($node);$node=$self->_parse_implicit($node)if$implicit}elsif ($self->inline =~ /^'/){$node=$self->_parse_inline_single_quoted();$node=$self->_parse_implicit($node)if$implicit}else {if ($top){$node=$self->inline;$self->inline('')}else {$node=$self->_parse_inline_simple()}$node=$self->_parse_implicit($node)unless$explicit;if ($self->numify and defined$node and not ref$node and length$node and $node =~ m/\A-?(?:0|[1-9][0-9]*)?(?:\.[0-9]*)?(?:[eE][+-]?[0-9]+)?\z/){$node += 0}}if ($explicit){$node=$self->_parse_explicit($node,$explicit)}if ($anchor){if (ref($self->anchor2node->{$anchor})eq 'YAML-anchor2node'){for my$ref (@{$self->anchor2node->{$anchor}}){${$ref->[0]}=$node;$self->warn('YAML_LOAD_WARN_UNRESOLVED_ALIAS',$anchor,$ref->[1])}}$self->anchor2node->{$anchor}=$node}return$node}sub _parse_inline_mapping {my$self=shift;my ($anchor)=@_;my$node={};$self->anchor2node->{$anchor}=$node;$self->die('YAML_PARSE_ERR_INLINE_MAP')unless$self->{inline}=~ s/^\{\s*//;while (not $self->{inline}=~ s/^\s*\}(\s+#.*$|\s*)//){my$key=$self->_parse_inline();$self->die('YAML_PARSE_ERR_INLINE_MAP')unless$self->{inline}=~ s/^\: \s*//;my$value=$self->_parse_inline();if (exists$node->{$key}){$self->warn('YAML_LOAD_WARN_DUPLICATE_KEY',$key)}else {$node->{$key}=$value}next if$self->inline =~ /^\s*\}/;$self->die('YAML_PARSE_ERR_INLINE_MAP')unless$self->{inline}=~ s/^\,\s*//}return$node}sub _parse_inline_seq {my$self=shift;my ($anchor)=@_;my$node=[];$self->anchor2node->{$anchor}=$node;$self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')unless$self->{inline}=~ s/^\[\s*//;while (not $self->{inline}=~ s/^\s*\](\s+#.*$|\s*)//){my$value=$self->_parse_inline();push @$node,$value;next if$self->inline =~ /^\s*\]/;$self->die('YAML_PARSE_ERR_INLINE_SEQUENCE')unless$self->{inline}=~ s/^\,\s*//}return$node}sub _parse_inline_double_quoted {my$self=shift;my$inline=$self->inline;if ($inline =~ s/^"//){my$node='';while ($inline =~ s/^(\\.|[^"\\]+)//){my$capture=$1;$capture =~ s/^\\"/"/;$node .= $capture;last unless length$inline}if ($inline =~ s/^"(?:\s+#.*|\s*)//){$self->inline($inline);return$node}}$self->die('YAML_PARSE_ERR_BAD_DOUBLE')}sub _parse_inline_single_quoted {my$self=shift;my$inline=$self->inline;if ($inline =~ s/^'//){my$node='';while ($inline =~ s/^(''|[^']+)//){my$capture=$1;$capture =~ s/^''/'/;$node .= $capture;last unless length$inline}if ($inline =~ s/^'(?:\s+#.*|\s*)//){$self->inline($inline);return$node}}$self->die('YAML_PARSE_ERR_BAD_SINGLE')}sub _parse_inline_simple {my$self=shift;my$value;if ($self->inline =~ /^(|[^!@#%^&*].*?)(?=[\[\]\{\},]|, |: |- |:\s*$|$)/){$value=$1;substr($self->{inline},0,length($1))=''}else {$self->die('YAML_PARSE_ERR_BAD_INLINE_IMPLICIT',$value)}return$value}sub _parse_implicit {my$self=shift;my ($value)=@_;$value =~ s/^#.*$//;$value =~ s/\s+#.*$//;$value =~ s/\s*$//;return$value if$value eq '';return undef if$value =~ /^~$/;return$value unless$value =~ /^[\@\`]/ or $value =~ /^[\-\?]\s/;$self->die('YAML_PARSE_ERR_BAD_IMPLICIT',$value)}sub _parse_unfold {my$self=shift;my ($chomp)=@_;my$node='';my$space=0;while (not $self->done and $self->indent==$self->offset->[$self->level]){$node .= $self->content."\n";$self->_parse_next_line(LEAF)}$node =~ s/^(\S.*)\n(?=\S)/$1 /gm;$node =~ s/^(\S.*)\n(\n+\S)/$1$2/gm;$node =~ s/\n*\Z// unless$chomp eq '+';$node .= "\n" unless$chomp;return$node}sub _parse_block {my$self=shift;my ($chomp)=@_;my$node='';while (not $self->done and $self->indent==$self->offset->[$self->level]){$node .= $self->content ."\n";$self->_parse_next_line(LEAF)}return$node if '+' eq $chomp;$node =~ s/\n*\Z/\n/;$node =~ s/\n\Z// if$chomp eq '-';return$node}sub _parse_throwaway_comments {my$self=shift;while (@{$self->lines}and $self->lines->[0]=~ m{^\s*(\#|$)}){shift @{$self->lines};$self->{line}++}$self->eos($self->{done}=not @{$self->lines})}sub _parse_next_line {my$self=shift;my ($type)=@_;my$level=$self->level;my$offset=$self->offset->[$level];$self->die('YAML_EMIT_ERR_BAD_LEVEL')unless defined$offset;shift @{$self->lines};$self->eos($self->{done}=not @{$self->lines});if ($self->eos){$self->offset->[$level + 1]=$offset + 1;return}$self->{line}++;if ($self->preface =~ qr/(?:^|\s)(?:$FOLD_CHAR|$LIT_CHAR_RX)(?:[+-]([0-9]*)|([0-9]*)[+-]?)(?:\s+#.*|\s*)$/){my$explicit_indent=defined $1 ? $1 : defined $2 ? $2 : '';$self->die('YAML_PARSE_ERR_ZERO_INDENT')if length($explicit_indent)and $explicit_indent==0;$type=LEAF;if (length($explicit_indent)){$self->offset->[$level + 1]=$offset + $explicit_indent}else {while (@{$self->lines}&& ($self->lines->[0]=~ /^\s*#/)){$self->lines->[0]=~ /^( *)/;last unless length($1)<= $offset;shift @{$self->lines};$self->{line}++}$self->eos($self->{done}=not @{$self->lines});return if$self->eos;if ($self->lines->[0]=~ /^( *)\S/ and length($1)> $offset){$self->offset->[$level+1]=length($1)}else {$self->offset->[$level+1]=$offset + 1}}$offset=$self->offset->[++$level]}elsif ($type==COLLECTION and $self->preface =~ /^(\s*(\!\S*|\&\S+))*\s*$/){$self->_parse_throwaway_comments();my$zero_indent=$self->zero_indent;if ($self->eos){$self->offset->[$level+1]=$offset + 1;return}elsif (defined$zero_indent->[$level ]and not $zero_indent->[$level ]and $self->lines->[0]=~ /^( {$offset,})-(?: |$)/){my$new_offset=length($1);$self->offset->[$level+1]=$new_offset;if ($new_offset==$offset){$zero_indent->[$level+1 ]=1}}else {$self->lines->[0]=~ /^( *)\S/ or $self->die('YAML_PARSE_ERR_NONSPACE_INDENTATION');if (length($1)> $offset){$self->offset->[$level+1]=length($1)}else {$self->offset->[$level+1]=$offset + 1}}$offset=$self->offset->[++$level]}if ($type==LEAF){if (@{$self->lines}and $self->lines->[0]=~ m{^( *)(\#)} and length($1)< $offset){if (length($1)< $offset){shift @{$self->lines};$self->{line}++;while (@{$self->lines}and $self->lines->[0]=~ m{^( *)(\#)}){shift @{$self->lines};$self->{line}++}}}$self->eos($self->{done}=not @{$self->lines})}else {$self->_parse_throwaway_comments()}return if$self->eos;if ($self->lines->[0]=~ /^---(\s|$)/){$self->done(1);return}if ($type==LEAF and $self->lines->[0]=~ /^ {$offset}(.*)$/){$self->indent($offset);$self->content($1)}elsif ($self->lines->[0]=~ /^\s*$/){$self->indent($offset);$self->content('')}else {$self->lines->[0]=~ /^( *)(\S.*)$/;while ($self->offset->[$level]> length($1)){$level--}$self->die('YAML_PARSE_ERR_INCONSISTENT_INDENTATION')if$self->offset->[$level]!=length($1);$self->indent(length($1));$self->content($2)}$self->die('YAML_PARSE_ERR_INDENTATION')if$self->indent - $offset > 1}my%unescapes=(0=>"\x00",a=>"\x07",t=>"\x09",n=>"\x0a",'v'=>"\x0b",f=>"\x0c",r=>"\x0d",e=>"\x1b",'\\'=>'\\',);sub _unescape {my$self=shift;my ($node)=@_;$node =~ s/\\([never\\fart0]|x([0-9a-fA-F]{2}))/
413 (length($1)>1)?pack("H2",$2):$unescapes{$1}/gex;return$node}1;
414 YAML_LOADER
415
416 $fatpacked{"YAML/Loader/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_LOADER_BASE';
417 package YAML::Loader::Base;use YAML::Mo;has load_code=>default=>sub {0};has preserve=>default=>sub {0};has stream=>default=>sub {''};has document=>default=>sub {0};has line=>default=>sub {0};has documents=>default=>sub {[]};has lines=>default=>sub {[]};has eos=>default=>sub {0};has done=>default=>sub {0};has anchor2node=>default=>sub {{}};has level=>default=>sub {0};has offset=>default=>sub {[]};has preface=>default=>sub {''};has content=>default=>sub {''};has indent=>default=>sub {0};has major_version=>default=>sub {0};has minor_version=>default=>sub {0};has inline=>default=>sub {''};has numify=>default=>sub {0};has zero_indent=>default=>sub {[]};sub set_global_options {my$self=shift;$self->load_code($YAML::LoadCode || $YAML::UseCode)if defined$YAML::LoadCode or defined$YAML::UseCode;$self->preserve($YAML::Preserve)if defined$YAML::Preserve;$self->numify($YAML::Numify)if defined$YAML::Numify}sub load {die 'load() not implemented in this class.'}1;
418 YAML_LOADER_BASE
419
420 $fatpacked{"YAML/Marshall.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_MARSHALL';
421 use strict;use warnings;package YAML::Marshall;use YAML::Node ();sub import {my$class=shift;no strict 'refs';my$package=caller;unless (grep {$_ eq $class}@{$package .'::ISA'}){push @{$package .'::ISA'},$class}my$tag=shift;if ($tag){no warnings 'once';$YAML::TagClass->{$tag}=$package;${$package ."::YamlTag"}=$tag}}sub yaml_dump {my$self=shift;no strict 'refs';my$tag=${ref($self)."::YamlTag"}|| 'perl/' .ref($self);$self->yaml_node($self,$tag)}sub yaml_load {my ($class,$node)=@_;if (my$ynode=$class->yaml_ynode($node)){$node=$ynode->{NODE}}bless$node,$class}sub yaml_node {shift;YAML::Node->new(@_)}sub yaml_ynode {shift;YAML::Node::ynode(@_)}1;
422 YAML_MARSHALL
423
424 $fatpacked{"YAML/Mo.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_MO';
425 package YAML::Mo;no warnings;my$M=__PACKAGE__.'::';*{$M.Object::new}=sub{my$c=shift;my$s=bless{@_},$c;my%n=%{$c.'::'.':E'};map{$s->{$_}=$n{$_}->()if!exists$s->{$_}}keys%n;$s};*{$M.import}=sub{import warnings;$^H|=1538;my($P,%e,%o)=caller.'::';shift;eval"no Mo::$_",&{$M.$_.::e}($P,\%e,\%o,\@_)for@_;return if$e{M};%e=(extends,sub{eval"no $_[0]()";@{$P.ISA}=$_[0]},has,sub{my$n=shift;my$m=sub{$#_?$_[0]{$n}=$_[1]:$_[0]{$n}};@_=(default,@_)if!($#_%2);$m=$o{$_}->($m,$n,@_)for sort keys%o;*{$P.$n}=$m},%e,);*{$P.$_}=$e{$_}for keys%e;@{$P.ISA}=$M.Object};*{$M.'builder::e'}=sub{my($P,$e,$o)=@_;$o->{builder}=sub{my($m,$n,%a)=@_;my$b=$a{builder}or return$m;my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=\&{$P.$b}and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$_[0]->$b:$m->(@_)}}};*{$M.'default::e'}=sub{my($P,$e,$o)=@_;$o->{default}=sub{my($m,$n,%a)=@_;exists$a{default}or return$m;my($d,$r)=$a{default};my$g='HASH'eq($r=ref$d)?sub{+{%$d}}:'ARRAY'eq$r?sub{[@$d]}:'CODE'eq$r?$d:sub{$d};my$i=exists$a{lazy}?$a{lazy}:!${$P.':N'};$i or ${$P.':E'}{$n}=$g and return$m;sub{$#_?$m->(@_):!exists$_[0]{$n}?$_[0]{$n}=$g->(@_):$m->(@_)}}};my$i=\&import;*{$M.import}=sub{(@_==2 and not$_[1])?pop@_:@_==1?push@_,grep!/import/,@f:();goto&$i};@f=qw[builder default import];use strict;use warnings;our$DumperModule='Data::Dumper';my ($_new_error,$_info,$_scalar_info);no strict 'refs';*{$M.'Object::die'}=sub {my$self=shift;my$error=$self->$_new_error(@_);$error->type('Error');Carp::croak($error->format_message)};*{$M.'Object::warn'}=sub {my$self=shift;return unless $^W;my$error=$self->$_new_error(@_);$error->type('Warning');Carp::cluck($error->format_message)};*{$M.'Object::node_info'}=sub {my$self=shift;my$stringify=$_[1]|| 0;my ($class,$type,$id)=ref($_[0])? $stringify ? &$_info("$_[0]"): do {require overload;my@info=&$_info(overload::StrVal($_[0]));if (ref($_[0])eq 'Regexp'){@info[0,1]=(undef,'REGEXP')}@info}: &$_scalar_info($_[0]);($class,$type,$id)=&$_scalar_info("$_[0]")unless$id;return wantarray ? ($class,$type,$id): $id};$_info=sub {return (($_[0])=~ qr{^(?:(.*)\=)?([^=]*)\(([^\(]*)\)$}o)};$_scalar_info=sub {my$id='undef';if (defined $_[0]){\$_[0]=~ /\((\w+)\)$/o or CORE::die();$id="$1-S"}return (undef,undef,$id)};$_new_error=sub {require Carp;my$self=shift;require YAML::Error;my$code=shift || 'unknown error';my$error=YAML::Error->new(code=>$code);$error->line($self->line)if$self->can('line');$error->document($self->document)if$self->can('document');$error->arguments([@_]);return$error};1;
426 YAML_MO
427
428 $fatpacked{"YAML/Node.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_NODE';
429 use strict;use warnings;package YAML::Node;use YAML::Tag;require YAML::Mo;use Exporter;our@ISA=qw(Exporter YAML::Mo::Object);our@EXPORT=qw(ynode);sub ynode {my$self;if (ref($_[0])eq 'HASH'){$self=tied(%{$_[0]})}elsif (ref($_[0])eq 'ARRAY'){$self=tied(@{$_[0]})}elsif (ref(\$_[0])eq 'GLOB'){$self=tied(*{$_[0]})}else {$self=tied($_[0])}return (ref($self)=~ /^yaml_/)? $self : undef}sub new {my ($class,$node,$tag)=@_;my$self;$self->{NODE}=$node;my (undef,$type)=YAML::Mo::Object->node_info($node);$self->{KIND}=(not defined$type)? 'scalar' : ($type eq 'ARRAY')? 'sequence' : ($type eq 'HASH')? 'mapping' : $class->die("Can't create YAML::Node from '$type'");tag($self,($tag || ''));if ($self->{KIND}eq 'scalar'){yaml_scalar->new($self,$_[1]);return \ $_[1]}my$package="yaml_" .$self->{KIND};$package->new($self)}sub node {$_->{NODE}}sub kind {$_->{KIND}}sub tag {my ($self,$value)=@_;if (defined$value){$self->{TAG}=YAML::Tag->new($value);return$self}else {return$self->{TAG}}}sub keys {my ($self,$value)=@_;if (defined$value){$self->{KEYS}=$value;return$self}else {return$self->{KEYS}}}package yaml_scalar;@yaml_scalar::ISA=qw(YAML::Node);sub new {my ($class,$self)=@_;tie $_[2],$class,$self}sub TIESCALAR {my ($class,$self)=@_;bless$self,$class;$self}sub FETCH {my ($self)=@_;$self->{NODE}}sub STORE {my ($self,$value)=@_;$self->{NODE}=$value}package yaml_sequence;@yaml_sequence::ISA=qw(YAML::Node);sub new {my ($class,$self)=@_;my$new;tie @$new,$class,$self;$new}sub TIEARRAY {my ($class,$self)=@_;bless$self,$class}sub FETCHSIZE {my ($self)=@_;scalar @{$self->{NODE}}}sub FETCH {my ($self,$index)=@_;$self->{NODE}[$index]}sub STORE {my ($self,$index,$value)=@_;$self->{NODE}[$index]=$value}sub undone {die "Not implemented yet"}*STORESIZE=*POP=*PUSH=*SHIFT=*UNSHIFT=*SPLICE=*DELETE=*EXISTS=*STORESIZE=*POP=*PUSH=*SHIFT=*UNSHIFT=*SPLICE=*DELETE=*EXISTS=*undone;package yaml_mapping;@yaml_mapping::ISA=qw(YAML::Node);sub new {my ($class,$self)=@_;@{$self->{KEYS}}=sort keys %{$self->{NODE}};my$new;tie %$new,$class,$self;$new}sub TIEHASH {my ($class,$self)=@_;bless$self,$class}sub FETCH {my ($self,$key)=@_;if (exists$self->{NODE}{$key}){return (grep {$_ eq $key}@{$self->{KEYS}})? $self->{NODE}{$key}: undef}return$self->{HASH}{$key}}sub STORE {my ($self,$key,$value)=@_;if (exists$self->{NODE}{$key}){$self->{NODE}{$key}=$value}elsif (exists$self->{HASH}{$key}){$self->{HASH}{$key}=$value}else {if (not grep {$_ eq $key}@{$self->{KEYS}}){push(@{$self->{KEYS}},$key)}$self->{HASH}{$key}=$value}$value}sub DELETE {my ($self,$key)=@_;my$return;if (exists$self->{NODE}{$key}){$return=$self->{NODE}{$key}}elsif (exists$self->{HASH}{$key}){$return=delete$self->{NODE}{$key}}for (my$i=0;$i < @{$self->{KEYS}};$i++){if ($self->{KEYS}[$i]eq $key){splice(@{$self->{KEYS}},$i,1)}}return$return}sub CLEAR {my ($self)=@_;@{$self->{KEYS}}=();%{$self->{HASH}}=()}sub FIRSTKEY {my ($self)=@_;$self->{ITER}=0;$self->{KEYS}[0]}sub NEXTKEY {my ($self)=@_;$self->{KEYS}[++$self->{ITER}]}sub EXISTS {my ($self,$key)=@_;exists$self->{NODE}{$key}}1;
430 YAML_NODE
431
432 $fatpacked{"YAML/Tag.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_TAG';
433 use strict;use warnings;package YAML::Tag;use overload '""'=>sub {${$_[0]}};sub new {my ($class,$self)=@_;bless \$self,$class}sub short {${$_[0]}}sub canonical {${$_[0]}}1;
434 YAML_TAG
435
436 $fatpacked{"YAML/Types.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'YAML_TYPES';
437 package YAML::Types;use YAML::Mo;use YAML::Node;package YAML::Type::blessed;use YAML::Mo;sub yaml_dump {my$self=shift;my ($value)=@_;my ($class,$type)=YAML::Mo::Object->node_info($value);no strict 'refs';my$kind=lc($type).':';my$tag=${$class .'::ClassTag'}|| "!perl/$kind$class";if ($type eq 'REF'){YAML::Node->new({(&YAML::VALUE,${$_[0]})},$tag)}elsif ($type eq 'SCALAR'){$_[1]=$$value;YAML::Node->new($_[1],$tag)}elsif ($type eq 'GLOB'){return YAML::Type::glob->yaml_dump($value,$tag)}else {YAML::Node->new($value,$tag)}}package YAML::Type::undef;sub yaml_dump {my$self=shift}sub yaml_load {my$self=shift}package YAML::Type::glob;sub yaml_dump {my$self=shift;my$tag=pop @_ if 2==@_;$tag='!perl/glob:' unless defined$tag;my$ynode=YAML::Node->new({},$tag);for my$type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)){my$value=*{$_[0]}{$type};$value=$$value if$type eq 'SCALAR';if (defined$value){if ($type eq 'IO'){my@stats=qw(device inode mode links uid gid rdev size atime mtime ctime blksize blocks);undef$value;$value->{stat}=YAML::Node->new({});if ($value->{fileno}=fileno(*{$_[0]})){local $^W;map {$value->{stat}{shift@stats}=$_}stat(*{$_[0]});$value->{tell}=tell(*{$_[0]})}}$ynode->{$type}=$value}}return$ynode}sub yaml_load {my$self=shift;my ($node,$class,$loader)=@_;my ($name,$package);if (defined$node->{NAME}){$name=$node->{NAME};delete$node->{NAME}}else {$loader->warn('YAML_LOAD_WARN_GLOB_NAME');return undef}if (defined$node->{PACKAGE}){$package=$node->{PACKAGE};delete$node->{PACKAGE}}else {$package='main'}no strict 'refs';if (exists$node->{SCALAR}){if ($YAML::LoadBlessed and $loader->load_code){*{"${package}::$name"}=\$node->{SCALAR}}delete$node->{SCALAR}}for my$elem (qw(ARRAY HASH CODE IO)){if (exists$node->{$elem}){if ($elem eq 'IO'){$loader->warn('YAML_LOAD_WARN_GLOB_IO');delete$node->{IO};next}if ($YAML::LoadBlessed and $loader->load_code){*{"${package}::$name"}=$node->{$elem}}delete$node->{$elem}}}for my$elem (sort keys %$node){$loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM',$elem)}return *{"${package}::$name"}}package YAML::Type::code;my$dummy_warned=0;my$default='{ "DUMMY" }';sub yaml_dump {my$self=shift;my$code;my ($dumpflag,$value)=@_;my ($class,$type)=YAML::Mo::Object->node_info($value);my$tag="!perl/code";$tag .= ":$class" if defined$class;if (not $dumpflag){$code=$default}else {bless$value,"CODE" if$class;eval {require B::Deparse};return if $@;my$deparse=B::Deparse->new();eval {local $^W=0;$code=$deparse->coderef2text($value)};if ($@){warn YAML::YAML_DUMP_WARN_DEPARSE_FAILED()if $^W;$code=$default}bless$value,$class if$class;chomp$code;$code .= "\n"}$_[2]=$code;YAML::Node->new($_[2],$tag)}sub yaml_load {my$self=shift;my ($node,$class,$loader)=@_;if ($loader->load_code){my$code=eval "package main; sub $node";if ($@){$loader->warn('YAML_LOAD_WARN_PARSE_CODE',$@);return sub {}}else {CORE::bless$code,$class if ($class and $YAML::LoadBlessed);return$code}}else {return CORE::bless sub {},$class if ($class and $YAML::LoadBlessed);return sub {}}}package YAML::Type::ref;sub yaml_dump {my$self=shift;YAML::Node->new({(&YAML::VALUE,${$_[0]})},'!perl/ref')}sub yaml_load {my$self=shift;my ($node,$class,$loader)=@_;$loader->die('YAML_LOAD_ERR_NO_DEFAULT_VALUE','ptr')unless exists$node->{&YAML::VALUE};return \$node->{&YAML::VALUE}}package YAML::Type::regexp;sub yaml_dump {die "YAML::Type::regexp::yaml_dump not currently implemented"}use constant _QR_TYPES=>{''=>sub {qr{$_[0]}},x=>sub {qr{$_[0]}x},i=>sub {qr{$_[0]}i},s=>sub {qr{$_[0]}s},m=>sub {qr{$_[0]}m},ix=>sub {qr{$_[0]}ix},sx=>sub {qr{$_[0]}sx},mx=>sub {qr{$_[0]}mx},si=>sub {qr{$_[0]}si},mi=>sub {qr{$_[0]}mi},ms=>sub {qr{$_[0]}sm},six=>sub {qr{$_[0]}six},mix=>sub {qr{$_[0]}mix},msx=>sub {qr{$_[0]}msx},msi=>sub {qr{$_[0]}msi},msix=>sub {qr{$_[0]}msix},};sub yaml_load {my$self=shift;my ($node,$class)=@_;return qr{$node} unless$node =~ /^\(\?([\^\-uxism]*):(.*)\)\z/s;my ($flags,$re)=($1,$2);$flags =~ s/-.*//;$flags =~ s/^\^//;$flags =~ tr/u//d;my$sub=_QR_TYPES->{$flags}|| sub {qr{$_[0]}};my$qr=&$sub($re);bless$qr,$class if (length$class and $YAML::LoadBlessed);return$qr}1;
438 YAML_TYPES
439
440 $fatpacked{"experimental.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPERIMENTAL';
441 package experimental;$experimental::VERSION='0.020';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',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%max_version=(autoderef=>'5.23.1',lexical_topic=>'5.23.4',);$_=version->new($_)for values%min_version;$_=version->new($_)for values%max_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 ($] >= ($max_version{$pragma}|| 7)){croak "Experimental feature $pragma has been removed from perl in version $max_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;
442 EXPERIMENTAL
443
444 s/^ //mg for values %fatpacked;
445
446 my $class = 'FatPacked::'.(0+\%fatpacked);
447 no strict 'refs';
448 *{"${class}::files"} = sub { keys %{$_[0]} };
449
450 if ($] < 5.008) {
451 *{"${class}::INC"} = sub {
452 if (my $fat = $_[0]{$_[1]}) {
453 my $pos = 0;
454 my $last = length $fat;
455 return (sub {
456 return 0 if $pos == $last;
457 my $next = (1 + index $fat, "\n", $pos) || $last;
458 $_ .= substr $fat, $pos, $next - $pos;
459 $pos = $next;
460 return 1;
461 });
462 }
463 };
464 }
465
466 else {
467 *{"${class}::INC"} = sub {
468 if (my $fat = $_[0]{$_[1]}) {
469 open my $fh, '<', \$fat
470 or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
471 return $fh;
472 }
473 return;
474 };
475 }
476
477 unshift @INC, bless \%fatpacked, $class;
478 } # END OF FATPACK CODE
479
480
481
482 use warnings;
483 use strict;
484
485 use App::Codeowners;
486
487 our $VERSION = '0.41'; # VERSION
488
489 App::Codeowners->main(@ARGV);
490
491 __END__
492
493 =pod
494
495 =encoding UTF-8
496
497 =head1 NAME
498
499 git-codeowners - A tool for managing CODEOWNERS files
500
501 =head1 VERSION
502
503 version 0.41
504
505 =head1 SYNOPSIS
506
507 git-codeowners [--version|--help|--manual]
508
509 git-codeowners [show] [--format FORMAT] [--[no-]project] [PATH...]
510
511 git-codeowners owners [--format FORMAT] [--pattern PATTERN]
512
513 git-codeowners patterns [--format FORMAT] [--owner OWNER]
514
515 git-codeowners create|update [REPO_DIRPATH|CODEOWNERS_FILEPATH]
516
517 # enable bash shell completion
518 eval "$(git-codeowners --shell-completion)"
519
520 =head1 DESCRIPTION
521
522 F<git-codeowners> is yet another CLI tool for managing F<CODEOWNERS> files in git repos. In
523 particular, it can be used to quickly find out who owns a particular file in a monorepo (or
524 monolith).
525
526 B<THIS IS EXPERIMENTAL!> The interface of this tool and its modules will probably change as I field
527 test some things. Feedback welcome.
528
529 =head1 INSTALL
530
531 There are several ways to install F<git-codeowners> to your system.
532
533 =head2 from CPAN
534
535 You can install F<git-codeowners> using L<cpanm>:
536
537 cpanm App::Codeowners
538
539 =head2 from GitHub
540
541 You can also choose to download F<git-codeowners> as a self-contained executable:
542
543 curl -OL https://raw.githubusercontent.com/chazmcgarvey/git-codeowners/solo/git-codeowners
544 chmod +x git-codeowners
545
546 To hack on the code, clone the repo instead:
547
548 git clone https://github.com/chazmcgarvey/git-codeowners.git
549 cd git-codeowners
550 make bootstrap # installs dependencies; requires cpanm
551
552 =head1 OPTIONS
553
554 =head2 --version
555
556 Print the program name and version to C<STDOUT>, and exit.
557
558 Alias: C<-v>
559
560 =head2 --help
561
562 Print the synopsis to C<STDOUT>, and exit.
563
564 Alias: C<-h>
565
566 You can also use C<--manual> to print the full documentation.
567
568 =head2 --color
569
570 Enable colorized output.
571
572 Color is ON by default on terminals; use C<--no-color> to disable. Some environment variables may
573 also alter the behavior of colorizing output:
574
575 =over 4
576
577 =item *
578
579 C<NO_COLOR> - Set to disable color (same as C<--no-color>).
580
581 =item *
582
583 C<COLOR_DEPTH> - Set the number of supportable colors (e.g. 0, 16, 256, 16777216).
584
585 =back
586
587 =head2 --format
588
589 Specify the output format to use. See L</FORMAT>.
590
591 Alias: C<-f>
592
593 =head2 --shell-completion
594
595 eval "$(lintany --shell-completion)"
596
597 Print shell code to enable completion to C<STDOUT>, and exit.
598
599 Does not yet support Zsh...
600
601 =head1 COMMANDS
602
603 =head2 show
604
605 git-codeowners [show] [--format FORMAT] [--[no-]project] [PATH...]
606
607 Show owners of one or more files in a repo.
608
609 =head2 owners
610
611 git-codeowners owners [--format FORMAT] [--pattern PATTERN]
612
613 =head2 patterns
614
615 git-codeowners patterns [--format FORMAT] [--owner OWNER]
616
617 =head2 create
618
619 git-codeowners create [REPO_DIRPATH|CODEOWNERS_FILEPATH]
620
621 Create a new F<CODEOWNERS> file for a specified repo (or current directory).
622
623 =head2 update
624
625 git-codeowners update [REPO_DIRPATH|CODEOWNERS_FILEPATH]
626
627 Update the "unowned" list of an existing F<CODEOWNERS> file for a specified
628 repo (or current directory).
629
630 =head1 FORMAT
631
632 The C<--format> argument can be one of:
633
634 =over 4
635
636 =item *
637
638 C<csv> - Comma-separated values (requires L<Text::CSV>)
639
640 =item *
641
642 C<json:pretty> - Pretty JSON (requires L<JSON::MaybeXS>)
643
644 =item *
645
646 C<json> - JSON (requires L<JSON::MaybeXS>)
647
648 =item *
649
650 C<table> - Table (requires L<Text::Table::Any>)
651
652 =item *
653
654 C<tsv> - Tab-separated values (requires L<Text::CSV>)
655
656 =item *
657
658 C<yaml> - YAML (requires L<YAML>)
659
660 =item *
661
662 C<FORMAT> - Custom format (see below)
663
664 =back
665
666 =head2 Custom
667
668 You can specify a custom format using printf-like format sequences. These are the items that can be
669 substituted:
670
671 =over 4
672
673 =item *
674
675 C<%F> - Filename
676
677 =item *
678
679 C<%O> - Owner or owners
680
681 =item *
682
683 C<%P> - Project
684
685 =item *
686
687 C<%T> - Pattern
688
689 =item *
690
691 C<%n> - newline
692
693 =item *
694
695 C<%t> - tab
696
697 =item *
698
699 C<%%> - percent sign
700
701 =back
702
703 The syntax also allows padding and some filters. Examples:
704
705 git-codeowners show -f ' * %-50F %O' # default for "show"
706 git-codeowners show -f '%{quote}F,%{quote}O' # ad hoc CSV
707 git-codeowners patterns -f '--> %{color:0c0}T' # whatever...
708
709 Available filters:
710
711 =over 4
712
713 =item *
714
715 C<quote> - Quote the replacement string.
716
717 =item *
718
719 C<color:FFFFFF> - Colorize the replacement string (if color is ON).
720
721 =item *
722
723 C<nocolor> - Do not colorize replacement string.
724
725 =back
726
727 =head2 Table
728
729 Table formatting can be done by one of several different modules, each with its own features and
730 bugs. The default module is L<Text::Table::Tiny>, but this can be overridden using the
731 C<PERL_TEXT_TABLE> environment variable if desired, like this:
732
733 PERL_TEXT_TABLE=Text::Table::HTML git-codeowners -f table
734
735 The list of available modules is at L<Text::Table::Any/@BACKENDS>.
736
737 =head1 BUGS
738
739 Please report any bugs or feature requests on the bugtracker website
740 L<https://github.com/chazmcgarvey/git-codeowners/issues>
741
742 When submitting a bug or request, please include a test-file or a
743 patch to an existing test-file that illustrates the bug or desired
744 feature.
745
746 =head1 AUTHOR
747
748 Charles McGarvey <chazmcgarvey@brokenzipper.com>
749
750 =head1 COPYRIGHT AND LICENSE
751
752 This software is copyright (c) 2019 by Charles McGarvey.
753
754 This is free software; you can redistribute it and/or modify it under
755 the same terms as the Perl 5 programming language system itself.
756
757 =cut
This page took 0.693395 seconds and 4 git commands to generate.