# HG changeset patch # User Takahiro SHIMIZU # Date 1555408704 -32400 # Node ID 73b27e5c1d79f6c3cc273d7131f20ea6ad4f363e # Parent 5f949b153f65429e0a333eb012987a5611eb468b# Parent ccfc78c23c6641627b68088a7da3a1b29ff6f455 auto-Update generated slides by script diff -r 5f949b153f65 -r 73b27e5c1d79 .gradle/4.10.1/fileChanges/last-build.bin Binary file .gradle/4.10.1/fileChanges/last-build.bin has changed diff -r 5f949b153f65 -r 73b27e5c1d79 .gradle/4.10.1/fileHashes/fileHashes.lock Binary file .gradle/4.10.1/fileHashes/fileHashes.lock has changed diff -r 5f949b153f65 -r 73b27e5c1d79 .gradle/4.10.1/gc.properties diff -r 5f949b153f65 -r 73b27e5c1d79 .gradle/4.10.1/taskHistory/taskHistory.lock Binary file .gradle/4.10.1/taskHistory/taskHistory.lock has changed diff -r 5f949b153f65 -r 73b27e5c1d79 .gradle/buildOutputCleanup/buildOutputCleanup.lock Binary file .gradle/buildOutputCleanup/buildOutputCleanup.lock has changed diff -r 5f949b153f65 -r 73b27e5c1d79 .gradle/buildOutputCleanup/cache.properties --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.gradle/buildOutputCleanup/cache.properties Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,2 @@ +#Tue Sep 18 18:54:51 JST 2018 +gradle.version=4.10.1 diff -r 5f949b153f65 -r 73b27e5c1d79 .hgignore --- a/.hgignore Tue Apr 16 18:48:55 2019 +0900 +++ b/.hgignore Tue Apr 16 18:58:24 2019 +0900 @@ -25,3 +25,6 @@ lib/Slideshow/local/* .vstags .DS_Store +local/* +cpanfile.snapshot +.envrc diff -r 5f949b153f65 -r 73b27e5c1d79 cpanfile --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cpanfile Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,5 @@ +requires 'Smart::Options'; +requires 'Class::Tiny'; +requires 'Path::Tiny'; +requires 'File::chdir'; +requires 'Capture::Tiny'; diff -r 5f949b153f65 -r 73b27e5c1d79 hoge.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hoge.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,2 @@ +You are right. +Since Mozilla::CA does not exist,it is impossible to https connection,but HTTP::Tinyish tried to connect HTTPS for LWP::Protocol::HTTPS. diff -r 5f949b153f65 -r 73b27e5c1d79 lib/CLI.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/CLI.pm Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,193 @@ +package CLI; +use strict; +use warnings; +use utf8; + +#use DDP { deparse => 1 }; + +use Smart::Options; +use Smart::Options::Declare; +use Time::Piece; +use Time::Seconds; +use Capture::Tiny qw/capture/; +use Path::Tiny; +use File::chdir; +use Carp qw/croak/; + +use Class::Tiny qw/ template root_dir/; +use feature 'say'; + +sub run { + my($self,@args) = @_; + my $opt = Smart::Options->new->options( + file => { describe => 'target file', alias => 'f'} + ); + $opt->subcmd( + new => Smart::Options->new(), + build => Smart::Options->new(), + open => Smart::Options->new->default('target' => 'slide.md'), + build_open => Smart::Options->new->default('target' => 'slide.md'), + upload => Smart::Options->new(), + memo => Smart::Options->new(), + edit => Smart::Options->new(), + zip => Smart::Options->new(), + ); + + my $result = $opt->parse(@args); + my $command = $result->{command} // "open"; + + my $option = $result->{cmd_option}->{f} || $result->{cmd_option}->{file} || 0; + + my $call = $self->can("cmd_$command"); + croak 'undefine subcommand' unless $call; + $self->$call($option); +} + +sub cmd_new { + my ($self) = @_; + my ($y,$m,$d) = _y_m_d(); + my $slide = path($self->root_dir)->child($y)->child($m)->child($d)->child('slide.md')->touchpath; + path($self->template)->copy($slide); +} + +sub cmd_build { + my($self,$target) = @_; + + if ($target){ + $target = path($target); + $self->_build($target->dirname,$target->basename); + } else { + $self->_build($self->_search_recently_day()); + } +} + +sub _build { + my ($self,$dir,$target) = @_; + + $target //= 'slide.md'; + + say "[AUTO] BUILD at $dir/$target"; + + local $CWD = $dir; + + my ($stdout,$stderr,$exit) = capture { + system("slideshow build ${target} -t s6cr"); + }; + + croak "Perl can't build...." if $stderr; +} + +sub cmd_build_open { + my($self,$target) = @_; + $self->cmd_build($target); + if($target){ + $target =~ s/\.md$/\.html/; + } else { + my @targets = $self->_search_recently_day()->children(qr/(?cmd_open(path($target)); +} + +sub cmd_open { + my($self,$slide) = @_; + + my $target; + + if ($slide){ + $target = $slide; + } else { + $slide = 'slide.html'; + $target = $self->_search_recently_day()->child($slide); + } + + if($target->realpath){ + system 'open', ($target->realpath); + } else { + croak 'dont found slide.html'; + } +} + +sub cmd_upload { + say "[AUTO]hg addremove"; + my ($stdout,$stderr,$exit) = capture { + system("hg addremove"); + system("hg add"); + }; + + + croak "didn't add" if $stderr; + + say "[AUTO]hg commit -m auto-Update generated slides by script"; + + ($stdout,$stderr,$exit) = capture { system('hg commit -m "auto-Update generated slides by script"');}; + + if ($stderr) { say $stderr; croak "didn't commit";} + + say "[AUTO]hg push"; + + ($stdout,$stderr,$exit) = capture { system('hg push'); }; + + if ( $stderr ) { + say $stderr; + croak "didn't commit"; + } else { + say $stdout; + } +} + +sub _y_m_d { + my $t = localtime; + # ex... 2018/02/14 + ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d')); +} + +sub _search_recently_day { + my ($self) = @_; + my ($y,$m,$d) = _y_m_d(); + my $root_dir = path($self->root_dir)->child($y)->child($m); + + my $date = shift @{ [sort { $b->stat->mtime <=> $a->stat->mtime } $root_dir->children]}; + return $date; +} + +sub cmd_memo { + my ($self) = @_; + my ($y,$m,$d) = _y_m_d(); + my $memo = path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt')->touchpath; + exec $ENV{EDITOR},($memo->realpath); +} + +sub cmd_edit { + my ($self) = @_; + my $recent_day = $self->_search_recently_day(); + my @targets = $recent_day->children(qr/\.md$/); + my $target = pop @targets; + exec $ENV{EDITOR},($target->realpath); +} + +sub cmd_zip { + my ($self) = @_; + my $recent_day = $self->_search_recently_day(); + my $t = localtime; + my $zip = $recent_day->child('zip.txt')->touch->opena; + + $t-= ONE_WEEK; + + for(0..7){ + my($y,$m,$d)=($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d')); + my $memo = path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt'); + + unless ($memo->exists) { + $t += ONE_DAY; + next; + } + + say $zip "$y-$m-$d----"; + say $zip $memo->slurp; + say $zip "----------"; + $t += ONE_DAY; + } +} + +1; diff -r 5f949b153f65 -r 73b27e5c1d79 lib/Slideshow/Util.pm --- a/lib/Slideshow/Util.pm Tue Apr 16 18:48:55 2019 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,198 +0,0 @@ -package Slideshow::Util; -use strict; -use warnings; -use utf8; - -use Carp qw/ croak /; - -use base 'Exporter'; - -use Time::Piece; -use feature 'say'; -use Path::Tiny; -use File::chdir; -use Capture::Tiny qw/capture/; - -our @EXPORT = qw/ - getopts - new - set_template - build_recently - build_pinpoint - open_slide - edit_slide - edit_memo -/; - -sub getopts { - my ($arg,$path) = @_; - - unless (defined $arg){ - return { help => 1}; - } - - if ($arg eq "new") { - return {new => 1}; - - } elsif ( $arg eq "upload") { - upload(); - exit; - - } elsif ( $arg eq "build") { - - if(defined $path){ - return { build_point=> $path}; - } else { - return { build => "recent"}; - } - - - } elsif ( $arg eq "build-open"){ - return { build_open => 1}; - - } elsif ( $arg eq "open"){ - return { open => 1}; - - } elsif ( $arg eq "edit"){ - return { edit=> 1}; - } elsif ( $arg eq "memo"){ - return { memo => 1}; - } else { - return { help => 1}; - } - -} - -sub set_template { - my $template = shift; - my $file = path($template); - return $file; -} - -sub new { - my ($template,$root_directory_name) = @_; - my $root_dir = path($root_directory_name); - my $t = localtime; - - # ex... 2018/02/14 - my ($y,$m,$d) = ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d')); - my $slide = $root_dir->child($y .'/'. $m .'/'. $d .'/'.'slide.md')->touchpath; - $template->copy($slide); -} - -sub _search_recently { - my ($root_directory_name) = @_; - my $t = localtime; - - # ex... 2018/02/14 - my ($y,$m,$d) = ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d')); - my $root_dir = path($root_directory_name.'/'.$y.'/'.$m); - - my $date = shift @{ [sort { $b->stat->mtime <=> $a->stat->mtime } $root_dir->children]}; - - return $date; -} - - - -sub build_recently { - my $recently = _search_recently(shift); - _build($recently); -} - -sub build_pinpoint { - my $target = shift; - - my $target_path = path($target); - - my $dir = $target_path->dirname; - my $slide = $target_path->basename; - - _build($dir,$slide); -} - -sub edit_memo { - my $root_dir = path(shift); - my $t = localtime; - - # ex... 2018/02/14 - my ($y,$m,$d) = ($t->strftime('%Y'), $t->strftime('%m'), $t->strftime('%d')); - my $memo = $root_dir->child($y .'/'. $m .'/'. $d .'/'.'memo.txt')->touchpath; - exec $ENV{EDITOR}, ($memo->realpath); -} - -sub edit_slide { - my $recently = _search_recently(shift); - my $target = $recently->child('slide.md'); - exec $ENV{EDITOR}, ($target->realpath); -} - -sub open_slide { - my $recently = _search_recently(shift); - my $target = $recently->child('slide.html'); - - if ( $target->realpath){ - system "open", ($target->realpath); - } else { - say "didn't slide.html"; - } -} - -sub _build { - my ($dir,$target) = @_; - use Capture::Tiny; - - $target //= 'slide.md'; - - say "[AUTO] BUILD at $dir/$target"; - - local $CWD = $dir; - - my ($stdout,$stderr,$exit) = capture { - system("slideshow build ${target} -t s6cr"); - }; - - if ($stderr){ - croak "Perl can't build...."; - } -} - - -sub upload { - - say "[AUTO]hg addremove"; - my ($stdout,$stderr,$exit) = capture { - system("hg addremove"); - system("hg add"); - }; - - if ($stderr) { - croak "didn't add"; - } - - say "[AUTO]hg commit -m auto-Update generated slides by script"; - - ($stdout,$stderr,$exit) = capture { - system('hg commit -m "auto-Update generated slides by script"'); - }; - - if ($stderr) { - say $stderr; - croak "didn't commit"; - } - - say "[AUTO]hg push"; - - ($stdout,$stderr,$exit) = capture { - system('hg push'); - }; - - if ( $stderr ) { - say $stderr; - croak "didn't commit"; - } else { - say $stdout; - } -} - -1; diff -r 5f949b153f65 -r 73b27e5c1d79 lib/Slideshow/cpanfile --- a/lib/Slideshow/cpanfile Tue Apr 16 18:48:55 2019 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -requires 'Path::Tiny'; -requires 'YAML::XS'; -requires 'File::chdir'; -requires 'DDP'; -requires 'perl', '5.008001'; \ No newline at end of file diff -r 5f949b153f65 -r 73b27e5c1d79 lib/template.md --- a/lib/template.md Tue Apr 16 18:48:55 2019 +0900 +++ b/lib/template.md Tue Apr 16 18:58:24 2019 +0900 @@ -1,12 +1,20 @@ -title: 近況報告 +title: CbCによるMoarVMの改良 author: Takahiro Shimizu profile: lang: Japanese -# 研究内容 -* OS +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する -# hoge +# 今週の進捗 * foo - * puyo + * puyohoge + +# 来週の予定 + diff -r 5f949b153f65 -r 73b27e5c1d79 slide-cr --- a/slide-cr Tue Apr 16 18:48:55 2019 +0900 +++ b/slide-cr Tue Apr 16 18:58:24 2019 +0900 @@ -1,42 +1,683 @@ #!/usr/bin/env perl -use strict; -use warnings; -use utf8; + +# This chunk of stuff was generated by App::FatPacker. To find the original +# file's code, look for the end of this BEGIN block or the string 'FATPACK' +BEGIN { +my %fatpacked; + +$fatpacked{"CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLI'; + package CLI;use strict;use warnings;use utf8;use DDP {deparse=>1 };use Smart::Options;use Smart::Options::Declare;use Time::Piece;use Time::Seconds;use Capture::Tiny qw/capture/;use Path::Tiny;use File::chdir;use Carp qw/croak/;use Class::Tiny qw/template root_dir/;use feature 'say';sub run {my($self,@args)=@_;my$opt=Smart::Options->new->options(file=>{describe=>'target file',alias=>'f'});$opt->subcmd(new=>Smart::Options->new(),build=>Smart::Options->new(),open=>Smart::Options->new->default('target'=>'slide.md'),build_open=>Smart::Options->new->default('target'=>'slide.md'),upload=>Smart::Options->new(),memo=>Smart::Options->new(),edit=>Smart::Options->new(),zip=>Smart::Options->new(),);my$result=$opt->parse(@args);my$command=$result->{command}// "open";my$option=$result->{cmd_option}->{f}|| $result->{cmd_option}->{file}|| 0;my$call=$self->can("cmd_$command");croak 'undefine subcommand' unless$call;$self->$call($option)}sub cmd_new {my ($self)=@_;my ($y,$m,$d)=_y_m_d();my$slide=path($self->root_dir)->child($y)->child($m)->child($d)->child('slide.md')->touchpath;path($self->template)->copy($slide)}sub cmd_build {my($self,$target)=@_;if ($target){$target=path($target);$self->_build($target->dirname,$target->basename)}else {$self->_build($self->_search_recently_day())}}sub _build {my ($self,$dir,$target)=@_;$target //= 'slide.md';say "[AUTO] BUILD at $dir/$target";local$CWD=$dir;my ($stdout,$stderr,$exit)=capture {system("slideshow build ${target} -t s6cr")};croak "Perl can't build...." if$stderr}sub cmd_build_open {my($self,$target)=@_;$self->cmd_build($target);if($target){$target =~ s/\.md$/\.html/}else {my@targets=$self->_search_recently_day()->children(qr/(?cmd_open(path($target))}sub cmd_open {my($self,$slide)=@_;my$target;if ($slide){$target=$slide}else {$slide='slide.html';$target=$self->_search_recently_day()->child($slide)}if($target->realpath){system 'open',($target->realpath)}else {croak 'dont found slide.html'}}sub cmd_upload {say "[AUTO]hg addremove";my ($stdout,$stderr,$exit)=capture {system("hg addremove");system("hg add")};croak "didn't add" if$stderr;say "[AUTO]hg commit -m auto-Update generated slides by script";($stdout,$stderr,$exit)=capture {system('hg commit -m "auto-Update generated slides by script"')};if ($stderr){say$stderr;croak "didn't commit"}say "[AUTO]hg push";($stdout,$stderr,$exit)=capture {system('hg push')};if ($stderr){say$stderr;croak "didn't commit"}else {say$stdout}}sub _y_m_d {my$t=localtime;($t->strftime('%Y'),$t->strftime('%m'),$t->strftime('%d'))}sub _search_recently_day {my ($self)=@_;my ($y,$m,$d)=_y_m_d();my$root_dir=path($self->root_dir)->child($y)->child($m);my$date=shift @{[sort {$b->stat->mtime <=> $a->stat->mtime}$root_dir->children]};return$date}sub cmd_memo {my ($self)=@_;my ($y,$m,$d)=_y_m_d();my$memo=path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt')->touchpath;exec$ENV{EDITOR},($memo->realpath)}sub cmd_edit {my ($self)=@_;my$recent_day=$self->_search_recently_day();my@targets=$recent_day->children(qr/\.md$/);my$target=pop@targets;exec$ENV{EDITOR},($target->realpath)}sub cmd_zip {my ($self)=@_;my$recent_day=$self->_search_recently_day();my$t=localtime;my$zip=$recent_day->child('zip.txt')->touch->opena;$t-= ONE_WEEK;for(0..7){my($y,$m,$d)=($t->strftime('%Y'),$t->strftime('%m'),$t->strftime('%d'));my$memo=path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt');unless ($memo->exists){$t += ONE_DAY;next}say$zip "$y-$m-$d----";say$zip $memo->slurp;say$zip "----------";$t += ONE_DAY}}1; +CLI + +$fatpacked{"Capture/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CAPTURE_TINY'; + use 5.006;use strict;use warnings;package Capture::Tiny;our$VERSION='0.48';use Carp ();use Exporter ();use IO::Handle ();use File::Spec ();use File::Temp qw/tempfile tmpnam/;use Scalar::Util qw/reftype blessed/;BEGIN {local $@;eval {require PerlIO;PerlIO->can('get_layers')}or *PerlIO::get_layers=sub {return ()}}my%api=(capture=>[1,1,0,0],capture_stdout=>[1,0,0,0],capture_stderr=>[0,1,0,0],capture_merged=>[1,1,1,0],tee=>[1,1,0,1],tee_stdout=>[1,0,0,1],tee_stderr=>[0,1,0,1],tee_merged=>[1,1,1,1],);for my$sub (keys%api){my$args=join q{, },@{$api{$sub}};eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"}our@ISA=qw/Exporter/;our@EXPORT_OK=keys%api;our%EXPORT_TAGS=('all'=>\@EXPORT_OK);my$IS_WIN32=$^O eq 'MSWin32';our$TIMEOUT=30;my@cmd=($^X,'-C0','-e',<<'HERE');sub _relayer {my ($fh,$apply_layers)=@_;binmode($fh,":raw");while (1 < (my$layers=()=PerlIO::get_layers($fh,output=>1))){binmode($fh,":pop")}my@to_apply=@$apply_layers;shift@to_apply;binmode($fh,":" .join(":",@to_apply))}sub _name {my$glob=shift;no strict 'refs';return *{$glob}{NAME}}sub _open {open $_[0],$_[1]or Carp::confess "Error from open(" .join(q{, },@_)."): $!"}sub _close {close $_[0]or Carp::confess "Error from close(" .join(q{, },@_)."): $!"}my%dup;my%proxy_count;sub _proxy_std {my%proxies;if (!defined fileno STDIN){$proxy_count{stdin}++;if (defined$dup{stdin}){_open \*STDIN,"<&=" .fileno($dup{stdin})}else {_open \*STDIN,"<" .File::Spec->devnull;_open$dup{stdin}=IO::Handle->new,"<&=STDIN"}$proxies{stdin}=\*STDIN;binmode(STDIN,':utf8')if $] >= 5.008}if (!defined fileno STDOUT){$proxy_count{stdout}++;if (defined$dup{stdout}){_open \*STDOUT,">&=" .fileno($dup{stdout})}else {_open \*STDOUT,">" .File::Spec->devnull;_open$dup{stdout}=IO::Handle->new,">&=STDOUT"}$proxies{stdout}=\*STDOUT;binmode(STDOUT,':utf8')if $] >= 5.008}if (!defined fileno STDERR){$proxy_count{stderr}++;if (defined$dup{stderr}){_open \*STDERR,">&=" .fileno($dup{stderr})}else {_open \*STDERR,">" .File::Spec->devnull;_open$dup{stderr}=IO::Handle->new,">&=STDERR"}$proxies{stderr}=\*STDERR;binmode(STDERR,':utf8')if $] >= 5.008}return%proxies}sub _unproxy {my (%proxies)=@_;for my$p (keys%proxies){$proxy_count{$p}--;if (!$proxy_count{$p}){_close$proxies{$p};_close$dup{$p}unless $] < 5.008;delete$dup{$p}}}}sub _copy_std {my%handles;for my$h (qw/stdout stderr stdin/){next if$h eq 'stdin' &&!$IS_WIN32;my$redir=$h eq 'stdin' ? "<&" : ">&";_open$handles{$h}=IO::Handle->new(),$redir .uc($h)}return \%handles}sub _open_std {my ($handles)=@_;_open \*STDIN,"<&" .fileno$handles->{stdin}if defined$handles->{stdin};_open \*STDOUT,">&" .fileno$handles->{stdout}if defined$handles->{stdout};_open \*STDERR,">&" .fileno$handles->{stderr}if defined$handles->{stderr}}sub _start_tee {my ($which,$stash)=@_;$stash->{$_}{$which}=IO::Handle->new for qw/tee reader/;pipe$stash->{reader}{$which},$stash->{tee}{$which};select((select($stash->{tee}{$which}),$|=1)[0]);$stash->{new}{$which}=$stash->{tee}{$which};$stash->{child}{$which}={stdin=>$stash->{reader}{$which},stdout=>$stash->{old}{$which},stderr=>$stash->{capture}{$which},};$stash->{flag_files}{$which}=scalar(tmpnam()).$$;if ($IS_WIN32){my$old_eval_err=$@;undef $@;eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";my$os_fhandle=GetOsFHandle($stash->{tee}{$which});my$result=SetHandleInformation($os_fhandle,HANDLE_FLAG_INHERIT(),0);_open_std($stash->{child}{$which});$stash->{pid}{$which}=system(1,@cmd,$stash->{flag_files}{$which});$@=$old_eval_err}else {_fork_exec($which,$stash)}}sub _fork_exec {my ($which,$stash)=@_;my$pid=fork;if (not defined$pid){Carp::confess "Couldn't fork(): $!"}elsif ($pid==0){untie*STDIN;untie*STDOUT;untie*STDERR;_close$stash->{tee}{$which};_open_std($stash->{child}{$which});exec@cmd,$stash->{flag_files}{$which}}$stash->{pid}{$which}=$pid}my$have_usleep=eval "use Time::HiRes 'usleep'; 1";sub _files_exist {return 1 if @_==grep {-f}@_;Time::HiRes::usleep(1000)if$have_usleep;return 0}sub _wait_for_tees {my ($stash)=@_;my$start=time;my@files=values %{$stash->{flag_files}};my$timeout=defined$ENV{PERL_CAPTURE_TINY_TIMEOUT}? $ENV{PERL_CAPTURE_TINY_TIMEOUT}: $TIMEOUT;1 until _files_exist(@files)|| ($timeout && (time - $start > $timeout));Carp::confess "Timed out waiting for subprocesses to start" if!_files_exist(@files);unlink $_ for@files}sub _kill_tees {my ($stash)=@_;if ($IS_WIN32){close($_)for values %{$stash->{tee}};my$start=time;1 until wait==-1 || (time - $start > 30)}else {_close $_ for values %{$stash->{tee}};waitpid $_,0 for values %{$stash->{pid}}}}sub _slurp {my ($name,$stash)=@_;my ($fh,$pos)=map {$stash->{$_}{$name}}qw/capture pos/;seek($fh,$pos,0)or die "Couldn't seek on capture handle for $name\n";my$text=do {local $/;scalar readline$fh};return defined($text)? $text : ""}sub _capture_tee {my ($do_stdout,$do_stderr,$do_merge,$do_tee,$code,@opts)=@_;my%do=($do_stdout ? (stdout=>1): (),$do_stderr ? (stderr=>1): ());Carp::confess("Custom capture options must be given as key/value pairs\n")unless@opts % 2==0;my$stash={capture=>{@opts }};for (keys %{$stash->{capture}}){my$fh=$stash->{capture}{$_};Carp::confess "Custom handle for $_ must be seekable\n" unless ref($fh)eq 'GLOB' || (blessed($fh)&& $fh->isa("IO::Seekable"))}local*CT_ORIG_STDIN=*STDIN ;local*CT_ORIG_STDOUT=*STDOUT;local*CT_ORIG_STDERR=*STDERR;my%layers=(stdin=>[PerlIO::get_layers(\*STDIN)],stdout=>[PerlIO::get_layers(\*STDOUT,output=>1)],stderr=>[PerlIO::get_layers(\*STDERR,output=>1)],);$layers{stdout}=[PerlIO::get_layers(tied*STDOUT)]if tied(*STDOUT)&& (reftype tied*STDOUT eq 'GLOB');$layers{stderr}=[PerlIO::get_layers(tied*STDERR)]if tied(*STDERR)&& (reftype tied*STDERR eq 'GLOB');my%localize;$localize{stdin}++,local(*STDIN)if grep {$_ eq 'scalar'}@{$layers{stdin}};$localize{stdout}++,local(*STDOUT)if$do_stdout && grep {$_ eq 'scalar'}@{$layers{stdout}};$localize{stderr}++,local(*STDERR)if ($do_stderr || $do_merge)&& grep {$_ eq 'scalar'}@{$layers{stderr}};$localize{stdin}++,local(*STDIN),_open(\*STDIN,"<&=0")if tied*STDIN && $] >= 5.008;$localize{stdout}++,local(*STDOUT),_open(\*STDOUT,">&=1")if$do_stdout && tied*STDOUT && $] >= 5.008;$localize{stderr}++,local(*STDERR),_open(\*STDERR,">&=2")if ($do_stderr || $do_merge)&& tied*STDERR && $] >= 5.008;my%proxy_std=_proxy_std();$layers{stdout}=[PerlIO::get_layers(\*STDOUT,output=>1)]if$proxy_std{stdout};$layers{stderr}=[PerlIO::get_layers(\*STDERR,output=>1)]if$proxy_std{stderr};$stash->{old}=_copy_std();$stash->{new}={%{$stash->{old}}};for (keys%do){$stash->{new}{$_}=($stash->{capture}{$_}||= File::Temp->new);seek($stash->{capture}{$_},0,2)or die "Could not seek on capture handle for $_\n";$stash->{pos}{$_}=tell$stash->{capture}{$_};_start_tee($_=>$stash)if$do_tee}_wait_for_tees($stash)if$do_tee;$stash->{new}{stderr}=$stash->{new}{stdout}if$do_merge;_open_std($stash->{new});my ($exit_code,$inner_error,$outer_error,$orig_pid,@result);{$orig_pid=$$;local*STDIN=*CT_ORIG_STDIN if$localize{stdin};_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;my$old_eval_err=$@;undef $@;eval {@result=$code->();$inner_error=$@};$exit_code=$?;$outer_error=$@;STDOUT->flush if$do_stdout;STDERR->flush if$do_stderr;$@=$old_eval_err}_open_std($stash->{old});_close($_)for values %{$stash->{old}};_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;_unproxy(%proxy_std);_kill_tees($stash)if$do_tee;my%got;if ($orig_pid==$$ and (defined wantarray or ($do_tee && keys%localize))){for (keys%do){_relayer($stash->{capture}{$_},$layers{$_});$got{$_}=_slurp($_,$stash)}print CT_ORIG_STDOUT$got{stdout}if$do_stdout && $do_tee && $localize{stdout};print CT_ORIG_STDERR$got{stderr}if$do_stderr && $do_tee && $localize{stderr}}$?=$exit_code;$@=$inner_error if$inner_error;die$outer_error if$outer_error;return unless defined wantarray;my@return;push@return,$got{stdout}if$do_stdout;push@return,$got{stderr}if$do_stderr &&!$do_merge;push@return,@result;return wantarray ? @return : $return[0]}1; + use Fcntl; + $SIG{HUP}=sub{exit}; + if ( my $fn=shift ) { + sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!; + print {$fh} $$; + close $fh; + } + my $buf; while (sysread(STDIN, $buf, 2048)) { + syswrite(STDOUT, $buf); syswrite(STDERR, $buf); + } + HERE +CAPTURE_TINY + +$fatpacked{"Class/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_TINY'; + use 5.006;use strict;no strict 'refs';use warnings;package Class::Tiny;our$VERSION='1.006';use Carp ();require($] >= 5.010 ? "mro.pm" : "MRO/Compat.pm");my%CLASS_ATTRIBUTES;sub import {my$class=shift;my$pkg=caller;$class->prepare_class($pkg);$class->create_attributes($pkg,@_)if @_}sub prepare_class {my ($class,$pkg)=@_;@{"${pkg}::ISA"}="Class::Tiny::Object" unless @{"${pkg}::ISA"}}sub create_attributes {my ($class,$pkg,@spec)=@_;my%defaults=map {ref $_ eq 'HASH' ? %$_ : ($_=>undef)}@spec;my@attr=grep {defined and!ref and /^[^\W\d]\w*$/s or Carp::croak "Invalid accessor name '$_'"}keys%defaults;$CLASS_ATTRIBUTES{$pkg}{$_}=$defaults{$_}for@attr;$class->_gen_accessor($pkg,$_)for grep {!*{"$pkg\::$_"}{CODE}}@attr;Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub _gen_accessor {my ($class,$pkg,$name)=@_;my$outer_default=$CLASS_ATTRIBUTES{$pkg}{$name};my$sub=$class->__gen_sub_body($name,defined($outer_default),ref($outer_default));eval "package $pkg; my \$default=\$outer_default; $sub";Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub __gen_sub_body {my ($self,$name,$has_default,$default_type)=@_;if ($has_default && $default_type eq 'CODE'){return << "HERE"}elsif ($has_default){return << "HERE"}else {return << "HERE"}}sub get_all_attributes_for {my ($class,$pkg)=@_;my%attr=map {$_=>undef}map {keys %{$CLASS_ATTRIBUTES{$_}|| {}}}@{mro::get_linear_isa($pkg)};return keys%attr}sub get_all_attribute_defaults_for {my ($class,$pkg)=@_;my$defaults={};for my$p (reverse @{mro::get_linear_isa($pkg)}){while (my ($k,$v)=each %{$CLASS_ATTRIBUTES{$p}|| {}}){$defaults->{$k}=$v}}return$defaults}package Class::Tiny::Object;our$VERSION='1.006';my (%HAS_BUILDARGS,%BUILD_CACHE,%DEMOLISH_CACHE,%ATTR_CACHE);my$_PRECACHE=sub {no warnings 'once';my ($class)=@_;my$linear_isa=@{"$class\::ISA"}==1 && ${"$class\::ISA"}[0]eq "Class::Tiny::Object" ? [$class]: mro::get_linear_isa($class);$DEMOLISH_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::DEMOLISH"}@$linear_isa ];$BUILD_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::BUILD"}reverse @$linear_isa ];$HAS_BUILDARGS{$class}=$class->can("BUILDARGS");return$ATTR_CACHE{$class}={map {$_=>1}Class::Tiny->get_all_attributes_for($class)}};sub new {my$class=shift;my$valid_attrs=$ATTR_CACHE{$class}|| $_PRECACHE->($class);my$args;if ($HAS_BUILDARGS{$class}){$args=$class->BUILDARGS(@_)}else {if (@_==1 && ref $_[0]){my%copy=eval {%{$_[0]}};Carp::croak("Argument to $class->new() could not be dereferenced as a hash")if $@;$args=\%copy}elsif (@_ % 2==0){$args={@_}}else {Carp::croak("$class->new() got an odd number of elements")}}my$self=bless {map {$_=>$args->{$_}}grep {exists$valid_attrs->{$_}}keys %$args },$class;$self->BUILDALL($args)if!delete$args->{__no_BUILD__}&& @{$BUILD_CACHE{$class}};return$self}sub BUILDALL {$_->(@_)for @{$BUILD_CACHE{ref $_[0]}}}require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE};sub DESTROY {my$self=shift;my$class=ref$self;my$in_global_destruction=defined ${^GLOBAL_PHASE} ? ${^GLOBAL_PHASE} eq 'DESTRUCT' : Devel::GlobalDestruction::in_global_destruction();for my$demolisher (@{$DEMOLISH_CACHE{$class}}){my$e=do {local ($?,$@);eval {$demolisher->($self,$in_global_destruction)};$@};no warnings 'misc';die$e if$e}}1; + sub $name { + return ( + ( \@_ == 1 && exists \$_[0]{$name} ) + ? ( \$_[0]{$name} ) + : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default->( \$_[0] ) ) + ); + } + HERE + sub $name { + return ( + ( \@_ == 1 && exists \$_[0]{$name} ) + ? ( \$_[0]{$name} ) + : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default ) + ); + } + HERE + sub $name { + return \@_ == 1 ? \$_[0]{$name} : ( \$_[0]{$name} = \$_[1] ); + } + HERE +CLASS_TINY + +$fatpacked{"Exporter/Shiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_SHINY'; + package Exporter::Shiny;use 5.006001;use strict;use warnings;use Exporter::Tiny ();our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.000000';sub import {my$me=shift;my$caller=caller;(my$nominal_file=$caller)=~ s(::)(/)g;$INC{"$nominal_file\.pm"}||= __FILE__;if (@_==2 and $_[0]eq -setup){my (undef,$opts)=@_;@_=@{delete($opts->{exports})|| []};if (%$opts){Exporter::Tiny::_croak('Unsupported Sub::Exporter-style options: %s',join(q[, ],sort keys %$opts),)}}ref($_)&& Exporter::Tiny::_croak('Expected sub name, got ref %s',$_)for @_;no strict qw(refs);push @{"$caller\::ISA"},'Exporter::Tiny';push @{"$caller\::EXPORT_OK"},@_}1; +EXPORTER_SHINY + +$fatpacked{"Exporter/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_TINY'; + package Exporter::Tiny;use 5.006001;use strict;use warnings;no warnings qw(void once uninitialized numeric redefine);our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.000000';our@EXPORT_OK=qw;sub _croak ($;@) {require Carp;my$fmt=shift;@_=sprintf($fmt,@_);goto \&Carp::croak}sub _carp ($;@) {require Carp;my$fmt=shift;@_=sprintf($fmt,@_);goto \&Carp::carp}my$_process_optlist=sub {my$class=shift;my ($global_opts,$opts,$want,$not_want)=@_;while (@$opts){my$opt=shift @{$opts};my ($name,$value)=@$opt;($name =~ m{\A\!(/.+/[msixpodual]+)\z})? do {my@not=$class->_exporter_expand_regexp($1,$value,$global_opts);++$not_want->{$_->[0]}for@not}: ($name =~ m{\A\!(.+)\z})? (++$not_want->{$1}): ($name =~ m{\A[:-](.+)\z})? push(@$opts,$class->_exporter_expand_tag($1,$value,$global_opts)): ($name =~ m{\A/.+/[msixpodual]+\z})? push(@$opts,$class->_exporter_expand_regexp($name,$value,$global_opts)): push(@$want,$opt)}};sub import {my$class=shift;my$global_opts=+{@_ && ref($_[0])eq q(HASH) ? %{+shift}: ()};$global_opts->{into}=caller unless exists$global_opts->{into};my@want;my%not_want;$global_opts->{not}=\%not_want;my@args=do {no strict qw(refs);@_ ? @_ : @{"$class\::EXPORT"}};my$opts=mkopt(\@args);$class->$_process_optlist($global_opts,$opts,\@want,\%not_want);my$permitted=$class->_exporter_permitted_regexp($global_opts);$class->_exporter_validate_opts($global_opts);for my$wanted (@want){next if$not_want{$wanted->[0]};my%symbols=$class->_exporter_expand_sub(@$wanted,$global_opts,$permitted);$class->_exporter_install_sub($_,$wanted->[1],$global_opts,$symbols{$_})for keys%symbols}}sub unimport {my$class=shift;my$global_opts=+{@_ && ref($_[0])eq q(HASH) ? %{+shift}: ()};$global_opts->{into}=caller unless exists$global_opts->{into};$global_opts->{is_unimport}=1;my@want;my%not_want;$global_opts->{not}=\%not_want;my@args=do {our%TRACKED;@_ ? @_ : keys(%{$TRACKED{$class}{$global_opts->{into}}})};my$opts=mkopt(\@args);$class->$_process_optlist($global_opts,$opts,\@want,\%not_want);my$permitted=$class->_exporter_permitted_regexp($global_opts);$class->_exporter_validate_unimport_opts($global_opts);my$expando=$class->can('_exporter_expand_sub');$expando=undef if$expando==\&_exporter_expand_sub;for my$wanted (@want){next if$not_want{$wanted->[0]};if ($wanted->[1]){_carp("Passing options to unimport '%s' makes no sense",$wanted->[0])unless (ref($wanted->[1])eq 'HASH' and not keys %{$wanted->[1]})}my%symbols=defined($expando)? $class->$expando(@$wanted,$global_opts,$permitted): ($wanted->[0]=>sub {"dummy"});$class->_exporter_uninstall_sub($_,$wanted->[1],$global_opts)for keys%symbols}}sub _exporter_validate_opts {1}sub _exporter_validate_unimport_opts {1}sub _exporter_merge_opts {my$class=shift;my ($tag_opts,$global_opts,@stuff)=@_;$tag_opts={}unless ref($tag_opts)eq q(HASH);_croak('Cannot provide an -as option for tags')if exists$tag_opts->{-as}&& ref$tag_opts->{-as}ne 'CODE';my$optlist=mkopt(\@stuff);for my$export (@$optlist){next if defined($export->[1])&& ref($export->[1])ne q(HASH);my%sub_opts=(%{$export->[1]or {}},%$tag_opts);$sub_opts{-prefix}=sprintf('%s%s',$tag_opts->{-prefix},$export->[1]{-prefix})if exists($export->[1]{-prefix})&& exists($tag_opts->{-prefix});$sub_opts{-suffix}=sprintf('%s%s',$export->[1]{-suffix},$tag_opts->{-suffix})if exists($export->[1]{-suffix})&& exists($tag_opts->{-suffix});$export->[1]=\%sub_opts}return @$optlist}sub _exporter_expand_tag {no strict qw(refs);my$class=shift;my ($name,$value,$globals)=@_;my$tags=\%{"$class\::EXPORT_TAGS"};return$class->_exporter_merge_opts($value,$globals,$tags->{$name}->($class,@_))if ref($tags->{$name})eq q(CODE);return$class->_exporter_merge_opts($value,$globals,@{$tags->{$name}})if exists$tags->{$name};return$class->_exporter_merge_opts($value,$globals,@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"})if$name eq 'all';return$class->_exporter_merge_opts($value,$globals,@{"$class\::EXPORT"})if$name eq 'default';$globals->{$name}=$value || 1;return}sub _exporter_expand_regexp {no strict qw(refs);our%TRACKED;my$class=shift;my ($name,$value,$globals)=@_;my$compiled=eval("qr$name");my@possible=$globals->{is_unimport}? keys(%{$TRACKED{$class}{$globals->{into}}}): @{"$class\::EXPORT_OK"};$class->_exporter_merge_opts($value,$globals,grep /$compiled/,@possible)}sub _exporter_permitted_regexp {no strict qw(refs);my$class=shift;my$re=join "|",map quotemeta,sort {length($b)<=> length($a)or $a cmp $b}@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"};qr{^(?:$re)$}ms}sub _exporter_expand_sub {my$class=shift;my ($name,$value,$globals,$permitted)=@_;$permitted ||= $class->_exporter_permitted_regexp($globals);no strict qw(refs);if ($name =~ $permitted){my$generator=$class->can("_generate_$name");return$name=>$class->$generator($name,$value,$globals)if$generator;my$sub=$class->can($name);return$name=>$sub if$sub}$class->_exporter_fail(@_)}sub _exporter_fail {my$class=shift;my ($name,$value,$globals)=@_;return if$globals->{is_unimport};_croak("Could not find sub '%s' exported by %s",$name,$class)}sub _exporter_install_sub {my$class=shift;my ($name,$value,$globals,$sym)=@_;my$into=$globals->{into};my$installer=$globals->{installer}|| $globals->{exporter};$name=ref$globals->{as}? $globals->{as}->($name): ref$value->{-as}? $value->{-as}->($name): exists$value->{-as}? $value->{-as}: $name;return unless defined$name;unless (ref($name)){my ($prefix)=grep defined,$value->{-prefix},$globals->{prefix},q();my ($suffix)=grep defined,$value->{-suffix},$globals->{suffix},q();$name="$prefix$name$suffix"}return ($$name=$sym)if ref($name)eq q(SCALAR);return ($into->{$name}=$sym)if ref($into)eq q(HASH);no strict qw(refs);if (exists &{"$into\::$name"}and \&{"$into\::$name"}!=$sym){my ($level)=grep defined,$value->{-replace},$globals->{replace},q(0);my$action={carp=>\&_carp,0=>\&_carp,''=>\&_carp,warn=>\&_carp,nonfatal=>\&_carp,croak=>\&_croak,fatal=>\&_croak,die=>\&_croak,}->{$level}|| sub {};$action->($action==\&_croak ? "Refusing to overwrite existing sub '%s::%s' with sub '%s' exported by %s" : "Overwriting existing sub '%s::%s' with sub '%s' exported by %s",$into,$name,$_[0],$class,)}our%TRACKED;$TRACKED{$class}{$into}{$name}=$sym;no warnings qw(prototype);$installer ? $installer->($globals,[$name,$sym]): (*{"$into\::$name"}=$sym)}sub _exporter_uninstall_sub {our%TRACKED;my$class=shift;my ($name,$value,$globals,$sym)=@_;my$into=$globals->{into};ref$into and return;no strict qw(refs);my$our_coderef=$TRACKED{$class}{$into}{$name};my$cur_coderef=exists(&{"$into\::$name"})? \&{"$into\::$name"}: -1;return unless$our_coderef==$cur_coderef;my$stash=\%{"$into\::"};my$old=delete$stash->{$name};my$full_name=join('::',$into,$name);for my$type (qw(SCALAR HASH ARRAY IO)){next unless defined(*{$old}{$type});*$full_name=*{$old}{$type}}delete$TRACKED{$class}{$into}{$name}}sub mkopt {my$in=shift or return [];my@out;$in=[map(($_=>ref($in->{$_})? $in->{$_}: ()),sort keys %$in)]if ref($in)eq q(HASH);for (my$i=0;$i < @$in;$i++){my$k=$in->[$i];my$v;($i==$#$in)? ($v=undef): !defined($in->[$i+1])? (++$i,($v=undef)): !ref($in->[$i+1])? ($v=undef): ($v=$in->[++$i]);push@out,[$k=>$v ]}\@out}sub mkopt_hash {my$in=shift or return;my%out=map +($_->[0]=>$_->[1]),@{mkopt($in)};\%out}1; +EXPORTER_TINY + +$fatpacked{"ExtUtils/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_CONFIG'; + package ExtUtils::Config;$ExtUtils::Config::VERSION='0.008';use strict;use warnings;use Config;use Data::Dumper ();sub new {my ($pack,$args)=@_;return bless {values=>($args ? {%$args }: {}),},$pack}sub get {my ($self,$key)=@_;return exists$self->{values}{$key}? $self->{values}{$key}: $Config{$key}}sub exists {my ($self,$key)=@_;return exists$self->{values}{$key}|| exists$Config{$key}}sub values_set {my$self=shift;return {%{$self->{values}}}}sub all_config {my$self=shift;return {%Config,%{$self->{values}}}}sub serialize {my$self=shift;return$self->{serialized}||= Data::Dumper->new([$self->values_set])->Terse(1)->Sortkeys(1)->Dump}1; +EXTUTILS_CONFIG + +$fatpacked{"ExtUtils/Helpers.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS'; + package ExtUtils::Helpers;$ExtUtils::Helpers::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';use Config;use File::Basename qw/basename/;use File::Spec::Functions qw/splitpath canonpath abs2rel splitdir/;use Text::ParseWords 3.24 ();our@EXPORT_OK=qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;BEGIN {my%impl_for=(MSWin32=>'Windows',VMS=>'VMS');my$package='ExtUtils::Helpers::' .($impl_for{$^O}|| 'Unix');my$impl=$impl_for{$^O}|| 'Unix';require "ExtUtils/Helpers/$impl.pm";"ExtUtils::Helpers::$impl"->import()}sub split_like_shell {my ($string)=@_;return if not defined$string;$string =~ s/^\s+|\s+$//g;return if not length$string;return Text::ParseWords::shellwords($string)}sub man1_pagename {my$filename=shift;return basename($filename).".$Config{man1ext}"}my%separator=(MSWin32=>'.',VMS=>'__',os2=>'.',cygwin=>'.',);my$separator=$separator{$^O}|| '::';sub man3_pagename {my ($filename,$base)=@_;$base ||= 'lib';my ($vols,$dirs,$file)=splitpath(canonpath(abs2rel($filename,$base)));$file=basename($file,qw/.pm .pod/);my@dirs=grep {length}splitdir($dirs);return join$separator,@dirs,"$file.$Config{man3ext}"}1; +EXTUTILS_HELPERS + +$fatpacked{"ExtUtils/Helpers/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_UNIX'; + package ExtUtils::Helpers::Unix;$ExtUtils::Helpers::Unix::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use Carp qw/croak/;use Config;my$layer=$] >= 5.008001 ? ":raw" : "";sub make_executable {my$filename=shift;my$current_mode=(stat$filename)[2]+ 0;if (-T $filename){open my$fh,"<$layer",$filename;my@lines=<$fh>;if (@lines and $lines[0]=~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms){open my$out,">$layer","$filename.new" or croak "Couldn't open $filename.new: $!";print$out @lines;close$out;rename$filename,"$filename.bak" or croak "Couldn't rename $filename to $filename.bak";rename "$filename.new",$filename or croak "Couldn't rename $filename.new to $filename";unlink "$filename.bak"}}chmod$current_mode | oct(111),$filename;return}sub detildefy {my$value=shift;for ($value){s{ ^ ~ (?= /|$)} [ $ENV{HOME} || (getpwuid $>)[7] ]ex or s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex}return$value}1; +EXTUTILS_HELPERS_UNIX + +$fatpacked{"ExtUtils/Helpers/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_VMS'; + package ExtUtils::Helpers::VMS;$ExtUtils::Helpers::VMS::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use File::Copy qw/copy/;sub make_executable {my$filename=shift;my$batchname="$filename.com";copy($filename,$batchname);ExtUtils::Helpers::Unix::make_executable($batchname);return}sub detildefy {my$arg=shift;return$arg if ($arg =~ /^~~/);return$arg if ($arg =~ /^~ /);if ($arg =~ /^~/){my$spec=$arg;$spec =~ s/^~//;$spec =~ s#^/##;my$home=VMS::Filespec::unixify($ENV{HOME});$home .= '/' unless$home =~ m#/$#;if ($spec eq ''){$home =~ s#/$##;return$home}my ($hvol,$hdir,$hfile)=File::Spec::Unix->splitpath($home);if ($hdir eq ''){$hdir=$hfile}my ($vol,$dir,$file)=File::Spec::Unix->splitpath($spec);my@hdirs=File::Spec::Unix->splitdir($hdir);my@dirs=File::Spec::Unix->splitdir($dir);unless ($arg =~ m#^~/#){shift@dirs}my$newdirs=File::Spec::Unix->catdir(@hdirs,@dirs);$arg=File::Spec::Unix->catpath($hvol,$newdirs,$file)}return$arg} +EXTUTILS_HELPERS_VMS + +$fatpacked{"ExtUtils/Helpers/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_WINDOWS'; + package ExtUtils::Helpers::Windows;$ExtUtils::Helpers::Windows::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use Config;use Carp qw/carp croak/;use ExtUtils::PL2Bat 'pl2bat';sub make_executable {my$script=shift;if (-T $script && $script !~ / \. (?:bat|cmd) $ /x){pl2bat(in=>$script,update=>1)}return}sub detildefy {my$value=shift;$value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if$ENV{USERPROFILE};return$value}1; +EXTUTILS_HELPERS_WINDOWS + +$fatpacked{"ExtUtils/InstallPaths.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLPATHS'; + package ExtUtils::InstallPaths;$ExtUtils::InstallPaths::VERSION='0.011';use 5.006;use strict;use warnings;use File::Spec ();use Carp ();use ExtUtils::Config 0.002;my%complex_accessors=map {$_=>1}qw/prefix_relpaths install_sets/;my%hash_accessors=map {$_=>1}qw/install_path install_base_relpaths original_prefix/;my%defaults=(installdirs=>'site',install_base=>undef,prefix=>undef,verbose=>0,blib=>'blib',create_packlist=>1,dist_name=>undef,module_name=>undef,destdir=>undef,install_path=>sub {{}},install_sets=>\&_default_install_sets,original_prefix=>\&_default_original_prefix,install_base_relpaths=>\&_default_base_relpaths,prefix_relpaths=>\&_default_prefix_relpaths,);sub _merge_shallow {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);$filter->($_)for grep$filter,values %$override;return {%$defaults,%$override }}}sub _merge_deep {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);my$pair_for=sub {my$key=shift;my%override=%{$override->{$key}|| {}};$filter && $filter->($_)for values%override;return$key=>{%{$defaults->{$key}},%override }};return {map {$pair_for->($_)}keys %$defaults }}}my%allowed_installdir=map {$_=>1}qw/core site vendor/;my$must_be_relative=sub {Carp::croak('Value must be a relative path')if File::Spec->file_name_is_absolute($_[0])};my%deep_filter=map {$_=>$must_be_relative}qw/install_base_relpaths prefix_relpaths/;my%filter=(installdirs=>sub {my$value=shift;$value='core',Carp::carp('Perhaps you meant installdirs to be "core" rather than "perl"?')if$value eq 'perl';Carp::croak('installdirs must be one of "core", "site", or "vendor"')if not $allowed_installdir{$value};return$value},(map {$_=>_merge_shallow($_,$deep_filter{$_})}qw/original_prefix install_base_relpaths/),(map {$_=>_merge_deep($_,$deep_filter{$_})}qw/install_sets prefix_relpaths/),);sub new {my ($class,%args)=@_;my$config=$args{config}|| ExtUtils::Config->new;my%self=(config=>$config,map {$_=>exists$args{$_}? $filter{$_}? $filter{$_}->($args{$_},$config): $args{$_}: ref$defaults{$_}? $defaults{$_}->($config): $defaults{$_}}keys%defaults,);$self{module_name}||= do {my$module_name=$self{dist_name};$module_name =~ s/-/::/g;$module_name}if defined$self{dist_name};return bless \%self,$class}for my$attribute (keys%defaults){no strict qw/refs/;*{$attribute}=$hash_accessors{$attribute}? sub {my ($self,$key)=@_;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$key}}: $complex_accessors{$attribute}? sub {my ($self,$installdirs,$key)=@_;Carp::confess("$attribute needs installdir")if not defined$installdirs;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$installdirs}{$key}}: sub {my$self=shift;return$self->{$attribute}}}my$script=$] > 5.008000 ? 'script' : 'bin';my@install_sets_keys=qw/lib arch bin script bindoc libdoc binhtml libhtml/;my@install_sets_tail=('bin',$script,qw/man1dir man3dir html1dir html3dir/);my%install_sets_values=(core=>[qw/privlib archlib/,@install_sets_tail ],site=>[map {"site$_"}qw/lib arch/,@install_sets_tail ],vendor=>[map {"vendor$_"}qw/lib arch/,@install_sets_tail ],);sub _default_install_sets {my$c=shift;my%ret;for my$installdir (qw/core site vendor/){@{$ret{$installdir}}{@install_sets_keys}=map {$c->get("install$_")}@{$install_sets_values{$installdir}}}return \%ret}sub _default_base_relpaths {my$config=shift;return {lib=>['lib','perl5'],arch=>['lib','perl5',$config->get('archname')],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],}}my%common_prefix_relpaths=(bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],);sub _default_prefix_relpaths {my$c=shift;my@libstyle=$c->get('installstyle')? File::Spec->splitdir($c->get('installstyle')): qw(lib perl5);my$arch=$c->get('archname');my$version=$c->get('version');return {core=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},vendor=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},site=>{lib=>[@libstyle,'site_perl'],arch=>[@libstyle,'site_perl',$version,$arch],%common_prefix_relpaths,},}}sub _default_original_prefix {my$c=shift;my%ret=(core=>$c->get('installprefixexp'),site=>$c->get('siteprefixexp'),vendor=>$c->get('usevendorprefix')? $c->get('vendorprefixexp'): '',);return \%ret}sub _log_verbose {my$self=shift;print @_ if$self->verbose;return}sub is_default_installable {my$self=shift;my$type=shift;my$installable=$self->install_destination($type)&& ($self->install_path($type)|| $self->install_sets($self->installdirs,$type));return$installable ? 1 : 0}sub _prefixify_default {my$self=shift;my$type=shift;my$rprefix=shift;my$default=$self->prefix_relpaths($self->installdirs,$type);if(!$default){$self->_log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n");return$rprefix}else {return File::Spec->catdir(@{$default})}}sub _prefixify_novms {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;$rprefix .= '/' if$sprefix =~ m{/$};$self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n")if defined$path && length$path;if (not defined$path or length$path==0){$self->_log_verbose(" no path to prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}elsif(!File::Spec->file_name_is_absolute($path)){$self->_log_verbose(" path is relative, not prefixifying.\n")}elsif($path !~ s{^\Q$sprefix\E\b}{}s){$self->_log_verbose(" cannot prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}$self->_log_verbose(" now $path in $rprefix\n");return$path}sub _catprefix_vms {my ($self,$rprefix,$default)=@_;my ($rvol,$rdirs)=File::Spec->splitpath($rprefix);if ($rvol){return File::Spec->catpath($rvol,File::Spec->catdir($rdirs,$default),'')}else {return File::Spec->catdir($rdirs,$default)}}sub _prefixify_vms {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;return '' unless defined$path;$self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n");require VMS::Filespec;$rprefix=VMS::Filespec::vmspath($rprefix)if$rprefix;$sprefix=VMS::Filespec::vmspath($sprefix)if$sprefix;$self->_log_verbose(" rprefix translated to $rprefix\n sprefix translated to $sprefix\n");if (length($path)==0){$self->_log_verbose(" no path to prefixify.\n")}elsif (!File::Spec->file_name_is_absolute($path)){$self->_log_verbose(" path is relative, not prefixifying.\n")}elsif ($sprefix eq $rprefix){$self->_log_verbose(" no new prefix.\n")}else {my ($path_vol,$path_dirs)=File::Spec->splitpath($path);my$vms_prefix=$self->config->get('vms_prefix');if ($path_vol eq $vms_prefix.':'){$self->_log_verbose(" $vms_prefix: seen\n");$path_dirs =~ s{^\[}{\[.} unless$path_dirs =~ m{^\[\.};$path=$self->_catprefix_vms($rprefix,$path_dirs)}else {$self->_log_verbose(" cannot prefixify.\n");return File::Spec->catdir($self->prefix_relpaths($self->installdirs,$type))}}$self->_log_verbose(" now $path\n");return$path}BEGIN {*_prefixify=$^O eq 'VMS' ? \&_prefixify_vms : \&_prefixify_novms}sub prefix_relative {my ($self,$installdirs,$type)=@_;my$relpath=$self->install_sets($installdirs,$type);return$self->_prefixify($relpath,$self->original_prefix($installdirs),$type)}sub install_destination {my ($self,$type)=@_;return$self->install_path($type)if$self->install_path($type);if ($self->install_base){my$relpath=$self->install_base_relpaths($type);return$relpath ? File::Spec->catdir($self->install_base,@{$relpath}): undef}if ($self->prefix){my$relpath=$self->prefix_relative($self->installdirs,$type);return$relpath ? File::Spec->catdir($self->prefix,$relpath): undef}return$self->install_sets($self->installdirs,$type)}sub install_types {my$self=shift;my%types=(%{$self->{install_path}},$self->install_base ? %{$self->{install_base_relpaths}}: $self->prefix ? %{$self->{prefix_relpaths}{$self->installdirs }}: %{$self->{install_sets}{$self->installdirs }});return sort keys%types}sub install_map {my ($self,$blib)=@_;$blib ||= $self->blib;my (%map,@skipping);for my$type ($self->install_types){my$localdir=File::Spec->catdir($blib,$type);next unless -e $localdir;if (my$dest=$self->install_destination($type)){$map{$localdir}=$dest}else {push@skipping,$type}}warn "WARNING: Can't figure out install path for types: @skipping\nFiles will not be installed.\n" if@skipping;if ($self->create_packlist and my$module_name=$self->module_name){my$archdir=$self->install_destination('arch');my@ext=split /::/,$module_name;$map{write}=File::Spec->catfile($archdir,'auto',@ext,'.packlist')}if (length(my$destdir=$self->destdir || '')){for (keys%map){my ($volume,$path,$file)=File::Spec->splitpath($map{$_},0);my@dirs=File::Spec->splitdir($path);$path=File::Spec->catdir($destdir,@dirs);if ($file ne ''){$map{$_}=File::Spec->catfile($path,$file)}else {$map{$_}=$path}}}$map{read}='';return \%map}1; +EXTUTILS_INSTALLPATHS + +$fatpacked{"File/Slurp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_SLURP'; + package File::Slurp;use 5.6.2 ;use strict;use warnings ;use Carp ;use Exporter ;use Fcntl qw(:DEFAULT) ;use POSIX qw(:fcntl_h) ;use Errno ;use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION) ;@ISA=qw(Exporter) ;$VERSION='9999.19';my@std_export=qw(read_file write_file overwrite_file append_file read_dir) ;my@edit_export=qw(edit_file edit_file_lines) ;my@ok_export=qw() ;@EXPORT_OK=(@edit_export,qw(slurp prepend_file),);%EXPORT_TAGS=('all'=>[@std_export,@edit_export,@EXPORT_OK ],'edit'=>[@edit_export ],'std'=>[@std_export ],);@EXPORT=@std_export ;my$max_fast_slurp_size=1024 * 100 ;my$is_win32=$^O =~ /win32/i ;BEGIN {unless(defined&SEEK_SET){*SEEK_SET=sub {0};*SEEK_CUR=sub {1};*SEEK_END=sub {2}}unless(defined&O_BINARY){*O_BINARY=sub {0};*O_RDONLY=sub {0};*O_WRONLY=sub {1}}unless (defined&O_APPEND){if ($^O =~ /olaris/){*O_APPEND=sub {8};*O_CREAT=sub {256};*O_EXCL=sub {1024}}elsif ($^O =~ /inux/){*O_APPEND=sub {1024};*O_CREAT=sub {64};*O_EXCL=sub {128}}elsif ($^O =~ /BSD/i){*O_APPEND=sub {8};*O_CREAT=sub {512};*O_EXCL=sub {2048}}}}*slurp=\&read_file ;sub read_file {my$file_name=shift ;my$opts=(ref $_[0]eq 'HASH')? shift : {@_};if (!ref$file_name && -e $file_name && -s _ > 0 && -s _ < $max_fast_slurp_size &&!%{$opts}&&!wantarray){my$fh ;unless(sysopen($fh,$file_name,O_RDONLY)){@_=($opts,"read_file '$file_name' - sysopen: $!");goto&_error }my$read_cnt=sysread($fh,my$buf,-s _);unless (defined$read_cnt){@_=($opts,"read_file '$file_name' - small sysread: $!");goto&_error }$buf =~ s/\015\012/\n/g if$is_win32 ;return$buf }my$buf ;my$buf_ref=$opts->{'buf_ref'}|| \$buf ;${$buf_ref}='' ;my($read_fh,$size_left,$blk_size);if (ref$file_name){my$ref_result=_check_ref($file_name);if (ref$ref_result){@_=($opts,$ref_result);goto&_error }if ($ref_result){$file_name=$ref_result }else {$read_fh=$file_name ;$blk_size=$opts->{'blk_size'}|| 1024 * 1024 ;$size_left=$blk_size }}unless ($read_fh){my$mode=O_RDONLY ;$read_fh=local(*FH);unless (sysopen($read_fh,$file_name,$mode)){@_=($opts,"read_file '$file_name' - sysopen: $!");goto&_error }if (my$binmode=$opts->{'binmode'}){binmode($read_fh,$binmode)}$size_left=-s $read_fh ;unless($size_left){$blk_size=$opts->{'blk_size'}|| 1024 * 1024 ;$size_left=$blk_size }}while(1){my$read_cnt=sysread($read_fh,${$buf_ref},$size_left,length ${$buf_ref});next if $!{EINTR};unless (defined$read_cnt){@_=($opts,"read_file '$file_name' - loop sysread: $!");goto&_error }last if$read_cnt==0 ;next if$blk_size ;$size_left -= $read_cnt ;last if$size_left <= 0 }${$buf_ref}=~ s/\015\012/\n/g if$is_win32 &&!$opts->{'binmode'};my$sep=$/ ;$sep='\n\n+' if defined$sep && $sep eq '' ;if(wantarray || $opts->{'array_ref'}){use re 'taint' ;my@lines=length(${$buf_ref})? ${$buf_ref}=~ /(.*?$sep|.+)/sg : ();chomp@lines if$opts->{'chomp'};return \@lines if$opts->{'array_ref'};return@lines }return$buf_ref if$opts->{'scalar_ref'};return ${$buf_ref}if defined wantarray ;return }sub _check_ref {my($handle)=@_ ;if (eval {$handle->isa('GLOB')|| $handle->isa('IO')}){my$err=_seek_data_handle($handle);return \$err if$err ;return }eval {require overload};return \"Bad handle '$handle' is not a GLOB or IO object or overloaded" if $@ ||!overload::Overloaded($handle);return "$handle" }sub _seek_data_handle {my($handle)=@_ ;eval{require B};if ($@){return <IO->IoFLAGS & 16){unless(sysseek($handle,tell($handle),SEEK_SET)){return "read_file '$handle' - sysseek: $!" }}return }sub write_file {my$file_name=shift ;my$opts=(ref $_[0]eq 'HASH')? shift : {};my($buf_ref,$write_fh,$no_truncate,$orig_file_name,$data_is_ref);if (ref$opts->{'buf_ref'}eq 'SCALAR'){$buf_ref=$opts->{'buf_ref'};$data_is_ref=1 }elsif (ref $_[0]eq 'SCALAR'){$buf_ref=shift ;$data_is_ref=1 }elsif (ref $_[0]eq 'ARRAY'){${$buf_ref}=join '',@{$_[0]}}else {${$buf_ref}=join '',@_ }if (ref$file_name){my$ref_result=_check_ref($file_name);if (ref$ref_result){@_=($opts,$ref_result);goto&_error }if ($ref_result){$file_name=$ref_result }else {$write_fh=$file_name ;$no_truncate=1 }}unless($write_fh){if ($opts->{'atomic'}){$orig_file_name=$file_name ;$file_name .= ".$$" }my$mode=O_WRONLY | O_CREAT ;$mode |= O_APPEND if$opts->{'append'};$mode |= O_EXCL if$opts->{'no_clobber'};my$perms=$opts->{perms};$perms=0666 unless defined$perms ;$write_fh=local(*FH);unless (sysopen($write_fh,$file_name,$mode,$perms)){@_=($opts,"write_file '$file_name' - sysopen: $!");goto&_error }}if (my$binmode=$opts->{'binmode'}){binmode($write_fh,$binmode)}sysseek($write_fh,0,SEEK_END)if$opts->{'append'};if ($is_win32 &&!$opts->{'binmode'}){$buf_ref=\do{my$copy=${$buf_ref}}if$data_is_ref ;${$buf_ref}=~ s/\n/\015\012/g }my$size_left=length(${$buf_ref});my$offset=0 ;do {my$write_cnt=syswrite($write_fh,${$buf_ref},$size_left,$offset);next if $!{EINTR};unless (defined$write_cnt){@_=($opts,"write_file '$file_name' - syswrite: $!");goto&_error }$size_left -= $write_cnt ;$offset += $write_cnt }while($size_left > 0);truncate($write_fh,sysseek($write_fh,0,SEEK_CUR))unless$no_truncate ;close($write_fh);if ($opts->{'atomic'}&&!rename($file_name,$orig_file_name)){@_=($opts,"write_file '$file_name' - rename: $!");goto&_error }return 1 }*overwrite_file=\&write_file ;sub append_file {my$opts=$_[1];if (ref$opts eq 'HASH'){$opts->{append}=1 }else {splice(@_,1,0,{append=>1 })}goto&write_file}sub prepend_file {my$file_name=shift ;my$opts=(ref $_[0]eq 'HASH')? shift : {};my@bad_opts=grep $_ ne 'err_mode' && $_ ne 'binmode',keys %{$opts};delete @{$opts}{@bad_opts};my$prepend_data=shift ;$prepend_data='' unless defined$prepend_data ;$prepend_data=${$prepend_data}if ref$prepend_data eq 'SCALAR' ;my$err_mode=delete$opts->{err_mode};$opts->{err_mode }='croak' ;$opts->{scalar_ref }=1 ;my$existing_data=eval {read_file($file_name,$opts)};if ($@){@_=({err_mode=>$err_mode },"prepend_file '$file_name' - read_file: $!");goto&_error }$opts->{atomic}=1 ;my$write_result=eval {write_file($file_name,$opts,$prepend_data,$$existing_data)};if ($@){@_=({err_mode=>$err_mode },"prepend_file '$file_name' - write_file: $!");goto&_error }return$write_result }sub edit_file(&$;$) {my($edit_code,$file_name,$opts)=@_ ;$opts={}unless ref$opts eq 'HASH' ;my@bad_opts=grep $_ ne 'err_mode' && $_ ne 'binmode',keys %{$opts};delete @{$opts}{@bad_opts};my$err_mode=delete$opts->{err_mode};$opts->{err_mode }='croak' ;$opts->{scalar_ref }=1 ;my$existing_data=eval {read_file($file_name,$opts)};if ($@){@_=({err_mode=>$err_mode },"edit_file '$file_name' - read_file: $!");goto&_error }my($edited_data)=map {$edit_code->();$_}$$existing_data ;$opts->{atomic}=1 ;my$write_result=eval {write_file($file_name,$opts,$edited_data)};if ($@){@_=({err_mode=>$err_mode },"edit_file '$file_name' - write_file: $!");goto&_error }return$write_result }sub edit_file_lines(&$;$) {my($edit_code,$file_name,$opts)=@_ ;$opts={}unless ref$opts eq 'HASH' ;my@bad_opts=grep $_ ne 'err_mode' && $_ ne 'binmode',keys %{$opts};delete @{$opts}{@bad_opts};my$err_mode=delete$opts->{err_mode};$opts->{err_mode }='croak' ;$opts->{array_ref }=1 ;my$existing_data=eval {read_file($file_name,$opts)};if ($@){@_=({err_mode=>$err_mode },"edit_file_lines '$file_name' - read_file: $!");goto&_error }my@edited_data=map {$edit_code->();$_}@$existing_data ;$opts->{atomic}=1 ;my$write_result=eval {write_file($file_name,$opts,@edited_data)};if ($@){@_=({err_mode=>$err_mode },"edit_file_lines '$file_name' - write_file: $!");goto&_error }return$write_result }sub read_dir {my$dir=shift ;my$opts=(ref $_[0]eq 'HASH')? shift : {@_};local(*DIRH);unless (opendir(DIRH,$dir)){@_=($opts,"read_dir '$dir' - opendir: $!");goto&_error }my@dir_entries=readdir(DIRH);@dir_entries=grep($_ ne "." && $_ ne "..",@dir_entries)unless$opts->{'keep_dot_dot'};if ($opts->{'prefix'}){substr($_,0,0,"$dir/")for@dir_entries }return@dir_entries if wantarray ;return \@dir_entries }my%err_func=('carp'=>\&carp,'croak'=>\&croak,);sub _error {my($opts,$err_msg)=@_ ;my$func=$err_func{$opts->{'err_mode'}|| 'croak' };return unless$func ;$func->($err_msg)if$func ;return undef }1; + Can't find B.pm with this Perl: $!. + That module is needed to properly slurp the DATA handle. + ERR +FILE_SLURP + +$fatpacked{"File/chdir.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_CHDIR'; + package File::chdir;use 5.004;use strict;use vars qw($VERSION @ISA @EXPORT $CWD @CWD);our$VERSION='0.1010';require Exporter;@ISA=qw(Exporter);@EXPORT=qw(*CWD);use Carp;use Cwd 3.16;use File::Spec::Functions 3.27 qw/canonpath splitpath catpath splitdir catdir/;tie$CWD,'File::chdir::SCALAR' or die "Can't tie \$CWD";tie@CWD,'File::chdir::ARRAY' or die "Can't tie \@CWD";sub _abs_path {my($cwd)=Cwd::getcwd =~ /(.*)/s;return canonpath($cwd)}sub _split_cwd {my ($vol,$dir)=splitpath(_abs_path,1);my@dirs=splitdir($dir);shift@dirs;return ($vol,@dirs)}sub _catpath {my ($vol,@dirs)=@_;return catpath($vol,catdir(q{},@dirs),q{})}sub _chdir {my ($new_dir)=$_[0]=~ /(.*)/s;local$Carp::CarpLevel=$Carp::CarpLevel + 1;if (!CORE::chdir($new_dir)){croak "Failed to change directory to '$new_dir': $!"};return 1}{package File::chdir::SCALAR;use Carp;BEGIN {*_abs_path=\&File::chdir::_abs_path;*_chdir=\&File::chdir::_chdir;*_split_cwd=\&File::chdir::_split_cwd;*_catpath=\&File::chdir::_catpath}sub TIESCALAR {bless [],$_[0]}sub FETCH {return _abs_path}sub STORE {return unless defined $_[1];_chdir($_[1])}}{package File::chdir::ARRAY;use Carp;BEGIN {*_abs_path=\&File::chdir::_abs_path;*_chdir=\&File::chdir::_chdir;*_split_cwd=\&File::chdir::_split_cwd;*_catpath=\&File::chdir::_catpath}sub TIEARRAY {bless {},$_[0]}sub FETCH {my($self,$idx)=@_;my ($vol,@cwd)=_split_cwd;return$cwd[$idx]}sub STORE {my($self,$idx,$val)=@_;my ($vol,@cwd)=_split_cwd;if($self->{Cleared}){@cwd=();$self->{Cleared}=0}$cwd[$idx]=$val;my$dir=_catpath($vol,@cwd);_chdir($dir);return$cwd[$idx]}sub FETCHSIZE {my ($vol,@cwd)=_split_cwd;return scalar@cwd}sub STORESIZE {}sub PUSH {my($self)=shift;my$dir=_catpath(_split_cwd,@_);_chdir($dir);return$self->FETCHSIZE}sub POP {my($self)=shift;my ($vol,@cwd)=_split_cwd;my$popped=pop@cwd;my$dir=_catpath($vol,@cwd);_chdir($dir);return$popped}sub SHIFT {my($self)=shift;my ($vol,@cwd)=_split_cwd;my$shifted=shift@cwd;my$dir=_catpath($vol,@cwd);_chdir($dir);return$shifted}sub UNSHIFT {my($self)=shift;my ($vol,@cwd)=_split_cwd;my$dir=_catpath($vol,@_,@cwd);_chdir($dir);return$self->FETCHSIZE}sub CLEAR {my($self)=shift;$self->{Cleared}=1}sub SPLICE {my$self=shift;my$offset=shift || 0;my$len=shift || $self->FETCHSIZE - $offset;my@new_dirs=@_;my ($vol,@cwd)=_split_cwd;my@orig_dirs=splice@cwd,$offset,$len,@new_dirs;my$dir=_catpath($vol,@cwd);_chdir($dir);return@orig_dirs}sub EXTEND {}sub EXISTS {my($self,$idx)=@_;return$self->FETCHSIZE >= $idx ? 1 : 0}sub DELETE {my($self,$idx)=@_;croak "Can't delete except at the end of \@CWD" if$idx < $self->FETCHSIZE - 1;local$Carp::CarpLevel=$Carp::CarpLevel + 1;$self->POP}}1; +FILE_CHDIR + +$fatpacked{"List/MoreUtils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS'; + package List::MoreUtils;use 5.008_001;use strict;use warnings;my$have_xs;our$VERSION='0.428';BEGIN {unless (defined($have_xs)){eval {require List::MoreUtils::XS}unless$ENV{LIST_MOREUTILS_PP};die $@ if $@ && defined$ENV{LIST_MOREUTILS_PP}&& $ENV{LIST_MOREUTILS_PP}==0;$have_xs=0+defined($INC{'List/MoreUtils/XS.pm'})}use List::MoreUtils::PP qw()}use Exporter::Tiny qw();my@junctions=qw(any all none notall);my@v0_22=qw(true false firstidx lastidx insert_after insert_after_string apply indexes after after_incl before before_incl firstval lastval each_array each_arrayref pairwise natatime mesh uniq minmax part _XScompiled);my@v0_24=qw(bsearch);my@v0_33=qw(sort_by nsort_by);my@v0_400=qw(one any_u all_u none_u notall_u one_u firstres onlyidx onlyval onlyres lastres singleton bsearchidx);my@v0_420=qw(arrayify duplicates minmaxstr samples zip6 reduce_0 reduce_1 reduce_u listcmp frequency occurrences mode binsert bremove equal_range lower_bound upper_bound qsort);my@all_functions=(@junctions,@v0_22,@v0_24,@v0_33,@v0_400,@v0_420);no strict "refs";if ($have_xs){my$x;for (@all_functions){List::MoreUtils->can($_)or *$_=$x if ($x=List::MoreUtils::XS->can($_))}}List::MoreUtils->can($_)or *$_=List::MoreUtils::PP->can($_)for (@all_functions);use strict;my%alias_list=(v0_22=>{first_index=>"firstidx",last_index=>"lastidx",first_value=>"firstval",last_value=>"lastval",zip=>"mesh",},v0_33=>{distinct=>"uniq",},v0_400=>{first_result=>"firstres",only_index=>"onlyidx",only_value=>"onlyval",only_result=>"onlyres",last_result=>"lastres",bsearch_index=>"bsearchidx",},v0_420=>{bsearch_insert=>"binsert",bsearch_remove=>"bremove",zip_unflatten=>"zip6",},);our@ISA=qw(Exporter::Tiny);our@EXPORT_OK=(@all_functions,map {keys %$_}values%alias_list);our%EXPORT_TAGS=(all=>\@EXPORT_OK,'like_0.22'=>[any_u=>{-as=>'any'},all_u=>{-as=>'all'},none_u=>{-as=>'none'},notall_u=>{-as=>'notall'},@v0_22,keys %{$alias_list{v0_22}},],'like_0.24'=>[any_u=>{-as=>'any'},all_u=>{-as=>'all'},notall_u=>{-as=>'notall'},'none',@v0_22,@v0_24,keys %{$alias_list{v0_22}},],'like_0.33'=>[@junctions,@v0_22,@v0_33,keys %{$alias_list{v0_22}},keys %{$alias_list{v0_33}},],);for my$set (values%alias_list){for my$alias (keys %$set){no strict qw(refs);*$alias=__PACKAGE__->can($set->{$alias})}}1; +LIST_MOREUTILS + +$fatpacked{"List/MoreUtils/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS_PP'; + package List::MoreUtils::PP;use 5.008_001;use strict;use warnings;our$VERSION='0.428';sub any (&@) {my$f=shift;for (@_){return 1 if$f->()}return 0}sub all (&@) {my$f=shift;for (@_){return 0 unless$f->()}return 1}sub none (&@) {my$f=shift;for (@_){return 0 if$f->()}return 1}sub notall (&@) {my$f=shift;for (@_){return 1 unless$f->()}return 0}sub one (&@) {my$f=shift;my$found=0;for (@_){$f->()and $found++ and return 0}$found}sub any_u (&@) {my$f=shift;return if!@_;$f->()and return 1 foreach (@_);return 0}sub all_u (&@) {my$f=shift;return if!@_;$f->()or return 0 foreach (@_);return 1}sub none_u (&@) {my$f=shift;return if!@_;$f->()and return 0 foreach (@_);return 1}sub notall_u (&@) {my$f=shift;return if!@_;$f->()or return 1 foreach (@_);return 0}sub one_u (&@) {my$f=shift;return if!@_;my$found=0;for (@_){$f->()and $found++ and return 0}$found}sub reduce_u(&@) {my$code=shift;my ($caller_a,$caller_b)=do {my$pkg=caller();no strict 'refs';\*{$pkg .'::a'},\*{$pkg .'::b'}};local (*$caller_a,*$caller_b);*$caller_a=\();for (0 .. $#_){*$caller_b=\$_[$_];*$caller_a=\($code->())}${*$caller_a}}sub reduce_0(&@) {my$code=shift;my ($caller_a,$caller_b)=do {my$pkg=caller();no strict 'refs';\*{$pkg .'::a'},\*{$pkg .'::b'}};local (*$caller_a,*$caller_b);*$caller_a=\0;for (0 .. $#_){*$caller_b=\$_[$_];*$caller_a=\($code->())}${*$caller_a}}sub reduce_1(&@) {my$code=shift;my ($caller_a,$caller_b)=do {my$pkg=caller();no strict 'refs';\*{$pkg .'::a'},\*{$pkg .'::b'}};local (*$caller_a,*$caller_b);*$caller_a=\1;for (0 .. $#_){*$caller_b=\$_[$_];*$caller_a=\($code->())}${*$caller_a}}sub true (&@) {my$f=shift;my$count=0;$f->()and ++$count foreach (@_);return$count}sub false (&@) {my$f=shift;my$count=0;$f->()or ++$count foreach (@_);return$count}sub firstidx (&@) {my$f=shift;for my$i (0 .. $#_){local*_=\$_[$i];return$i if$f->()}return -1}sub firstval (&@) {my$test=shift;for (@_){return $_ if$test->()}return undef}sub firstres (&@) {my$test=shift;for (@_){my$testval=$test->();$testval and return$testval}return undef}sub onlyidx (&@) {my$f=shift;my$found;for my$i (0 .. $#_){local*_=\$_[$i];$f->()or next;defined$found and return -1;$found=$i}return defined$found ? $found : -1}sub onlyval (&@) {my$test=shift;my$result=undef;my$found=0;for (@_){$test->()or next;$result=$_;$found++ and return undef}return$result}sub onlyres (&@) {my$test=shift;my$result=undef;my$found=0;for (@_){my$rv=$test->()or next;$result=$rv;$found++ and return undef}return$found ? $result : undef}sub lastidx (&@) {my$f=shift;for my$i (reverse 0 .. $#_){local*_=\$_[$i];return$i if$f->()}return -1}sub lastval (&@) {my$test=shift;my$ix;for ($ix=$#_;$ix >= 0;$ix--){local*_=\$_[$ix];my$testval=$test->();$_[$ix]=$_;return $_ if$testval}return undef}sub lastres (&@) {my$test=shift;my$ix;for ($ix=$#_;$ix >= 0;$ix--){local*_=\$_[$ix];my$testval=$test->();$_[$ix]=$_;return$testval if$testval}return undef}sub insert_after (&$\@) {my ($f,$val,$list)=@_;my$c=&firstidx($f,@$list);@$list=(@{$list}[0 .. $c],$val,@{$list}[$c + 1 .. $#$list],)and return 1 if$c!=-1;return 0}sub insert_after_string ($$\@) {my ($string,$val,$list)=@_;my$c=firstidx {defined $_ and $string eq $_}@$list;@$list=(@{$list}[0 .. $c],$val,@{$list}[$c + 1 .. $#$list],)and return 1 if$c!=-1;return 0}sub apply (&@) {my$action=shift;&$action foreach my@values=@_;wantarray ? @values : $values[-1]}sub after (&@) {my$test=shift;my$started;my$lag;grep$started ||= do {my$x=$lag;$lag=$test->();$x},@_}sub after_incl (&@) {my$test=shift;my$started;grep$started ||= $test->(),@_}sub before (&@) {my$test=shift;my$more=1;grep$more &&=!$test->(),@_}sub before_incl (&@) {my$test=shift;my$more=1;my$lag=1;grep$more &&= do {my$x=$lag;$lag=!$test->();$x},@_}sub indexes (&@) {my$test=shift;grep {local*_=\$_[$_];$test->()}0 .. $#_}sub pairwise (&\@\@) {my$op=shift;use vars qw{@A @B};local (*A,*B)=@_;my ($caller_a,$caller_b)=do {my$pkg=caller();no strict 'refs';\*{$pkg .'::a'},\*{$pkg .'::b'}};my$limit=$#A > $#B ? $#A : $#B;local (*$caller_a,*$caller_b);map {(*$caller_a,*$caller_b)=\($#A < $_ ? undef : $A[$_],$#B < $_ ? undef : $B[$_]);$op->()}0 .. $limit}sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {return each_arrayref(@_)}sub each_arrayref {my@list=@_;my$index=0;my$max=0;for (@list){unless (ref $_ eq 'ARRAY'){require Carp;Carp::croak("each_arrayref: argument is not an array reference\n")}$max=@$_ if @$_ > $max}return sub {if (@_){my$method=shift;unless ($method eq 'index'){require Carp;Carp::croak("each_array: unknown argument '$method' passed to iterator.")}return undef if$index==0 || $index > $max;return$index - 1}return if$index >= $max;my$i=$index++;return map $_->[$i],@list}}sub natatime ($@) {my$n=shift;my@list=@_;return sub {return splice@list,0,$n}}my$flatten;$flatten=sub {map {(ref $_ and ("ARRAY" eq ref $_ or overload::Method($_,'@{}')))? ($flatten->(@{$_})): ($_)}@_};sub arrayify {map {$flatten->($_)}@_}sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {my$max=-1;$max < $#$_ && ($max=$#$_)foreach @_;map {my$ix=$_;map $_->[$ix],@_}0 .. $max}sub zip6 (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {my$max=-1;$max < $#$_ && ($max=$#$_)foreach @_;map {my$ix=$_;[map $_->[$ix],@_]}0 .. $max}sub listcmp (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {my%ret;for (my$i=0;$i < scalar @_;++$i){my%seen;my$k;for my$w (grep {defined $_ and not $seen{$k=$_}++}@{$_[$i]}){$ret{$w}||= [];push @{$ret{$w}},$i}}%ret}sub uniq (@) {my%seen=();my$k;my$seen_undef;grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_}sub singleton (@) {my%seen=();my$k;my$seen_undef;grep {1==(defined $_ ? $seen{$k=$_}: $seen_undef)}grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_}sub duplicates (@) {my%seen=();my$k;my$seen_undef;grep {1 < (defined $_ ? $seen{$k=$_}: $seen_undef)}grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_}sub frequency (@) {my%seen=();my$k;my$seen_undef;my%h=map {defined $_ ? ($_=>$seen{$k=$_}): ()}grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_;wantarray or return (scalar keys%h)+ ($seen_undef ? 1 : 0);undef$k;(%h,$seen_undef ? (\$k=>$seen_undef): ())}sub occurrences (@) {my%seen=();my$k;my$seen_undef;my@ret;for my$l (map {$_}grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_){my$n=defined$l ? $seen{$l}: $seen_undef;defined$ret[$n]or $ret[$n]=[];push @{$ret[$n]},$l}@ret}sub mode (@) {my%seen=();my ($max,$k,$seen_undef)=(1);for (@_){defined $_ ? ($max < ++$seen{$k=$_}and ++$max): ($max < ++$seen_undef and ++$max)}wantarray or return$max;my@ret=($max);for my$l (grep {$seen{$_}==$max}keys%seen){push@ret,$l}$seen_undef and $seen_undef==$max and push@ret,undef;@ret}sub samples ($@) {my$n=shift;if ($n > @_){require Carp;Carp::croak(sprintf("Cannot get %d samples from %d elements",$n,scalar @_))}for (my$i=@_;@_ - $i > $n;){my$idx=@_ - $i;my$swp=$idx + int(rand(--$i));my$xchg=$_[$swp];$_[$swp]=$_[$idx];$_[$idx]=$xchg}return splice @_,0,$n}sub minmax (@) {return unless @_;my$min=my$max=$_[0];for (my$i=1;$i < @_;$i += 2){if ($_[$i - 1]<= $_[$i]){$min=$_[$i - 1]if$min > $_[$i - 1];$max=$_[$i]if$max < $_[$i]}else {$min=$_[$i]if$min > $_[$i];$max=$_[$i - 1]if$max < $_[$i - 1]}}if (@_ & 1){my$i=$#_;if ($_[$i - 1]<= $_[$i]){$min=$_[$i - 1]if$min > $_[$i - 1];$max=$_[$i]if$max < $_[$i]}else {$min=$_[$i]if$min > $_[$i];$max=$_[$i - 1]if$max < $_[$i - 1]}}return ($min,$max)}sub minmaxstr (@) {return unless @_;my$min=my$max=$_[0];for (my$i=1;$i < @_;$i += 2){if ($_[$i - 1]le $_[$i]){$min=$_[$i - 1]if$min gt $_[$i - 1];$max=$_[$i]if$max lt $_[$i]}else {$min=$_[$i]if$min gt $_[$i];$max=$_[$i - 1]if$max lt $_[$i - 1]}}if (@_ & 1){my$i=$#_;if ($_[$i - 1]le $_[$i]){$min=$_[$i - 1]if$min gt $_[$i - 1];$max=$_[$i]if$max lt $_[$i]}else {$min=$_[$i]if$min gt $_[$i];$max=$_[$i - 1]if$max lt $_[$i - 1]}}return ($min,$max)}sub part (&@) {my ($code,@list)=@_;my@parts;push @{$parts[$code->($_)]},$_ foreach@list;return@parts}sub bsearch(&@) {my$code=shift;my$rc;my$i=0;my$j=@_;do {my$k=int(($i + $j)/ 2);$k >= @_ and return;local*_=\$_[$k];$rc=$code->();$rc==0 and return wantarray ? $_ : 1;if ($rc < 0){$i=$k + 1}else {$j=$k - 1}}until$i > $j;return}sub bsearchidx(&@) {my$code=shift;my$rc;my$i=0;my$j=@_;do {my$k=int(($i + $j)/ 2);$k >= @_ and return -1;local*_=\$_[$k];$rc=$code->();$rc==0 and return$k;if ($rc < 0){$i=$k + 1}else {$j=$k - 1}}until$i > $j;return -1}sub lower_bound(&@) {my$code=shift;my$count=@_;my$first=0;while ($count > 0){my$step=$count >> 1;my$it=$first + $step;local*_=\$_[$it];if ($code->()< 0){$first=++$it;$count -= $step + 1}else {$count=$step}}$first}sub upper_bound(&@) {my$code=shift;my$count=@_;my$first=0;while ($count > 0){my$step=$count >> 1;my$it=$first + $step;local*_=\$_[$it];if ($code->()<= 0){$first=++$it;$count -= $step + 1}else {$count=$step}}$first}sub equal_range(&@) {my$lb=&lower_bound(@_);my$ub=&upper_bound(@_);($lb,$ub)}sub binsert (&$\@) {my$lb=&lower_bound($_[0],@{$_[2]});splice @{$_[2]},$lb,0,$_[1];$lb}sub bremove (&\@) {my$lb=&lower_bound($_[0],@{$_[1]});splice @{$_[1]},$lb,1}sub qsort(&\@) {require Carp;Carp::croak("It's insane to use a pure-perl qsort")}sub sort_by(&@) {my ($code,@list)=@_;return map {$_->[0]}sort {$a->[1]cmp $b->[1]}map {[$_,scalar($code->())]}@list}sub nsort_by(&@) {my ($code,@list)=@_;return map {$_->[0]}sort {$a->[1]<=> $b->[1]}map {[$_,scalar($code->())]}@list}sub _XScompiled {0}1; +LIST_MOREUTILS_PP + +$fatpacked{"List/MoreUtils/XS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS_XS'; + package List::MoreUtils::XS;use 5.008_001;use strict;use warnings;use base ('Exporter');use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS};$VERSION='0.428';@EXPORT=();@EXPORT_OK=qw(any all none notall one any_u all_u none_u notall_u one_u reduce_u reduce_0 reduce_1 true false insert_after insert_after_string apply indexes after after_incl before before_incl firstidx lastidx onlyidx firstval lastval onlyval firstres lastres onlyres singleton duplicates frequency occurrences mode each_array each_arrayref pairwise natatime arrayify mesh zip6 uniq listcmp samples minmax minmaxstr part bsearch bsearchidx binsert bremove lower_bound upper_bound equal_range qsort);%EXPORT_TAGS=(all=>\@EXPORT_OK);local$ENV{PERL_DL_NONLAZY}=0 if$ENV{PERL_DL_NONLAZY};use XSLoader ();XSLoader::load("List::MoreUtils::XS","$VERSION");1; +LIST_MOREUTILS_XS + +$fatpacked{"Module/Build.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD'; + package Module::Build;use 5.006;use strict;use warnings;use File::Spec ();use File::Path ();use File::Basename ();use Perl::OSType ();use Module::Build::Base;our@ISA=qw(Module::Build::Base);our$VERSION='0.4224';$VERSION=eval$VERSION;sub _interpose_module {my ($self,$mod)=@_;eval "use $mod";die $@ if $@;no strict 'refs';my$top_class=$mod;while (@{"${top_class}::ISA"}){last if ${"${top_class}::ISA"}[0]eq $ISA[0];$top_class=${"${top_class}::ISA"}[0]}@{"${top_class}::ISA"}=@ISA;@ISA=($mod)}if (grep {-e File::Spec->catfile($_,qw(Module Build Platform),$^O).'.pm'}@INC){__PACKAGE__->_interpose_module("Module::Build::Platform::$^O")}elsif (my$ostype=os_type()){__PACKAGE__->_interpose_module("Module::Build::Platform::$ostype")}else {warn "Unknown OS type '$^O' - using default settings\n"}sub os_type {return Perl::OSType::os_type()}sub is_vmsish {return Perl::OSType::is_os_type('VMS')}sub is_windowsish {return Perl::OSType::is_os_type('Windows')}sub is_unixish {return Perl::OSType::is_os_type('Unix')}1; +MODULE_BUILD -use lib "lib","lib/Slideshow/local/lib/perl5"; +$fatpacked{"Module/Build/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_BASE'; + package Module::Build::Base;use 5.006;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Carp;use Cwd ();use File::Copy ();use File::Find ();use File::Path ();use File::Basename ();use File::Spec 0.82 ();use File::Compare ();use Module::Build::Dumper ();use Text::ParseWords ();use Module::Metadata;use Module::Build::Notes;use Module::Build::Config;use version;sub new {my$self=shift()->_construct(@_);$self->{invoked_action}=$self->{action}||= 'Build_PL';$self->cull_args(@ARGV);die "Too early to specify a build action '$self->{action}'. Do 'Build $self->{action}' instead.\n" if$self->{action}&& $self->{action}ne 'Build_PL';$self->check_manifest;$self->auto_require;if(grep {!$_}$self->check_prereq,$self->check_autofeatures){$self->log_warn(<dist_name eq 'Module-Build' || $ENV{PERL5_CPANPLUS_IS_RUNNING}|| $ENV{PERL5_CPAN_IS_RUNNING}){$self->log_warn("Run 'Build installdeps' to install missing prerequisites.\n\n")}}$self->{properties}{_added_to_INC}=[$self->_added_to_INC ];$self->set_bundle_inc;$self->dist_name;$self->dist_version;$self->release_status;$self->_guess_module_name unless$self->module_name;$self->_find_nested_builds;return$self}sub resume {my$package=shift;my$self=$package->_construct(@_);$self->read_config;my@added_earlier=@{$self->{properties}{_added_to_INC}|| []};@INC=($self->_added_to_INC,@added_earlier,$self->_default_INC);unless ($package->isa($self->build_class)){my$build_class=$self->build_class;my$config_dir=$self->config_dir || '_build';my$build_lib=File::Spec->catdir($config_dir,'lib');unshift(@INC,$build_lib);unless ($build_class->can('new')){eval "require $build_class; 1" or die "Failed to re-load '$build_class': $@"}return$build_class->resume(@_)}unless ($self->_perl_is_same($self->{properties}{perl})){my$perl=$self->find_perl_interpreter;die(<<"DIEFATAL")}$self->cull_args(@ARGV);unless ($self->allow_mb_mismatch){my$mb_version=$Module::Build::VERSION;if ($mb_version ne $self->{properties}{mb_version}){$self->log_warn(<<"MISMATCH")}}$self->{invoked_action}=$self->{action}||= 'build';return$self}sub new_from_context {my ($package,%args)=@_;$package->run_perl_script('Build.PL',[],[$package->unparse_args(\%args)]);return$package->resume}sub current {local@ARGV;return shift()->resume}sub _construct {my ($package,%input)=@_;my$args=delete$input{args}|| {};my$config=delete$input{config}|| {};my$self=bless {args=>{%$args},config=>Module::Build::Config->new(values=>$config),properties=>{base_dir=>$package->cwd,mb_version=>$Module::Build::VERSION,%input,},phash=>{},stash=>{},},$package;$self->_set_defaults;my ($p,$ph)=($self->{properties},$self->{phash});for (qw(notes config_data features runtime_params cleanup auto_features)){my$file=File::Spec->catfile($self->config_dir,$_);$ph->{$_}=Module::Build::Notes->new(file=>$file);$ph->{$_}->restore if -e $file;if (exists$p->{$_}){my$vals=delete$p->{$_};for my$k (sort keys %$vals){$self->$_($k,$vals->{$k})}}}$p->{perl}=$self->find_perl_interpreter or $self->log_warn("Warning: Can't locate your perl binary");my$blibdir=sub {File::Spec->catdir($p->{blib},@_)};$p->{bindoc_dirs}||= [$blibdir->("script")];$p->{libdoc_dirs}||= [$blibdir->("lib"),$blibdir->("arch")];$p->{dist_author}=[$p->{dist_author}]if defined$p->{dist_author}and not ref$p->{dist_author};$p->{requires}=delete$p->{prereq}if defined$p->{prereq};$p->{script_files}=delete$p->{scripts}if defined$p->{scripts};for ('extra_compiler_flags','extra_linker_flags'){$p->{$_}=[$self->split_like_shell($p->{$_})]if exists$p->{$_}}for ('include_dirs'){$p->{$_}=[$p->{$_}]if exists$p->{$_}&&!ref$p->{$_}}$self->add_to_cleanup(@{delete$p->{add_to_cleanup}})if$p->{add_to_cleanup};return$self}sub log_info {my$self=shift;print @_ if ref($self)&& ($self->verbose ||!$self->quiet)}sub log_verbose {my$self=shift;print @_ if ref($self)&& $self->verbose}sub log_debug {my$self=shift;print @_ if ref($self)&& $self->debug}sub log_warn {shift;if (@_ and $_[-1]!~ /\n$/){my (undef,$file,$line)=caller();warn @_," at $file line $line.\n"}else {warn @_}}sub _default_install_paths {my$self=shift;my$c=$self->{config};my$p={};my@libstyle=$c->get('installstyle')? File::Spec->splitdir($c->get('installstyle')): qw(lib perl5);my$arch=$c->get('archname');my$version=$c->get('version');my$bindoc=$c->get('installman1dir')|| undef;my$libdoc=$c->get('installman3dir')|| undef;my$binhtml=$c->get('installhtml1dir')|| $c->get('installhtmldir')|| undef;my$libhtml=$c->get('installhtml3dir')|| $c->get('installhtmldir')|| undef;$p->{install_sets}={core=>{lib=>$c->get('installprivlib'),arch=>$c->get('installarchlib'),bin=>$c->get('installbin'),script=>$c->get('installscript'),bindoc=>$bindoc,libdoc=>$libdoc,binhtml=>$binhtml,libhtml=>$libhtml,},site=>{lib=>$c->get('installsitelib'),arch=>$c->get('installsitearch'),bin=>$c->get('installsitebin')|| $c->get('installbin'),script=>$c->get('installsitescript')|| $c->get('installsitebin')|| $c->get('installscript'),bindoc=>$c->get('installsiteman1dir')|| $bindoc,libdoc=>$c->get('installsiteman3dir')|| $libdoc,binhtml=>$c->get('installsitehtml1dir')|| $binhtml,libhtml=>$c->get('installsitehtml3dir')|| $libhtml,},vendor=>{lib=>$c->get('installvendorlib'),arch=>$c->get('installvendorarch'),bin=>$c->get('installvendorbin')|| $c->get('installbin'),script=>$c->get('installvendorscript')|| $c->get('installvendorbin')|| $c->get('installscript'),bindoc=>$c->get('installvendorman1dir')|| $bindoc,libdoc=>$c->get('installvendorman3dir')|| $libdoc,binhtml=>$c->get('installvendorhtml1dir')|| $binhtml,libhtml=>$c->get('installvendorhtml3dir')|| $libhtml,},};$p->{original_prefix}={core=>$c->get('installprefixexp')|| $c->get('installprefix')|| $c->get('prefixexp')|| $c->get('prefix')|| '',site=>$c->get('siteprefixexp'),vendor=>$c->get('usevendorprefix')? $c->get('vendorprefixexp'): '',};$p->{original_prefix}{site}||= $p->{original_prefix}{core};$p->{install_base_relpaths}={lib=>['lib','perl5'],arch=>['lib','perl5',$arch],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],};$p->{prefix_relpaths}={core=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],},vendor=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],},site=>{lib=>[@libstyle,'site_perl'],arch=>[@libstyle,'site_perl',$version,$arch],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],},};return$p}sub _find_nested_builds {my$self=shift;my$r=$self->recurse_into or return;my ($file,@r);if (!ref($r)&& $r eq 'auto'){local*DH;opendir DH,$self->base_dir or die "Can't scan directory " .$self->base_dir ." for nested builds: $!";while (defined($file=readdir DH)){my$subdir=File::Spec->catdir($self->base_dir,$file);next unless -d $subdir;push@r,$subdir if -e File::Spec->catfile($subdir,'Build.PL')}}$self->recurse_into(\@r)}sub cwd {return Cwd::cwd()}sub _quote_args {my ($self,@args)=@_;my@quoted;for (@args){if (/^[^\s*?!\$<>;\\|'"\[\]\{\}]+$/){push@quoted,$_}else {s/('+)/'"$1"'/g;push@quoted,qq('$_')}}return join " ",@quoted}sub _backticks {my ($self,@cmd)=@_;if ($self->have_forkpipe){local*FH;my$pid=open*FH,"-|";if ($pid){return wantarray ? : join '',}else {die "Can't execute @cmd: $!\n" unless defined$pid;exec {$cmd[0]}@cmd}}else {my$cmd=$self->_quote_args(@cmd);return `$cmd`}}sub have_forkpipe {1}sub _perl_is_same {my ($self,$perl)=@_;my@cmd=($perl);if ($ENV{PERL_CORE}){push@cmd,'-I' .File::Spec->catdir(File::Basename::dirname($perl),'lib')}push@cmd,qw(-MConfig=myconfig -e print -e myconfig);return$self->_backticks(@cmd)eq Config->myconfig}{my$known_perl;sub find_perl_interpreter {my$self=shift;return$known_perl if defined($known_perl);return$known_perl=$self->_discover_perl_interpreter}}sub _discover_perl_interpreter {my$proto=shift;my$c=ref($proto)? $proto->{config}: 'Module::Build::Config';my$perl=$^X;my$perl_basename=File::Basename::basename($perl);my@potential_perls;push(@potential_perls,$perl)if File::Spec->file_name_is_absolute($perl);my$abs_perl=File::Spec->rel2abs($perl);push(@potential_perls,$abs_perl);if ($ENV{PERL_CORE}){require ExtUtils::CBuilder;my$perl_src=Cwd::realpath(ExtUtils::CBuilder->perl_src);if (defined($perl_src)&& length($perl_src)){my$uninstperl=File::Spec->rel2abs(File::Spec->catfile($perl_src,$perl_basename));push(@potential_perls,$uninstperl)}}else {push(@potential_perls,$c->get('perlpath'));push(@potential_perls,map File::Spec->catfile($_,$perl_basename),File::Spec->path())}my$exe=$c->get('exe_ext');for my$thisperl (@potential_perls){if (defined$exe){$thisperl .= $exe unless$thisperl =~ m/$exe$/i}if (-f $thisperl && $proto->_perl_is_same($thisperl)){return$thisperl}}my@paths=map File::Basename::dirname($_),@potential_perls;die "Can't locate the perl binary used to run this script " ."in (@paths)\n"}sub find_command {my ($self,$command)=@_;if(File::Spec->file_name_is_absolute($command)){return$self->_maybe_command($command)}else {for my$dir (File::Spec->path){my$abs=File::Spec->catfile($dir,$command);return$abs if$abs=$self->_maybe_command($abs)}}}sub _maybe_command {my($self,$file)=@_;return$file if -x $file &&!-d $file;return}sub _is_interactive {return -t STDIN && (-t STDOUT ||!(-f STDOUT || -c STDOUT))}sub _is_unattended {my$self=shift;return$ENV{PERL_MM_USE_DEFAULT}|| (!$self->_is_interactive && eof STDIN)}sub _readline {my$self=shift;return undef if$self->_is_unattended;my$answer=;chomp$answer if defined$answer;return$answer}sub prompt {my$self=shift;my$mess=shift or die "prompt() called without a prompt message";my@def;@def=(shift)if @_;my@dispdef=scalar(@def)? ('[',(defined($def[0])? $def[0].' ' : ''),']'): (' ','');local $|=1;print "$mess ",@dispdef;if ($self->_is_unattended &&!@def){die <_readline();if (!defined($ans)or!length($ans)){print "$dispdef[1]\n";$ans=scalar(@def)? $def[0]: ''}return$ans}sub y_n {my$self=shift;my ($mess,$def)=@_;die "y_n() called without a prompt message" unless$mess;die "Invalid default value: y_n() default must be 'y' or 'n'" if$def && $def !~ /^[yn]/i;my$answer;while (1){$answer=$self->prompt(@_);return 1 if$answer =~ /^y/i;return 0 if$answer =~ /^n/i;local $|=1;print "Please answer 'y' or 'n'.\n"}}sub current_action {shift->{action}}sub invoked_action {shift->{invoked_action}}sub notes {shift()->{phash}{notes}->access(@_)}sub config_data {shift()->{phash}{config_data}->access(@_)}sub runtime_params {shift->{phash}{runtime_params}->read(@_ ? shift : ())}sub auto_features {shift()->{phash}{auto_features}->access(@_)}sub features {my$self=shift;my$ph=$self->{phash};if (@_){my$key=shift;if ($ph->{features}->exists($key)){return$ph->{features}->access($key,@_)}if (my$info=$ph->{auto_features}->access($key)){my$disabled;for my$type (@{$self->prereq_action_types}){next if$type eq 'description' || $type eq 'recommends' ||!exists$info->{$type};my$prereqs=$info->{$type};for my$modname (sort keys %$prereqs){my$spec=$prereqs->{$modname};my$status=$self->check_installed_status($modname,$spec);if ((!$status->{ok})xor ($type =~ /conflicts$/)){return 0}if (!eval "require $modname; 1"){return 0}}}return 1}return$ph->{features}->access($key,@_)}my%features;my%auto_features=$ph->{auto_features}->access();while (my ($name,$info)=each%auto_features){my$failures=$self->prereq_failures($info);my$disabled=grep(/^(?:\w+_)?(?:requires|conflicts)$/,keys %$failures)? 1 : 0;$features{$name}=$disabled ? 0 : 1}%features=(%features,$ph->{features}->access());return wantarray ? %features : \%features}BEGIN {*feature=\&features}sub _mb_feature {my$self=shift;if (($self->module_name || '')eq 'Module::Build'){return$self->feature(@_)}else {require Module::Build::ConfigData;return Module::Build::ConfigData->feature(@_)}}sub _warn_mb_feature_deps {my$self=shift;my$name=shift;$self->log_warn("The '$name' feature is not available. Please install missing\n" ."feature dependencies and try again.\n".$self->_feature_deps_msg($name)."\n")}sub add_build_element {my ($self,$elem)=@_;my$elems=$self->build_elements;push @$elems,$elem unless grep {$_ eq $elem}@$elems}sub ACTION_config_data {my$self=shift;return unless$self->has_config_data;my$module_name=$self->module_name or die "The config_data feature requires that 'module_name' be set";my$notes_name=$module_name .'::ConfigData';my$notes_pm=File::Spec->catfile($self->blib,'lib',split /::/,"$notes_name.pm");return if$self->up_to_date(['Build.PL',$self->config_file('config_data'),$self->config_file('features')],$notes_pm);$self->log_verbose("Writing config notes to $notes_pm\n");File::Path::mkpath(File::Basename::dirname($notes_pm));Module::Build::Notes->write_config_data (file=>$notes_pm,module=>$module_name,config_module=>$notes_name,config_data=>scalar$self->config_data,feature=>scalar$self->{phash}{features}->access(),auto_features=>scalar$self->auto_features,)}{my%valid_properties=(__PACKAGE__,{});my%additive_properties;sub _mb_classes {my$class=ref($_[0])|| $_[0];return ($class,$class->mb_parents)}sub valid_property {my ($class,$prop)=@_;return grep exists($valid_properties{$_}{$prop}),$class->_mb_classes}sub valid_properties {return keys %{shift->valid_properties_defaults()}}sub valid_properties_defaults {my%out;for my$class (reverse shift->_mb_classes){@out{keys %{$valid_properties{$class}}}=map {$_->()}values %{$valid_properties{$class}}}return \%out}sub array_properties {map {exists$additive_properties{$_}->{ARRAY}? @{$additive_properties{$_}->{ARRAY}}: ()}shift->_mb_classes}sub hash_properties {map {exists$additive_properties{$_}->{HASH}? @{$additive_properties{$_}->{HASH}}: ()}shift->_mb_classes}sub add_property {my ($class,$property)=(shift,shift);die "Property '$property' already exists" if$class->valid_property($property);my%p=@_==1 ? (default=>shift): @_;my$type=ref$p{default};$valid_properties{$class}{$property}=$type eq 'CODE' ? $p{default}: $type eq 'HASH' ? sub {return {%{$p{default}}}}: $type eq 'ARRAY'? sub {return [@{$p{default}}]}: sub {return$p{default}};push @{$additive_properties{$class}->{$type}},$property if$type;unless ($class->can($property)){my$sub=$type eq 'HASH' ? _make_hash_accessor($property,\%p): _make_accessor($property,\%p);no strict 'refs';*{"$class\::$property"}=$sub}return$class}sub property_error {my$self=shift;die 'ERROR: ',@_}sub _set_defaults {my$self=shift;$self->{properties}{build_class}||= ref$self;$self->{properties}{orig_dir}||= $self->{properties}{base_dir};my$defaults=$self->valid_properties_defaults;for my$prop (keys %$defaults){$self->{properties}{$prop}=$defaults->{$prop}unless exists$self->{properties}{$prop}}for my$prop ($self->array_properties){$self->{properties}{$prop}=[@{$defaults->{$prop}}]unless exists$self->{properties}{$prop}}for my$prop ($self->hash_properties){$self->{properties}{$prop}={%{$defaults->{$prop}}}unless exists$self->{properties}{$prop}}}}sub _make_hash_accessor {my ($property,$p)=@_;my$check=$p->{check}|| sub {1};return sub {my$self=shift;unless(ref($self)){carp("\n$property not a class method (@_)");return}my$x=$self->{properties};return$x->{$property}unless @_;my$prop=$x->{$property};if (defined $_[0]&&!ref $_[0]){if (@_==1){return exists$prop->{$_[0]}? $prop->{$_[0]}: undef}elsif (@_ % 2==0){my%new=(%{$prop},@_);local $_=\%new;$x->{$property}=\%new if$check->($self);return$x->{$property}}else {die "Unexpected arguments for property '$property'\n"}}else {die "Unexpected arguments for property '$property'\n" if defined $_[0]&& ref $_[0]ne 'HASH';local $_=$_[0];$x->{$property}=shift if$check->($self)}}}sub _make_accessor {my ($property,$p)=@_;my$check=$p->{check}|| sub {1};return sub {my$self=shift;unless(ref($self)){carp("\n$property not a class method (@_)");return}my$x=$self->{properties};return$x->{$property}unless @_;local $_=$_[0];$x->{$property}=shift if$check->($self);return$x->{$property}}}__PACKAGE__->add_property(auto_configure_requires=>1);__PACKAGE__->add_property(blib=>'blib');__PACKAGE__->add_property(build_class=>'Module::Build');__PACKAGE__->add_property(build_elements=>[qw(PL support pm xs share_dir pod script)]);__PACKAGE__->add_property(build_script=>'Build');__PACKAGE__->add_property(build_bat=>0);__PACKAGE__->add_property(bundle_inc=>[]);__PACKAGE__->add_property(bundle_inc_preload=>[]);__PACKAGE__->add_property(config_dir=>'_build');__PACKAGE__->add_property(dynamic_config=>1);__PACKAGE__->add_property(include_dirs=>[]);__PACKAGE__->add_property(license=>'unknown');__PACKAGE__->add_property(metafile=>'META.yml');__PACKAGE__->add_property(mymetafile=>'MYMETA.yml');__PACKAGE__->add_property(metafile2=>'META.json');__PACKAGE__->add_property(mymetafile2=>'MYMETA.json');__PACKAGE__->add_property(recurse_into=>[]);__PACKAGE__->add_property(use_rcfile=>1);__PACKAGE__->add_property(create_packlist=>1);__PACKAGE__->add_property(allow_mb_mismatch=>0);__PACKAGE__->add_property(config=>undef);__PACKAGE__->add_property(test_file_exts=>['.t']);__PACKAGE__->add_property(use_tap_harness=>0);__PACKAGE__->add_property(cpan_client=>'cpan');__PACKAGE__->add_property(tap_harness_args=>{});__PACKAGE__->add_property(pureperl_only=>0);__PACKAGE__->add_property(allow_pureperl=>0);__PACKAGE__->add_property('installdirs',default=>'site',check=>sub {return 1 if /^(core|site|vendor)$/;return shift->property_error($_ eq 'perl' ? 'Perhaps you meant installdirs to be "core" rather than "perl"?' : 'installdirs must be one of "core", "site", or "vendor"');return shift->property_error("Perhaps you meant 'core'?")if $_ eq 'perl';return 0},);{__PACKAGE__->add_property(html_css=>'')}{my@prereq_action_types=qw(requires build_requires test_requires conflicts recommends);for my$type (@prereq_action_types){__PACKAGE__->add_property($type=>{})}__PACKAGE__->add_property(prereq_action_types=>\@prereq_action_types)}__PACKAGE__->add_property($_=>{})for qw(get_options install_base_relpaths install_path install_sets meta_add meta_merge original_prefix prefix_relpaths configure_requires);__PACKAGE__->add_property($_)for qw(PL_files autosplit base_dir bindoc_dirs c_source cover create_license create_makefile_pl create_readme debugger destdir dist_abstract dist_author dist_name dist_suffix dist_version dist_version_from extra_compiler_flags extra_linker_flags has_config_data install_base libdoc_dirs magic_number mb_version module_name needs_compiler orig_dir perl pm_files pod_files pollute prefix program_name quiet recursive_test_files release_status script_files scripts share_dir sign test_files verbose debug xs_files extra_manify_args);sub config {my$self=shift;my$c=ref($self)? $self->{config}: 'Module::Build::Config';return$c->all_config unless @_;my$key=shift;return$c->get($key)unless @_;my$val=shift;return$c->set($key=>$val)}sub mb_parents {my@in_stack=(shift);my%seen=($in_stack[0]=>1);my ($current,@out);while (@in_stack){next unless defined($current=shift@in_stack)&& $current->isa('Module::Build::Base');push@out,$current;next if$current eq 'Module::Build::Base';no strict 'refs';unshift@in_stack,map {my$c=$_;substr($c,0,2)="main::" if substr($c,0,2)eq '::';$seen{$c}++ ? (): $c}@{"$current\::ISA"}}shift@out;return@out}sub extra_linker_flags {shift->_list_accessor('extra_linker_flags',@_)}sub extra_compiler_flags {shift->_list_accessor('extra_compiler_flags',@_)}sub _list_accessor {(my$self,local $_)=(shift,shift);my$p=$self->{properties};$p->{$_}=[@_]if @_;$p->{$_}=[]unless exists$p->{$_};return ref($p->{$_})? $p->{$_}: [$p->{$_}]}sub subclass {my ($pack,%opts)=@_;my$build_dir='_build';$pack->delete_filetree($build_dir)if -e $build_dir;die "Must provide 'code' or 'class' option to subclass()\n" unless$opts{code}or $opts{class};$opts{code}||= '';$opts{class}||= 'MyModuleBuilder';my$filename=File::Spec->catfile($build_dir,'lib',split '::',$opts{class}).'.pm';my$filedir=File::Basename::dirname($filename);$pack->log_verbose("Creating custom builder $filename in $filedir\n");File::Path::mkpath($filedir);die "Can't create directory $filedir: $!" unless -d $filedir;open(my$fh,'>',$filename)or die "Can't create $filename: $!";print$fh <catdir(File::Spec->rel2abs($build_dir),'lib');eval "use $opts{class}";die $@ if $@;return$opts{class}}sub _guess_module_name {my$self=shift;my$p=$self->{properties};return if$p->{module_name};if ($p->{dist_version_from}&& -e $p->{dist_version_from}){my$mi=Module::Metadata->new_from_file($self->dist_version_from);$p->{module_name}=$mi->name}else {my$mod_path=my$mod_name=$p->{dist_name};$mod_name =~ s{-}{::}g;$mod_path =~ s{-}{/}g;$mod_path .= ".pm";if (-e $mod_path || -e "lib/$mod_path"){$p->{module_name}=$mod_name}else {$self->log_warn(<< 'END_WARN')}}}sub dist_name {my$self=shift;my$p=$self->{properties};my$me='dist_name';return$p->{$me}if defined$p->{$me};die "Can't determine distribution name, must supply either 'dist_name' or 'module_name' parameter" unless$self->module_name;($p->{$me}=$self->module_name)=~ s/::/-/g;return$p->{$me}}sub release_status {my ($self)=@_;my$me='release_status';my$p=$self->{properties};if (!defined$p->{$me}){$p->{$me}=$self->_is_dev_version ? 'testing' : 'stable'}unless ($p->{$me}=~ qr/\A(?:stable|testing|unstable)\z/){die "Illegal value '$p->{$me}' for $me\n"}if ($p->{$me}eq 'stable' && $self->_is_dev_version){my$version=$self->dist_version;die "Illegal value '$p->{$me}' with version '$version'\n"}return$p->{$me}}sub dist_suffix {my ($self)=@_;my$p=$self->{properties};my$me='dist_suffix';return$p->{$me}if defined$p->{$me};if ($self->release_status eq 'stable'){$p->{$me}=""}else {$p->{$me}=$self->_is_dev_version ? "" : "TRIAL" }return$p->{$me}}sub dist_version_from {my ($self)=@_;my$p=$self->{properties};my$me='dist_version_from';if ($self->module_name){$p->{$me}||= join('/','lib',split(/::/,$self->module_name)).'.pm'}return$p->{$me}|| undef}sub dist_version {my ($self)=@_;my$p=$self->{properties};my$me='dist_version';return$p->{$me}if defined$p->{$me};if (my$dist_version_from=$self->dist_version_from){my$version_from=File::Spec->catfile(split(qr{/},$dist_version_from));my$pm_info=Module::Metadata->new_from_file($version_from)or die "Can't find file $version_from to determine version";$p->{$me}=$self->normalize_version($pm_info->version());unless (defined$p->{$me}){die "Can't determine distribution version from $version_from"}}die ("Can't determine distribution version, must supply either 'dist_version',\n"."'dist_version_from', or 'module_name' parameter")unless defined$p->{$me};return$p->{$me}}sub _is_dev_version {my ($self)=@_;my$dist_version=$self->dist_version;my$version_obj=eval {version->new($dist_version)};return $@ ? 0 : $version_obj->is_alpha}sub dist_author {shift->_pod_parse('author')}sub dist_abstract {shift->_pod_parse('abstract')}sub _pod_parse {my ($self,$part)=@_;my$p=$self->{properties};my$member="dist_$part";return$p->{$member}if defined$p->{$member};my$docfile=$self->_main_docfile or return;open(my$fh,'<',$docfile)or return;require Module::Build::PodParser;my$parser=Module::Build::PodParser->new(fh=>$fh);my$method="get_$part";return$p->{$member}=$parser->$method()}sub version_from_file {return Module::Metadata->new_from_file($_[1])->version()}sub find_module_by_name {return Module::Metadata->find_module_by_name(@_[1,2])}{my%unlink_list_for_pid;sub _unlink_on_exit {my$self=shift;for my$f (@_){push @{$unlink_list_for_pid{$$}},$f if -f $f}return 1}END {for my$f (map glob($_),@{$unlink_list_for_pid{$$}|| []}){next unless -e $f;File::Path::rmtree($f,0,0)}}}sub add_to_cleanup {my$self=shift;my%files=map {$self->localize_file_path($_),1}@_;$self->{phash}{cleanup}->write(\%files)}sub cleanup {my$self=shift;my$all=$self->{phash}{cleanup}->read;return wantarray ? sort keys %$all : keys %$all}sub config_file {my$self=shift;return unless -d $self->config_dir;return File::Spec->catfile($self->config_dir,@_)}sub read_config {my ($self)=@_;my$file=$self->config_file('build_params')or die "Can't find 'build_params' in " .$self->config_dir;open(my$fh,'<',$file)or die "Can't read '$file': $!";my$ref=eval do {local $/;<$fh>};die if $@;close$fh;my$c;($self->{args},$c,$self->{properties})=@$ref;$self->{config}=Module::Build::Config->new(values=>$c)}sub has_config_data {my$self=shift;return scalar grep$self->{phash}{$_}->has_data(),qw(config_data features auto_features)}sub _write_data {my ($self,$filename,$data)=@_;my$file=$self->config_file($filename);open(my$fh,'>',$file)or die "Can't create '$file': $!";unless (ref($data)){print$fh $data;return}print {$fh}Module::Build::Dumper->_data_dump($data);close$fh}sub write_config {my ($self)=@_;File::Path::mkpath($self->{properties}{config_dir});-d $self->{properties}{config_dir}or die "Can't mkdir $self->{properties}{config_dir}: $!";my@items=@{$self->prereq_action_types};$self->_write_data('prereqs',{map {$_,$self->$_()}@items });$self->_write_data('build_params',[$self->{args},$self->{config}->values_set,$self->{properties}]);$self->_write_data('magicnum',$self->magic_number(int rand 1_000_000));$self->{phash}{$_}->write()foreach qw(notes cleanup features auto_features config_data runtime_params)}{my%packlist_map=('^File::Spec'=>'Cwd','^Devel::AssertOS'=>'Devel::CheckOS',);sub _find_packlist {my ($self,$inst,$mod)=@_;my$lookup=$mod;my$packlist=eval {$inst->packlist($lookup)};if (!$packlist){while (my ($re,$new_mod)=each%packlist_map){if ($mod =~ qr/$re/){$lookup=$new_mod;$packlist=eval {$inst->packlist($lookup)};last}}}return$packlist ? $lookup : undef}sub set_bundle_inc {my$self=shift;my$bundle_inc=$self->{properties}{bundle_inc};my$bundle_inc_preload=$self->{properties}{bundle_inc_preload};return unless inc::latest->can('loaded_modules');require ExtUtils::Installed;my$inst=eval {ExtUtils::Installed->new(extra_libs=>[@INC])};if ($@){$self->log_warn(<< "EUI_ERROR");return}my@bundle_list=map {[$_,0 ]}inc::latest->loaded_modules;while(@bundle_list){my ($mod,$prereq)=@{shift@bundle_list};my$lookup=$self->_find_packlist($inst,$mod);if (!$lookup){die << "NO_PACKLIST"}else {push @{$prereq ? $bundle_inc_preload : $bundle_inc},$lookup}}}}sub check_autofeatures {my ($self)=@_;my$features=$self->auto_features;return 1 unless %$features;my$longest=sub {my@str=@_ or croak("no strings given");my@len=map({length($_)}@str);my$max=0;my$longest;for my$i (0..$#len){($max,$longest)=($len[$i],$str[$i])if($len[$i]> $max)}return($longest)};my$max_name_len=length($longest->(keys %$features));my ($num_disabled,$log_text)=(0,"\nChecking optional features...\n");for my$name (sort keys %$features){$log_text .= $self->_feature_deps_msg($name,$max_name_len)}$num_disabled=()=$log_text =~ /disabled/g;if ($num_disabled){$self->log_warn($log_text);return 0}else {$self->log_verbose($log_text);return 1}}sub _feature_deps_msg {my ($self,$name,$max_name_len)=@_;$max_name_len ||= length$name;my$features=$self->auto_features;my$info=$features->{$name};my$feature_text="$name" .'.' x ($max_name_len - length($name)+ 4);my ($log_text,$disabled)=('','');if (my$failures=$self->prereq_failures($info)){$disabled=grep(/^(?:\w+_)?(?:requires|conflicts)$/,keys %$failures)? 1 : 0;$feature_text .= $disabled ? "disabled\n" : "enabled\n";for my$type (@{$self->prereq_action_types}){next unless exists$failures->{$type};$feature_text .= " $type:\n";my$prereqs=$failures->{$type};for my$module (sort keys %$prereqs){my$status=$prereqs->{$module};my$required=($type =~ /^(?:\w+_)?(?:requires|conflicts)$/)? 1 : 0;my$prefix=($required)? '!' : '*';$feature_text .= " $prefix $status->{message}\n"}}}else {$feature_text .= "enabled\n"}$log_text .= $feature_text if$disabled || $self->verbose;return$log_text}sub auto_config_requires {my ($self)=@_;my$p=$self->{properties};if ($self->dist_name ne 'Module-Build' && $self->auto_configure_requires &&!exists$p->{configure_requires}{'Module::Build'}){(my$ver=$VERSION)=~ s/^(\d+\.\d\d).*$/$1/;$self->log_warn(<_add_prereq('configure_requires','Module::Build',$ver)}if (inc::latest->can('loaded_module')){for my$mod (inc::latest->loaded_modules){next if exists$p->{configure_requires}{$mod};$self->_add_prereq('configure_requires',$mod,$mod->VERSION)}}return}sub auto_require {my ($self)=@_;my$p=$self->{properties};my$xs_files=$self->find_xs_files;if (!defined$p->{needs_compiler}){$self->needs_compiler(keys %$xs_files || defined$self->c_source)}if ($self->needs_compiler){$self->_add_prereq('build_requires','ExtUtils::CBuilder',0);if (!$self->have_c_compiler){$self->log_warn(<<'EOM')}}if ($self->share_dir){$self->_add_prereq('requires','File::ShareDir','1.00')}return}sub _add_prereq {my ($self,$type,$module,$version)=@_;my$p=$self->{properties};$version=0 unless defined$version;if (exists$p->{$type}{$module}){return if$self->compare_versions($version,'<=',$p->{$type}{$module})}$self->log_verbose("Adding to $type\: $module => $version\n");$p->{$type}{$module}=$version;return 1}sub prereq_failures {my ($self,$info)=@_;my@types=@{$self->prereq_action_types};$info ||= {map {$_,$self->$_()}@types};my$out;for my$type (@types){my$prereqs=$info->{$type};for my$modname (keys %$prereqs){my$spec=$prereqs->{$modname};my$status=$self->check_installed_status($modname,$spec);if ($type =~ /^(?:\w+_)?conflicts$/){next if!$status->{ok};$status->{conflicts}=delete$status->{need};$status->{message}="$modname ($status->{have}) conflicts with this distribution"}elsif ($type =~ /^(?:\w+_)?recommends$/){next if$status->{ok};$status->{message}=(!ref($status->{have})&& $status->{have}eq '' ? "$modname is not installed" : "$modname ($status->{have}) is installed, but we prefer to have $spec")}else {next if$status->{ok}}$out->{$type}{$modname}=$status}}return$out}sub _enum_prereqs {my$self=shift;my%prereqs;for my$type (@{$self->prereq_action_types}){if ($self->can($type)){my$prereq=$self->$type()|| {};$prereqs{$type}=$prereq if %$prereq}}return \%prereqs}sub check_prereq {my$self=shift;my$info=$self->_enum_prereqs;return 1 unless$info;my$log_text="Checking prerequisites...\n";my$failures=$self->prereq_failures($info);if ($failures){$self->log_warn($log_text);for my$type (@{$self->prereq_action_types}){my$prereqs=$failures->{$type};$self->log_warn(" ${type}:\n")if keys %$prereqs;for my$module (sort keys %$prereqs){my$status=$prereqs->{$module};my$prefix=($type =~ /^(?:\w+_)?recommends$/)? "* " : "! ";$self->log_warn(" $prefix $status->{message}\n")}}return 0}else {$self->log_verbose($log_text ."Looks good\n\n");return 1}}sub perl_version {my ($self)=@_;return $^V ? $self->perl_version_to_float(sprintf "%vd",$^V): $]}sub perl_version_to_float {my ($self,$version)=@_;return$version if grep(/\./,$version)< 2;$version =~ s/\./../;$version =~ s/\.(\d+)/sprintf '%03d', $1/eg;return$version}sub _parse_conditions {my ($self,$spec)=@_;return ">= 0" if not defined$spec;if ($spec =~ /^\s*([\w.]+)\s*$/){return (">= $spec")}else {return split /\s*,\s*/,$spec}}sub try_require {my ($self,$modname,$spec)=@_;my$status=$self->check_installed_status($modname,defined($spec)? $spec : 0);return unless$status->{ok};my$path=$modname;$path =~ s{::}{/}g;$path .= ".pm";if (defined$INC{$path}){return 1}elsif (exists$INC{$path}){return}else {return eval "require $modname"}}sub check_installed_status {my ($self,$modname,$spec)=@_;my%status=(need=>$spec);if ($modname eq 'perl'){$status{have}=$self->perl_version}elsif (eval {no strict;$status{have}=${"${modname}::VERSION"}}){}else {my$pm_info=Module::Metadata->new_from_module($modname);unless (defined($pm_info)){@status{qw(have message) }=('',"$modname is not installed");return \%status}$status{have}=eval {$pm_info->version()};if ($spec and!defined($status{have})){@status{qw(have message) }=(undef,"Couldn't find a \$VERSION in prerequisite $modname");return \%status}}my@conditions=$self->_parse_conditions($spec);for (@conditions){my ($op,$version)=/^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x or die "Invalid prerequisite condition '$_' for $modname";$version=$self->perl_version_to_float($version)if$modname eq 'perl';next if$op eq '>=' and!$version;unless ($self->compare_versions($status{have},$op,$version)){$status{message}="$modname ($status{have}) is installed, but we need version $op $version";return \%status}}$status{ok}=1;return \%status}sub compare_versions {my$self=shift;my ($v1,$op,$v2)=@_;$v1=version->new($v1)unless eval {$v1->isa('version')};my$eval_str="\$v1 $op \$v2";my$result=eval$eval_str;$self->log_warn("error comparing versions: '$eval_str' $@")if $@;return$result}sub check_installed_version {my ($self,$modname,$spec)=@_;my$status=$self->check_installed_status($modname,$spec);if ($status->{ok}){return$status->{have}if$status->{have}and "$status->{have}" ne '';return '0 but true'}$@=$status->{message};return 0}sub make_executable {my$self=shift;for (@_){my$current_mode=(stat $_)[2];chmod$current_mode | oct(111),$_}}sub is_executable {my ($self,$file)=@_;return -x $file}sub _startperl {shift()->config('startperl')}sub _added_to_INC {my$self=shift;my%seen;$seen{$_}++ foreach$self->_default_INC;return grep!$seen{$_}++,@INC}{my@default_inc;sub _default_INC {my$self=shift;return@default_inc if@default_inc;local$ENV{PERL5LIB};my$perl=ref($self)? $self->perl : $self->find_perl_interpreter;my@inc=$self->_backticks($perl,'-le','print for @INC');chomp@inc;return@default_inc=@inc}}sub print_build_script {my ($self,$fh)=@_;my$build_package=$self->build_class;my$closedata="";my$config_requires;if (-f $self->metafile){my$meta=eval {$self->read_metafile($self->metafile)};$config_requires=$meta && $meta->{prereqs}{configure}{requires}{'Module::Build'}}$config_requires ||= 0;my%q=map {$_,$self->$_()}qw(config_dir base_dir);$q{base_dir}=Win32::GetShortPathName($q{base_dir})if$self->is_windowsish;$q{magic_numfile}=$self->config_file('magicnum');my@myINC=$self->_added_to_INC;for (@myINC,values%q){$_=File::Spec->canonpath($_)unless$self->is_vmsish;s/([\\\'])/\\$1/g}my$quoted_INC=join ",\n",map " '$_'",@myINC;my$shebang=$self->_startperl;my$magic_number=$self->magic_number;my$dot_in_inc_code=$INC[-1]eq '.' ? <<'END' : '';print$fh <metafile2,$self->metafile,);my@mymetafiles=($self->mymetafile2,$self->mymetafile,);for my$f (@mymetafiles){if ($self->delete_filetree($f)){$self->log_verbose("Removed previous '$f'\n")}}if ($self->try_require("CPAN::Meta","2.142060")){for my$file (@metafiles){next unless -f $file;$meta_obj=eval {CPAN::Meta->load_file($file,{lazy_validation=>0 })};last if$meta_obj}}my$mymeta_obj;if ($meta_obj){my%updated=(%{$meta_obj->as_struct({version=>2.0 })},prereqs=>$self->_normalize_prereqs,dynamic_config=>0,generated_by=>"Module::Build version $Module::Build::VERSION",);$mymeta_obj=CPAN::Meta->new(\%updated,{lazy_validation=>0 })}else {$mymeta_obj=$self->_get_meta_object(quiet=>0,dynamic=>0,fatal=>1,auto=>0)}my@created=$self->_write_meta_files($mymeta_obj,'MYMETA');$self->log_warn("Could not create MYMETA files\n")unless@created;return 1}sub create_build_script {my ($self)=@_;$self->write_config;$self->create_mymeta;my ($build_script,$dist_name,$dist_version)=map$self->$_(),qw(build_script dist_name dist_version);if ($self->delete_filetree($build_script)){$self->log_verbose("Removed previous script '$build_script'\n")}$self->log_info("Creating new '$build_script' script for ","'$dist_name' version '$dist_version'\n");open(my$fh,'>',$build_script)or die "Can't create '$build_script': $!";$self->print_build_script($fh);close$fh;$self->make_executable($build_script);return 1}sub check_manifest {my$self=shift;return unless -e 'MANIFEST';require ExtUtils::Manifest;local ($^W,$ExtUtils::Manifest::Quiet)=(0,1);$self->log_verbose("Checking whether your kit is complete...\n");if (my@missed=ExtUtils::Manifest::manicheck()){$self->log_warn("WARNING: the following files are missing in your kit:\n","\t",join("\n\t",@missed),"\n","Please inform the author.\n\n")}else {$self->log_verbose("Looks good\n\n")}}sub dispatch {my$self=shift;local$self->{_completed_actions}={};if (@_){my ($action,%p)=@_;my$args=$p{args}? delete($p{args}): {};local$self->{invoked_action}=$action;local$self->{args}={%{$self->{args}},%$args};local$self->{properties}={%{$self->{properties}},%p};return$self->_call_action($action)}die "No build action specified" unless$self->{action};local$self->{invoked_action}=$self->{action};$self->_call_action($self->{action})}sub _call_action {my ($self,$action)=@_;return if$self->{_completed_actions}{$action}++;local$self->{action}=$action;my$method=$self->can_action($action);die "No action '$action' defined, try running the 'help' action.\n" unless$method;$self->log_debug("Starting ACTION_$action\n");my$rc=$self->$method();$self->log_debug("Finished ACTION_$action\n");return$rc}sub can_action {my ($self,$action)=@_;return$self->can("ACTION_$action")}sub cull_options {my$self=shift;my (@argv)=@_;return({},@argv)unless(ref($self));my$specs=$self->get_options;return({},@argv)unless($specs and %$specs);require Getopt::Long;my@specs;my$args={};for my$k (sort keys %$specs){my$v=$specs->{$k};die "Option specification '$k' conflicts with a " .ref$self ." option of the same name" if$self->valid_property($k);push@specs,$k .(defined$v->{type}? $v->{type}: '');push@specs,$v->{store}if exists$v->{store};$args->{$k}=$v->{default}if exists$v->{default}}local@ARGV=@argv;if (@specs){Getopt::Long::Configure('pass_through');Getopt::Long::GetOptions($args,@specs)}return$args,@ARGV}sub unparse_args {my ($self,$args)=@_;my@out;for my$k (sort keys %$args){my$v=$args->{$k};push@out,(ref$v eq 'HASH' ? map {+"--$k","$_=$v->{$_}"}sort keys %$v : ref$v eq 'ARRAY' ? map {+"--$k",$_}@$v : ("--$k",$v))}return@out}sub args {my$self=shift;return wantarray ? %{$self->{args}}: $self->{args}unless @_;my$key=shift;$self->{args}{$key}=shift if @_;return$self->{args}{$key}}sub _translate_option {my$self=shift;my$opt=shift;(my$tr_opt=$opt)=~ tr/-/_/;return$tr_opt if grep$tr_opt =~ /^(?:no_?)?$_$/,qw(create_license create_makefile_pl create_readme extra_compiler_flags extra_linker_flags install_base install_path meta_add meta_merge test_files use_rcfile use_tap_harness tap_harness_args cpan_client pureperl_only allow_pureperl);return$opt}my%singular_argument=map {($_=>1)}qw/install_base prefix destdir installdirs verbose quiet uninst debug sign/;sub _read_arg {my ($self,$args,$key,$val)=@_;$key=$self->_translate_option($key);if (exists$args->{$key}and not $singular_argument{$key}){$args->{$key}=[$args->{$key}]unless ref$args->{$key};push @{$args->{$key}},$val}else {$args->{$key}=$val}}sub _optional_arg {my$self=shift;my$opt=shift;my$argv=shift;$opt=$self->_translate_option($opt);my@bool_opts=qw(build_bat create_license create_readme pollute quiet uninst use_rcfile verbose debug sign use_tap_harness pureperl_only allow_pureperl);if (grep$opt =~ /^no[-_]?$_$/,@bool_opts){$opt =~ s/^no-?//;return ($opt,0)}return ($opt,shift(@$argv))unless grep $_ eq $opt,@bool_opts;my$arg=1;$arg=shift(@$argv)if @$argv && $argv->[0]=~ /^\d+$/;return ($opt,$arg)}sub read_args {my$self=shift;(my$args,@_)=$self->cull_options(@_);my%args=%$args;my$opt_re=qr/[\w\-]+/;my ($action,@argv);while (@_){local $_=shift;if (/^(?:--)?($opt_re)=(.*)$/){$self->_read_arg(\%args,$1,$2)}elsif (/^--($opt_re)$/){my($opt,$arg)=$self->_optional_arg($1,\@_);$self->_read_arg(\%args,$opt,$arg)}elsif (/^($opt_re)$/ and!defined($action)){$action=$1}else {push@argv,$_}}$args{ARGV}=\@argv;for ('extra_compiler_flags','extra_linker_flags'){$args{$_}=[$self->split_like_shell($args{$_})]if exists$args{$_}}for ('include_dirs'){$args{$_}=[$args{$_}]if exists$args{$_}&&!ref$args{$_}}for ($self->hash_properties,'config'){next unless exists$args{$_};my%hash;$args{$_}||= [];$args{$_}=[$args{$_}]unless ref$args{$_};for my$arg (@{$args{$_}}){$arg =~ /($opt_re)=(.*)/ or die "Malformed '$_' argument: '$arg' should be something like 'foo=bar'";$hash{$1}=$2}$args{$_}=\%hash}for my$key (qw(prefix install_base destdir)){next if!defined$args{$key};$args{$key}=$self->_detildefy($args{$key})}for my$key (qw(install_path)){next if!defined$args{$key};for my$subkey (keys %{$args{$key}}){next if!defined$args{$key}{$subkey};my$subkey_ext=$self->_detildefy($args{$key}{$subkey});if ($subkey eq 'html'){$args{$key}{binhtml}=$subkey_ext;$args{$key}{libhtml}=$subkey_ext}else {$args{$key}{$subkey}=$subkey_ext}}}if ($args{makefile_env_macros}){require Module::Build::Compat;%args=(%args,Module::Build::Compat->makefile_to_build_macros)}return \%args,$action}sub _detildefy {}sub _merge_arglist {my($self,$opts1,$opts2)=@_;$opts1 ||= {};$opts2 ||= {};my%new_opts=%$opts1;while (my ($key,$val)=each %$opts2){if (exists($opts1->{$key})){if (ref($val)eq 'HASH'){while (my ($k,$v)=each %$val){$new_opts{$key}{$k}=$v unless exists($opts1->{$key}{$k})}}}else {$new_opts{$key}=$val}}return%new_opts}sub _home_dir {my@home_dirs;push(@home_dirs,$ENV{HOME})if$ENV{HOME};push(@home_dirs,File::Spec->catpath($ENV{HOMEDRIVE},$ENV{HOMEPATH},''))if$ENV{HOMEDRIVE}&& $ENV{HOMEPATH};my@other_home_envs=qw(USERPROFILE APPDATA WINDIR SYS$LOGIN);push(@home_dirs,map$ENV{$_},grep$ENV{$_},@other_home_envs);my@real_home_dirs=grep -d,@home_dirs;return wantarray ? @real_home_dirs : shift(@real_home_dirs)}sub _find_user_config {my$self=shift;my$file=shift;for my$dir ($self->_home_dir){my$path=File::Spec->catfile($dir,$file);return$path if -e $path}return undef}sub read_modulebuildrc {my($self,$action)=@_;return ()unless$self->use_rcfile;my$modulebuildrc;if (exists($ENV{MODULEBUILDRC})&& $ENV{MODULEBUILDRC}eq 'NONE'){return ()}elsif (exists($ENV{MODULEBUILDRC})&& -e $ENV{MODULEBUILDRC}){$modulebuildrc=$ENV{MODULEBUILDRC}}elsif (exists($ENV{MODULEBUILDRC})){$self->log_warn("WARNING: Can't find resource file " ."'$ENV{MODULEBUILDRC}' defined in environment.\n" ."No options loaded\n");return ()}else {$modulebuildrc=$self->_find_user_config('.modulebuildrc');return ()unless$modulebuildrc}open(my$fh,'<',$modulebuildrc)or die "Can't open $modulebuildrc: $!";my%options;my$buffer='';while (defined(my$line=<$fh>)){chomp($line);$line =~ s/#.*$//;next unless length($line);if ($line =~ /^\S/){if ($buffer){my($action,$options)=split(/\s+/,$buffer,2);$options{$action}.= $options .' ';$buffer=''}$buffer=$line}else {$buffer .= $line}}if ($buffer){my($action,$options)=split(/\s+/,$buffer,2);$options{$action}.= $options .' '}my ($global_opts)=$self->read_args($self->split_like_shell($options{'*'}|| ''));if ($action eq 'fakeinstall' &&!exists$options{fakeinstall}){$action='install'}my ($action_opts)=$self->read_args($self->split_like_shell($options{$action}|| ''));return$self->_merge_arglist($action_opts,$global_opts)}sub merge_modulebuildrc {my($self,$action,%cmdline_opts)=@_;my%rc_opts=$self->read_modulebuildrc($action || $self->{action}|| 'build');my%new_opts=$self->_merge_arglist(\%cmdline_opts,\%rc_opts);$self->merge_args($action,%new_opts)}sub merge_args {my ($self,$action,%args)=@_;$self->{action}=$action if defined$action;my%additive=map {$_=>1}$self->hash_properties;while (my ($key,$val)=each%args){$self->{phash}{runtime_params}->access($key=>$val)if$self->valid_property($key);if ($key eq 'config'){$self->config($_=>$val->{$_})foreach keys %$val}else {my$add_to=$additive{$key}? $self->{properties}{$key}: $self->valid_property($key)? $self->{properties}: $self->{args};if ($additive{$key}){$add_to->{$_}=$val->{$_}foreach keys %$val}else {$add_to->{$key}=$val}}}}sub cull_args {my$self=shift;my@arg_list=@_;unshift@arg_list,$self->split_like_shell($ENV{PERL_MB_OPT})if$ENV{PERL_MB_OPT};my ($args,$action)=$self->read_args(@arg_list);$self->merge_args($action,%$args);$self->merge_modulebuildrc($action,%$args)}sub super_classes {my ($self,$class,$seen)=@_;$class ||= ref($self)|| $self;$seen ||= {};no strict 'refs';my@super=grep {not $seen->{$_}++}$class,@{$class .'::ISA'};return@super,map {$self->super_classes($_,$seen)}@super}sub known_actions {my ($self)=@_;my%actions;no strict 'refs';for my$class ($self->super_classes){for (keys %{$class .'::'}){$actions{$1}++ if /^ACTION_(\w+)/}}return wantarray ? sort keys%actions : \%actions}sub get_action_docs {my ($self,$action)=@_;my$actions=$self->known_actions;die "No known action '$action'" unless$actions->{$action};my ($files_found,@docs)=(0);for my$class ($self->super_classes){(my$file=$class)=~ s{::}{/}g;$file=$INC{$file .'.pm'}or next;open(my$fh,'<',$file)or next;$files_found++;local $_;while (<$fh>){last if /^=head1 ACTIONS\s/}my$style;while (<$fh>){last if /^=head1 /;if(/^=(item|head2)\s+\Q$action\E\b/){$style=$1;push@docs,$_;last}}$style or next;if($style eq 'item'){my ($found,$inlist)=(0,0);while (<$fh>){if (/^=(item|back)/){last unless$inlist}push@docs,$_;++$inlist if /^=over/;--$inlist if /^=back/}}else {while (<$fh>){last if(/^=(?:head[12]|cut)/);push@docs,$_}}}unless ($files_found){$@="Couldn't find any documentation to search";return}unless (@docs){$@="Couldn't find any docs for action '$action'";return}return join '',@docs}sub ACTION_prereq_report {my$self=shift;$self->log_info($self->prereq_report)}sub ACTION_prereq_data {my$self=shift;$self->log_info(Module::Build::Dumper->_data_dump($self->prereq_data))}sub prereq_data {my$self=shift;my@types=('configure_requires',@{$self->prereq_action_types});my$info={map {$_=>$self->$_()}grep {%{$self->$_()}}@types };return$info}sub prereq_report {my$self=shift;my$info=$self->prereq_data;my$output='';for my$type (sort keys %$info){my$prereqs=$info->{$type};$output .= "\n$type:\n";my$mod_len=2;my$ver_len=4;my%mods;for my$modname (sort keys %$prereqs){my$spec=$prereqs->{$modname};my$len=length$modname;$mod_len=$len if$len > $mod_len;$spec ||= '0';$len=length$spec;$ver_len=$len if$len > $ver_len;my$mod=$self->check_installed_status($modname,$spec);$mod->{name}=$modname;$mod->{ok}||= 0;$mod->{ok}=!$mod->{ok}if$type =~ /^(\w+_)?conflicts$/;$mods{lc$modname}=$mod}my$space=q{ } x ($mod_len - 3);my$vspace=q{ } x ($ver_len - 3);my$sline=q{-} x ($mod_len - 3);my$vline=q{-} x ($ver_len - 3);my$disposition=($type =~ /^(\w+_)?conflicts$/)? 'Clash' : 'Need';$output .= " Module $space $disposition $vspace Have\n"." ------$sline+------$vline-+----------\n";for my$k (sort keys%mods){my$mod=$mods{$k};my$space=q{ } x ($mod_len - length$k);my$vspace=q{ } x ($ver_len - length$mod->{need});my$f=$mod->{ok}? ' ' : '!';$output .= " $f $mod->{name} $space $mod->{need} $vspace ".(defined($mod->{have})? $mod->{have}: "")."\n"}}return$output}sub ACTION_help {my ($self)=@_;my$actions=$self->known_actions;if (@{$self->{args}{ARGV}}){my$msg=eval {$self->get_action_docs($self->{args}{ARGV}[0],$actions)};print $@ ? "$@\n" : $msg;return}print <_action_listing($actions);print "\nRun `Build help ` for details on an individual action.\n";print "See `perldoc Module::Build` for complete documentation.\n"}sub _action_listing {my ($self,$actions)=@_;my@actions=sort keys %$actions;@actions=map$actions[($_ + ($_ % 2)* @actions)/ 2],0..$#actions;my$out='';while (my ($one,$two)=splice@actions,0,2){$out .= sprintf(" %-12s %-12s\n",$one,$two||'')}$out =~ s{\s*$}{}mg;return$out}sub ACTION_retest {my ($self)=@_;local@INC=@INC;@INC=grep {ref()|| -d}@INC if@INC > 100;$self->do_tests}sub ACTION_testall {my ($self)=@_;my@types;for my$action (grep {$_ ne 'all'}$self->get_test_types){push(@types,$action)}$self->generic_test(types=>['default',@types])}sub get_test_types {my ($self)=@_;my$t=$self->{properties}->{test_types};return (defined$t ? (wantarray ? sort keys %$t : keys %$t): ())}sub ACTION_test {my ($self)=@_;$self->generic_test(type=>'default')}sub generic_test {my$self=shift;(@_ % 2)and croak('Odd number of elements in argument hash');my%args=@_;my$p=$self->{properties};my@types=((exists($args{type})? $args{type}: ()),(exists($args{types})? @{$args{types}}: ()),);@types or croak "need some types of tests to check";my%test_types=(default=>$p->{test_file_exts},(defined($p->{test_types})? %{$p->{test_types}}: ()),);for my$type (@types){croak "$type not defined in test_types!" unless defined$test_types{$type }}local$p->{test_file_exts}=[map {ref $_ ? @$_ : $_}@test_types{@types}];$self->depends_on('code');local@INC=@INC;unshift@INC,(File::Spec->catdir($p->{base_dir},$self->blib,'lib'),File::Spec->catdir($p->{base_dir},$self->blib,'arch'));@INC=grep {ref()|| -d}@INC if@INC > 100;$self->do_tests}sub do_tests {my$self=shift;my$tests=$self->find_test_files;local$ENV{PERL_DL_NONLAZY}=1;if(@$tests){my$args=$self->tap_harness_args;if($self->use_tap_harness or ($args and %$args)){my$aggregate=$self->run_tap_harness($tests);if ($aggregate->has_errors){die "Errors in testing. Cannot continue.\n"}}else {$self->run_test_harness($tests)}}else {$self->log_info("No tests defined.\n")}$self->run_visual_script}sub run_tap_harness {my ($self,$tests)=@_;require TAP::Harness::Env;my$aggregate=TAP::Harness::Env->create({lib=>[@INC],verbosity=>$self->{properties}{verbose},switches=>[$self->harness_switches ],%{$self->tap_harness_args},})->runtests(@$tests);return$aggregate}sub run_test_harness {my ($self,$tests)=@_;require Test::Harness;local$Test::Harness::verbose=$self->verbose || 0;local$Test::Harness::switches=join ' ',$self->harness_switches;Test::Harness::runtests(@$tests)}sub run_visual_script {my$self=shift;$self->run_perl_script('visual.pl','-Mblib='.$self->blib)if -e 'visual.pl'}sub harness_switches {my$self=shift;my@res;push@res,qw(-w -d) if$self->{properties}{debugger};push@res,'-MDevel::Cover' if$self->{properties}{cover};return@res}sub test_files {my$self=shift;my$p=$self->{properties};if (@_){return$p->{test_files}=(@_==1 ? shift : [@_])}return$self->find_test_files}sub expand_test_dir {my ($self,$dir)=@_;my$exts=$self->{properties}{test_file_exts};return sort map {@{$self->rscan_dir($dir,qr{^[^.].*\Q$_\E$})}}@$exts if$self->recursive_test_files;return sort map {glob File::Spec->catfile($dir,"*$_")}@$exts}sub ACTION_testdb {my ($self)=@_;local$self->{properties}{debugger}=1;$self->depends_on('test')}sub ACTION_testcover {my ($self)=@_;unless (Module::Metadata->find_module_by_name('Devel::Cover')){warn("Cannot run testcover action unless Devel::Cover is installed.\n");return}$self->add_to_cleanup('coverage','cover_db');$self->depends_on('code');if (-e 'cover_db'){my$pm_files=$self->rscan_dir (File::Spec->catdir($self->blib,'lib'),$self->file_qr('\.pm$'));my$cover_files=$self->rscan_dir('cover_db',sub {-f $_ and not /\.html$/});$self->do_system(qw(cover -delete))unless$self->up_to_date($pm_files,$cover_files)&& $self->up_to_date($self->test_files,$cover_files)}local$self->{properties}{cover}=1;$self->depends_on('test');$self->do_system('cover')}sub ACTION_code {my ($self)=@_;my$blib=$self->blib;$self->add_to_cleanup($blib);File::Path::mkpath(File::Spec->catdir($blib,'arch'));if (my$split=$self->autosplit){$self->autosplit_file($_,$blib)for ref($split)? @$split : ($split)}for my$element (@{$self->build_elements}){my$method="process_${element}_files";$method="process_files_by_extension" unless$self->can($method);$self->$method($element)}$self->depends_on('config_data')}sub ACTION_build {my$self=shift;$self->log_info("Building " .$self->dist_name ."\n");$self->depends_on('code');$self->depends_on('docs')}sub process_files_by_extension {my ($self,$ext)=@_;my$method="find_${ext}_files";my$files=$self->can($method)? $self->$method(): $self->_find_file_by_type($ext,'lib');for my$file (sort keys %$files){$self->copy_if_modified(from=>$file,to=>File::Spec->catfile($self->blib,$files->{$file}))}}sub process_support_files {my$self=shift;my$p=$self->{properties};return unless$p->{c_source};my$files;if (ref($p->{c_source})eq "ARRAY"){push @{$p->{include_dirs}},@{$p->{c_source}};for my$path (@{$p->{c_source}}){push @$files,@{$self->rscan_dir($path,$self->file_qr('\.c(c|p|pp|xx|\+\+)?$'))}}}else {push @{$p->{include_dirs}},$p->{c_source};$files=$self->rscan_dir($p->{c_source},$self->file_qr('\.c(c|p|pp|xx|\+\+)?$'))}for my$file (@$files){push @{$p->{objects}},$self->compile_c($file)}}sub process_share_dir_files {my$self=shift;my$files=$self->_find_share_dir_files;return unless$files;my$share_prefix=File::Spec->catdir($self->blib,qw/lib auto share/);for my$file (sort keys %$files){$self->copy_if_modified(from=>$file,to=>File::Spec->catfile($share_prefix,$files->{$file}))}}sub _find_share_dir_files {my$self=shift;my$share_dir=$self->share_dir;return unless$share_dir;my@file_map;if ($share_dir->{dist}){my$prefix="dist/".$self->dist_name;push@file_map,$self->_share_dir_map($prefix,$share_dir->{dist})}if ($share_dir->{module}){for my$mod (sort keys %{$share_dir->{module}}){(my$altmod=$mod)=~ s{::}{-}g;my$prefix="module/$altmod";push@file_map,$self->_share_dir_map($prefix,$share_dir->{module}{$mod})}}return {@file_map }}sub _share_dir_map {my ($self,$prefix,$list)=@_;my%files;for my$dir (@$list){for my$f (@{$self->rscan_dir($dir,sub {-f})}){$f =~ s{\A.*?\Q$dir\E/}{};$files{"$dir/$f"}="$prefix/$f"}}return%files}sub process_PL_files {my ($self)=@_;my$files=$self->find_PL_files;for my$file (sort keys %$files){my$to=$files->{$file};unless ($self->up_to_date($file,$to)){$self->run_perl_script($file,[],[@$to])or die "$file failed";$self->add_to_cleanup(@$to)}}}sub process_xs_files {my$self=shift;return if$self->pureperl_only && $self->allow_pureperl;my$files=$self->find_xs_files;croak 'Can\'t build xs files under --pureperl-only' if %$files && $self->pureperl_only;for my$from (sort keys %$files){my$to=$files->{$from};unless ($from eq $to){$self->add_to_cleanup($to);$self->copy_if_modified(from=>$from,to=>$to)}$self->process_xs($to)}}sub process_pod_files {shift()->process_files_by_extension(shift())}sub process_pm_files {shift()->process_files_by_extension(shift())}sub process_script_files {my$self=shift;my$files=$self->find_script_files;return unless keys %$files;my$script_dir=File::Spec->catdir($self->blib,'script');File::Path::mkpath($script_dir);for my$file (sort keys %$files){my$result=$self->copy_if_modified($file,$script_dir,'flatten')or next;$self->fix_shebang_line($result)unless$self->is_vmsish;$self->make_executable($result)}}sub find_PL_files {my$self=shift;if (my$files=$self->{properties}{PL_files}){if (ref$files eq 'ARRAY'){return {map {$_,[/^(.*)\.PL$/]}map$self->localize_file_path($_),@$files }}elsif (ref$files eq 'HASH'){my%out;while (my ($file,$to)=each %$files){$out{$self->localize_file_path($file)}=[map$self->localize_file_path($_),ref$to ? @$to : ($to)]}return \%out}else {die "'PL_files' must be a hash reference or array reference"}}return unless -d 'lib';return {map {$_,[/^(.*)\.PL$/i ]}@{$self->rscan_dir('lib',$self->file_qr('\.PL$'))}}}sub find_pm_files {shift->_find_file_by_type('pm','lib')}sub find_pod_files {shift->_find_file_by_type('pod','lib')}sub find_xs_files {shift->_find_file_by_type('xs','lib')}sub find_script_files {my$self=shift;if (my$files=$self->script_files){return {map {$self->localize_file_path($_),$files->{$_}}keys %$files }}return {}}sub find_test_files {my$self=shift;my$p=$self->{properties};if (my$files=$p->{test_files}){$files=[sort keys %$files]if ref$files eq 'HASH';$files=[map {-d $_ ? $self->expand_test_dir($_): $_}map glob,$self->split_like_shell($files)];return [map$self->localize_file_path($_),@$files ]}else {my@tests;push@tests,'test.pl' if -e 'test.pl';push@tests,$self->expand_test_dir('t')if -e 't' and -d _;return \@tests}}sub _find_file_by_type {my ($self,$type,$dir)=@_;if (my$files=$self->{properties}{"${type}_files"}){return {map$self->localize_file_path($_),%$files }}return {}unless -d $dir;return {map {$_,$_}map$self->localize_file_path($_),grep!/\.\#/,@{$self->rscan_dir($dir,$self->file_qr("\\.$type\$"))}}}sub localize_file_path {my ($self,$path)=@_;return File::Spec->catfile(split m{/},$path)}sub localize_dir_path {my ($self,$path)=@_;return File::Spec->catdir(split m{/},$path)}sub fix_shebang_line {my ($self,@files)=@_;my$c=ref($self)? $self->{config}: 'Module::Build::Config';my ($does_shbang)=$c->get('sharpbang')=~ /^\s*\#\!/;for my$file (@files){open(my$FIXIN,'<',$file)or die "Can't process '$file': $!";local $/="\n";chomp(my$line=<$FIXIN>);next unless$line =~ s/^\s*\#!\s*//;my ($cmd,$arg)=(split(' ',$line,2),'');next unless$cmd =~ /perl/i;my$interpreter=$self->{properties}{perl};$self->log_verbose("Changing sharpbang in $file to $interpreter\n");my$shb='';$shb .= $c->get('sharpbang')."$interpreter $arg\n" if$does_shbang;open(my$FIXOUT,'>',"$file.new")or die "Can't create new $file: $!\n";local $\;undef $/;print$FIXOUT $shb,<$FIXIN>;close$FIXIN;close$FIXOUT;rename($file,"$file.bak")or die "Can't rename $file to $file.bak: $!";rename("$file.new",$file)or die "Can't rename $file.new to $file: $!";$self->delete_filetree("$file.bak")or $self->log_warn("Couldn't clean up $file.bak, leaving it there");$self->do_system($c->get('eunicefix'),$file)if$c->get('eunicefix')ne ':'}}sub ACTION_testpod {my$self=shift;$self->depends_on('docs');eval q{use Test::Pod 0.95; 1} or die "The 'testpod' action requires Test::Pod version 0.95";my@files=sort keys %{$self->_find_pods($self->libdoc_dirs)},keys %{$self->_find_pods ($self->bindoc_dirs,exclude=>[$self->file_qr('\.bat$')])}or die "Couldn't find any POD files to test\n";{package Module::Build::PodTester;Test::Pod->import(tests=>scalar@files);pod_file_ok($_)foreach@files}}sub ACTION_testpodcoverage {my$self=shift;$self->depends_on('docs');eval q{use Test::Pod::Coverage 1.00; 1} or die "The 'testpodcoverage' action requires ","Test::Pod::Coverage version 1.00";local@INC=@INC;my$p=$self->{properties};unshift(@INC,File::Spec->catdir($p->{base_dir},$self->blib,'lib'),);all_pod_coverage_ok()}sub ACTION_docs {my$self=shift;$self->depends_on('code');$self->depends_on('manpages','html')}sub _is_default_installable {my$self=shift;my$type=shift;return ($self->install_destination($type)&& ($self->install_path($type)|| $self->install_sets($self->installdirs)->{$type}))? 1 : 0}sub _is_ActivePerl {my$self=shift;unless (exists($self->{_is_ActivePerl})){$self->{_is_ActivePerl}=(eval {require ActivePerl::DocTools}|| 0)}return$self->{_is_ActivePerl}}sub _is_ActivePPM {my$self=shift;unless (exists($self->{_is_ActivePPM})){$self->{_is_ActivePPM}=(eval {require ActivePerl::PPM}|| 0)}return$self->{_is_ActivePPM}}sub ACTION_manpages {my$self=shift;return unless$self->_mb_feature('manpage_support');$self->depends_on('code');my%extra_manify_args=$self->{properties}{'extra_manify_args'}? %{$self->{properties}{'extra_manify_args'}}: ();for my$type (qw(bin lib)){next unless ($self->invoked_action eq 'manpages' || $self->_is_default_installable("${type}doc"));my$files=$self->_find_pods($self->{properties}{"${type}doc_dirs"},exclude=>[$self->file_qr('\.bat$')]);next unless %$files;my$sub=$self->can("manify_${type}_pods");$self->$sub(%extra_manify_args)if defined($sub)}}sub manify_bin_pods {my$self=shift;my%podman_args=(section=>1,@_);my$files=$self->_find_pods($self->{properties}{bindoc_dirs},exclude=>[$self->file_qr('\.bat$')]);return unless keys %$files;my$mandir=File::Spec->catdir($self->blib,'bindoc');File::Path::mkpath($mandir,0,oct(777));require Pod::Man;for my$file (sort keys %$files){my$parser=Pod::Man->new(%podman_args);my$manpage=$self->man1page_name($file).'.' .$self->config('man1ext');my$outfile=File::Spec->catfile($mandir,$manpage);next if$self->up_to_date($file,$outfile);$self->log_verbose("Manifying $file -> $outfile\n");eval {$parser->parse_from_file($file,$outfile);1}or $self->log_warn("Error creating '$outfile': $@\n");$files->{$file}=$outfile}}sub manify_lib_pods {my$self=shift;my%podman_args=(section=>3,@_);my$files=$self->_find_pods($self->{properties}{libdoc_dirs});return unless keys %$files;my$mandir=File::Spec->catdir($self->blib,'libdoc');File::Path::mkpath($mandir,0,oct(777));require Pod::Man;for my$file (sort keys %$files){my$parser=Pod::Man->new(%podman_args);my$manpage=$self->man3page_name($files->{$file}).'.' .$self->config('man3ext');my$outfile=File::Spec->catfile($mandir,$manpage);next if$self->up_to_date($file,$outfile);$self->log_verbose("Manifying $file -> $outfile\n");eval {$parser->parse_from_file($file,$outfile);1}or $self->log_warn("Error creating '$outfile': $@\n");$files->{$file}=$outfile}}sub _find_pods {my ($self,$dirs,%args)=@_;my%files;for my$spec (@$dirs){my$dir=$self->localize_dir_path($spec);next unless -e $dir;FILE: foreach my$file (@{$self->rscan_dir($dir)}){for my$regexp (@{$args{exclude}}){next FILE if$file =~ $regexp}$file=$self->localize_file_path($file);$files{$file}=File::Spec->abs2rel($file,$dir)if$self->contains_pod($file)}}return \%files}sub contains_pod {my ($self,$file)=@_;return '' unless -T $file;open(my$fh,'<',$file)or die "Can't open $file: $!";while (my$line=<$fh>){return 1 if$line =~ /^\=(?:head|pod|item)/}return ''}sub ACTION_html {my$self=shift;return unless$self->_mb_feature('HTML_support');$self->depends_on('code');for my$type (qw(bin lib)){next unless ($self->invoked_action eq 'html' || $self->_is_default_installable("${type}html"));$self->htmlify_pods($type)}}sub htmlify_pods {my$self=shift;my$type=shift;my$htmldir=shift || File::Spec->catdir($self->blib,"${type}html");$self->add_to_cleanup('pod2htm*');my$pods=$self->_find_pods($self->{properties}{"${type}doc_dirs"},exclude=>[$self->file_qr('\.(?:bat|com|html)$')]);return unless %$pods;unless (-d $htmldir){File::Path::mkpath($htmldir,0,oct(755))or die "Couldn't mkdir $htmldir: $!"}my@rootdirs=($type eq 'bin')? qw(bin) : $self->installdirs eq 'core' ? qw(lib) : qw(site lib);my$podroot=$ENV{PERL_CORE}? File::Basename::dirname($ENV{PERL_CORE}): $self->original_prefix('core');my$htmlroot=$self->install_sets('core')->{libhtml};my$podpath;unless (defined$self->args('html_links')and!$self->args('html_links')){my@podpath=((map {File::Spec->abs2rel($_,$podroot)}grep {-d}($self->install_sets('core','lib'),$self->install_sets('core','bin'),$self->install_sets('site','lib'),)),File::Spec->rel2abs($self->blib));$podpath=$ENV{PERL_CORE}? File::Spec->catdir($podroot,'lib'): join(":",map {tr,:\\,|/,;$_}@podpath)}my$blibdir=join('/',File::Spec->splitdir((File::Spec->splitpath(File::Spec->rel2abs($htmldir),1))[1]),'');my ($with_ActiveState,$htmltool);if ($with_ActiveState=$self->_is_ActivePerl && eval {require ActivePerl::DocTools::Pod;1}){my$tool_v=ActiveState::DocTools::Pod->VERSION;$htmltool="ActiveState::DocTools::Pod";$htmltool .= " $tool_v" if$tool_v && length$tool_v}else {require Module::Build::PodParser;require Pod::Html;$htmltool="Pod::Html " .Pod::Html->VERSION}$self->log_verbose("Converting Pod to HTML with $htmltool\n");my$errors=0;POD: foreach my$pod (sort keys %$pods){my ($name,$path)=File::Basename::fileparse($pods->{$pod},$self->file_qr('\.(?:pm|plx?|pod)$'));my@dirs=File::Spec->splitdir(File::Spec->canonpath($path));pop(@dirs)if scalar(@dirs)&& $dirs[-1]eq File::Spec->curdir;my$fulldir=File::Spec->catdir($htmldir,@rootdirs,@dirs);my$tmpfile=File::Spec->catfile($fulldir,"${name}.tmp");my$outfile=File::Spec->catfile($fulldir,"${name}.html");my$infile=File::Spec->abs2rel($pod);next if$self->up_to_date($infile,$outfile);unless (-d $fulldir){File::Path::mkpath($fulldir,0,oct(755))or die "Couldn't mkdir $fulldir: $!"}$self->log_verbose("HTMLifying $infile -> $outfile\n");if ($with_ActiveState){my$depth=@rootdirs + @dirs;my%opts=(infile=>$infile,outfile=>$tmpfile,(defined($podpath)? (podpath=>$podpath): ()),podroot=>$podroot,index=>1,depth=>$depth,);eval {ActivePerl::DocTools::Pod::pod2html(map {($_,$opts{$_})}sort keys%opts);1}or $self->log_warn("[$htmltool] pod2html (" .join(", ",map {"q{$_} => q{$opts{$_}}"}(sort keys%opts)).") failed: $@")}else {my$path2root=File::Spec->catdir((File::Spec->updir)x @dirs);open(my$fh,'<',$infile)or die "Can't read $infile: $!";my$abstract=Module::Build::PodParser->new(fh=>$fh)->get_abstract();my$title=join('::',(@dirs,$name));$title .= " - $abstract" if$abstract;my@opts=("--title=$title",(defined($podpath)? "--podpath=$podpath" : ()),"--infile=$infile","--outfile=$tmpfile","--podroot=$podroot",($path2root ? "--htmlroot=$path2root" : ()),);unless (eval{Pod::Html->VERSION(1.12)}){push(@opts,('--flush'))}if (eval{Pod::Html->VERSION(1.12)}){push(@opts,('--header','--backlink'))}elsif (eval{Pod::Html->VERSION(1.03)}){push(@opts,('--header','--backlink=Back to Top'))}$self->log_verbose("P::H::pod2html @opts\n");{my$orig=Cwd::getcwd();eval {Pod::Html::pod2html(@opts);1}or $self->log_warn("[$htmltool] pod2html( " .join(", ",map {"q{$_}"}@opts).") failed: $@");chdir($orig)}}if (!-r $tmpfile){$errors++;next POD}open(my$fh,'<',$tmpfile)or die "Can't read $tmpfile: $!";my$html=join('',<$fh>);close$fh;if (!$self->_is_ActivePerl){$html =~ s#^##im;$html =~ s###i;$html =~ s##\n#i}$html =~ s/\Q$blibdir\E//g;open($fh,'>',$outfile)or die "Can't write $outfile: $!";print$fh $html;close$fh;unlink($tmpfile)}return!$errors}sub man1page_name {my$self=shift;return File::Basename::basename(shift)}sub man3page_name {my$self=shift;my ($vol,$dirs,$file)=File::Spec->splitpath(shift);my@dirs=File::Spec->splitdir(File::Spec->canonpath($dirs));$file =~ s/\.p(?:od|m|l)\z//i;return join($self->manpage_separator,@dirs,$file)}sub manpage_separator {return '::'}sub ACTION_diff {my$self=shift;$self->depends_on('build');my$local_lib=File::Spec->rel2abs('lib');my@myINC=grep {$_ ne $local_lib}@INC;push@myINC,map$self->install_destination($_),qw(lib arch);my@flags=@{$self->{args}{ARGV}};@flags=$self->split_like_shell($self->{args}{flags}|| '')unless@flags;my$installmap=$self->install_map;delete$installmap->{read};delete$installmap->{write};my$text_suffix=$self->file_qr('\.(pm|pod)$');for my$localdir (sort keys %$installmap){my@localparts=File::Spec->splitdir($localdir);my$files=$self->rscan_dir($localdir,sub {-f});for my$file (@$files){my@parts=File::Spec->splitdir($file);@parts=@parts[@localparts .. $#parts];my$installed=Module::Metadata->find_module_by_name(join('::',@parts),\@myINC);if (not $installed){print "Only in lib: $file\n";next}my$status=File::Compare::compare($installed,$file);next if$status==0;die "Can't compare $installed and $file: $!" if$status==-1;if ($file =~ $text_suffix){$self->do_system('diff',@flags,$installed,$file)}else {print "Binary files $file and $installed differ\n"}}}}sub ACTION_pure_install {shift()->depends_on('install')}sub ACTION_install {my ($self)=@_;require ExtUtils::Install;$self->depends_on('build');$self->_do_in_dir(".",sub {ExtUtils::Install::install($self->install_map,$self->verbose,0,$self->{args}{uninst}||0)});if ($self->_is_ActivePerl && $self->{_completed_actions}{html}){$self->log_info("Building ActivePerl Table of Contents\n");eval {ActivePerl::DocTools::WriteTOC(verbose=>$self->verbose ? 1 : 0);1}or $self->log_warn("AP::DT:: WriteTOC() failed: $@")}if ($self->_is_ActivePPM){my$F_perllocal=File::Spec->catfile($self->install_sets('core','lib'),'perllocal.pod');my$dt_stamp=time;$self->log_info("For ActivePerl's PPM: touch '$F_perllocal'\n");open my$perllocal,">>",$F_perllocal;close$perllocal;utime($dt_stamp,$dt_stamp,$F_perllocal)}}sub ACTION_fakeinstall {my ($self)=@_;require ExtUtils::Install;my$eui_version=ExtUtils::Install->VERSION;if ($eui_version < 1.32){$self->log_warn("The 'fakeinstall' action requires Extutils::Install 1.32 or later.\n" ."(You only have version $eui_version).");return}$self->depends_on('build');ExtUtils::Install::install($self->install_map,!$self->quiet,1,$self->{args}{uninst}||0)}sub ACTION_versioninstall {my ($self)=@_;die "You must have only.pm 0.25 or greater installed for this operation: $@\n" unless eval {require only;'only'->VERSION(0.25);1};$self->depends_on('build');my%onlyargs=map {exists($self->{args}{$_})? ($_=>$self->{args}{$_}): ()}qw(version versionlib);only::install::install(%onlyargs)}sub ACTION_installdeps {my ($self)=@_;my$info=$self->_enum_prereqs;if (!$info){$self->log_info("No prerequisites detected\n");return}my$failures=$self->prereq_failures($info);if (!$failures){$self->log_info("All prerequisites satisfied\n");return}my@install;for my$type (sort keys %$failures){my$prereqs=$failures->{$type};if($type =~ m/^(?:\w+_)?requires$/){push(@install,sort keys %$prereqs);next}$self->log_info("Checking optional dependencies:\n");for my$module (sort keys %$prereqs){push(@install,$module)if($self->y_n("Install $module?",'y'))}}return unless@install;my ($command,@opts)=$self->split_like_shell($self->cpan_client);if (!File::Spec->file_name_is_absolute($command)){my@loc=('site','vendor','');my@bindirs=File::Basename::dirname($self->perl);push@bindirs,map {($self->config->{"install${_}bin"},$self->config->{"install${_}script"})}@loc;for my$d (@bindirs){my$abs_cmd=$self->find_command(File::Spec->catfile($d,$command));if (defined$abs_cmd){$command=$abs_cmd;last}}}$self->do_system($command,@opts,@install)}sub ACTION_clean {my ($self)=@_;$self->log_info("Cleaning up build files\n");for my$item (map glob($_),$self->cleanup){$self->delete_filetree($item)}}sub ACTION_realclean {my ($self)=@_;$self->depends_on('clean');$self->log_info("Cleaning up configuration files\n");$self->delete_filetree($self->config_dir,$self->mymetafile,$self->mymetafile2,$self->build_script)}sub ACTION_ppd {my ($self)=@_;require Module::Build::PPMMaker;my$ppd=Module::Build::PPMMaker->new();my$file=$ppd->make_ppd(%{$self->{args}},build=>$self);$self->add_to_cleanup($file)}sub ACTION_ppmdist {my ($self)=@_;$self->depends_on('build');my$ppm=$self->ppm_name;$self->delete_filetree($ppm);$self->log_info("Creating $ppm\n");$self->add_to_cleanup($ppm,"$ppm.tar.gz");my%types=(lib=>'lib',arch=>'arch',bin=>'bin',script=>'script',bindoc=>'man1',libdoc=>'man3',binhtml=>undef,libhtml=>undef,);for my$type ($self->install_types){next if exists($types{$type})&&!defined($types{$type});my$dir=File::Spec->catdir($self->blib,$type);next unless -e $dir;my$files=$self->rscan_dir($dir);for my$file (@$files){next unless -f $file;my$rel_file=File::Spec->abs2rel(File::Spec->rel2abs($file),File::Spec->rel2abs($dir));my$to_file=File::Spec->catfile($ppm,'blib',exists($types{$type})? $types{$type}: $type,$rel_file);$self->copy_if_modified(from=>$file,to=>$to_file)}}for my$type (qw(bin lib)){$self->htmlify_pods($type,File::Spec->catdir($ppm,'blib','html'))}my$target=File::Spec->catfile(File::Spec->updir,$ppm);$self->_do_in_dir($ppm,sub {$self->make_tarball('blib',$target)});$self->depends_on('ppd');$self->delete_filetree($ppm)}sub ACTION_pardist {my ($self)=@_;if (not eval {require PAR::Dist;PAR::Dist->VERSION(0.17)}){$self->log_warn("In order to create .par distributions, you need to\n" ."install PAR::Dist first.");return()}$self->depends_on('build');return PAR::Dist::blib_to_par(name=>$self->dist_name,version=>$self->dist_version,)}sub ACTION_dist {my ($self)=@_;$self->dispatch('distdir');my$dist_dir=$self->dist_dir;$self->make_tarball($dist_dir);$self->delete_filetree($dist_dir)}sub ACTION_distcheck {my ($self)=@_;$self->_check_manifest_skip unless$self->invoked_action eq 'distclean';require ExtUtils::Manifest;local $^W;my ($missing,$extra)=ExtUtils::Manifest::fullcheck();return unless @$missing || @$extra;my$msg="MANIFEST appears to be out of sync with the distribution\n";if ($self->invoked_action eq 'distcheck'){die$msg}else {warn$msg}}sub _check_mymeta_skip {my$self=shift;my$maniskip=shift || 'MANIFEST.SKIP';require ExtUtils::Manifest;local $^W;my$skip_factory=ExtUtils::Manifest->can('maniskip')|| ExtUtils::Manifest->can('_maniskip');my$mymetafile=$self->mymetafile;for my$file ($self->mymetafile,$self->mymetafile2){unless ($skip_factory && $skip_factory->($maniskip)->($file)){$self->log_warn("File '$maniskip' does not include '$file'. Adding it now.\n");my$safe=quotemeta($file);$self->_append_maniskip("^$safe\$",$maniskip)}}}sub _add_to_manifest {my ($self,$manifest,$lines)=@_;$lines=[$lines]unless ref$lines;my$existing_files=$self->_read_manifest($manifest);return unless defined($existing_files);@$lines=grep {!exists$existing_files->{$_}}@$lines or return;my$mode=(stat$manifest)[2];chmod($mode | oct(222),$manifest)or die "Can't make $manifest writable: $!";open(my$fh,'<',$manifest)or die "Can't read $manifest: $!";my$last_line=(<$fh>)[-1]|| "\n";my$has_newline=$last_line =~ /\n$/;close$fh;open($fh,'>>',$manifest)or die "Can't write to $manifest: $!";print$fh "\n" unless$has_newline;print$fh map "$_\n",@$lines;close$fh;chmod($mode,$manifest);$self->log_verbose(map "Added to $manifest: $_\n",@$lines)}sub _sign_dir {my ($self,$dir)=@_;unless (eval {require Module::Signature;1}){$self->log_warn("Couldn't load Module::Signature for 'distsign' action:\n $@\n");return}{my$manifest=File::Spec->catfile($dir,'MANIFEST');die "Signing a distribution requires a MANIFEST file" unless -e $manifest;$self->_add_to_manifest($manifest,"SIGNATURE Added here by Module::Build")}$self->_do_in_dir($dir,sub {local$Module::Signature::Quiet=1;Module::Signature::sign()})}sub _do_in_dir {my ($self,$dir,$do)=@_;my$start_dir=File::Spec->rel2abs($self->cwd);chdir$dir or die "Can't chdir() to $dir: $!";eval {$do->()};my@err=$@ ? ($@): ();chdir$start_dir or push@err,"Can't chdir() back to $start_dir: $!";die join "\n",@err if@err}sub ACTION_distsign {my ($self)=@_;{local$self->{properties}{sign}=0;$self->depends_on('distdir')unless -d $self->dist_dir}$self->_sign_dir($self->dist_dir)}sub ACTION_skipcheck {my ($self)=@_;require ExtUtils::Manifest;local $^W;ExtUtils::Manifest::skipcheck()}sub ACTION_distclean {my ($self)=@_;$self->depends_on('realclean');$self->depends_on('distcheck')}sub do_create_makefile_pl {my$self=shift;require Module::Build::Compat;$self->log_info("Creating Makefile.PL\n");eval {Module::Build::Compat->create_makefile_pl($self->create_makefile_pl,$self,@_)};if ($@){1 while unlink 'Makefile.PL';die "$@\n"}$self->_add_to_manifest('MANIFEST','Makefile.PL')}sub do_create_license {my$self=shift;$self->log_info("Creating LICENSE file\n");if (!$self->_mb_feature('license_creation')){$self->_warn_mb_feature_deps('license_creation');die "Aborting.\n"}my$l=$self->license or die "Can't create LICENSE file: No license specified\n";my$license=$self->_software_license_object or die << "HERE";$self->delete_filetree('LICENSE');open(my$fh,'>','LICENSE')or die "Can't write LICENSE file: $!";print$fh $license->fulltext;close$fh;$self->_add_to_manifest('MANIFEST','LICENSE')}sub do_create_readme {my$self=shift;$self->delete_filetree('README');my$docfile=$self->_main_docfile;unless ($docfile){$self->log_warn(<can('new')}){$self->log_info("Creating README using Pod::Readme\n");my$parser=Pod::Readme->new;$parser->parse_from_file($docfile,'README',@_)}elsif (eval {require Pod::Text;1}){$self->log_info("Creating README using Pod::Text\n");if (open(my$fh,'>','README')){local $^W=0;no strict "refs";my$old_parse_file;$old_parse_file=\&{"Pod::Simple::parse_file"}and local *{"Pod::Simple::parse_file"}=sub {my$self=shift;$self->output_fh($_[1])if $_[1];$self->$old_parse_file($_[0])}if$Pod::Text::VERSION ==3.01;Pod::Text::pod2text($docfile,$fh);close$fh}else {$self->log_warn("Cannot create 'README' file: Can't open file for writing\n");return}}else {$self->log_warn("Can't load Pod::Readme or Pod::Text to create README\n");return}$self->_add_to_manifest('MANIFEST','README')}sub _main_docfile {my$self=shift;if (my$pm_file=$self->dist_version_from){(my$pod_file=$pm_file)=~ s/.pm$/.pod/;return (-e $pod_file ? $pod_file : $pm_file)}else {return undef}}sub do_create_bundle_inc {my$self=shift;my$dist_inc=File::Spec->catdir($self->dist_dir,'inc');require inc::latest;inc::latest->write($dist_inc,@{$self->bundle_inc_preload});inc::latest->bundle_module($_,$dist_inc)for @{$self->bundle_inc};return 1}sub ACTION_distdir {my ($self)=@_;if (@{$self->bundle_inc}&&!$self->_mb_feature('inc_bundling_support')){$self->_warn_mb_feature_deps('inc_bundling_support');die "Aborting.\n"}$self->depends_on('distmeta');my$dist_files=$self->_read_manifest('MANIFEST')or die "Can't create distdir without a MANIFEST file - run 'manifest' action first.\n";delete$dist_files->{SIGNATURE};die "No files found in MANIFEST - try running 'manifest' action?\n" unless ($dist_files and keys %$dist_files);my$metafile=$self->metafile;$self->log_warn("*** Did you forget to add $metafile to the MANIFEST?\n")unless exists$dist_files->{$metafile};my$dist_dir=$self->dist_dir;$self->delete_filetree($dist_dir);$self->log_info("Creating $dist_dir\n");$self->add_to_cleanup($dist_dir);for my$file (sort keys %$dist_files){next if$file =~ m{^MYMETA\.};my$new=$self->copy_if_modified(from=>$file,to_dir=>$dist_dir,verbose=>0)}$self->do_create_bundle_inc if @{$self->bundle_inc};$self->_sign_dir($dist_dir)if$self->{properties}{sign}}sub ACTION_disttest {my ($self)=@_;$self->depends_on('distdir');$self->_do_in_dir ($self->dist_dir,sub {local$ENV{AUTHOR_TESTING}=1;local$ENV{RELEASE_TESTING}=1;$self->run_perl_script('Build.PL')or die "Error executing 'Build.PL' in dist directory: $!";$self->run_perl_script($self->build_script)or die "Error executing $self->build_script in dist directory: $!";$self->run_perl_script($self->build_script,[],['test'])or die "Error executing 'Build test' in dist directory"})}sub ACTION_distinstall {my ($self,@args)=@_;$self->depends_on('distdir');$self->_do_in_dir ($self->dist_dir,sub {$self->run_perl_script('Build.PL')or die "Error executing 'Build.PL' in dist directory: $!";$self->run_perl_script($self->build_script)or die "Error executing $self->build_script in dist directory: $!";$self->run_perl_script($self->build_script,[],['install'])or die "Error executing 'Build install' in dist directory"})}sub _eumanifest_has_include {my$self=shift;require ExtUtils::Manifest;return eval {ExtUtils::Manifest->VERSION(1.50);1}}sub _default_maniskip {my$self=shift;my$default_maniskip;for my$dir (@INC){$default_maniskip=File::Spec->catfile($dir,"ExtUtils","MANIFEST.SKIP");last if -r $default_maniskip}return$default_maniskip}sub _slurp {my$self=shift;my$file=shift;my$mode=shift || "";open my$fh,"<$mode",$file or croak "Can't open $file for reading: $!";local $/;return <$fh>}sub _spew {my$self=shift;my$file=shift;my$content=shift || "";my$mode=shift || "";open my$fh,">$mode",$file or croak "Can't open $file for writing: $!";print {$fh}$content;close$fh}sub _case_tolerant {my$self=shift;if (ref$self){$self->{_case_tolerant}=File::Spec->case_tolerant unless defined($self->{_case_tolerant});return$self->{_case_tolerant}}else {return File::Spec->case_tolerant}}sub _append_maniskip {my$self=shift;my$skip=shift;my$file=shift || 'MANIFEST.SKIP';return unless defined$skip && length$skip;open(my$fh,'>>',$file)or die "Can't open $file: $!";print$fh "$skip\n";close$fh}sub _write_default_maniskip {my$self=shift;my$file=shift || 'MANIFEST.SKIP';open(my$fh,'>',$file)or die "Can't open $file: $!";my$content=$self->_eumanifest_has_include ? "#!include_default\n" : $self->_slurp($self->_default_maniskip);$content .= <<'EOF';$content .= '\b'.$self->dist_name.'-[\d\.\_]+'."\n";print$fh $content;close$fh;return}sub _check_manifest_skip {my ($self)=@_;my$maniskip='MANIFEST.SKIP';if (!-e $maniskip){$self->log_warn("File '$maniskip' does not exist: Creating a temporary '$maniskip'\n");$self->_write_default_maniskip($maniskip);$self->_unlink_on_exit($maniskip)}else {$self->_check_mymeta_skip($maniskip)}return}sub ACTION_manifest {my ($self)=@_;$self->_check_manifest_skip;require ExtUtils::Manifest;local ($^W,$ExtUtils::Manifest::Quiet)=(0,1);ExtUtils::Manifest::mkmanifest()}sub ACTION_manifest_skip {my ($self)=@_;if (-e 'MANIFEST.SKIP'){$self->log_warn("MANIFEST.SKIP already exists.\n");return 0}$self->log_info("Creating a new MANIFEST.SKIP file\n");return$self->_write_default_maniskip;return -e 'MANIFEST.SKIP'}sub file_qr {return shift->{_case_tolerant}? qr($_[0])i : qr($_[0])}sub dist_dir {my ($self)=@_;my$dir=join "-",$self->dist_name,$self->dist_version;$dir .= "-" .$self->dist_suffix if$self->dist_suffix;return$dir}sub ppm_name {my$self=shift;return 'PPM-' .$self->dist_dir}sub _files_in {my ($self,$dir)=@_;return unless -d $dir;local*DH;opendir DH,$dir or die "Can't read directory $dir: $!";my@files;while (defined (my$file=readdir DH)){my$full_path=File::Spec->catfile($dir,$file);next if -d $full_path;push@files,$full_path}return@files}sub share_dir {my$self=shift;my$p=$self->{properties};$p->{share_dir}=shift if @_;if (!defined$p->{share_dir}){return}elsif (!ref$p->{share_dir}){$p->{share_dir}={dist=>[$p->{share_dir}]}}elsif (ref$p->{share_dir}eq 'ARRAY'){$p->{share_dir}={dist=>$p->{share_dir}}}elsif (ref$p->{share_dir}eq 'HASH'){my$share_dir=$p->{share_dir};if (defined$share_dir->{dist}){if (!ref$share_dir->{dist}){$share_dir->{dist}=[$share_dir->{dist}]}elsif (ref$share_dir->{dist}ne 'ARRAY'){die "'dist' key in 'share_dir' must be scalar or arrayref"}}if (defined$share_dir->{module}){my$mod_hash=$share_dir->{module};if (ref$mod_hash eq 'HASH'){for my$k (sort keys %$mod_hash){if (!ref$mod_hash->{$k}){$mod_hash->{$k}=[$mod_hash->{$k}]}elsif(ref$mod_hash->{$k}ne 'ARRAY'){die "modules in 'module' key of 'share_dir' must be scalar or arrayref"}}}else {die "'module' key in 'share_dir' must be hashref"}}}else {die "'share_dir' must be hashref, arrayref or string"}return$p->{share_dir}}sub script_files {my$self=shift;for ($self->{properties}{script_files}){$_=shift if @_;next unless $_;return $_ if ref $_ eq 'HASH';return $_={map {$_,1}@$_ }if ref $_ eq 'ARRAY';die "'script_files' must be a hashref, arrayref, or string" if ref();return $_={map {$_,1}$self->_files_in($_)}if -d $_;return $_={$_=>1}}my%pl_files=map {File::Spec->canonpath($_)=>1}keys %{$self->PL_files || {}};my@bin_files=$self->_files_in('bin');my%bin_map=map {$_=>File::Spec->canonpath($_)}@bin_files;return $_={map {$_=>1}grep!$pl_files{$bin_map{$_}},@bin_files }}BEGIN {*scripts=\&script_files}{my%licenses=(perl=>'Perl_5',apache=>'Apache_2_0',apache_1_1=>'Apache_1_1',artistic=>'Artistic_1',artistic_2=>'Artistic_2',lgpl=>'LGPL_2_1',lgpl2=>'LGPL_2_1',lgpl3=>'LGPL_3_0',bsd=>'BSD',gpl=>'GPL_1',gpl2=>'GPL_2',gpl3=>'GPL_3',mit=>'MIT',mozilla=>'Mozilla_1_1',restrictive=>'Restricted',open_source=>undef,unrestricted=>undef,unknown=>undef,);my%license_urls=(perl=>'http://dev.perl.org/licenses/',apache=>'http://apache.org/licenses/LICENSE-2.0',apache_1_1=>'http://apache.org/licenses/LICENSE-1.1',artistic=>'http://opensource.org/licenses/artistic-license.php',artistic_2=>'http://opensource.org/licenses/artistic-license-2.0.php',lgpl=>'http://opensource.org/licenses/lgpl-license.php',lgpl2=>'http://opensource.org/licenses/lgpl-2.1.php',lgpl3=>'http://opensource.org/licenses/lgpl-3.0.html',bsd=>'http://opensource.org/licenses/bsd-license.php',gpl=>'http://opensource.org/licenses/gpl-license.php',gpl2=>'http://opensource.org/licenses/gpl-2.0.php',gpl3=>'http://opensource.org/licenses/gpl-3.0.html',mit=>'http://opensource.org/licenses/mit-license.php',mozilla=>'http://opensource.org/licenses/mozilla1.1.php',restrictive=>undef,open_source=>undef,unrestricted=>undef,unknown=>undef,);sub valid_licenses {return \%licenses}sub _license_url {return$license_urls{$_[1]}}}sub _software_license_class {my ($self,$license)=@_;if ($self->valid_licenses->{$license}&& eval {require Software::LicenseUtils;Software::LicenseUtils->VERSION(0.103009)}){my@classes=Software::LicenseUtils->guess_license_from_meta_key($license,1);if (@classes==1){eval "require $classes[0]";return$classes[0]}}LICENSE: for my$l ($self->valid_licenses->{$license },$license){next unless defined$l;my$trial="Software::License::" .$l;if (eval "require Software::License; Software::License->VERSION(0.014); require $trial; 1"){return$trial}}return}sub _software_license_object {my ($self)=@_;return unless defined(my$license=$self->license);my$class=$self->_software_license_class($license)or return;my$author=join(" & ",@{$self->dist_author})|| 'unknown';my$sl=eval {$class->new({holder=>$author})};if ($@){$self->log_warn("Error getting '$class' object: $@")}return$sl}sub _hash_merge {my ($self,$h,$k,$v)=@_;if (ref$h->{$k}eq 'ARRAY'){push @{$h->{$k}},ref$v ? @$v : $v}elsif (ref$h->{$k}eq 'HASH'){$h->{$k}{$_}=$v->{$_}foreach keys %$v}else {$h->{$k}=$v}}sub ACTION_distmeta {my ($self)=@_;$self->do_create_makefile_pl if$self->create_makefile_pl;$self->do_create_readme if$self->create_readme;$self->do_create_license if$self->create_license;$self->do_create_metafile}sub do_create_metafile {my$self=shift;return if$self->{wrote_metadata};my$p=$self->{properties};unless ($p->{license}){$self->log_warn("No license specified, setting license = 'unknown'\n");$p->{license}='unknown'}my@metafiles=($self->metafile,$self->metafile2);$self->delete_filetree($_)for@metafiles;local@INC=@INC;if (($self->module_name || '')eq 'Module::Build'){$self->depends_on('config_data');push@INC,File::Spec->catdir($self->blib,'lib')}my$meta_obj=$self->_get_meta_object(quiet=>1,fatal=>1,auto=>1);my@created=$self->_write_meta_files($meta_obj,'META');if (@created){$self->{wrote_metadata}=1;$self->_add_to_manifest('MANIFEST',$_)for@created}return 1}sub _write_meta_files {my$self=shift;my ($meta,$file)=@_;$file =~ s{\.(?:yml|json)$}{};my@created;push@created,"$file\.yml" if$meta && $meta->save("$file\.yml",{version=>"1.4"});push@created,"$file\.json" if$meta && $meta->save("$file\.json");if (@created){$self->log_info("Created " .join(" and ",@created)."\n")}return@created}sub _get_meta_object {my$self=shift;my%args=@_;return unless$self->try_require("CPAN::Meta","2.142060");my$meta;eval {my$data=$self->get_metadata(fatal=>$args{fatal},auto=>$args{auto},);$data->{dynamic_config}=$args{dynamic}if defined$args{dynamic};$meta=CPAN::Meta->create($data)};if ($@ &&!$args{quiet}){$self->log_warn("Could not get valid metadata. Error is: $@\n")}return$meta}sub read_metafile {my$self=shift;my ($metafile)=@_;return unless$self->try_require("CPAN::Meta","2.110420");my$meta=CPAN::Meta->load_file($metafile);return$meta->as_struct({version=>"2.0"})}sub normalize_version {my ($self,$version)=@_;$version=0 unless defined$version and length$version;if ($version =~ /[=<>!,]/){}elsif (ref$version eq 'version'){$version=$version->is_qv ? $version->normal : $version->stringify}elsif ($version =~ /^[^v][^.]*\.[^.]+\./){$version="v$version"}else {}return$version}my%prereq_map=(requires=>[qw/runtime requires/],configure_requires=>[qw/configure requires/],build_requires=>[qw/build requires/ ],test_requires=>[qw/test requires/ ],test_recommends=>[qw/test recommends/ ],recommends=>[qw/runtime recommends/ ],conflicts=>[qw/runtime conflicts/ ],);sub _normalize_prereqs {my ($self)=@_;my$p=$self->{properties};my%prereq_types;for my$type ('configure_requires',@{$self->prereq_action_types}){if (exists$p->{$type}and keys %{$p->{$type}}){my ($phase,$relation)=@{$prereq_map{$type}};for my$mod (keys %{$p->{$type}}){$prereq_types{$phase}{$relation}{$mod}=$self->normalize_version($p->{$type}{$mod})}}}return \%prereq_types}sub _get_license {my$self=shift;my$license=$self->license;my ($meta_license,$meta_license_url);my$valid_licenses=$self->valid_licenses();if (my$sl=$self->_software_license_object){$meta_license=$sl->meta2_name;$meta_license_url=$sl->url}elsif (exists$valid_licenses->{$license}){$meta_license=$valid_licenses->{$license}? lc$valid_licenses->{$license}: $license;$meta_license_url=$self->_license_url($license)}else {$self->log_warn("Can not determine license type for '" .$self->license ."'\nSetting META license field to 'unknown'.\n");$meta_license='unknown'}return ($meta_license,$meta_license_url)}sub get_metadata {my ($self,%args)=@_;my$fatal=$args{fatal}|| 0;my$p=$self->{properties};$self->auto_config_requires if$args{auto};for my$f (qw(dist_name dist_version dist_author dist_abstract license)){my$field=$self->$f();unless (defined$field and length$field){my$err="ERROR: Missing required field '$f' for metafile\n";if ($fatal){die$err}else {$self->log_warn($err)}}}my%metadata=(name=>$self->dist_name,version=>$self->normalize_version($self->dist_version),author=>$self->dist_author,abstract=>$self->dist_abstract,generated_by=>"Module::Build version $Module::Build::VERSION",'meta-spec'=>{version=>'2',url=>'http://search.cpan.org/perldoc?CPAN::Meta::Spec',},dynamic_config=>exists$p->{dynamic_config}? $p->{dynamic_config}: 1,release_status=>$self->release_status,);my ($meta_license,$meta_license_url)=$self->_get_license;$metadata{license}=[$meta_license ];$metadata{resources}{license}=[$meta_license_url ]if defined$meta_license_url;$metadata{prereqs}=$self->_normalize_prereqs;if (exists$p->{no_index}){$metadata{no_index}=$p->{no_index}}elsif (my$pkgs=eval {$self->find_dist_packages}){$metadata{provides}=$pkgs if %$pkgs}else {$self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" ."Nothing to enter for 'provides' field in metafile.\n")}if (my$add=$self->meta_add){if (not exists$add->{'meta-spec'}or $add->{'meta-spec'}{version}!=2){require CPAN::Meta::Converter;if (CPAN::Meta::Converter->VERSION('2.141170')){$add=CPAN::Meta::Converter->new($add)->upgrade_fragment;delete$add->{prereqs}}else {$self->log_warn("Can't meta_add without CPAN::Meta 2.141170")}}while (my($k,$v)=each %{$add}){$metadata{$k}=$v}}if (my$merge=$self->meta_merge){if (eval {require CPAN::Meta::Merge}){%metadata=%{CPAN::Meta::Merge->new(default_version=>'1.4')->merge(\%metadata,$merge)}}else {$self->log_warn("Can't merge without CPAN::Meta::Merge")}}return \%metadata}sub prepare_metadata {my ($self,$node,$keys,$args)=@_;unless (ref$node eq 'HASH'){croak "prepare_metadata() requires a hashref argument to hold output\n"}croak 'Keys argument to prepare_metadata is no longer supported' if$keys;%{$node}=%{$self->get_meta(%{$args})};return$node}sub _read_manifest {my ($self,$file)=@_;return undef unless -e $file;require ExtUtils::Manifest;local ($^W,$ExtUtils::Manifest::Quiet)=(0,1);return scalar ExtUtils::Manifest::maniread($file)}sub find_dist_packages {my$self=shift;my$manifest=$self->_read_manifest('MANIFEST')or die "Can't find dist packages without a MANIFEST file\nRun 'Build manifest' to generate one\n";my%dist_files=map {$self->localize_file_path($_)=>$_}keys %$manifest;my@pm_files=sort grep {$_ !~ m{^t}}grep {exists$dist_files{$_}}keys %{$self->find_pm_files};return$self->find_packages_in_files(\@pm_files,\%dist_files)}sub find_packages_in_files {my ($self,$file_list,$filename_map)=@_;my(%prime,%alt);for my$file (@{$file_list}){my$mapped_filename=$filename_map->{$file};my@path=split(/\//,$mapped_filename);(my$prime_package=join('::',@path[1..$#path]))=~ s/\.pm$//;my$pm_info=Module::Metadata->new_from_file($file);for my$package ($pm_info->packages_inside){next if$package eq 'main';next if$package eq 'DB';next if grep /^_/,split(/::/,$package);my$version=$pm_info->version($package);if ($package eq $prime_package){if (exists($prime{$package})){die "Unexpected conflict in '$package'; multiple versions found.\n"}else {$prime{$package}{file}=$mapped_filename;$prime{$package}{version}=$version if defined($version)}}else {push(@{$alt{$package}},{file=>$mapped_filename,version=>$version,})}}}for my$package (sort keys(%alt)){my$result=$self->_resolve_module_versions($alt{$package});if (exists($prime{$package})){if ($result->{err}){$self->log_warn("Found conflicting versions for package '$package'\n" ." $prime{$package}{file} ($prime{$package}{version})\n" .$result->{err})}elsif (defined($result->{version})){if (exists($prime{$package}{version})&& defined($prime{$package}{version})){if ($self->compare_versions($prime{$package}{version},'!=',$result->{version})){$self->log_warn("Found conflicting versions for package '$package'\n" ." $prime{$package}{file} ($prime{$package}{version})\n" ." $result->{file} ($result->{version})\n")}}else {$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}}}else {}}else {if ($result->{err}){$self->log_warn("Found conflicting versions for package '$package'\n" .$result->{err})}$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}if defined($result->{version})}}for my$provides (values%prime){if ($provides->{version}){$provides->{version}=$self->normalize_version($provides->{version})}else {delete$provides->{version}}}return \%prime}sub _resolve_module_versions {my$self=shift;my$packages=shift;my($file,$version);my$err='';for my$p (@$packages){if (defined($p->{version})){if (defined($version)){if ($self->compare_versions($version,'!=',$p->{version})){$err .= " $p->{file} ($p->{version})\n"}else {}}else {$file=$p->{file};$version=$p->{version}}}$file ||= $p->{file}if defined($p->{file})}if ($err){$err=" $file ($version)\n" .$err}my%result=(file=>$file,version=>$version,err=>$err);return \%result}sub make_tarball {my ($self,$dir,$file)=@_;$file ||= $dir;$self->log_info("Creating $file.tar.gz\n");if ($self->{args}{tar}){my$tar_flags=$self->verbose ? 'cvf' : 'cf';$self->do_system($self->split_like_shell($self->{args}{tar}),$tar_flags,"$file.tar",$dir);$self->do_system($self->split_like_shell($self->{args}{gzip}),"$file.tar")if$self->{args}{gzip}}else {eval {require Archive::Tar && Archive::Tar->VERSION(1.09);1}or die "You must install Archive::Tar 1.09+ to make a distribution tarball\n"."or specify a binary tar program with the '--tar' option.\n"."See the documentation for the 'dist' action.\n";my$files=$self->rscan_dir($dir);$Archive::Tar::DO_NOT_USE_PREFIX=(grep {length($_)>= 100}@$files)? 0 : 1;my$tar=Archive::Tar->new;$tar->add_files(@$files);for my$f ($tar->get_files){$f->mode($f->mode & ~022)}$tar->write("$file.tar.gz",1)}}sub install_path {my$self=shift;my($type,$value)=(@_,'');Carp::croak('Type argument missing')unless defined($type);my$map=$self->{properties}{install_path};return$map unless @_;unless (defined($value)){delete($map->{$type});return undef}if ($value eq ''){return undef unless exists$map->{$type};return$map->{$type}}return$map->{$type}=$value}sub install_sets {my ($self,$dirs,$key,$value)=@_;$dirs=$self->installdirs unless defined$dirs;if (@_==4 && defined$dirs && defined$key){$self->{properties}{install_sets}{$dirs}{$key}=$value}my$map={$self->_merge_arglist($self->{properties}{install_sets},$self->_default_install_paths->{install_sets})};if (defined$dirs && defined$key){return$map->{$dirs}{$key}}elsif (defined$dirs){return$map->{$dirs}}else {croak "Can't determine installdirs for install_sets()"}}sub original_prefix {my ($self,$key,$value)=@_;if (@_==3 && defined$key){$self->{properties}{original_prefix}{$key}=$value}my$map={$self->_merge_arglist($self->{properties}{original_prefix},$self->_default_install_paths->{original_prefix})};return$map unless defined$key;return$map->{$key}}sub install_base_relpaths {my$self=shift;if (@_ > 1){$self->_set_relpaths($self->{properties}{install_base_relpaths},@_)}my$map={$self->_merge_arglist($self->{properties}{install_base_relpaths},$self->_default_install_paths->{install_base_relpaths})};return$map unless @_;my$relpath=$map->{$_[0]};return defined$relpath ? File::Spec->catdir(@$relpath): undef}sub prefix_relpaths {my$self=shift;my$installdirs=shift || $self->installdirs or croak "Can't determine installdirs for prefix_relpaths()";if (@_ > 1){$self->{properties}{prefix_relpaths}{$installdirs}||= {};$self->_set_relpaths($self->{properties}{prefix_relpaths}{$installdirs},@_)}my$map={$self->_merge_arglist($self->{properties}{prefix_relpaths}{$installdirs},$self->_default_install_paths->{prefix_relpaths}{$installdirs})};return$map unless @_;my$relpath=$map->{$_[0]};return defined$relpath ? File::Spec->catdir(@$relpath): undef}sub _set_relpaths {my$self=shift;my($map,$type,$value)=@_;Carp::croak('Type argument missing')unless defined($type);if (!defined($value)){$map->{$type}=undef;return}else {Carp::croak("Value must be a relative path")if File::Spec::Unix->file_name_is_absolute($value);my@value=split(/\//,$value);$map->{$type}=\@value}}sub prefix_relative {my ($self,$type)=@_;my$installdirs=$self->installdirs;my$relpath=$self->install_sets($installdirs)->{$type};return$self->_prefixify($relpath,$self->original_prefix($installdirs),$type,)}sub _prefixify {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;$rprefix .= '/' if$sprefix =~ m|/$|;$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n")if defined($path)&& length($path);if(!defined($path)|| (length($path)==0)){$self->log_verbose(" no path to prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}elsif(!File::Spec->file_name_is_absolute($path)){$self->log_verbose(" path is relative, not prefixifying.\n")}elsif($path !~ s{^\Q$sprefix\E\b}{}s){$self->log_verbose(" cannot prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}$self->log_verbose(" now $path in $rprefix\n");return$path}sub _prefixify_default {my$self=shift;my$type=shift;my$rprefix=shift;my$default=$self->prefix_relpaths($self->installdirs,$type);if(!$default){$self->log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n");return$rprefix}else {return$default}}sub install_destination {my ($self,$type)=@_;return$self->install_path($type)if$self->install_path($type);if ($self->install_base){my$relpath=$self->install_base_relpaths($type);return$relpath ? File::Spec->catdir($self->install_base,$relpath): undef}if ($self->prefix){my$relpath=$self->prefix_relative($type);return$relpath ? File::Spec->catdir($self->prefix,$relpath): undef}return$self->install_sets($self->installdirs)->{$type}}sub install_types {my$self=shift;my%types;if ($self->install_base){%types=%{$self->install_base_relpaths}}elsif ($self->prefix){%types=%{$self->prefix_relpaths}}else {%types=%{$self->install_sets($self->installdirs)}}%types=(%types,%{$self->install_path});return sort keys%types}sub install_map {my ($self,$blib)=@_;$blib ||= $self->blib;my(%map,@skipping);for my$type ($self->install_types){my$localdir=File::Spec->catdir($blib,$type);next unless -e $localdir;if (my$dest=$self->install_destination($type)){$map{$localdir}=$dest}else {push(@skipping,$type)}}$self->log_warn("WARNING: Can't figure out install path for types: @skipping\n" ."Files will not be installed.\n")if@skipping;if ($self->create_packlist and my$module_name=$self->module_name){my$archdir=$self->install_destination('arch');my@ext=split /::/,$module_name;$map{write}=File::Spec->catfile($archdir,'auto',@ext,'.packlist')}if (length(my$destdir=$self->destdir || '')){for (keys%map){my ($volume,$path,$file)=File::Spec->splitpath($map{$_},0);my@dirs=File::Spec->splitdir($path);$path=File::Spec->catdir($destdir,@dirs);if ($file ne ''){$map{$_}=File::Spec->catfile($path,$file)}else {$map{$_}=$path}}}$map{read}='';return \%map}sub depends_on {my$self=shift;for my$action (@_){$self->_call_action($action)}}sub rscan_dir {my ($self,$dir,$pattern)=@_;my@result;local $_;my$subr=!$pattern ? sub {push@result,$File::Find::name}: !ref($pattern)|| (ref$pattern eq 'Regexp')? sub {push@result,$File::Find::name if /$pattern/}: ref($pattern)eq 'CODE' ? sub {push@result,$File::Find::name if$pattern->()}: die "Unknown pattern type";File::Find::find({wanted=>$subr,no_chdir=>1,preprocess=>sub {sort @_}},$dir);return \@result}sub delete_filetree {my$self=shift;my$deleted=0;for (@_){next unless -e $_;$self->log_verbose("Deleting $_\n");File::Path::rmtree($_,0,0);die "Couldn't remove '$_': $!\n" if -e $_;$deleted++}return$deleted}sub autosplit_file {my ($self,$file,$to)=@_;require AutoSplit;my$dir=File::Spec->catdir($to,'lib','auto');AutoSplit::autosplit($file,$dir)}sub cbuilder {my$self=shift;my$s=$self->{stash};return$s->{_cbuilder}if$s->{_cbuilder};require ExtUtils::CBuilder;return$s->{_cbuilder}=ExtUtils::CBuilder->new(config=>$self->config,($self->quiet ? (quiet=>1): ()),)}sub have_c_compiler {my ($self)=@_;my$p=$self->{properties};return$p->{_have_c_compiler}if defined$p->{_have_c_compiler};$self->log_verbose("Checking if compiler tools configured... ");my$b=$self->cbuilder;my$have=$b && eval {$b->have_compiler};$self->log_verbose($have ? "ok.\n" : "failed.\n");return$p->{_have_c_compiler}=$have}sub compile_c {my ($self,$file,%args)=@_;if (!$self->have_c_compiler){die "Error: no compiler detected to compile '$file'. Aborting\n"}my$b=$self->cbuilder;my$obj_file=$b->object_file($file);$self->add_to_cleanup($obj_file);return$obj_file if$self->up_to_date($file,$obj_file);$b->compile(source=>$file,defines=>$args{defines},object_file=>$obj_file,include_dirs=>$self->include_dirs,extra_compiler_flags=>$self->extra_compiler_flags,);return$obj_file}sub link_c {my ($self,$spec)=@_;my$p=$self->{properties};$self->add_to_cleanup($spec->{lib_file});my$objects=$p->{objects}|| [];return$spec->{lib_file}if$self->up_to_date([$spec->{obj_file},@$objects],$spec->{lib_file});my$module_name=$spec->{module_name}|| $self->module_name;$self->cbuilder->link(module_name=>$module_name,objects=>[$spec->{obj_file},@$objects],lib_file=>$spec->{lib_file},extra_linker_flags=>$self->extra_linker_flags);return$spec->{lib_file}}sub compile_xs {my ($self,$file,%args)=@_;$self->log_verbose("$file -> $args{outfile}\n");if (eval {require ExtUtils::ParseXS;1}){ExtUtils::ParseXS::process_file(filename=>$file,prototypes=>0,output=>$args{outfile},)}else {my$xsubpp=Module::Metadata->find_module_by_name('ExtUtils::xsubpp')or die "Can't find ExtUtils::xsubpp in INC (@INC)";my@typemaps;push@typemaps,Module::Metadata->find_module_by_name('ExtUtils::typemap',\@INC);my$lib_typemap=Module::Metadata->find_module_by_name('typemap',[File::Basename::dirname($file),File::Spec->rel2abs('.')]);push@typemaps,$lib_typemap if$lib_typemap;@typemaps=map {+'-typemap',$_}@typemaps;my$cf=$self->{config};my$perl=$self->{properties}{perl};my@command=($perl,"-I".$cf->get('installarchlib'),"-I".$cf->get('installprivlib'),$xsubpp,'-noprototypes',@typemaps,$file);$self->log_info("@command\n");open(my$fh,'>',$args{outfile})or die "Couldn't write $args{outfile}: $!";print {$fh}$self->_backticks(@command);close$fh}}sub split_like_shell {my ($self,$string)=@_;return ()unless defined($string);return @$string if ref$string eq 'ARRAY';$string =~ s/^\s+|\s+$//g;return ()unless length($string);return Text::ParseWords::shellwords($string)}sub oneliner {my($self,$cmd,$switches,$args)=@_;$switches=[]unless defined$switches;$args=[]unless defined$args;$cmd =~ s{^\n+}{};$cmd =~ s{\n+$}{};my$perl=ref($self)? $self->perl : $self->find_perl_interpreter;return$self->_quote_args($perl,@$switches,'-e',$cmd,@$args)}sub run_perl_script {my ($self,$script,$preargs,$postargs)=@_;for ($preargs,$postargs){$_=[$self->split_like_shell($_)]unless ref()}return$self->run_perl_command([@$preargs,$script,@$postargs])}sub run_perl_command {my ($self,$args)=@_;$args=[$self->split_like_shell($args)]unless ref($args);my$perl=ref($self)? $self->perl : $self->find_perl_interpreter;local$ENV{PERL5LIB}=join$self->config('path_sep'),$self->_added_to_INC;return$self->do_system($perl,@$args)}sub _infer_xs_spec {my$self=shift;my$file=shift;my$cf=$self->{config};my%spec;my($v,$d,$f)=File::Spec->splitpath($file);my@d=File::Spec->splitdir($d);(my$file_base=$f)=~ s/\.[^.]+$//i;$spec{base_name}=$file_base;$spec{src_dir}=File::Spec->catpath($v,$d,'');shift(@d)while@d && ($d[0]eq 'lib' || $d[0]eq '');pop(@d)while@d && $d[-1]eq '';$spec{module_name}=join('::',(@d,$file_base));$spec{archdir}=File::Spec->catdir($self->blib,'arch','auto',@d,$file_base);$spec{c_file}=File::Spec->catfile($spec{src_dir},"${file_base}.c");$spec{obj_file}=File::Spec->catfile($spec{src_dir},"${file_base}".$cf->get('obj_ext'));require DynaLoader;my$modfname=defined&DynaLoader::mod2fname ? DynaLoader::mod2fname([@d,$file_base]): $file_base;$spec{bs_file}=File::Spec->catfile($spec{archdir},"$modfname.bs");$spec{lib_file}=File::Spec->catfile($spec{archdir},"$modfname.".$cf->get('dlext'));return \%spec}sub process_xs {my ($self,$file)=@_;my$spec=$self->_infer_xs_spec($file);(my$file_base=$file)=~ s/\.[^.]+$//;$self->add_to_cleanup($spec->{c_file});unless ($self->up_to_date($file,$spec->{c_file})){$self->compile_xs($file,outfile=>$spec->{c_file})}my$v=$self->dist_version;$self->compile_c($spec->{c_file},defines=>{VERSION=>qq{"$v"},XS_VERSION=>qq{"$v"}});File::Path::mkpath($spec->{archdir},0,oct(777))unless -d $spec->{archdir};$self->add_to_cleanup($spec->{bs_file});unless ($self->up_to_date($file,$spec->{bs_file})){require ExtUtils::Mkbootstrap;$self->log_info("ExtUtils::Mkbootstrap::Mkbootstrap('$spec->{bs_file}')\n");ExtUtils::Mkbootstrap::Mkbootstrap($spec->{bs_file});open(my$fh,'>>',$spec->{bs_file});utime((time)x2,$spec->{bs_file})}$self->link_c($spec)}sub do_system {my ($self,@cmd)=@_;$self->log_verbose("@cmd\n");my%seen;my$sep=$self->config('path_sep');local$ENV{PERL5LIB}=(!exists($ENV{PERL5LIB})? '' : length($ENV{PERL5LIB})< 500 ? $ENV{PERL5LIB}: join$sep,grep {!$seen{$_}++ and -d $_}split($sep,$ENV{PERL5LIB}));my$status=system(@cmd);if ($status and $! =~ /Argument list too long/i){my$env_entries='';for (sort keys%ENV){$env_entries .= "$_=>".length($ENV{$_})."; "}warn "'Argument list' was 'too long', env lengths are $env_entries"}return!$status}sub copy_if_modified {my$self=shift;my%args=(@_ > 3 ? (@_): (from=>shift,to_dir=>shift,flatten=>shift));$args{verbose}=!$self->quiet unless exists$args{verbose};my$file=$args{from};unless (defined$file and length$file){die "No 'from' parameter given to copy_if_modified"}$args{flatten}=1 if File::Spec->file_name_is_absolute($file);my$to_path;if (defined$args{to}and length$args{to}){$to_path=$args{to}}elsif (defined$args{to_dir}and length$args{to_dir}){$to_path=File::Spec->catfile($args{to_dir},$args{flatten}? File::Basename::basename($file): $file)}else {die "No 'to' or 'to_dir' parameter given to copy_if_modified"}return if$self->up_to_date($file,$to_path);{local$self->{properties}{quiet}=1;$self->delete_filetree($to_path)}File::Path::mkpath(File::Basename::dirname($to_path),0,oct(777));$self->log_verbose("Copying $file -> $to_path\n");if ($^O eq 'os2'){chmod 0666,$to_path;File::Copy::syscopy($file,$to_path,0x1)or die "Can't copy('$file', '$to_path'): $!"}else {File::Copy::copy($file,$to_path)or die "Can't copy('$file', '$to_path'): $!"}my$mode=oct(444)| ($self->is_executable($file)? oct(111): 0);chmod($mode,$to_path);return$to_path}sub up_to_date {my ($self,$source,$derived)=@_;$source=[$source]unless ref$source;$derived=[$derived]unless ref$derived;return 0 if @$source &&!@$derived || grep {not -e}@$derived;my$most_recent_source=time / (24*60*60);for my$file (@$source){unless (-e $file){$self->log_warn("Can't find source file $file for up-to-date check");next}$most_recent_source=-M _ if -M _ < $most_recent_source}for my$derived (@$derived){return 0 if -M $derived > $most_recent_source}return 1}sub dir_contains {my ($self,$first,$second)=@_;($first,$second)=map File::Spec->canonpath($_),($first,$second);my@first_dirs=File::Spec->splitdir($first);my@second_dirs=File::Spec->splitdir($second);return 0 if@second_dirs < @first_dirs;my$is_same=($self->_case_tolerant ? sub {lc(shift())eq lc(shift())}: sub {shift()eq shift()});while (@first_dirs){return 0 unless$is_same->(shift@first_dirs,shift@second_dirs)}return 1}1; + + ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions + of the modules indicated above before proceeding with this installation + + EOF + * FATAL ERROR: Perl interpreter mismatch. Configuration was initially + created with '$self->{properties}{perl}' + but we are now using '$perl'. You must + run 'Build realclean' or 'make realclean' and re-configure. + DIEFATAL + * WARNING: Configuration was initially created with Module::Build + version '$self->{properties}{mb_version}' but we are now using version '$mb_version'. + If errors occur, you must re-run the Build.PL or Makefile.PL script. + MISMATCH + ERROR: This build seems to be unattended, but there is no default value + for this question. Aborting. + EOF + package $opts{class}; + use $pack; + \@ISA = qw($pack); + $opts{code} + 1; + EOF + No 'module_name' was provided and it could not be inferred + from other properties. This will prevent a packlist from + being written for this file. Please set either 'module_name' + or 'dist_version_from' in Build.PL. + END_WARN + Bundling in inc/ is disabled because ExtUtils::Installed could not + create a list of your installed modules. Here is the error: + $@ + EUI_ERROR + Could not find a packlist for '$mod'. If it's a core module, try + force installing it from CPAN. + NO_PACKLIST + Module::Build was not found in configure_requires! Adding it now + automatically as: configure_requires => { 'Module::Build' => $ver } + EOM + Warning: ExtUtils::CBuilder not installed or no compiler detected + Proceeding with configuration, but compilation may fail during Build + + EOM + if ($INC[-1] ne '.') { + push @INC, '.'; + } + END + $shebang + + use strict; + use Cwd; + use File::Basename; + use File::Spec; + + sub magic_number_matches { + return 0 unless -e '$q{magic_numfile}'; + my \$FH; + open \$FH, '<','$q{magic_numfile}' or return 0; + my \$filenum = <\$FH>; + close \$FH; + return \$filenum == $magic_number; + } + + my \$progname; + my \$orig_dir; + BEGIN { + \$^W = 1; # Use warnings + \$progname = basename(\$0); + \$orig_dir = Cwd::cwd(); + my \$base_dir = '$q{base_dir}'; + if (!magic_number_matches()) { + unless (chdir(\$base_dir)) { + die ("Couldn't chdir(\$base_dir), aborting\\n"); + } + unless (magic_number_matches()) { + die ("Configuration seems to be out of date, please re-run 'perl Build.PL' again.\\n"); + } + } + unshift \@INC, + ( + $quoted_INC + ); + $dot_in_inc_code + } + + close(*DATA) unless eof(*DATA); # ensure no open handles to this script + + use $build_package; + Module::Build->VERSION(q{$config_requires}); + + # Some platforms have problems setting \$^X in shebang contexts, fix it up here + \$^X = Module::Build->find_perl_interpreter; + + if (-e 'Build.PL' and not $build_package->up_to_date('Build.PL', \$progname)) { + warn "Warning: Build.PL has been altered. You may need to run 'perl Build.PL' again.\\n"; + } + + # This should have just enough arguments to be able to bootstrap the rest. + my \$build = $build_package->resume ( + properties => { + config_dir => '$q{config_dir}', + orig_dir => \$orig_dir, + }, + ); + + \$build->dispatch; + EOF + + Usage: $0 --arg1=value --arg2=value ... + Example: $0 test --verbose=1 + + Actions defined: + EOF + Can't create LICENSE file: '$l' is not a valid license key + or Software::License subclass; + HERE + Cannot create README: can't determine which file contains documentation; + Must supply either 'dist_version_from', or 'module_name' parameter. + EOF + # Avoid configuration metadata file + ^MYMETA\. + + # Avoid Module::Build generated and utility files. + \bBuild$ + \bBuild.bat$ + \b_build + \bBuild.COM$ + \bBUILD.COM$ + \bbuild.com$ + ^MANIFEST\.SKIP + + # Avoid archives of this distribution + EOF +MODULE_BUILD_BASE + +$fatpacked{"Module/Build/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_COMPAT'; + package Module::Build::Compat;use strict;use warnings;our$VERSION='0.4224';use File::Basename ();use File::Spec;use Config;use Module::Build;use Module::Metadata;use version;use Data::Dumper;my%convert_installdirs=(PERL=>'core',SITE=>'site',VENDOR=>'vendor',);my%makefile_to_build=(TEST_VERBOSE=>'verbose',VERBINST=>'verbose',INC=>sub {map {(extra_compiler_flags=>$_)}Module::Build->split_like_shell(shift)},POLLUTE=>sub {(extra_compiler_flags=>'-DPERL_POLLUTE')},INSTALLDIRS=>sub {(installdirs=>$convert_installdirs{uc shift()})},LIB=>sub {my$lib=shift;my%config=(installprivlib=>$lib,installsitelib=>$lib,installarchlib=>"$lib/$Config{archname}",installsitearch=>"$lib/$Config{archname}");return map {(config=>"$_=$config{$_}")}sort keys%config},(map {my$name=$_;$name=>sub {my@ret=(config=>lc($name)."=" .shift);print STDERR "# Converted to @ret\n";return@ret}}qw(INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR)),map {$_,lc($_)}qw(DESTDIR PREFIX INSTALL_BASE UNINST),);my%macro_to_build=%makefile_to_build;delete$macro_to_build{LIB};sub _merge_prereq {my ($req,$breq)=@_;$req ||= {};$breq ||= {};for my$p ($req,$breq){for my$k (sort keys %$p){next if$k eq 'perl';my$v_obj=eval {version->new($p->{$k})};if (!defined$v_obj){die "A prereq of the form '$p->{$k}' for '$k' is not supported by Module::Build::Compat ( use a simpler version like '0.05' or 'v1.4.25' )\n"}if ($v_obj->is_qv){my$proper_ver=$v_obj->numify;warn "Dotted-decimal prereq '$p->{$k}' for '$k' is not portable - converting it to '$proper_ver'\n";$p->{$k}=$proper_ver}}}my$merge={%$req };for my$k (keys %$breq){my$v1=$merge->{$k}|| 0;my$v2=$breq->{$k};$merge->{$k}=$v1 > $v2 ? $v1 : $v2}return %$merge}sub create_makefile_pl {my ($package,$type,$build,%args)=@_;die "Don't know how to build Makefile.PL of type '$type'" unless$type =~ /^(small|passthrough|traditional)$/;if ($type eq 'passthrough'){$build->log_warn(<<"HERE")}my$fh;if ($args{fh}){$fh=$args{fh}}else {$args{file}||= 'Makefile.PL';local$build->{properties}{quiet}=1;$build->delete_filetree($args{file});open($fh,'>',"$args{file}")or die "Can't write $args{file}: $!"}print {$fh}"# Note: this file was auto-generated by ",__PACKAGE__," version $VERSION\n";my$requires=$build->requires;if (my$minimum_perl=$requires->{perl}){my$min_ver=version->new($minimum_perl)->numify;print {$fh}"require $min_ver;\n"}my$subclass_load='';if (ref($build)ne "Module::Build"){my$subclass_dir=$package->subclass_dir($build);if (File::Spec->file_name_is_absolute($subclass_dir)){my$base_dir=$build->base_dir;if ($build->dir_contains($base_dir,$subclass_dir)){$subclass_dir=File::Spec->abs2rel($subclass_dir,$base_dir);$subclass_dir=$package->unixify_dir($subclass_dir);$subclass_load="use lib '$subclass_dir';"}}else {$subclass_dir=$package->unixify_dir($subclass_dir);$subclass_load="use lib '$subclass_dir';"}}if ($type eq 'small'){printf {$fh}<<'EOF',$subclass_load,ref($build),ref($build)}elsif ($type eq 'passthrough'){printf {$fh}<<'EOF',$subclass_load,ref($build),ref($build)}elsif ($type eq 'traditional'){my (%MM_Args,%prereq);if (eval "use Tie::IxHash 1.2; 1"){tie%MM_Args,'Tie::IxHash';tie%prereq,'Tie::IxHash'}my%name=($build->module_name ? (NAME=>$build->module_name): (DISTNAME=>$build->dist_name));my%version=($build->dist_version_from ? (VERSION_FROM=>$build->dist_version_from): (VERSION=>$build->dist_version));%MM_Args=(%name,%version);%prereq=_merge_prereq($build->requires,$build->build_requires);%prereq=map {$_,$prereq{$_}}sort keys%prereq;delete$prereq{perl};$MM_Args{PREREQ_PM}=\%prereq;$MM_Args{INSTALLDIRS}=$build->installdirs eq 'core' ? 'perl' : $build->installdirs;$MM_Args{EXE_FILES}=[sort keys %{$build->script_files}]if$build->script_files;$MM_Args{PL_FILES}=$build->PL_files || {};if ($build->recursive_test_files){$MM_Args{test}={TESTS=>join q{ },$package->_test_globs($build)}}local$Data::Dumper::Terse=1;my$args=Data::Dumper::Dumper(\%MM_Args);$args =~ s/\{(.*)\}/($1)/s;print$fh <<"EOF"}}sub _test_globs {my ($self,$build)=@_;return map {File::Spec->catfile($_,'*.t')}@{$build->rscan_dir('t',sub {-d $File::Find::name})}}sub subclass_dir {my ($self,$build)=@_;return (Module::Metadata->find_module_dir_by_name(ref$build)|| File::Spec->catdir($build->config_dir,'lib'))}sub unixify_dir {my ($self,$path)=@_;return join '/',File::Spec->splitdir($path)}sub makefile_to_build_args {my$class=shift;my@out;for my$arg (@_){next if$arg eq '';my ($key,$val)=($arg =~ /^(\w+)=(.+)/ ? ($1,$2): die "Malformed argument '$arg'");($val)=Module::Build->_detildefy($val)if$val =~ /^~/;if (exists$makefile_to_build{$key}){my$trans=$makefile_to_build{$key};push@out,$class->_argvify(ref($trans)? $trans->($val): ($trans=>$val))}elsif (exists$Config{lc($key)}){push@out,$class->_argvify(config=>lc($key)."=$val")}else {push@out,$class->_argvify("\L$key"=>$val)}}return@out}sub _argvify {my ($self,@pairs)=@_;my@out;while (@pairs){my ($k,$v)=splice@pairs,0,2;push@out,("--$k",$v)}return@out}sub makefile_to_build_macros {my@out;my%config;for my$macro (sort keys%macro_to_build){my$trans=$macro_to_build{$macro};next unless exists$ENV{$macro}&& length$ENV{$macro};my$val=$ENV{$macro};my@args=ref($trans)? $trans->($val): ($trans=>$val);while (@args){my ($k,$v)=splice(@args,0,2);if ($k eq 'config'){if ($v =~ /^([^=]+)=(.*)$/){$config{$1}=$2}else {warn "Couldn't parse config '$v'\n"}}else {push@out,($k=>$v)}}}push@out,(config=>\%config)if%config;return@out}sub run_build_pl {my ($pack,%in)=@_;$in{script}||= 'Build.PL';my@args=$in{args}? $pack->makefile_to_build_args(@{$in{args}}): ();print "# running $in{script} @args\n";Module::Build->run_perl_script($in{script},[],\@args)or die "Couldn't run $in{script}: $!"}sub fake_makefile {my ($self,%args)=@_;unless (exists$args{build_class}){warn "Unknown 'build_class', defaulting to 'Module::Build'\n";$args{build_class}='Module::Build'}my$class=$args{build_class};my$perl=$class->find_perl_interpreter;$perl='MCR ' .$perl if$self->_is_vms_mms;my$noop=($class->is_windowsish ? 'rem>nul' : $self->_is_vms_mms ? 'Continue' : 'true');my$filetype=$class->is_vmsish ? '.COM' : '';my$Build='Build' .$filetype .' --makefile_env_macros 1';my$unlink=$class->oneliner('1 while unlink $ARGV[0]',[],[$args{makefile}]);$unlink =~ s/\$/\$\$/g unless$class->is_vmsish;my$maketext=join '',map {"$_=\n"}sort keys%macro_to_build;$maketext .= ($^O eq 'os2' ? "SHELL = sh\n\n" : $^O eq 'MSWin32' && $Config{make}=~ /gmake/ ? "SHELL = $ENV{COMSPEC}\n\n" : "\n\n");$maketext .= <<"EOF";for my$action ($class->known_actions){next if$action =~ /^(all|distclean|realclean|force_do_it)$/;$maketext .= <<"EOF"}if ($self->_is_vms_mms){$maketext .= "\n.FIRST\n\t\@ $noop\n";for my$macro (sort keys%macro_to_build){$maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n"}$maketext .= "\n"}else {$maketext .= "\n.EXPORT : " .join(' ',sort keys%macro_to_build)."\n\n"}return$maketext}sub fake_prereqs {my$file=File::Spec->catfile('_build','prereqs');open(my$fh,'<',"$file")or die "Can't read $file: $!";my$prereqs=eval do {local $/;<$fh>};close$fh;my%merged=_merge_prereq($prereqs->{requires},$prereqs->{build_requires});my@prereq;for (sort keys%merged){next if $_ eq 'perl';push@prereq,"$_=>q[$merged{$_}]"}return unless@prereq;return "# PREREQ_PM => { " .join(", ",@prereq)." }\n\n"}sub write_makefile {my ($pack,%in)=@_;unless (exists$in{build_class}){warn "Unknown 'build_class', defaulting to 'Module::Build'\n";$in{build_class}='Module::Build'}my$class=$in{build_class};$in{makefile}||= $pack->_is_vms_mms ? 'Descrip.MMS' : 'Makefile';open MAKE,"> $in{makefile}" or die "Cannot write $in{makefile}: $!";print MAKE$pack->fake_prereqs;print MAKE$pack->fake_makefile(%in);close MAKE}sub _is_vms_mms {return Module::Build->is_vmsish && ($Config{make}=~ m/MM[SK]/i)}1; + + IMPORTANT NOTE: The '$type' style of Makefile.PL is deprecated and + may be removed in a future version of Module::Build in favor of the + 'configure_requires' property. See Module::Build::Compat + documentation for details. + + HERE + use Module::Build::Compat 0.02; + %s + Module::Build::Compat->run_build_pl(args => \@ARGV); + require %s; + Module::Build::Compat->write_makefile(build_class => '%s'); + EOF + + unless (eval "use Module::Build::Compat 0.02; 1" ) { + print "This module requires Module::Build to install itself.\n"; + + require ExtUtils::MakeMaker; + my $yn = ExtUtils::MakeMaker::prompt + (' Install Module::Build now from CPAN?', 'y'); + + unless ($yn =~ /^y/i) { + die " *** Cannot install without Module::Build. Exiting ...\n"; + } + + require Cwd; + require File::Spec; + require CPAN; + + # Save this 'cause CPAN will chdir all over the place. + my $cwd = Cwd::cwd(); + + CPAN::Shell->install('Module::Build::Compat'); + CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate + or die "Couldn't install Module::Build, giving up.\n"; + + chdir $cwd or die "Cannot chdir() back to $cwd: $!"; + } + eval "use Module::Build::Compat 0.02; 1" or die $@; + %s + Module::Build::Compat->run_build_pl(args => \@ARGV); + my $build_script = 'Build'; + $build_script .= '.com' if $^O eq 'VMS'; + exit(0) unless(-e $build_script); # cpantesters convention + require %s; + Module::Build::Compat->write_makefile(build_class => '%s'); + EOF + use ExtUtils::MakeMaker; + WriteMakefile + $args; + EOF + all : force_do_it + $perl $Build + realclean : force_do_it + $perl $Build realclean + $unlink + distclean : force_do_it + $perl $Build distclean + $unlink + + + force_do_it : + @ $noop + EOF + $action : force_do_it + $perl $Build $action + EOF +MODULE_BUILD_COMPAT + +$fatpacked{"Module/Build/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_CONFIG'; + package Module::Build::Config;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Config;sub new {my ($pack,%args)=@_;return bless {stack=>{},values=>$args{values}|| {},},$pack}sub get {my ($self,$key)=@_;return$self->{values}{$key}if ref($self)&& exists$self->{values}{$key};return$Config{$key}}sub set {my ($self,$key,$val)=@_;$self->{values}{$key}=$val}sub push {my ($self,$key,$val)=@_;push @{$self->{stack}{$key}},$self->{values}{$key}if exists$self->{values}{$key};$self->{values}{$key}=$val}sub pop {my ($self,$key)=@_;my$val=delete$self->{values}{$key};if (exists$self->{stack}{$key}){$self->{values}{$key}=pop @{$self->{stack}{$key}};delete$self->{stack}{$key}unless @{$self->{stack}{$key}}}return$val}sub values_set {my$self=shift;return undef unless ref($self);return$self->{values}}sub all_config {my$self=shift;my$v=ref($self)? $self->{values}: {};return {%Config,%$v}}1; +MODULE_BUILD_CONFIG -use Slideshow::Util; -use feature 'say'; +$fatpacked{"Module/Build/ConfigData.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_CONFIGDATA'; + package Module::Build::ConfigData;use strict;my$arrayref=eval do {local $/;}or die "Couldn't load ConfigData data: $@";close DATA;my ($config,$features,$auto_features)=@$arrayref;sub config {$config->{$_[1]}}sub set_config {$config->{$_[1]}=$_[2]}sub set_feature {$features->{$_[1]}=0+!!$_[2]}sub auto_feature_names {sort grep!exists$features->{$_},keys %$auto_features}sub feature_names {my@features=(sort keys %$features,auto_feature_names());@features}sub config_names {sort keys %$config}sub write {my$me=__FILE__;require Data::Dumper;my$mode_orig=(stat$me)[2]& 07777;chmod($mode_orig | 0222,$me);open(my$fh,'+<',$me)or die "Can't rewrite $me: $!";seek($fh,0,0);while (<$fh>){last if /^__DATA__$/}die "Couldn't find __DATA__ token in $me" if eof($fh);seek($fh,tell($fh),0);my$data=[$config,$features,$auto_features];print($fh 'do{ my ' .Data::Dumper->new([$data],['x'])->Purity(1)->Dump().'$x; }');truncate($fh,tell($fh));close$fh;chmod($mode_orig,$me)or warn "Couldn't restore permissions on $me: $!"}sub feature {my ($package,$key)=@_;return$features->{$key}if exists$features->{$key};my$info=$auto_features->{$key}or return 0;require Module::Build;for my$type (sort keys %$info){my$prereqs=$info->{$type};next if$type eq 'description' || $type eq 'recommends';for my$modname (sort keys %$prereqs){my$status=Module::Build->check_installed_status($modname,$prereqs->{$modname});if ((!$status->{ok})xor ($type =~ /conflicts$/)){return 0}if (!eval "require $modname; 1"){return 0}}}return 1}__DATA__ do{ my $x = [ + {}, + {}, + { + 'HTML_support' => { + 'description' => 'Create HTML documentation', + 'requires' => { + 'Pod::Html' => 0 + } + }, + 'PPM_support' => { + 'description' => 'Generate PPM files for distributions' + }, + 'dist_authoring' => { + 'description' => 'Create new distributions', + 'recommends' => { + 'Module::Signature' => '0.21', + 'Pod::Readme' => '0.04' + }, + 'requires' => { + 'Archive::Tar' => '1.09' + } + }, + 'inc_bundling_support' => { + 'description' => 'Bundle Module::Build in inc/', + 'requires' => { + 'ExtUtils::Install' => '1.54', + 'ExtUtils::Installed' => '1.999', + 'inc::latest' => '0.5' + } + }, + 'license_creation' => { + 'description' => 'Create licenses automatically in distributions', + 'requires' => { + 'Software::License' => '0.103009' + } + }, + 'manpage_support' => { + 'description' => 'Create Unix man pages', + 'requires' => { + 'Pod::Man' => 0 + } + } + } + ]; + $x; } +MODULE_BUILD_CONFIGDATA + +$fatpacked{"Module/Build/Cookbook.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_COOKBOOK'; + package Module::Build::Cookbook;use strict;use warnings;our$VERSION='0.4224'; +MODULE_BUILD_COOKBOOK + +$fatpacked{"Module/Build/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_DUMPER'; + package Module::Build::Dumper;use strict;use warnings;our$VERSION='0.4224';use Data::Dumper;sub _data_dump {my ($self,$data)=@_;return ("do{ my " .Data::Dumper->new([$data],['x'])->Purity(1)->Terse(0)->Sortkeys(1)->Dump().'$x; }')}1; +MODULE_BUILD_DUMPER -my $flags = getopts(@ARGV); +$fatpacked{"Module/Build/Notes.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_NOTES'; + package Module::Build::Notes;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Data::Dumper;use Module::Build::Dumper;sub new {my ($class,%args)=@_;my$file=delete$args{file}or die "Missing required parameter 'file' to new()";my$self=bless {disk=>{},new=>{},file=>$file,%args,},$class}sub restore {my$self=shift;open(my$fh,'<',$self->{file})or die "Can't read $self->{file}: $!";$self->{disk}=eval do {local $/;<$fh>};die $@ if $@;close$fh;$self->{new}={}}sub access {my$self=shift;return$self->read()unless @_;my$key=shift;return$self->read($key)unless @_;my$value=shift;$self->write({$key=>$value });return$self->read($key)}sub has_data {my$self=shift;return keys %{$self->read()}> 0}sub exists {my ($self,$key)=@_;return exists($self->{new}{$key})|| exists($self->{disk}{$key})}sub read {my$self=shift;if (@_){my$key=shift;return$self->{new}{$key}if exists$self->{new}{$key};return$self->{disk}{$key}}my$out=(keys %{$self->{new}}? {%{$self->{disk}},%{$self->{new}}}: $self->{disk});return wantarray ? %$out : $out}sub _same {my ($self,$x,$y)=@_;return 1 if!defined($x)and!defined($y);return 0 if!defined($x)or!defined($y);return$x eq $y}sub write {my ($self,$href)=@_;$href ||= {};@{$self->{new}}{keys %$href }=values %$href;for my$key (keys %{$self->{new}}){next if ref$self->{new}{$key};next if ref$self->{disk}{$key}or!exists$self->{disk}{$key};delete$self->{new}{$key}if$self->_same($self->{new}{$key},$self->{disk}{$key})}if (my$file=$self->{file}){my ($vol,$dir,$base)=File::Spec->splitpath($file);$dir=File::Spec->catpath($vol,$dir,'');return unless -e $dir && -d $dir;return if -e $file and!keys %{$self->{new}};@{$self->{disk}}{keys %{$self->{new}}}=values %{$self->{new}};$self->_dump($file,$self->{disk});$self->{new}={}}return$self->read}sub _dump {my ($self,$file,$data)=@_;open(my$fh,'>',$file)or die "Can't create '$file': $!";print {$fh}Module::Build::Dumper->_data_dump($data);close$fh}my$orig_template=do {local $/;};close DATA;sub write_config_data {my ($self,%args)=@_;my$template=$orig_template;$template =~ s/NOTES_NAME/$args{config_module}/g;$template =~ s/MODULE_NAME/$args{module}/g;$template =~ s/=begin private\n//;$template =~ s/=end private/=cut/;$template =~ s{$_\n}{} for '=begin private','=end private';open(my$fh,'>',$args{file})or die "Can't create '$args{file}': $!";print {$fh}$template;print {$fh}"\n__DATA__\n";print {$fh}Module::Build::Dumper->_data_dump([$args{config_data},$args{feature},$args{auto_features}]);close$fh}1;__DATA__ package NOTES_NAME; + use strict; + my $arrayref = eval do {local $/; } + or die "Couldn't load ConfigData data: $@"; + close DATA; + my ($config, $features, $auto_features) = @$arrayref; + + sub config { $config->{$_[1]} } + + sub set_config { $config->{$_[1]} = $_[2] } + sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0 + + sub auto_feature_names { sort grep !exists $features->{$_}, keys %$auto_features } + + sub feature_names { + my @features = (sort keys %$features, auto_feature_names()); + @features; + } + + sub config_names { sort keys %$config } + + sub write { + my $me = __FILE__; + + # Can't use Module::Build::Dumper here because M::B is only a + # build-time prereq of this module + require Data::Dumper; + + my $mode_orig = (stat $me)[2] & 07777; + chmod($mode_orig | 0222, $me); # Make it writeable + open(my $fh, '+<', $me) or die "Can't rewrite $me: $!"; + seek($fh, 0, 0); + while (<$fh>) { + last if /^__DATA__$/; + } + die "Couldn't find __DATA__ token in $me" if eof($fh); + + seek($fh, tell($fh), 0); + my $data = [$config, $features, $auto_features]; + print($fh 'do{ my ' + . Data::Dumper->new([$data],['x'])->Purity(1)->Dump() + . '$x; }' ); + truncate($fh, tell($fh)); + close $fh; + + chmod($mode_orig, $me) + or warn "Couldn't restore permissions on $me: $!"; + } + + sub feature { + my ($package, $key) = @_; + return $features->{$key} if exists $features->{$key}; + + my $info = $auto_features->{$key} or return 0; + + require Module::Build; # XXX should get rid of this + foreach my $type (sort keys %$info) { + my $prereqs = $info->{$type}; + next if $type eq 'description' || $type eq 'recommends'; + + foreach my $modname (sort keys %$prereqs) { + my $status = Module::Build->check_installed_status($modname, $prereqs->{$modname}); + if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; } + if ( ! eval "require $modname; 1" ) { return 0; } + } + } + return 1; + } + + =begin private + + =head1 NAME + + NOTES_NAME - Configuration for MODULE_NAME + + =head1 SYNOPSIS + + use NOTES_NAME; + $value = NOTES_NAME->config('foo'); + $value = NOTES_NAME->feature('bar'); + + @names = NOTES_NAME->config_names; + @names = NOTES_NAME->feature_names; + + NOTES_NAME->set_config(foo => $new_value); + NOTES_NAME->set_feature(bar => $new_value); + NOTES_NAME->write; # Save changes + + + =head1 DESCRIPTION + + This module holds the configuration data for the C + module. It also provides a programmatic interface for getting or + setting that configuration data. Note that in order to actually make + changes, you'll have to have write access to the C + module, and you should attempt to understand the repercussions of your + actions. + + + =head1 METHODS + + =over 4 + + =item config($name) + + Given a string argument, returns the value of the configuration item + by that name, or C if no such item exists. + + =item feature($name) + + Given a string argument, returns the value of the feature by that + name, or C if no such feature exists. + + =item set_config($name, $value) + + Sets the configuration item with the given name to the given value. + The value may be any Perl scalar that will serialize correctly using + C. This includes references, objects (usually), and + complex data structures. It probably does not include transient + things like filehandles or sockets. + + =item set_feature($name, $value) + + Sets the feature with the given name to the given boolean value. The + value will be converted to 0 or 1 automatically. + + =item config_names() + + Returns a list of all the names of config items currently defined in + C, or in scalar context the number of items. + + =item feature_names() + + Returns a list of all the names of features currently defined in + C, or in scalar context the number of features. + + =item auto_feature_names() + + Returns a list of all the names of features whose availability is + dynamically determined, or in scalar context the number of such + features. Does not include such features that have later been set to + a fixed value. + + =item write() + + Commits any changes from C and C to disk. + Requires write access to the C module. + + =back + + + =head1 AUTHOR + + C was automatically created using C. + C was written by Ken Williams, but he holds no + authorship claim or copyright claim to the contents of C. + + =end private + +MODULE_BUILD_NOTES -if ( $flags->{help} ){ - help(); - exit; +$fatpacked{"Module/Build/PPMMaker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PPMMAKER'; + package Module::Build::PPMMaker;use strict;use warnings;use Config;our$VERSION='0.4224';$VERSION=eval$VERSION;sub new {my$package=shift;return bless {@_},$package}sub make_ppd {my ($self,%args)=@_;my$build=delete$args{build};my@codebase;if (exists$args{codebase}){@codebase=ref$args{codebase}? @{$args{codebase}}: ($args{codebase})}else {my$distfile=$build->ppm_name .'.tar.gz';print "Using default codebase '$distfile'\n";@codebase=($distfile)}my%dist;for my$info (qw(name author abstract version)){my$method="dist_$info";$dist{$info}=$build->$method()or die "Can't determine distribution's $info\n"}$self->_simple_xml_escape($_)foreach$dist{abstract},@{$dist{author}};my$ppd=<<"PPD";for my$type (qw(requires)){my$prereq=$build->$type();for my$modname (sort keys %$prereq){next if$modname eq 'perl';my$min_version='0.0';for my$c ($build->_parse_conditions($prereq->{$modname})){my ($op,$version)=$c =~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x;if ($op eq '>='){$min_version=$version;last}}$modname .= '::' unless$modname =~ /::/;$ppd .= qq! \n!}}if (keys %{$build->find_xs_files}){my$perl_version=$self->_ppd_version($build->perl_version);$ppd .= sprintf(<<'EOF',$self->_varchname($build->config))}for my$codebase (@codebase){$self->_simple_xml_escape($codebase);$ppd .= sprintf(<<'EOF',$codebase)}$ppd .= <<'EOF';my$ppd_file="$dist{name}.ppd";open(my$fh,'>',$ppd_file)or die "Cannot write to $ppd_file: $!";binmode($fh,":utf8")if $] >= 5.008 && $Config{useperlio};print$fh $ppd;close$fh;return$ppd_file}sub _ppd_version {my ($self,$version)=@_;return join ',',(split(/\./,$version),(0)x4)[0..3]}sub _varchname {my ($self,$config)=@_;my$varchname=$config->{archname};if ($] >= 5.008){my$vstring=sprintf "%vd",$^V;$vstring =~ s/\.\d+$//;$varchname .= "-$vstring"}return$varchname}{my%escapes=("\n"=>"\\n",'"'=>'"','&'=>'&','>'=>'>','<'=>'<',);my$rx=join '|',keys%escapes;sub _simple_xml_escape {$_[1]=~ s/($rx)/$escapes{$1}/go}}1; + + $dist{abstract} + @{[ join "\n", map " $_", @{$dist{author}} ]} + + PPD + + EOF + + EOF + + + EOF +MODULE_BUILD_PPMMAKER + +$fatpacked{"Module/Build/Platform/Default.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_DEFAULT'; + package Module::Build::Platform::Default;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;our@ISA=qw(Module::Build::Base);1; +MODULE_BUILD_PLATFORM_DEFAULT + +$fatpacked{"Module/Build/Platform/MacOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_MACOS'; + package Module::Build::Platform::MacOS;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;our@ISA=qw(Module::Build::Base);use ExtUtils::Install;sub have_forkpipe {0}sub new {my$class=shift;my$self=$class->SUPER::new(@_);for ('sitelib','sitearch'){$self->config($_=>$self->config("install$_"))unless$self->config($_)}(my$sp=$self->config('startperl'))=~ s/.*Exit \{Status\}\s//;$self->config(startperl=>$sp);return$self}sub make_executable {my$self=shift;require MacPerl;for (@_){MacPerl::SetFileInfo('McPL','TEXT',$_)}}sub dispatch {my$self=shift;if(!@_ and!@ARGV){require MacPerl;my@action_list=qw(build test install);my%actions=map {+($_,1)}$self->known_actions;delete@actions{@action_list};push@action_list,sort {$a cmp $b}keys%actions;my%toolserver=map {+$_=>1}qw(test disttest diff testdb);for (@action_list){$_ .= ' *' if$toolserver{$_}}my$cmd=MacPerl::Pick("What build command? ('*' requires ToolServer)",@action_list);return unless defined$cmd;$cmd =~ s/ \*$//;$ARGV[0]=($cmd);my$args=MacPerl::Ask('Any extra arguments? (ie. verbose=1)','');return unless defined$args;push@ARGV,$self->split_like_shell($args)}$self->SUPER::dispatch(@_)}sub ACTION_realclean {my$self=shift;chmod 0666,$self->{properties}{build_script};$self->SUPER::ACTION_realclean}sub ACTION_install {my$self=shift;return$self->SUPER::ACTION_install(@_)if eval {ExtUtils::Install->VERSION('1.30');1};local $^W=0;local*ExtUtils::Install::find=sub {my ($code,@dirs)=@_;@dirs=map {$_ eq '.' ? File::Spec->curdir : $_}@dirs;return File::Find::find($code,@dirs)};return$self->SUPER::ACTION_install(@_)}1; +MODULE_BUILD_PLATFORM_MACOS + +$fatpacked{"Module/Build/Platform/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_UNIX'; + package Module::Build::Platform::Unix;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;our@ISA=qw(Module::Build::Base);sub is_executable {my ($self,$file)=@_;return +(stat$file)[2]& 0100}sub _startperl {"#! " .shift()->perl}sub _construct {my$self=shift()->SUPER::_construct(@_);my$c=$self->{config};for (qw(siteman1 siteman3 vendorman1 vendorman3)){$c->{"install${_}dir"}||= $c->{"install${_}"}}return$self}sub _detildefy {my ($self,$value)=@_;$value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username [$1 ? (eval{(getpwnam $1)[7]}|| "~$1"): ($ENV{HOME}|| eval{(getpwuid $>)[7]}|| glob("~"))]ex;return$value}1; +MODULE_BUILD_PLATFORM_UNIX + +$fatpacked{"Module/Build/Platform/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_VMS'; + package Module::Build::Platform::VMS;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;use Config;our@ISA=qw(Module::Build::Base);sub _set_defaults {my$self=shift;$self->SUPER::_set_defaults(@_);$self->{properties}{build_script}='Build.com'}sub cull_args {my$self=shift;my($action,$args)=$self->SUPER::cull_args(@_);my@possible_actions=grep {lc $_ eq lc$action}$self->known_actions;die "Ambiguous action '$action'. Could be one of @possible_actions" if@possible_actions > 1;return ($possible_actions[0],$args)}sub manpage_separator {return '__'}sub _catprefix {my($self,$rprefix,$default)=@_;my($rvol,$rdirs)=File::Spec->splitpath($rprefix);if($rvol){return File::Spec->catpath($rvol,File::Spec->catdir($rdirs,$default),'')}else {return File::Spec->catdir($rdirs,$default)}}sub _prefixify {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;return '' unless defined$path;$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");$rprefix=VMS::Filespec::vmspath($rprefix)if$rprefix;$sprefix=VMS::Filespec::vmspath($sprefix)if$sprefix;$self->log_verbose(" rprefix translated to $rprefix\n"." sprefix translated to $sprefix\n");if(length($path)==0){$self->log_verbose(" no path to prefixify.\n")}elsif(!File::Spec->file_name_is_absolute($path)){$self->log_verbose(" path is relative, not prefixifying.\n")}elsif($sprefix eq $rprefix){$self->log_verbose(" no new prefix.\n")}else {my($path_vol,$path_dirs)=File::Spec->splitpath($path);my$vms_prefix=$self->config('vms_prefix');if($path_vol eq $vms_prefix.':'){$self->log_verbose(" $vms_prefix: seen\n");$path_dirs =~ s{^\[}{\[.} unless$path_dirs =~ m{^\[\.};$path=$self->_catprefix($rprefix,$path_dirs)}else {$self->log_verbose(" cannot prefixify.\n");return$self->prefix_relpaths($self->installdirs,$type)}}$self->log_verbose(" now $path\n");return$path}sub _quote_args {my ($self,@args)=@_;my$got_arrayref=(scalar(@args)==1 && ref$args[0]eq 'ARRAY')? 1 : 0;map {if (!/^\//){$_ =~ s/\"/""/g;$_=q(").$_.q(")}}($got_arrayref ? @{$args[0]}: @args);return$got_arrayref ? $args[0]: join(' ',@args)}sub have_forkpipe {0}sub _backticks {my ($self,@cmd)=@_;my$cmd=shift@cmd;my$args=$self->_quote_args(@cmd);return `$cmd $args`}sub find_command {my ($self,$command)=@_;if ($^O eq 'VMS'){require VMS::DCLsym;my$syms=VMS::DCLsym->new;return$command if scalar$syms->getsym(uc$command)}$self->SUPER::find_command($command)}sub _maybe_command {my($self,$file)=@_;return$file if -x $file &&!-d _;my(@dirs)=('');my(@exts)=('',$Config{'exe_ext'},'.exe','.com');if ($file !~ m![/:>\]]!){for (my$i=0;defined$ENV{"DCL\$PATH;$i"};$i++){my$dir=$ENV{"DCL\$PATH;$i"};$dir .= ':' unless$dir =~ m%[\]:]$%;push(@dirs,$dir)}push(@dirs,'Sys$System:');for my$dir (@dirs){my$sysfile="$dir$file";for my$ext (@exts){return$file if -x "$sysfile$ext" &&!-d _}}}return}sub do_system {my ($self,@cmd)=@_;$self->log_verbose("@cmd\n");my$cmd=shift@cmd;my$args=$self->_quote_args(@cmd);return!system("$cmd $args")}sub oneliner {my$self=shift;my$oneliner=$self->SUPER::oneliner(@_);$oneliner =~ s/^\"\S+\"//;return "MCR $^X $oneliner"}sub rscan_dir {my ($self,$dir,$pattern)=@_;my$result=$self->SUPER::rscan_dir($dir,$pattern);for my$file (@$result){if (!_efs()&& ($file =~ m#/#)){$file =~ s/\.$//}}return$result}sub dist_dir {my$self=shift;my$dist_dir=$self->SUPER::dist_dir;$dist_dir =~ s/\./_/g unless _efs();return$dist_dir}sub man3page_name {my$self=shift;my$mpname=$self->SUPER::man3page_name(shift);my$sep=$self->manpage_separator;$mpname =~ s/^$sep//;return$mpname}sub expand_test_dir {my ($self,$dir)=@_;my@reldirs=$self->SUPER::expand_test_dir($dir);for my$eachdir (@reldirs){my ($v,$d,$f)=File::Spec->splitpath($eachdir);my$reldir=File::Spec->abs2rel(File::Spec->catpath($v,$d,''));$eachdir=File::Spec->catfile($reldir,$f)}return@reldirs}sub _detildefy {my ($self,$arg)=@_;return$arg if ($arg =~ /^~~/);return$arg if ($arg =~ /^~ /);if ($arg =~ /^~/){my$spec=$arg;$spec =~ s/^~//;$spec =~ s#^/##;my$home=VMS::Filespec::unixify($ENV{HOME});$home .= '/' unless$home =~ m#/$#;if ($spec eq ''){$home =~ s#/$##;return$home}my ($hvol,$hdir,$hfile)=File::Spec::Unix->splitpath($home);if ($hdir eq ''){$hdir=$hfile}my ($vol,$dir,$file)=File::Spec::Unix->splitpath($spec);my@hdirs=File::Spec::Unix->splitdir($hdir);my@dirs=File::Spec::Unix->splitdir($dir);unless ($arg =~ m#^~/#){shift@dirs}my$newdirs=File::Spec::Unix->catdir(@hdirs,@dirs);$arg=File::Spec::Unix->catpath($hvol,$newdirs,$file)}return$arg}sub find_perl_interpreter {return VMS::Filespec::vmsify($^X)}sub localize_file_path {my ($self,$path)=@_;$path=VMS::Filespec::vmsify($path);$path =~ s/\.\z//;return$path}sub localize_dir_path {my ($self,$path)=@_;return VMS::Filespec::vmspath($path)}sub ACTION_clean {my ($self)=@_;for my$item (map glob(VMS::Filespec::rmsexpand($_,'.;0')),$self->cleanup){$self->delete_filetree($item)}}my$use_feature;BEGIN {if (eval {local$SIG{__DIE__};require VMS::Feature}){$use_feature=1}}sub _unix_rpt {my$unix_rpt;if ($use_feature){$unix_rpt=VMS::Feature::current("filename_unix_report")}else {my$env_unix_rpt=$ENV{'DECC$FILENAME_UNIX_REPORT'}|| '';$unix_rpt=$env_unix_rpt =~ /^[ET1]/i}return$unix_rpt}sub _efs {my$efs;if ($use_feature){$efs=VMS::Feature::current("efs_charset")}else {my$env_efs=$ENV{'DECC$EFS_CHARSET'}|| '';$efs=$env_efs =~ /^[ET1]/i}return$efs}1; +MODULE_BUILD_PLATFORM_VMS + +$fatpacked{"Module/Build/Platform/VOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_VOS'; + package Module::Build::Platform::VOS;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;our@ISA=qw(Module::Build::Base);1; +MODULE_BUILD_PLATFORM_VOS + +$fatpacked{"Module/Build/Platform/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_WINDOWS'; + package Module::Build::Platform::Windows;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Config;use File::Basename;use File::Spec;use Module::Build::Base;our@ISA=qw(Module::Build::Base);sub manpage_separator {return '.'}sub have_forkpipe {0}sub _detildefy {my ($self,$value)=@_;$value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x if$ENV{HOME};return$value}sub ACTION_realclean {my ($self)=@_;$self->SUPER::ACTION_realclean();my$basename=basename($0);$basename =~ s/(?:\.bat)?$//i;if (lc$basename eq lc$self->build_script){if ($self->build_bat){$self->log_verbose("Deleting $basename.bat\n");my$full_progname=$0;$full_progname =~ s/(?:\.bat)?$/.bat/i;require Win32;my$null_arg=(Win32::IsWinNT())? '""' : '';my$cmd=qq(start $null_arg /min "\%comspec\%" /c del "$full_progname");open(my$fh,'>>',"$basename.bat")or die "Can't create $basename.bat: $!";print$fh $cmd;close$fh }else {$self->delete_filetree($self->build_script .'.bat')}}}sub make_executable {my$self=shift;$self->SUPER::make_executable(@_);for my$script (@_){if ($script =~ /\.(bat|cmd)$/){$self->SUPER::make_executable($script);next}else {my%opts=();if ($script eq $self->build_script){$opts{ntargs}=q(-x -S %0 --build_bat %*);$opts{otherargs}=q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9)}my$out=eval {$self->pl2bat(in=>$script,update=>1,%opts)};if ($@){$self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@")}else {$self->SUPER::make_executable($out)}}}}sub pl2bat {my$self=shift;my%opts=@_;$opts{ntargs}='-x -S %0 %*' unless exists$opts{ntargs};$opts{otherargs}='-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists$opts{otherargs};$opts{stripsuffix}='/\\.plx?/' unless exists$opts{stripsuffix};$opts{stripsuffix}=($opts{stripsuffix}=~ m{^/([^/]*[^/\$]|)\$?/?$} ? $1 : "\Q$opts{stripsuffix}\E");unless (exists$opts{out}){$opts{out}=$opts{in};$opts{out}=~ s/$opts{stripsuffix}$//oi;$opts{out}.= '.bat' unless$opts{in}=~ /\.bat$/i or $opts{in}=~ /^-$/}my$head=<;close($in);for my$line (@file){$linenum++;if ($line =~ /^:endofperl\b/){if (!exists$opts{update}){warn "$opts{in} has already been converted to a batch file!\n";return}$taildone++}if (not $linedone and $line =~ /^#!.*perl/){if (exists$opts{update}){$skiplines=$linenum - 1;$line .= "#line ".(1+$headlines)."\n"}else {$line .= "#line ".($linenum+$headlines)."\n"}$linedone++}if ($line =~ /^#\s*line\b/ and $linenum==2 + $skiplines){$line=""}}open(my$out,'>',"$opts{out}")or die "Can't open $opts{out}: $!";print$out $head;print$out $start,($opts{usewarnings}? " -w" : ""),"\n#line ",($headlines+1),"\n" unless$linedone;print$out @file[$skiplines..$#file];print$out $tail unless$taildone;close($out);return$opts{out}}sub _quote_args {my ($self,@args)=@_;my@quoted;for (@args){if (/^[^\s*?!\$<>;|'"\[\]\{\}]+$/){push@quoted,$_}else {s/"/\\"/g;push@quoted,qq("$_")}}return join " ",@quoted}sub split_like_shell {(my$self,local $_)=@_;return @$_ if defined()&& ref()eq 'ARRAY';my@argv;return@argv unless defined()&& length();my$length=length;m/\G\s*/gc;ARGS: until (pos==$length){my$quote_mode;my$arg='';CHARS: until (pos==$length){if (m/\G((?:\\\\)+)(?=\\?(")?)/gc){if (defined $2){$arg .= '\\' x (length($1)/ 2)}else {$arg .= $1}}elsif (m/\G\\"/gc){$arg .= '"'}elsif (m/\G"/gc){if ($quote_mode && m/\G"/gc){$arg .= '"'}$quote_mode=!$quote_mode}elsif (!$quote_mode && m/\G\s+/gc){last}elsif (m/\G(.)/sgc){$arg .= $1}}push@argv,$arg}return@argv}sub do_system {my ($self,@cmd)=@_;my$cmd=$self->_quote_args(@cmd);my$status=system($cmd);if ($status and $! =~ /Argument list too long/i){my$env_entries='';for (sort keys%ENV){$env_entries .= "$_=>".length($ENV{$_})."; "}warn "'Argument list' was 'too long', env lengths are $env_entries"}return!$status}sub _maybe_command {my($self,$file)=@_;my@e=exists($ENV{'PATHEXT'})? split(/;/,$ENV{PATHEXT}): qw(.com .exe .bat .cmd);my$e='';for (@e){$e .= "\Q$_\E|"}chop$e;if ($file =~ /($e)$/i){return$file if -e $file}else {for (@e){return "$file$_" if -e "$file$_"}}return}1; + \@rem = '--*-Perl-*-- + \@echo off + if "%OS%" == "Windows_NT" goto WinNT + perl $opts{otherargs} + goto endofperl + :WinNT + perl $opts{ntargs} + if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl + if %errorlevel% == 9009 echo You do not have Perl in your PATH. + if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul + goto endofperl + \@rem '; + EOT +MODULE_BUILD_PLATFORM_WINDOWS + +$fatpacked{"Module/Build/Platform/aix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_AIX'; + package Module::Build::Platform::aix;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Platform::Unix;our@ISA=qw(Module::Build::Platform::Unix);1; +MODULE_BUILD_PLATFORM_AIX + +$fatpacked{"Module/Build/Platform/cygwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_CYGWIN'; + package Module::Build::Platform::cygwin;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Platform::Unix;our@ISA=qw(Module::Build::Platform::Unix);sub manpage_separator {'.'}sub _maybe_command {my ($self,$file)=@_;if ($file =~ m{^/cygdrive/}i){require Module::Build::Platform::Windows;return Module::Build::Platform::Windows->_maybe_command($file)}return$self->SUPER::_maybe_command($file)}1; +MODULE_BUILD_PLATFORM_CYGWIN + +$fatpacked{"Module/Build/Platform/darwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_DARWIN'; + package Module::Build::Platform::darwin;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Platform::Unix;our@ISA=qw(Module::Build::Platform::Unix);1; +MODULE_BUILD_PLATFORM_DARWIN + +$fatpacked{"Module/Build/Platform/os2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_OS2'; + package Module::Build::Platform::os2;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Platform::Unix;our@ISA=qw(Module::Build::Platform::Unix);sub manpage_separator {'.'}sub have_forkpipe {0}sub _maybe_command {my($self,$file)=@_;$file =~ s,[/\\]+,/,g;return$file if -x $file &&!-d _;return "$file.exe" if -x "$file.exe" &&!-d _;return "$file.cmd" if -x "$file.cmd" &&!-d _;return}1; +MODULE_BUILD_PLATFORM_OS2 + +$fatpacked{"Module/Build/PodParser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PODPARSER'; + package Module::Build::PodParser;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;sub new {my$package=shift;my$self;$self=bless {have_pod_parser=>0,@_},$package;unless ($self->{fh}){die "No 'file' or 'fh' parameter given" unless$self->{file};open($self->{fh},'<',$self->{file})or die "Couldn't open $self->{file}: $!"}return$self}sub parse_from_filehandle {my ($self,$fh)=@_;local $_;while (<$fh>){next unless /^=(?!cut)/ .. /^=cut/;last if ($self->{abstract})=/^ (?: [a-z_0-9:]+ | [BCIF] < [a-z_0-9:]+ > ) \s+ - \s+ (.*\S) /ix}my@author;while (<$fh>){next unless /^=head1\s+AUTHORS?/i ... /^=/;next if /^=/;push@author,$_ if /\@/}return unless@author;s/^\s+|\s+$//g foreach@author;$self->{author}=\@author;return}sub get_abstract {my$self=shift;return$self->{abstract}if defined$self->{abstract};$self->parse_from_filehandle($self->{fh});return$self->{abstract}}sub get_author {my$self=shift;return$self->{author}if defined$self->{author};$self->parse_from_filehandle($self->{fh});return$self->{author}|| []} +MODULE_BUILD_PODPARSER + +$fatpacked{"Module/Build/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_TINY'; + package Module::Build::Tiny;$Module::Build::Tiny::VERSION='0.039';use strict;use warnings;use Exporter 5.57 'import';our@EXPORT=qw/Build Build_PL/;use CPAN::Meta;use ExtUtils::Config 0.003;use ExtUtils::Helpers 0.020 qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;use ExtUtils::Install qw/pm_to_blib install/;use ExtUtils::InstallPaths 0.002;use File::Basename qw/basename dirname/;use File::Find ();use File::Path qw/mkpath rmtree/;use File::Spec::Functions qw/catfile catdir rel2abs abs2rel splitdir curdir/;use Getopt::Long 2.36 qw/GetOptionsFromArray/;use JSON::PP 2 qw/encode_json decode_json/;sub write_file {my ($filename,$content)=@_;open my$fh,'>',$filename or die "Could not open $filename: $!\n";print$fh $content}sub read_file {my ($filename,$mode)=@_;open my$fh,'<',$filename or die "Could not open $filename: $!\n";return do {local $/;<$fh>}}sub get_meta {my ($metafile)=grep {-e $_}qw/META.json META.yml/ or die "No META information provided\n";return CPAN::Meta->load_file($metafile)}sub manify {my ($input_file,$output_file,$section,$opts)=@_;return if -e $output_file && -M $input_file <= -M $output_file;my$dirname=dirname($output_file);mkpath($dirname,$opts->{verbose})if not -d $dirname;require Pod::Man;Pod::Man->new(section=>$section)->parse_from_file($input_file,$output_file);print "Manifying $output_file\n" if$opts->{verbose}&& $opts->{verbose}> 0;return}sub process_xs {my ($source,$options)=@_;die "Can't build xs files under --pureperl-only\n" if$options->{'pureperl-only'};my (undef,@parts)=splitdir(dirname($source));push@parts,my$file_base=basename($source,'.xs');my$archdir=catdir(qw/blib arch auto/,@parts);my$tempdir='temp';my$c_file=catfile($tempdir,"$file_base.c");require ExtUtils::ParseXS;mkpath($tempdir,$options->{verbose},oct '755');ExtUtils::ParseXS::process_file(filename=>$source,prototypes=>0,output=>$c_file);my$version=$options->{meta}->version;require ExtUtils::CBuilder;my$builder=ExtUtils::CBuilder->new(config=>$options->{config}->values_set);my$ob_file=$builder->compile(source=>$c_file,defines=>{VERSION=>qq/"$version"/,XS_VERSION=>qq/"$version"/ },include_dirs=>[curdir,dirname($source)]);require DynaLoader;my$mod2fname=defined&DynaLoader::mod2fname ? \&DynaLoader::mod2fname : sub {return $_[0][-1]};mkpath($archdir,$options->{verbose},oct '755')unless -d $archdir;my$lib_file=catfile($archdir,$mod2fname->(\@parts).'.' .$options->{config}->get('dlext'));return$builder->link(objects=>$ob_file,lib_file=>$lib_file,module_name=>join '::',@parts)}sub find {my ($pattern,$dir)=@_;my@ret;File::Find::find(sub {push@ret,$File::Find::name if /$pattern/ && -f},$dir)if -d $dir;return@ret}my%actions=(build=>sub {my%opt=@_;for my$pl_file (find(qr/\.PL$/,'lib')){(my$pm=$pl_file)=~ s/\.PL$//;system $^X,$pl_file,$pm and die "$pl_file returned $?\n"}my%modules=map {$_=>catfile('blib',$_)}find(qr/\.p(?:m|od)$/,'lib');my%scripts=map {$_=>catfile('blib',$_)}find(qr//,'script');my%shared=map {$_=>catfile(qw/blib lib auto share dist/,$opt{meta}->name,abs2rel($_,'share'))}find(qr//,'share');pm_to_blib({%modules,%scripts,%shared},catdir(qw/blib lib auto/));make_executable($_)for values%scripts;mkpath(catdir(qw/blib arch/),$opt{verbose});process_xs($_,\%opt)for find(qr/.xs$/,'lib');if ($opt{install_paths}->install_destination('bindoc')&& $opt{install_paths}->is_default_installable('bindoc')){manify($_,catfile('blib','bindoc',man1_pagename($_)),$opt{config}->get('man1ext'),\%opt)for keys%scripts}if ($opt{install_paths}->install_destination('libdoc')&& $opt{install_paths}->is_default_installable('libdoc')){manify($_,catfile('blib','libdoc',man3_pagename($_)),$opt{config}->get('man3ext'),\%opt)for keys%modules}},test=>sub {my%opt=@_;die "Must run `./Build build` first\n" if not -d 'blib';require TAP::Harness::Env;my%test_args=((verbosity=>$opt{verbose})x!!exists$opt{verbose},(jobs=>$opt{jobs})x!!exists$opt{jobs},(color=>1)x!!-t STDOUT,lib=>[map {rel2abs(catdir(qw/blib/,$_))}qw/arch lib/ ],);my$tester=TAP::Harness::Env->create(\%test_args);$tester->runtests(sort +find(qr/\.t$/,'t'))->has_errors and exit 1},install=>sub {my%opt=@_;die "Must run `./Build build` first\n" if not -d 'blib';install($opt{install_paths}->install_map,@opt{qw/verbose dry_run uninst/})},clean=>sub {my%opt=@_;rmtree($_,$opt{verbose})for qw/blib temp/},realclean=>sub {my%opt=@_;rmtree($_,$opt{verbose})for qw/blib temp Build _build_params MYMETA.yml MYMETA.json/},);sub Build {my$action=@ARGV && $ARGV[0]=~ /\A\w+\z/ ? shift@ARGV : 'build';die "No such action '$action'\n" if not $actions{$action};my($env,$bargv)=@{decode_json(read_file('_build_params'))};my%opt;GetOptionsFromArray($_,\%opt,qw/install_base=s install_path=s% installdirs=s destdir=s prefix=s config=s% uninst:1 verbose:1 dry_run:1 pureperl-only:1 create_packlist=i jobs=i/)for ($env,$bargv,\@ARGV);$_=detildefy($_)for grep {defined}@opt{qw/install_base destdir prefix/},values %{$opt{install_path}};@opt{'config','meta' }=(ExtUtils::Config->new($opt{config}),get_meta());$actions{$action}->(%opt,install_paths=>ExtUtils::InstallPaths->new(%opt,dist_name=>$opt{meta}->name))}sub Build_PL {my$meta=get_meta();printf "Creating new 'Build' script for '%s' version '%s'\n",$meta->name,$meta->version;my$dir=$meta->name eq 'Module-Build-Tiny' ? "use lib 'lib';" : '';write_file('Build',"#!perl\n$dir\nuse Module::Build::Tiny;\nBuild();\n");make_executable('Build');my@env=defined$ENV{PERL_MB_OPT}? split_like_shell($ENV{PERL_MB_OPT}): ();write_file('_build_params',encode_json([\@env,\@ARGV ]));$meta->save(@$_)for ['MYMETA.json'],['MYMETA.yml'=>{version=>1.4 }]}1; +MODULE_BUILD_TINY + +$fatpacked{"PadWalker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PADWALKER'; + package PadWalker;use strict;use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);require Exporter;require DynaLoader;require 5.008;@ISA=qw(Exporter DynaLoader);@EXPORT_OK=qw(peek_my peek_our closed_over peek_sub var_name set_closed_over);%EXPORT_TAGS=(all=>\@EXPORT_OK);$VERSION='2.3';bootstrap PadWalker$VERSION;sub peek_my;sub peek_our;sub closed_over;sub peek_sub;sub var_name;1; +PADWALKER + +$fatpacked{"Path/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_TINY'; + use 5.008001;use strict;use warnings;package Path::Tiny;our$VERSION='0.104';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_BSD=>(scalar $^O =~ /bsd$/),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 {!!eval {require Unicode::UTF8;Unicode::UTF8->VERSION(0.58);1}}my$HAS_PU;sub _check_PU {!!eval {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 if Path::Tiny::IS_BSD(),'warnings::register'}my$WARNED_BSD_NFS=0;sub _throw {my ($self,$function,$file,$msg)=@_;if (IS_BSD()&& $function =~ /^flock/ && $! =~ /operation not supported/i &&!warnings::fatal_enabled('flock')){if (!$WARNED_BSD_NFS){warnings::warn(flock=>"No flock for NFS on BSD: continuing in unsafe mode");$WARNED_BSD_NFS++}}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}){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; +PATH_TINY + +$fatpacked{"Smart/Options.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SMART_OPTIONS'; + package Smart::Options;use strict;use warnings;use 5.010001;our$VERSION='0.061';require Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(argv);use List::MoreUtils qw(uniq);use Text::Table;use File::Slurp;sub new {my$pkg=shift;my%opt=@_;my$self=bless {alias=>{},default=>{},boolean=>{},demand=>{},usage=>"Usage: $0",describe=>{},type=>{},subcmd=>{},coerce=>{},env=>{},env_prefix=>'',},$pkg;if ($opt{add_help}// 1){$self->options(h=>{alias=>'help',describe=>'show help',});$self->{add_help}=1}$self}sub argv {Smart::Options->new->parse(@_)}sub _set {my$self=shift;my$param=shift;my%args=@_;for my$option (keys%args){$self->{$param}->{$option}=$args{$option}}$self}sub alias {shift->_set('alias',@_)}sub default {shift->_set('default',@_)}sub describe {shift->_set('describe',@_)}sub type {shift->_set('type',@_)}sub subcmd {shift->_set('subcmd',@_)}sub _set_flag {my$self=shift;my$param=shift;for my$option (@_){$self->{$param}->{$option}=1}$self}sub boolean {shift->_set_flag('boolean',@_)}sub demand {shift->_set_flag('demand',@_)}sub env {shift->_set_flag('env',@_)}sub options {my$self=shift;my%args=@_;while (my($opt,$setting)=each%args){for my$key (keys %$setting){$self->$key($opt,$setting->{$key})}}$self}sub coerce {my ($self,$isa,$type,$generater)=@_;$self->{coerce}->{$isa}={type=>$type,generater=>$generater,};$self}sub usage {$_[0]->{usage}=$_[1];$_[0]}sub env_prefix {$_[0]->{env_prefix}=$_[1];$_[0]}sub _get_opt_desc {my ($self,$option)=@_;my@opts=($option);while (my($opt,$val)=each %{$self->{alias}}){push@opts,$opt if$val eq $option}return join(', ',map {(length($_)==1 ? '-' : '--').$_}sort@opts)}sub _get_describe {my ($self,$option)=@_;my$desc=$self->{describe}->{$option};while (my($opt,$val)=each %{$self->{alias}}){$desc ||= $self->{describe}->{$opt}if$val eq $option}return$desc ? ucfirst($desc): ''}sub _get_default {my ($self,$option)=@_;my$value=$self->{default}->{$option};while (my($opt,$val)=each %{$self->{alias}}){$value ||= $self->{default}->{$opt}if$val eq $option}$value}sub help {my$self=shift;my$alias=$self->{alias};my$demand=$self->{demand};my$describe=$self->{describe};my$default=$self->{default};my$boolean=$self->{boolean};my$help=$self->{usage}."\n";if (scalar(keys %$demand)or scalar(keys %$describe)){my@opts;for my$opt (uniq sort keys %$demand,keys %$describe,keys %$default,keys %$boolean,values %$alias){next if$alias->{$opt};push@opts,[$self->_get_opt_desc($opt),$self->_get_describe($opt),$boolean->{$opt}? '[boolean]' : '',$demand->{$opt}? '[required]' : '',$self->_get_default($opt)? "[default: @{[$self->_get_default($opt)]}]" : '',]}my$sep=\' ';$help .= "\nOptions:\n";$help .= Text::Table->new($sep,'',$sep,'',$sep,'',$sep,'',$sep,'')->load(@opts)->stringify ."\n";if (keys %{$self->{subcmd}}){$help .= "Implemented commands are:\n";$help .= " " .join(', ',sort keys %{$self->{subcmd}})."\n\n"}}$help}sub showHelp {my ($self,$fh)=@_;$fh //= *STDERR;print$fh $self->help}sub _set_v2a {my ($argv,$key,$value,$k)=@_;if ($k){$argv->{$key}//= {};_set_v2a($argv->{$key},$k,$value)}elsif (exists$argv->{$key}){if (ref($argv->{$key})){push @{$argv->{$key}},$value}else {$argv->{$key}=[$argv->{$key},$value ]}}else {$argv->{$key}=$value}}sub _get_real_name {my ($self,$opt)=@_;while (my$name=$self->{alias}->{$opt}){$opt=$name}return$opt}sub _load_config {my ($self,$argv,$file)=@_;for my$line (read_file($file)){next if$line =~ /^\[/;next if$line =~ /^;/;next if$line !~ /=/;chomp($line);if ($line =~ /^(.+?[^\\])=(.*)$/){$argv->{$1}=$2}}}sub parse {my$self=shift;push @_,@ARGV unless @_;my$argv={};my@args;my$boolean=$self->{boolean};my$key;my$nest_key;my$stop=0;for my$arg (@_){if ($stop){push@args,$arg;next}if ($arg =~ /^--((?:\w|-|\.)+)=(.+)$/){my ($opt,$k)=split(/\./,$1);my$option=$self->_get_real_name($opt);if ($k){_set_v2a($argv,$option,$2,$k)}else {_set_v2a($argv,$option,$2)}}elsif ($arg =~ /^(-(\w)|--((?:\w|-|\.)+))$/){if ($key){$argv->{$key}=1}my$opt=$2 // $3;if ($opt =~ /^no\-(.+)$/){my$option=$self->_get_real_name($1);$argv->{$option}=0;next}($opt,my$k)=split(/\./,$opt);my$option=$self->_get_real_name($opt);if ($boolean->{$option}){if ($k){$argv->{$option}//= {};$argv->{$option}->{$k}=1}else {$argv->{$option}=1}}else {$key=$option;$nest_key=$k}}elsif ($arg =~ /^-(\w(?:\w|-|\.)+)$/){if ($key){$argv->{$key}=1}my$opt_str=$1;if ($opt_str =~ /^(.)([0-9])+$/){my$option=$self->_get_real_name($1);$argv->{$option}=$2}else {for (split //,$opt_str){my$option=$self->_get_real_name($_);$argv->{$option}=1}}}elsif ($arg =~ /^--$/){$stop=1;next}else {if ($key){if ($nest_key){_set_v2a($argv,$key,$arg,$nest_key)}else {_set_v2a($argv,$key,$arg)}$key=$nest_key=undef}else {if (!scalar(@args)&& keys %{$self->{subcmd}}){if ($self->{subcmd}->{$arg}){$argv->{command}=$arg;$stop=1;next}else {die "sub command '$arg' not defined."}}push@args,$arg}}}if ($key){if ($nest_key){$argv->{$key}//= {};$argv->{$key}->{$nest_key}=1}else {$argv->{$key}=1}}if (my$parser=$self->{subcmd}->{$argv->{command}||''}){$argv->{cmd_option}=$parser->parse(@args)}else {$argv->{_}=\@args}for my$env (keys %{$self->{env}}){if (defined($ENV{uc($self->{env_prefix}."_$env")})){my$option=$self->_get_real_name($env);$argv->{$option}//= $ENV{uc($self->{env_prefix}."_$env")}}}while (my ($key,$val)=each %{$self->{default}}){my$opt=$self->_get_real_name($key);if (ref($val)&& ref($val)eq 'CODE'){$argv->{$opt}//= $val->()}else {$argv->{$opt}//= $val}}while (my ($key,$val)=each %{$self->{type}}){next if$val ne 'Config';next if!($argv->{$key})||!(-f $argv->{$key});$self->_load_config($argv,delete$argv->{$key})}for my$key (keys %{$self->{demand}}){my$opt=$self->_get_real_name($key);if (!$argv->{$opt}){$self->showHelp;print STDERR "\nMissing required arguments: $opt\n";die}}for my$key (keys %{$self->{type}}){my$opt=$self->_get_real_name($key);my$type=$self->{type}->{$key};if (my$c=$self->{coerce}->{$type}){$type=$c->{type};$argv->{$opt}=$c->{generater}->($argv->{$opt})}my$check=0;if ($type eq 'Bool'){$argv->{$opt}//= 0;$check=($argv->{$opt}=~ /^(0|1)$/)? 1 : 0}elsif ($type eq 'Str'){$check=1}elsif ($type eq 'Int'){if ($argv->{$opt}){$check=($argv->{$opt}=~ /^\-?\d+$/)? 1 : 0}else {$check=1}}elsif ($type eq 'Num'){if ($argv->{$opt}){$check=($argv->{$opt}=~ /^\-?\d+(\.\d+)$/)? 1 : 0}else {$check=1}}elsif ($type eq 'ArrayRef'){$argv->{$opt}//= [];unless (ref($argv->{$opt})){$argv->{$opt}=[$argv->{$opt}]}$check=(ref($argv->{$opt})eq 'ARRAY')? 1 : 0}elsif ($type eq 'HashRef'){$argv->{$opt}//= {};$check=(ref($argv->{$opt})eq 'HASH')? 1 : 0}elsif ('Config'){if ($argv->{$opt}&&!(-f $argv->{$opt})){die "cannot load config file '@{[$argv->{$opt}]}\n"}$check=1}else {die "cannot find type constraint '$type'\n"}unless ($check){die "Value '@{[$argv->{$opt}]}' invalid for option $opt($type)\n"}}if ($argv->{help}&& $self->{add_help}){$self->showHelp;die}$argv}1; +SMART_OPTIONS + +$fatpacked{"Smart/Options/Declare.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SMART_OPTIONS_DECLARE'; + package Smart::Options::Declare;use strict;use warnings;use Exporter 'import';use Smart::Options;use PadWalker qw/var_name/;our@EXPORT=qw(opts opts_coerce);our$COERCE={Multiple=>{type=>'ArrayRef',generater=>sub {if (defined $_[0]){return [split(qr{,},ref($_[0])eq 'ARRAY' ? join(q{,},@{$_[0]}): $_[0])]}else {return $_[0]}}}};my%is_invocant=map{$_=>undef}qw($self $class);sub opts {{package DB;()=caller(1)}if (exists$is_invocant{var_name(1,\$_[0])|| '' }){$_[0]=shift@DB::args;shift}my$opt=Smart::Options->new();$opt->type(config=>'Config');for (my$i=0 ;$i < @_ ;$i++ ){(my$name=var_name(1,\$_[$i]))or Carp::croak('usage: opts my $var => TYPE, ...');$name =~ s/^\$//;if ($name =~ /_/){(my$newname=$name)=~ s/_/-/g;$opt->alias($newname=>$name);$name=$newname}my$rule=$_[$i+1];if ($rule){if (ref($rule)&& ref($rule)eq 'HASH'){if ($rule->{default}){$opt->default($name=>$rule->{default})}if ($rule->{required}){$opt->demand($name)}if ($rule->{alias}){$opt->alias($rule->{alias}=>$name)}if ($rule->{comment}){$opt->describe($name=>$rule->{comment})}if (my$isa=$rule->{isa}){if ($isa eq 'Bool'){$opt->boolean($name)}$opt->type($name=>$isa)}}else {if ($rule eq 'Bool'){$opt->boolean($name)}$opt->type($name=>$rule)}}if (length($name)> 1){$opt->alias(substr($name,0,1)=>$name)}$i++ if defined $_[$i+1]}while (my ($isa,$c)=each(%$COERCE)){$opt->coerce($isa=>$c->{type},$c->{generater})}my$argv=$opt->parse;for (my$i=0 ;$i < @_ ;$i++ ){(my$name=var_name(1,\$_[$i]))or Carp::croak('usage: opts my $var => TYPE, ...');$name =~ s/^\$//;$_[$i]=$argv->{$name};$i++ if defined $_[$i+1]}}sub opts_coerce {my ($isa,$type,$generater)=@_;$COERCE->{$isa}={type=>$type,generater=>$generater }}1; +SMART_OPTIONS_DECLARE + +$fatpacked{"Text/Aligner.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_ALIGNER'; + 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; +TEXT_ALIGNER + +$fatpacked{"Text/Table.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE'; + 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 /(?_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}} +TEXT_TABLE + +s/^ //mg for values %fatpacked; + +my $class = 'FatPacked::'.(0+\%fatpacked); +no strict 'refs'; +*{"${class}::files"} = sub { keys %{$_[0]} }; + +if ($] < 5.008) { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + my $pos = 0; + my $last = length $fat; + return (sub { + return 0 if $pos == $last; + my $next = (1 + index $fat, "\n", $pos) || $last; + $_ .= substr $fat, $pos, $next - $pos; + $pos = $next; + return 1; + }); + } + }; } - -if ($flags->{new}){ - new(set_template('lib/template.md'),"slides"); -} elsif ($flags->{build}) { - build_recently("slides"); -} elsif ($flags->{build_open}) { - build_recently("slides"); - open_slide("slides"); -} elsif ( $flags->{open}) { - open_slide("slides"); -} elsif ($flags->{memo}) { - edit_memo("slides"); -} elsif ( $flags->{edit}) { - edit_slide("slides"); -} else { - build_pinpoint($flags->{build_point}); +else { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + open my $fh, '<', \$fat + or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; + return $fh; + } + return; + }; } +unshift @INC, bless \%fatpacked, $class; + } # END OF FATPACK CODE -sub help { - say 'slider [new build build-open open edit]'; -} +use strict; +use warnings; +use lib 'lib'; +use CLI; -__END__ +CLI->new(template => $ENV{CR_TEMPLATE}, root_dir => $ENV{CR_ROOT_DIR})->run(@ARGV); diff -r 5f949b153f65 -r 73b27e5c1d79 slide-cr.fatpack.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slide-cr.fatpack.pl Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,683 @@ +#!/usr/bin/env perl + +# This chunk of stuff was generated by App::FatPacker. To find the original +# file's code, look for the end of this BEGIN block or the string 'FATPACK' +BEGIN { +my %fatpacked; + +$fatpacked{"CLI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLI'; + package CLI;use strict;use warnings;use utf8;use Smart::Options;use Smart::Options::Declare;use Time::Piece;use Time::Seconds;use Capture::Tiny qw/capture/;use Path::Tiny;use File::chdir;use Carp qw/croak/;use Class::Tiny qw/template root_dir/;use feature 'say';sub run {my($self,@args)=@_;my$opt=Smart::Options->new->options(file=>{describe=>'target file',alias=>'f'});$opt->subcmd(new=>Smart::Options->new(),build=>Smart::Options->new(),open=>Smart::Options->new->default('target'=>'slide.md'),build_open=>Smart::Options->new->default('target'=>'slide.md'),upload=>Smart::Options->new(),memo=>Smart::Options->new(),edit=>Smart::Options->new(),zip=>Smart::Options->new(),);my$result=$opt->parse(@args);my$command=$result->{command}// "open";my$option=$result->{cmd_option}->{f}|| $result->{cmd_option}->{file}|| 0;my$call=$self->can("cmd_$command");croak 'undefine subcommand' unless$call;$self->$call($option)}sub cmd_new {my ($self)=@_;my ($y,$m,$d)=_y_m_d();my$slide=path($self->root_dir)->child($y)->child($m)->child($d)->child('slide.md')->touchpath;path($self->template)->copy($slide)}sub cmd_build {my($self,$target)=@_;if ($target){$target=path($target);$self->_build($target->dirname,$target->basename)}else {$self->_build($self->_search_recently_day())}}sub _build {my ($self,$dir,$target)=@_;$target //= 'slide.md';say "[AUTO] BUILD at $dir/$target";local$CWD=$dir;my ($stdout,$stderr,$exit)=capture {system("slideshow build ${target} -t s6cr")};croak "Perl can't build...." if$stderr}sub cmd_build_open {my($self,$target)=@_;$self->cmd_build($target);if($target){$target =~ s/\.md$/\.html/}else {my@targets=$self->_search_recently_day()->children(qr/(?cmd_open(path($target))}sub cmd_open {my($self,$slide)=@_;my$target;if ($slide){$target=$slide}else {$slide='slide.html';$target=$self->_search_recently_day()->child($slide)}if($target->realpath){system 'open',($target->realpath)}else {croak 'dont found slide.html'}}sub cmd_upload {say "[AUTO]hg addremove";my ($stdout,$stderr,$exit)=capture {system("hg addremove");system("hg add")};croak "didn't add" if$stderr;say "[AUTO]hg commit -m auto-Update generated slides by script";($stdout,$stderr,$exit)=capture {system('hg commit -m "auto-Update generated slides by script"')};if ($stderr){say$stderr;croak "didn't commit"}say "[AUTO]hg push";($stdout,$stderr,$exit)=capture {system('hg push')};if ($stderr){say$stderr;croak "didn't commit"}else {say$stdout}}sub _y_m_d {my$t=localtime;($t->strftime('%Y'),$t->strftime('%m'),$t->strftime('%d'))}sub _search_recently_day {my ($self)=@_;my ($y,$m,$d)=_y_m_d();my$root_dir=path($self->root_dir)->child($y)->child($m);my$date=shift @{[sort {$b->stat->mtime <=> $a->stat->mtime}$root_dir->children]};return$date}sub cmd_memo {my ($self)=@_;my ($y,$m,$d)=_y_m_d();my$memo=path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt')->touchpath;exec$ENV{EDITOR},($memo->realpath)}sub cmd_edit {my ($self)=@_;my$recent_day=$self->_search_recently_day();my@targets=$recent_day->children(qr/\.md$/);my$target=pop@targets;exec$ENV{EDITOR},($target->realpath)}sub cmd_zip {my ($self)=@_;my$recent_day=$self->_search_recently_day();my$t=localtime;my$zip=$recent_day->child('zip.txt')->touch->opena;$t-= ONE_WEEK;for(0..7){my($y,$m,$d)=($t->strftime('%Y'),$t->strftime('%m'),$t->strftime('%d'));my$memo=path($self->root_dir)->child($y)->child($m)->child($d)->child('memo.txt');unless ($memo->exists){$t += ONE_DAY;next}say$zip "$y-$m-$d----";say$zip $memo->slurp;say$zip "----------";$t += ONE_DAY}}1; +CLI + +$fatpacked{"Capture/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CAPTURE_TINY'; + use 5.006;use strict;use warnings;package Capture::Tiny;our$VERSION='0.48';use Carp ();use Exporter ();use IO::Handle ();use File::Spec ();use File::Temp qw/tempfile tmpnam/;use Scalar::Util qw/reftype blessed/;BEGIN {local $@;eval {require PerlIO;PerlIO->can('get_layers')}or *PerlIO::get_layers=sub {return ()}}my%api=(capture=>[1,1,0,0],capture_stdout=>[1,0,0,0],capture_stderr=>[0,1,0,0],capture_merged=>[1,1,1,0],tee=>[1,1,0,1],tee_stdout=>[1,0,0,1],tee_stderr=>[0,1,0,1],tee_merged=>[1,1,1,1],);for my$sub (keys%api){my$args=join q{, },@{$api{$sub}};eval "sub $sub(&;@) {unshift \@_, $args; goto \\&_capture_tee;}"}our@ISA=qw/Exporter/;our@EXPORT_OK=keys%api;our%EXPORT_TAGS=('all'=>\@EXPORT_OK);my$IS_WIN32=$^O eq 'MSWin32';our$TIMEOUT=30;my@cmd=($^X,'-C0','-e',<<'HERE');sub _relayer {my ($fh,$apply_layers)=@_;binmode($fh,":raw");while (1 < (my$layers=()=PerlIO::get_layers($fh,output=>1))){binmode($fh,":pop")}my@to_apply=@$apply_layers;shift@to_apply;binmode($fh,":" .join(":",@to_apply))}sub _name {my$glob=shift;no strict 'refs';return *{$glob}{NAME}}sub _open {open $_[0],$_[1]or Carp::confess "Error from open(" .join(q{, },@_)."): $!"}sub _close {close $_[0]or Carp::confess "Error from close(" .join(q{, },@_)."): $!"}my%dup;my%proxy_count;sub _proxy_std {my%proxies;if (!defined fileno STDIN){$proxy_count{stdin}++;if (defined$dup{stdin}){_open \*STDIN,"<&=" .fileno($dup{stdin})}else {_open \*STDIN,"<" .File::Spec->devnull;_open$dup{stdin}=IO::Handle->new,"<&=STDIN"}$proxies{stdin}=\*STDIN;binmode(STDIN,':utf8')if $] >= 5.008}if (!defined fileno STDOUT){$proxy_count{stdout}++;if (defined$dup{stdout}){_open \*STDOUT,">&=" .fileno($dup{stdout})}else {_open \*STDOUT,">" .File::Spec->devnull;_open$dup{stdout}=IO::Handle->new,">&=STDOUT"}$proxies{stdout}=\*STDOUT;binmode(STDOUT,':utf8')if $] >= 5.008}if (!defined fileno STDERR){$proxy_count{stderr}++;if (defined$dup{stderr}){_open \*STDERR,">&=" .fileno($dup{stderr})}else {_open \*STDERR,">" .File::Spec->devnull;_open$dup{stderr}=IO::Handle->new,">&=STDERR"}$proxies{stderr}=\*STDERR;binmode(STDERR,':utf8')if $] >= 5.008}return%proxies}sub _unproxy {my (%proxies)=@_;for my$p (keys%proxies){$proxy_count{$p}--;if (!$proxy_count{$p}){_close$proxies{$p};_close$dup{$p}unless $] < 5.008;delete$dup{$p}}}}sub _copy_std {my%handles;for my$h (qw/stdout stderr stdin/){next if$h eq 'stdin' &&!$IS_WIN32;my$redir=$h eq 'stdin' ? "<&" : ">&";_open$handles{$h}=IO::Handle->new(),$redir .uc($h)}return \%handles}sub _open_std {my ($handles)=@_;_open \*STDIN,"<&" .fileno$handles->{stdin}if defined$handles->{stdin};_open \*STDOUT,">&" .fileno$handles->{stdout}if defined$handles->{stdout};_open \*STDERR,">&" .fileno$handles->{stderr}if defined$handles->{stderr}}sub _start_tee {my ($which,$stash)=@_;$stash->{$_}{$which}=IO::Handle->new for qw/tee reader/;pipe$stash->{reader}{$which},$stash->{tee}{$which};select((select($stash->{tee}{$which}),$|=1)[0]);$stash->{new}{$which}=$stash->{tee}{$which};$stash->{child}{$which}={stdin=>$stash->{reader}{$which},stdout=>$stash->{old}{$which},stderr=>$stash->{capture}{$which},};$stash->{flag_files}{$which}=scalar(tmpnam()).$$;if ($IS_WIN32){my$old_eval_err=$@;undef $@;eval "use Win32API::File qw/GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";my$os_fhandle=GetOsFHandle($stash->{tee}{$which});my$result=SetHandleInformation($os_fhandle,HANDLE_FLAG_INHERIT(),0);_open_std($stash->{child}{$which});$stash->{pid}{$which}=system(1,@cmd,$stash->{flag_files}{$which});$@=$old_eval_err}else {_fork_exec($which,$stash)}}sub _fork_exec {my ($which,$stash)=@_;my$pid=fork;if (not defined$pid){Carp::confess "Couldn't fork(): $!"}elsif ($pid==0){untie*STDIN;untie*STDOUT;untie*STDERR;_close$stash->{tee}{$which};_open_std($stash->{child}{$which});exec@cmd,$stash->{flag_files}{$which}}$stash->{pid}{$which}=$pid}my$have_usleep=eval "use Time::HiRes 'usleep'; 1";sub _files_exist {return 1 if @_==grep {-f}@_;Time::HiRes::usleep(1000)if$have_usleep;return 0}sub _wait_for_tees {my ($stash)=@_;my$start=time;my@files=values %{$stash->{flag_files}};my$timeout=defined$ENV{PERL_CAPTURE_TINY_TIMEOUT}? $ENV{PERL_CAPTURE_TINY_TIMEOUT}: $TIMEOUT;1 until _files_exist(@files)|| ($timeout && (time - $start > $timeout));Carp::confess "Timed out waiting for subprocesses to start" if!_files_exist(@files);unlink $_ for@files}sub _kill_tees {my ($stash)=@_;if ($IS_WIN32){close($_)for values %{$stash->{tee}};my$start=time;1 until wait==-1 || (time - $start > 30)}else {_close $_ for values %{$stash->{tee}};waitpid $_,0 for values %{$stash->{pid}}}}sub _slurp {my ($name,$stash)=@_;my ($fh,$pos)=map {$stash->{$_}{$name}}qw/capture pos/;seek($fh,$pos,0)or die "Couldn't seek on capture handle for $name\n";my$text=do {local $/;scalar readline$fh};return defined($text)? $text : ""}sub _capture_tee {my ($do_stdout,$do_stderr,$do_merge,$do_tee,$code,@opts)=@_;my%do=($do_stdout ? (stdout=>1): (),$do_stderr ? (stderr=>1): ());Carp::confess("Custom capture options must be given as key/value pairs\n")unless@opts % 2==0;my$stash={capture=>{@opts }};for (keys %{$stash->{capture}}){my$fh=$stash->{capture}{$_};Carp::confess "Custom handle for $_ must be seekable\n" unless ref($fh)eq 'GLOB' || (blessed($fh)&& $fh->isa("IO::Seekable"))}local*CT_ORIG_STDIN=*STDIN ;local*CT_ORIG_STDOUT=*STDOUT;local*CT_ORIG_STDERR=*STDERR;my%layers=(stdin=>[PerlIO::get_layers(\*STDIN)],stdout=>[PerlIO::get_layers(\*STDOUT,output=>1)],stderr=>[PerlIO::get_layers(\*STDERR,output=>1)],);$layers{stdout}=[PerlIO::get_layers(tied*STDOUT)]if tied(*STDOUT)&& (reftype tied*STDOUT eq 'GLOB');$layers{stderr}=[PerlIO::get_layers(tied*STDERR)]if tied(*STDERR)&& (reftype tied*STDERR eq 'GLOB');my%localize;$localize{stdin}++,local(*STDIN)if grep {$_ eq 'scalar'}@{$layers{stdin}};$localize{stdout}++,local(*STDOUT)if$do_stdout && grep {$_ eq 'scalar'}@{$layers{stdout}};$localize{stderr}++,local(*STDERR)if ($do_stderr || $do_merge)&& grep {$_ eq 'scalar'}@{$layers{stderr}};$localize{stdin}++,local(*STDIN),_open(\*STDIN,"<&=0")if tied*STDIN && $] >= 5.008;$localize{stdout}++,local(*STDOUT),_open(\*STDOUT,">&=1")if$do_stdout && tied*STDOUT && $] >= 5.008;$localize{stderr}++,local(*STDERR),_open(\*STDERR,">&=2")if ($do_stderr || $do_merge)&& tied*STDERR && $] >= 5.008;my%proxy_std=_proxy_std();$layers{stdout}=[PerlIO::get_layers(\*STDOUT,output=>1)]if$proxy_std{stdout};$layers{stderr}=[PerlIO::get_layers(\*STDERR,output=>1)]if$proxy_std{stderr};$stash->{old}=_copy_std();$stash->{new}={%{$stash->{old}}};for (keys%do){$stash->{new}{$_}=($stash->{capture}{$_}||= File::Temp->new);seek($stash->{capture}{$_},0,2)or die "Could not seek on capture handle for $_\n";$stash->{pos}{$_}=tell$stash->{capture}{$_};_start_tee($_=>$stash)if$do_tee}_wait_for_tees($stash)if$do_tee;$stash->{new}{stderr}=$stash->{new}{stdout}if$do_merge;_open_std($stash->{new});my ($exit_code,$inner_error,$outer_error,$orig_pid,@result);{$orig_pid=$$;local*STDIN=*CT_ORIG_STDIN if$localize{stdin};_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;my$old_eval_err=$@;undef $@;eval {@result=$code->();$inner_error=$@};$exit_code=$?;$outer_error=$@;STDOUT->flush if$do_stdout;STDERR->flush if$do_stderr;$@=$old_eval_err}_open_std($stash->{old});_close($_)for values %{$stash->{old}};_relayer(\*STDOUT,$layers{stdout})if$do_stdout;_relayer(\*STDERR,$layers{stderr})if$do_stderr;_unproxy(%proxy_std);_kill_tees($stash)if$do_tee;my%got;if ($orig_pid==$$ and (defined wantarray or ($do_tee && keys%localize))){for (keys%do){_relayer($stash->{capture}{$_},$layers{$_});$got{$_}=_slurp($_,$stash)}print CT_ORIG_STDOUT$got{stdout}if$do_stdout && $do_tee && $localize{stdout};print CT_ORIG_STDERR$got{stderr}if$do_stderr && $do_tee && $localize{stderr}}$?=$exit_code;$@=$inner_error if$inner_error;die$outer_error if$outer_error;return unless defined wantarray;my@return;push@return,$got{stdout}if$do_stdout;push@return,$got{stderr}if$do_stderr &&!$do_merge;push@return,@result;return wantarray ? @return : $return[0]}1; + use Fcntl; + $SIG{HUP}=sub{exit}; + if ( my $fn=shift ) { + sysopen(my $fh, qq{$fn}, O_WRONLY|O_CREAT|O_EXCL) or die $!; + print {$fh} $$; + close $fh; + } + my $buf; while (sysread(STDIN, $buf, 2048)) { + syswrite(STDOUT, $buf); syswrite(STDERR, $buf); + } + HERE +CAPTURE_TINY + +$fatpacked{"Class/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'CLASS_TINY'; + use 5.006;use strict;no strict 'refs';use warnings;package Class::Tiny;our$VERSION='1.006';use Carp ();require($] >= 5.010 ? "mro.pm" : "MRO/Compat.pm");my%CLASS_ATTRIBUTES;sub import {my$class=shift;my$pkg=caller;$class->prepare_class($pkg);$class->create_attributes($pkg,@_)if @_}sub prepare_class {my ($class,$pkg)=@_;@{"${pkg}::ISA"}="Class::Tiny::Object" unless @{"${pkg}::ISA"}}sub create_attributes {my ($class,$pkg,@spec)=@_;my%defaults=map {ref $_ eq 'HASH' ? %$_ : ($_=>undef)}@spec;my@attr=grep {defined and!ref and /^[^\W\d]\w*$/s or Carp::croak "Invalid accessor name '$_'"}keys%defaults;$CLASS_ATTRIBUTES{$pkg}{$_}=$defaults{$_}for@attr;$class->_gen_accessor($pkg,$_)for grep {!*{"$pkg\::$_"}{CODE}}@attr;Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub _gen_accessor {my ($class,$pkg,$name)=@_;my$outer_default=$CLASS_ATTRIBUTES{$pkg}{$name};my$sub=$class->__gen_sub_body($name,defined($outer_default),ref($outer_default));eval "package $pkg; my \$default=\$outer_default; $sub";Carp::croak("Failed to generate attributes for $pkg: $@\n")if $@}sub __gen_sub_body {my ($self,$name,$has_default,$default_type)=@_;if ($has_default && $default_type eq 'CODE'){return << "HERE"}elsif ($has_default){return << "HERE"}else {return << "HERE"}}sub get_all_attributes_for {my ($class,$pkg)=@_;my%attr=map {$_=>undef}map {keys %{$CLASS_ATTRIBUTES{$_}|| {}}}@{mro::get_linear_isa($pkg)};return keys%attr}sub get_all_attribute_defaults_for {my ($class,$pkg)=@_;my$defaults={};for my$p (reverse @{mro::get_linear_isa($pkg)}){while (my ($k,$v)=each %{$CLASS_ATTRIBUTES{$p}|| {}}){$defaults->{$k}=$v}}return$defaults}package Class::Tiny::Object;our$VERSION='1.006';my (%HAS_BUILDARGS,%BUILD_CACHE,%DEMOLISH_CACHE,%ATTR_CACHE);my$_PRECACHE=sub {no warnings 'once';my ($class)=@_;my$linear_isa=@{"$class\::ISA"}==1 && ${"$class\::ISA"}[0]eq "Class::Tiny::Object" ? [$class]: mro::get_linear_isa($class);$DEMOLISH_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::DEMOLISH"}@$linear_isa ];$BUILD_CACHE{$class}=[map {(*{$_}{CODE})? (*{$_}{CODE}): ()}map {"$_\::BUILD"}reverse @$linear_isa ];$HAS_BUILDARGS{$class}=$class->can("BUILDARGS");return$ATTR_CACHE{$class}={map {$_=>1}Class::Tiny->get_all_attributes_for($class)}};sub new {my$class=shift;my$valid_attrs=$ATTR_CACHE{$class}|| $_PRECACHE->($class);my$args;if ($HAS_BUILDARGS{$class}){$args=$class->BUILDARGS(@_)}else {if (@_==1 && ref $_[0]){my%copy=eval {%{$_[0]}};Carp::croak("Argument to $class->new() could not be dereferenced as a hash")if $@;$args=\%copy}elsif (@_ % 2==0){$args={@_}}else {Carp::croak("$class->new() got an odd number of elements")}}my$self=bless {map {$_=>$args->{$_}}grep {exists$valid_attrs->{$_}}keys %$args },$class;$self->BUILDALL($args)if!delete$args->{__no_BUILD__}&& @{$BUILD_CACHE{$class}};return$self}sub BUILDALL {$_->(@_)for @{$BUILD_CACHE{ref $_[0]}}}require Devel::GlobalDestruction unless defined ${^GLOBAL_PHASE};sub DESTROY {my$self=shift;my$class=ref$self;my$in_global_destruction=defined ${^GLOBAL_PHASE} ? ${^GLOBAL_PHASE} eq 'DESTRUCT' : Devel::GlobalDestruction::in_global_destruction();for my$demolisher (@{$DEMOLISH_CACHE{$class}}){my$e=do {local ($?,$@);eval {$demolisher->($self,$in_global_destruction)};$@};no warnings 'misc';die$e if$e}}1; + sub $name { + return ( + ( \@_ == 1 && exists \$_[0]{$name} ) + ? ( \$_[0]{$name} ) + : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default->( \$_[0] ) ) + ); + } + HERE + sub $name { + return ( + ( \@_ == 1 && exists \$_[0]{$name} ) + ? ( \$_[0]{$name} ) + : ( \$_[0]{$name} = ( \@_ == 2 ) ? \$_[1] : \$default ) + ); + } + HERE + sub $name { + return \@_ == 1 ? \$_[0]{$name} : ( \$_[0]{$name} = \$_[1] ); + } + HERE +CLASS_TINY + +$fatpacked{"Exporter/Shiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_SHINY'; + package Exporter::Shiny;use 5.006001;use strict;use warnings;use Exporter::Tiny ();our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.000000';sub import {my$me=shift;my$caller=caller;(my$nominal_file=$caller)=~ s(::)(/)g;$INC{"$nominal_file\.pm"}||= __FILE__;if (@_==2 and $_[0]eq -setup){my (undef,$opts)=@_;@_=@{delete($opts->{exports})|| []};if (%$opts){Exporter::Tiny::_croak('Unsupported Sub::Exporter-style options: %s',join(q[, ],sort keys %$opts),)}}ref($_)&& Exporter::Tiny::_croak('Expected sub name, got ref %s',$_)for @_;no strict qw(refs);push @{"$caller\::ISA"},'Exporter::Tiny';push @{"$caller\::EXPORT_OK"},@_}1; +EXPORTER_SHINY + +$fatpacked{"Exporter/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXPORTER_TINY'; + package Exporter::Tiny;use 5.006001;use strict;use warnings;no warnings qw(void once uninitialized numeric redefine);our$AUTHORITY='cpan:TOBYINK';our$VERSION='1.000000';our@EXPORT_OK=qw;sub _croak ($;@) {require Carp;my$fmt=shift;@_=sprintf($fmt,@_);goto \&Carp::croak}sub _carp ($;@) {require Carp;my$fmt=shift;@_=sprintf($fmt,@_);goto \&Carp::carp}my$_process_optlist=sub {my$class=shift;my ($global_opts,$opts,$want,$not_want)=@_;while (@$opts){my$opt=shift @{$opts};my ($name,$value)=@$opt;($name =~ m{\A\!(/.+/[msixpodual]+)\z})? do {my@not=$class->_exporter_expand_regexp($1,$value,$global_opts);++$not_want->{$_->[0]}for@not}: ($name =~ m{\A\!(.+)\z})? (++$not_want->{$1}): ($name =~ m{\A[:-](.+)\z})? push(@$opts,$class->_exporter_expand_tag($1,$value,$global_opts)): ($name =~ m{\A/.+/[msixpodual]+\z})? push(@$opts,$class->_exporter_expand_regexp($name,$value,$global_opts)): push(@$want,$opt)}};sub import {my$class=shift;my$global_opts=+{@_ && ref($_[0])eq q(HASH) ? %{+shift}: ()};$global_opts->{into}=caller unless exists$global_opts->{into};my@want;my%not_want;$global_opts->{not}=\%not_want;my@args=do {no strict qw(refs);@_ ? @_ : @{"$class\::EXPORT"}};my$opts=mkopt(\@args);$class->$_process_optlist($global_opts,$opts,\@want,\%not_want);my$permitted=$class->_exporter_permitted_regexp($global_opts);$class->_exporter_validate_opts($global_opts);for my$wanted (@want){next if$not_want{$wanted->[0]};my%symbols=$class->_exporter_expand_sub(@$wanted,$global_opts,$permitted);$class->_exporter_install_sub($_,$wanted->[1],$global_opts,$symbols{$_})for keys%symbols}}sub unimport {my$class=shift;my$global_opts=+{@_ && ref($_[0])eq q(HASH) ? %{+shift}: ()};$global_opts->{into}=caller unless exists$global_opts->{into};$global_opts->{is_unimport}=1;my@want;my%not_want;$global_opts->{not}=\%not_want;my@args=do {our%TRACKED;@_ ? @_ : keys(%{$TRACKED{$class}{$global_opts->{into}}})};my$opts=mkopt(\@args);$class->$_process_optlist($global_opts,$opts,\@want,\%not_want);my$permitted=$class->_exporter_permitted_regexp($global_opts);$class->_exporter_validate_unimport_opts($global_opts);my$expando=$class->can('_exporter_expand_sub');$expando=undef if$expando==\&_exporter_expand_sub;for my$wanted (@want){next if$not_want{$wanted->[0]};if ($wanted->[1]){_carp("Passing options to unimport '%s' makes no sense",$wanted->[0])unless (ref($wanted->[1])eq 'HASH' and not keys %{$wanted->[1]})}my%symbols=defined($expando)? $class->$expando(@$wanted,$global_opts,$permitted): ($wanted->[0]=>sub {"dummy"});$class->_exporter_uninstall_sub($_,$wanted->[1],$global_opts)for keys%symbols}}sub _exporter_validate_opts {1}sub _exporter_validate_unimport_opts {1}sub _exporter_merge_opts {my$class=shift;my ($tag_opts,$global_opts,@stuff)=@_;$tag_opts={}unless ref($tag_opts)eq q(HASH);_croak('Cannot provide an -as option for tags')if exists$tag_opts->{-as}&& ref$tag_opts->{-as}ne 'CODE';my$optlist=mkopt(\@stuff);for my$export (@$optlist){next if defined($export->[1])&& ref($export->[1])ne q(HASH);my%sub_opts=(%{$export->[1]or {}},%$tag_opts);$sub_opts{-prefix}=sprintf('%s%s',$tag_opts->{-prefix},$export->[1]{-prefix})if exists($export->[1]{-prefix})&& exists($tag_opts->{-prefix});$sub_opts{-suffix}=sprintf('%s%s',$export->[1]{-suffix},$tag_opts->{-suffix})if exists($export->[1]{-suffix})&& exists($tag_opts->{-suffix});$export->[1]=\%sub_opts}return @$optlist}sub _exporter_expand_tag {no strict qw(refs);my$class=shift;my ($name,$value,$globals)=@_;my$tags=\%{"$class\::EXPORT_TAGS"};return$class->_exporter_merge_opts($value,$globals,$tags->{$name}->($class,@_))if ref($tags->{$name})eq q(CODE);return$class->_exporter_merge_opts($value,$globals,@{$tags->{$name}})if exists$tags->{$name};return$class->_exporter_merge_opts($value,$globals,@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"})if$name eq 'all';return$class->_exporter_merge_opts($value,$globals,@{"$class\::EXPORT"})if$name eq 'default';$globals->{$name}=$value || 1;return}sub _exporter_expand_regexp {no strict qw(refs);our%TRACKED;my$class=shift;my ($name,$value,$globals)=@_;my$compiled=eval("qr$name");my@possible=$globals->{is_unimport}? keys(%{$TRACKED{$class}{$globals->{into}}}): @{"$class\::EXPORT_OK"};$class->_exporter_merge_opts($value,$globals,grep /$compiled/,@possible)}sub _exporter_permitted_regexp {no strict qw(refs);my$class=shift;my$re=join "|",map quotemeta,sort {length($b)<=> length($a)or $a cmp $b}@{"$class\::EXPORT"},@{"$class\::EXPORT_OK"};qr{^(?:$re)$}ms}sub _exporter_expand_sub {my$class=shift;my ($name,$value,$globals,$permitted)=@_;$permitted ||= $class->_exporter_permitted_regexp($globals);no strict qw(refs);if ($name =~ $permitted){my$generator=$class->can("_generate_$name");return$name=>$class->$generator($name,$value,$globals)if$generator;my$sub=$class->can($name);return$name=>$sub if$sub}$class->_exporter_fail(@_)}sub _exporter_fail {my$class=shift;my ($name,$value,$globals)=@_;return if$globals->{is_unimport};_croak("Could not find sub '%s' exported by %s",$name,$class)}sub _exporter_install_sub {my$class=shift;my ($name,$value,$globals,$sym)=@_;my$into=$globals->{into};my$installer=$globals->{installer}|| $globals->{exporter};$name=ref$globals->{as}? $globals->{as}->($name): ref$value->{-as}? $value->{-as}->($name): exists$value->{-as}? $value->{-as}: $name;return unless defined$name;unless (ref($name)){my ($prefix)=grep defined,$value->{-prefix},$globals->{prefix},q();my ($suffix)=grep defined,$value->{-suffix},$globals->{suffix},q();$name="$prefix$name$suffix"}return ($$name=$sym)if ref($name)eq q(SCALAR);return ($into->{$name}=$sym)if ref($into)eq q(HASH);no strict qw(refs);if (exists &{"$into\::$name"}and \&{"$into\::$name"}!=$sym){my ($level)=grep defined,$value->{-replace},$globals->{replace},q(0);my$action={carp=>\&_carp,0=>\&_carp,''=>\&_carp,warn=>\&_carp,nonfatal=>\&_carp,croak=>\&_croak,fatal=>\&_croak,die=>\&_croak,}->{$level}|| sub {};$action->($action==\&_croak ? "Refusing to overwrite existing sub '%s::%s' with sub '%s' exported by %s" : "Overwriting existing sub '%s::%s' with sub '%s' exported by %s",$into,$name,$_[0],$class,)}our%TRACKED;$TRACKED{$class}{$into}{$name}=$sym;no warnings qw(prototype);$installer ? $installer->($globals,[$name,$sym]): (*{"$into\::$name"}=$sym)}sub _exporter_uninstall_sub {our%TRACKED;my$class=shift;my ($name,$value,$globals,$sym)=@_;my$into=$globals->{into};ref$into and return;no strict qw(refs);my$our_coderef=$TRACKED{$class}{$into}{$name};my$cur_coderef=exists(&{"$into\::$name"})? \&{"$into\::$name"}: -1;return unless$our_coderef==$cur_coderef;my$stash=\%{"$into\::"};my$old=delete$stash->{$name};my$full_name=join('::',$into,$name);for my$type (qw(SCALAR HASH ARRAY IO)){next unless defined(*{$old}{$type});*$full_name=*{$old}{$type}}delete$TRACKED{$class}{$into}{$name}}sub mkopt {my$in=shift or return [];my@out;$in=[map(($_=>ref($in->{$_})? $in->{$_}: ()),sort keys %$in)]if ref($in)eq q(HASH);for (my$i=0;$i < @$in;$i++){my$k=$in->[$i];my$v;($i==$#$in)? ($v=undef): !defined($in->[$i+1])? (++$i,($v=undef)): !ref($in->[$i+1])? ($v=undef): ($v=$in->[++$i]);push@out,[$k=>$v ]}\@out}sub mkopt_hash {my$in=shift or return;my%out=map +($_->[0]=>$_->[1]),@{mkopt($in)};\%out}1; +EXPORTER_TINY + +$fatpacked{"ExtUtils/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_CONFIG'; + package ExtUtils::Config;$ExtUtils::Config::VERSION='0.008';use strict;use warnings;use Config;use Data::Dumper ();sub new {my ($pack,$args)=@_;return bless {values=>($args ? {%$args }: {}),},$pack}sub get {my ($self,$key)=@_;return exists$self->{values}{$key}? $self->{values}{$key}: $Config{$key}}sub exists {my ($self,$key)=@_;return exists$self->{values}{$key}|| exists$Config{$key}}sub values_set {my$self=shift;return {%{$self->{values}}}}sub all_config {my$self=shift;return {%Config,%{$self->{values}}}}sub serialize {my$self=shift;return$self->{serialized}||= Data::Dumper->new([$self->values_set])->Terse(1)->Sortkeys(1)->Dump}1; +EXTUTILS_CONFIG + +$fatpacked{"ExtUtils/Helpers.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS'; + package ExtUtils::Helpers;$ExtUtils::Helpers::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';use Config;use File::Basename qw/basename/;use File::Spec::Functions qw/splitpath canonpath abs2rel splitdir/;use Text::ParseWords 3.24 ();our@EXPORT_OK=qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;BEGIN {my%impl_for=(MSWin32=>'Windows',VMS=>'VMS');my$package='ExtUtils::Helpers::' .($impl_for{$^O}|| 'Unix');my$impl=$impl_for{$^O}|| 'Unix';require "ExtUtils/Helpers/$impl.pm";"ExtUtils::Helpers::$impl"->import()}sub split_like_shell {my ($string)=@_;return if not defined$string;$string =~ s/^\s+|\s+$//g;return if not length$string;return Text::ParseWords::shellwords($string)}sub man1_pagename {my$filename=shift;return basename($filename).".$Config{man1ext}"}my%separator=(MSWin32=>'.',VMS=>'__',os2=>'.',cygwin=>'.',);my$separator=$separator{$^O}|| '::';sub man3_pagename {my ($filename,$base)=@_;$base ||= 'lib';my ($vols,$dirs,$file)=splitpath(canonpath(abs2rel($filename,$base)));$file=basename($file,qw/.pm .pod/);my@dirs=grep {length}splitdir($dirs);return join$separator,@dirs,"$file.$Config{man3ext}"}1; +EXTUTILS_HELPERS + +$fatpacked{"ExtUtils/Helpers/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_UNIX'; + package ExtUtils::Helpers::Unix;$ExtUtils::Helpers::Unix::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use Carp qw/croak/;use Config;my$layer=$] >= 5.008001 ? ":raw" : "";sub make_executable {my$filename=shift;my$current_mode=(stat$filename)[2]+ 0;if (-T $filename){open my$fh,"<$layer",$filename;my@lines=<$fh>;if (@lines and $lines[0]=~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms){open my$out,">$layer","$filename.new" or croak "Couldn't open $filename.new: $!";print$out @lines;close$out;rename$filename,"$filename.bak" or croak "Couldn't rename $filename to $filename.bak";rename "$filename.new",$filename or croak "Couldn't rename $filename.new to $filename";unlink "$filename.bak"}}chmod$current_mode | oct(111),$filename;return}sub detildefy {my$value=shift;for ($value){s{ ^ ~ (?= /|$)} [ $ENV{HOME} || (getpwuid $>)[7] ]ex or s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex}return$value}1; +EXTUTILS_HELPERS_UNIX + +$fatpacked{"ExtUtils/Helpers/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_VMS'; + package ExtUtils::Helpers::VMS;$ExtUtils::Helpers::VMS::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use File::Copy qw/copy/;sub make_executable {my$filename=shift;my$batchname="$filename.com";copy($filename,$batchname);ExtUtils::Helpers::Unix::make_executable($batchname);return}sub detildefy {my$arg=shift;return$arg if ($arg =~ /^~~/);return$arg if ($arg =~ /^~ /);if ($arg =~ /^~/){my$spec=$arg;$spec =~ s/^~//;$spec =~ s#^/##;my$home=VMS::Filespec::unixify($ENV{HOME});$home .= '/' unless$home =~ m#/$#;if ($spec eq ''){$home =~ s#/$##;return$home}my ($hvol,$hdir,$hfile)=File::Spec::Unix->splitpath($home);if ($hdir eq ''){$hdir=$hfile}my ($vol,$dir,$file)=File::Spec::Unix->splitpath($spec);my@hdirs=File::Spec::Unix->splitdir($hdir);my@dirs=File::Spec::Unix->splitdir($dir);unless ($arg =~ m#^~/#){shift@dirs}my$newdirs=File::Spec::Unix->catdir(@hdirs,@dirs);$arg=File::Spec::Unix->catpath($hvol,$newdirs,$file)}return$arg} +EXTUTILS_HELPERS_VMS + +$fatpacked{"ExtUtils/Helpers/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_HELPERS_WINDOWS'; + package ExtUtils::Helpers::Windows;$ExtUtils::Helpers::Windows::VERSION='0.026';use strict;use warnings FATAL=>'all';use Exporter 5.57 'import';our@EXPORT=qw/make_executable detildefy/;use Config;use Carp qw/carp croak/;use ExtUtils::PL2Bat 'pl2bat';sub make_executable {my$script=shift;if (-T $script && $script !~ / \. (?:bat|cmd) $ /x){pl2bat(in=>$script,update=>1)}return}sub detildefy {my$value=shift;$value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if$ENV{USERPROFILE};return$value}1; +EXTUTILS_HELPERS_WINDOWS + +$fatpacked{"ExtUtils/InstallPaths.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'EXTUTILS_INSTALLPATHS'; + package ExtUtils::InstallPaths;$ExtUtils::InstallPaths::VERSION='0.011';use 5.006;use strict;use warnings;use File::Spec ();use Carp ();use ExtUtils::Config 0.002;my%complex_accessors=map {$_=>1}qw/prefix_relpaths install_sets/;my%hash_accessors=map {$_=>1}qw/install_path install_base_relpaths original_prefix/;my%defaults=(installdirs=>'site',install_base=>undef,prefix=>undef,verbose=>0,blib=>'blib',create_packlist=>1,dist_name=>undef,module_name=>undef,destdir=>undef,install_path=>sub {{}},install_sets=>\&_default_install_sets,original_prefix=>\&_default_original_prefix,install_base_relpaths=>\&_default_base_relpaths,prefix_relpaths=>\&_default_prefix_relpaths,);sub _merge_shallow {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);$filter->($_)for grep$filter,values %$override;return {%$defaults,%$override }}}sub _merge_deep {my ($name,$filter)=@_;return sub {my ($override,$config)=@_;my$defaults=$defaults{$name}->($config);my$pair_for=sub {my$key=shift;my%override=%{$override->{$key}|| {}};$filter && $filter->($_)for values%override;return$key=>{%{$defaults->{$key}},%override }};return {map {$pair_for->($_)}keys %$defaults }}}my%allowed_installdir=map {$_=>1}qw/core site vendor/;my$must_be_relative=sub {Carp::croak('Value must be a relative path')if File::Spec->file_name_is_absolute($_[0])};my%deep_filter=map {$_=>$must_be_relative}qw/install_base_relpaths prefix_relpaths/;my%filter=(installdirs=>sub {my$value=shift;$value='core',Carp::carp('Perhaps you meant installdirs to be "core" rather than "perl"?')if$value eq 'perl';Carp::croak('installdirs must be one of "core", "site", or "vendor"')if not $allowed_installdir{$value};return$value},(map {$_=>_merge_shallow($_,$deep_filter{$_})}qw/original_prefix install_base_relpaths/),(map {$_=>_merge_deep($_,$deep_filter{$_})}qw/install_sets prefix_relpaths/),);sub new {my ($class,%args)=@_;my$config=$args{config}|| ExtUtils::Config->new;my%self=(config=>$config,map {$_=>exists$args{$_}? $filter{$_}? $filter{$_}->($args{$_},$config): $args{$_}: ref$defaults{$_}? $defaults{$_}->($config): $defaults{$_}}keys%defaults,);$self{module_name}||= do {my$module_name=$self{dist_name};$module_name =~ s/-/::/g;$module_name}if defined$self{dist_name};return bless \%self,$class}for my$attribute (keys%defaults){no strict qw/refs/;*{$attribute}=$hash_accessors{$attribute}? sub {my ($self,$key)=@_;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$key}}: $complex_accessors{$attribute}? sub {my ($self,$installdirs,$key)=@_;Carp::confess("$attribute needs installdir")if not defined$installdirs;Carp::confess("$attribute needs key")if not defined$key;return$self->{$attribute}{$installdirs}{$key}}: sub {my$self=shift;return$self->{$attribute}}}my$script=$] > 5.008000 ? 'script' : 'bin';my@install_sets_keys=qw/lib arch bin script bindoc libdoc binhtml libhtml/;my@install_sets_tail=('bin',$script,qw/man1dir man3dir html1dir html3dir/);my%install_sets_values=(core=>[qw/privlib archlib/,@install_sets_tail ],site=>[map {"site$_"}qw/lib arch/,@install_sets_tail ],vendor=>[map {"vendor$_"}qw/lib arch/,@install_sets_tail ],);sub _default_install_sets {my$c=shift;my%ret;for my$installdir (qw/core site vendor/){@{$ret{$installdir}}{@install_sets_keys}=map {$c->get("install$_")}@{$install_sets_values{$installdir}}}return \%ret}sub _default_base_relpaths {my$config=shift;return {lib=>['lib','perl5'],arch=>['lib','perl5',$config->get('archname')],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],}}my%common_prefix_relpaths=(bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],);sub _default_prefix_relpaths {my$c=shift;my@libstyle=$c->get('installstyle')? File::Spec->splitdir($c->get('installstyle')): qw(lib perl5);my$arch=$c->get('archname');my$version=$c->get('version');return {core=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},vendor=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],%common_prefix_relpaths,},site=>{lib=>[@libstyle,'site_perl'],arch=>[@libstyle,'site_perl',$version,$arch],%common_prefix_relpaths,},}}sub _default_original_prefix {my$c=shift;my%ret=(core=>$c->get('installprefixexp'),site=>$c->get('siteprefixexp'),vendor=>$c->get('usevendorprefix')? $c->get('vendorprefixexp'): '',);return \%ret}sub _log_verbose {my$self=shift;print @_ if$self->verbose;return}sub is_default_installable {my$self=shift;my$type=shift;my$installable=$self->install_destination($type)&& ($self->install_path($type)|| $self->install_sets($self->installdirs,$type));return$installable ? 1 : 0}sub _prefixify_default {my$self=shift;my$type=shift;my$rprefix=shift;my$default=$self->prefix_relpaths($self->installdirs,$type);if(!$default){$self->_log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n");return$rprefix}else {return File::Spec->catdir(@{$default})}}sub _prefixify_novms {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;$rprefix .= '/' if$sprefix =~ m{/$};$self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n")if defined$path && length$path;if (not defined$path or length$path==0){$self->_log_verbose(" no path to prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}elsif(!File::Spec->file_name_is_absolute($path)){$self->_log_verbose(" path is relative, not prefixifying.\n")}elsif($path !~ s{^\Q$sprefix\E\b}{}s){$self->_log_verbose(" cannot prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}$self->_log_verbose(" now $path in $rprefix\n");return$path}sub _catprefix_vms {my ($self,$rprefix,$default)=@_;my ($rvol,$rdirs)=File::Spec->splitpath($rprefix);if ($rvol){return File::Spec->catpath($rvol,File::Spec->catdir($rdirs,$default),'')}else {return File::Spec->catdir($rdirs,$default)}}sub _prefixify_vms {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;return '' unless defined$path;$self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n");require VMS::Filespec;$rprefix=VMS::Filespec::vmspath($rprefix)if$rprefix;$sprefix=VMS::Filespec::vmspath($sprefix)if$sprefix;$self->_log_verbose(" rprefix translated to $rprefix\n sprefix translated to $sprefix\n");if (length($path)==0){$self->_log_verbose(" no path to prefixify.\n")}elsif (!File::Spec->file_name_is_absolute($path)){$self->_log_verbose(" path is relative, not prefixifying.\n")}elsif ($sprefix eq $rprefix){$self->_log_verbose(" no new prefix.\n")}else {my ($path_vol,$path_dirs)=File::Spec->splitpath($path);my$vms_prefix=$self->config->get('vms_prefix');if ($path_vol eq $vms_prefix.':'){$self->_log_verbose(" $vms_prefix: seen\n");$path_dirs =~ s{^\[}{\[.} unless$path_dirs =~ m{^\[\.};$path=$self->_catprefix_vms($rprefix,$path_dirs)}else {$self->_log_verbose(" cannot prefixify.\n");return File::Spec->catdir($self->prefix_relpaths($self->installdirs,$type))}}$self->_log_verbose(" now $path\n");return$path}BEGIN {*_prefixify=$^O eq 'VMS' ? \&_prefixify_vms : \&_prefixify_novms}sub prefix_relative {my ($self,$installdirs,$type)=@_;my$relpath=$self->install_sets($installdirs,$type);return$self->_prefixify($relpath,$self->original_prefix($installdirs),$type)}sub install_destination {my ($self,$type)=@_;return$self->install_path($type)if$self->install_path($type);if ($self->install_base){my$relpath=$self->install_base_relpaths($type);return$relpath ? File::Spec->catdir($self->install_base,@{$relpath}): undef}if ($self->prefix){my$relpath=$self->prefix_relative($self->installdirs,$type);return$relpath ? File::Spec->catdir($self->prefix,$relpath): undef}return$self->install_sets($self->installdirs,$type)}sub install_types {my$self=shift;my%types=(%{$self->{install_path}},$self->install_base ? %{$self->{install_base_relpaths}}: $self->prefix ? %{$self->{prefix_relpaths}{$self->installdirs }}: %{$self->{install_sets}{$self->installdirs }});return sort keys%types}sub install_map {my ($self,$blib)=@_;$blib ||= $self->blib;my (%map,@skipping);for my$type ($self->install_types){my$localdir=File::Spec->catdir($blib,$type);next unless -e $localdir;if (my$dest=$self->install_destination($type)){$map{$localdir}=$dest}else {push@skipping,$type}}warn "WARNING: Can't figure out install path for types: @skipping\nFiles will not be installed.\n" if@skipping;if ($self->create_packlist and my$module_name=$self->module_name){my$archdir=$self->install_destination('arch');my@ext=split /::/,$module_name;$map{write}=File::Spec->catfile($archdir,'auto',@ext,'.packlist')}if (length(my$destdir=$self->destdir || '')){for (keys%map){my ($volume,$path,$file)=File::Spec->splitpath($map{$_},0);my@dirs=File::Spec->splitdir($path);$path=File::Spec->catdir($destdir,@dirs);if ($file ne ''){$map{$_}=File::Spec->catfile($path,$file)}else {$map{$_}=$path}}}$map{read}='';return \%map}1; +EXTUTILS_INSTALLPATHS + +$fatpacked{"File/Slurp.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_SLURP'; + package File::Slurp;use 5.6.2 ;use strict;use warnings ;use Carp ;use Exporter ;use Fcntl qw(:DEFAULT) ;use POSIX qw(:fcntl_h) ;use Errno ;use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION) ;@ISA=qw(Exporter) ;$VERSION='9999.19';my@std_export=qw(read_file write_file overwrite_file append_file read_dir) ;my@edit_export=qw(edit_file edit_file_lines) ;my@ok_export=qw() ;@EXPORT_OK=(@edit_export,qw(slurp prepend_file),);%EXPORT_TAGS=('all'=>[@std_export,@edit_export,@EXPORT_OK ],'edit'=>[@edit_export ],'std'=>[@std_export ],);@EXPORT=@std_export ;my$max_fast_slurp_size=1024 * 100 ;my$is_win32=$^O =~ /win32/i ;BEGIN {unless(defined&SEEK_SET){*SEEK_SET=sub {0};*SEEK_CUR=sub {1};*SEEK_END=sub {2}}unless(defined&O_BINARY){*O_BINARY=sub {0};*O_RDONLY=sub {0};*O_WRONLY=sub {1}}unless (defined&O_APPEND){if ($^O =~ /olaris/){*O_APPEND=sub {8};*O_CREAT=sub {256};*O_EXCL=sub {1024}}elsif ($^O =~ /inux/){*O_APPEND=sub {1024};*O_CREAT=sub {64};*O_EXCL=sub {128}}elsif ($^O =~ /BSD/i){*O_APPEND=sub {8};*O_CREAT=sub {512};*O_EXCL=sub {2048}}}}*slurp=\&read_file ;sub read_file {my$file_name=shift ;my$opts=(ref $_[0]eq 'HASH')? shift : {@_};if (!ref$file_name && -e $file_name && -s _ > 0 && -s _ < $max_fast_slurp_size &&!%{$opts}&&!wantarray){my$fh ;unless(sysopen($fh,$file_name,O_RDONLY)){@_=($opts,"read_file '$file_name' - sysopen: $!");goto&_error }my$read_cnt=sysread($fh,my$buf,-s _);unless (defined$read_cnt){@_=($opts,"read_file '$file_name' - small sysread: $!");goto&_error }$buf =~ s/\015\012/\n/g if$is_win32 ;return$buf }my$buf ;my$buf_ref=$opts->{'buf_ref'}|| \$buf ;${$buf_ref}='' ;my($read_fh,$size_left,$blk_size);if (ref$file_name){my$ref_result=_check_ref($file_name);if (ref$ref_result){@_=($opts,$ref_result);goto&_error }if ($ref_result){$file_name=$ref_result }else {$read_fh=$file_name ;$blk_size=$opts->{'blk_size'}|| 1024 * 1024 ;$size_left=$blk_size }}unless ($read_fh){my$mode=O_RDONLY ;$read_fh=local(*FH);unless (sysopen($read_fh,$file_name,$mode)){@_=($opts,"read_file '$file_name' - sysopen: $!");goto&_error }if (my$binmode=$opts->{'binmode'}){binmode($read_fh,$binmode)}$size_left=-s $read_fh ;unless($size_left){$blk_size=$opts->{'blk_size'}|| 1024 * 1024 ;$size_left=$blk_size }}while(1){my$read_cnt=sysread($read_fh,${$buf_ref},$size_left,length ${$buf_ref});next if $!{EINTR};unless (defined$read_cnt){@_=($opts,"read_file '$file_name' - loop sysread: $!");goto&_error }last if$read_cnt==0 ;next if$blk_size ;$size_left -= $read_cnt ;last if$size_left <= 0 }${$buf_ref}=~ s/\015\012/\n/g if$is_win32 &&!$opts->{'binmode'};my$sep=$/ ;$sep='\n\n+' if defined$sep && $sep eq '' ;if(wantarray || $opts->{'array_ref'}){use re 'taint' ;my@lines=length(${$buf_ref})? ${$buf_ref}=~ /(.*?$sep|.+)/sg : ();chomp@lines if$opts->{'chomp'};return \@lines if$opts->{'array_ref'};return@lines }return$buf_ref if$opts->{'scalar_ref'};return ${$buf_ref}if defined wantarray ;return }sub _check_ref {my($handle)=@_ ;if (eval {$handle->isa('GLOB')|| $handle->isa('IO')}){my$err=_seek_data_handle($handle);return \$err if$err ;return }eval {require overload};return \"Bad handle '$handle' is not a GLOB or IO object or overloaded" if $@ ||!overload::Overloaded($handle);return "$handle" }sub _seek_data_handle {my($handle)=@_ ;eval{require B};if ($@){return <IO->IoFLAGS & 16){unless(sysseek($handle,tell($handle),SEEK_SET)){return "read_file '$handle' - sysseek: $!" }}return }sub write_file {my$file_name=shift ;my$opts=(ref $_[0]eq 'HASH')? shift : {};my($buf_ref,$write_fh,$no_truncate,$orig_file_name,$data_is_ref);if (ref$opts->{'buf_ref'}eq 'SCALAR'){$buf_ref=$opts->{'buf_ref'};$data_is_ref=1 }elsif (ref $_[0]eq 'SCALAR'){$buf_ref=shift ;$data_is_ref=1 }elsif (ref $_[0]eq 'ARRAY'){${$buf_ref}=join '',@{$_[0]}}else {${$buf_ref}=join '',@_ }if (ref$file_name){my$ref_result=_check_ref($file_name);if (ref$ref_result){@_=($opts,$ref_result);goto&_error }if ($ref_result){$file_name=$ref_result }else {$write_fh=$file_name ;$no_truncate=1 }}unless($write_fh){if ($opts->{'atomic'}){$orig_file_name=$file_name ;$file_name .= ".$$" }my$mode=O_WRONLY | O_CREAT ;$mode |= O_APPEND if$opts->{'append'};$mode |= O_EXCL if$opts->{'no_clobber'};my$perms=$opts->{perms};$perms=0666 unless defined$perms ;$write_fh=local(*FH);unless (sysopen($write_fh,$file_name,$mode,$perms)){@_=($opts,"write_file '$file_name' - sysopen: $!");goto&_error }}if (my$binmode=$opts->{'binmode'}){binmode($write_fh,$binmode)}sysseek($write_fh,0,SEEK_END)if$opts->{'append'};if ($is_win32 &&!$opts->{'binmode'}){$buf_ref=\do{my$copy=${$buf_ref}}if$data_is_ref ;${$buf_ref}=~ s/\n/\015\012/g }my$size_left=length(${$buf_ref});my$offset=0 ;do {my$write_cnt=syswrite($write_fh,${$buf_ref},$size_left,$offset);next if $!{EINTR};unless (defined$write_cnt){@_=($opts,"write_file '$file_name' - syswrite: $!");goto&_error }$size_left -= $write_cnt ;$offset += $write_cnt }while($size_left > 0);truncate($write_fh,sysseek($write_fh,0,SEEK_CUR))unless$no_truncate ;close($write_fh);if ($opts->{'atomic'}&&!rename($file_name,$orig_file_name)){@_=($opts,"write_file '$file_name' - rename: $!");goto&_error }return 1 }*overwrite_file=\&write_file ;sub append_file {my$opts=$_[1];if (ref$opts eq 'HASH'){$opts->{append}=1 }else {splice(@_,1,0,{append=>1 })}goto&write_file}sub prepend_file {my$file_name=shift ;my$opts=(ref $_[0]eq 'HASH')? shift : {};my@bad_opts=grep $_ ne 'err_mode' && $_ ne 'binmode',keys %{$opts};delete @{$opts}{@bad_opts};my$prepend_data=shift ;$prepend_data='' unless defined$prepend_data ;$prepend_data=${$prepend_data}if ref$prepend_data eq 'SCALAR' ;my$err_mode=delete$opts->{err_mode};$opts->{err_mode }='croak' ;$opts->{scalar_ref }=1 ;my$existing_data=eval {read_file($file_name,$opts)};if ($@){@_=({err_mode=>$err_mode },"prepend_file '$file_name' - read_file: $!");goto&_error }$opts->{atomic}=1 ;my$write_result=eval {write_file($file_name,$opts,$prepend_data,$$existing_data)};if ($@){@_=({err_mode=>$err_mode },"prepend_file '$file_name' - write_file: $!");goto&_error }return$write_result }sub edit_file(&$;$) {my($edit_code,$file_name,$opts)=@_ ;$opts={}unless ref$opts eq 'HASH' ;my@bad_opts=grep $_ ne 'err_mode' && $_ ne 'binmode',keys %{$opts};delete @{$opts}{@bad_opts};my$err_mode=delete$opts->{err_mode};$opts->{err_mode }='croak' ;$opts->{scalar_ref }=1 ;my$existing_data=eval {read_file($file_name,$opts)};if ($@){@_=({err_mode=>$err_mode },"edit_file '$file_name' - read_file: $!");goto&_error }my($edited_data)=map {$edit_code->();$_}$$existing_data ;$opts->{atomic}=1 ;my$write_result=eval {write_file($file_name,$opts,$edited_data)};if ($@){@_=({err_mode=>$err_mode },"edit_file '$file_name' - write_file: $!");goto&_error }return$write_result }sub edit_file_lines(&$;$) {my($edit_code,$file_name,$opts)=@_ ;$opts={}unless ref$opts eq 'HASH' ;my@bad_opts=grep $_ ne 'err_mode' && $_ ne 'binmode',keys %{$opts};delete @{$opts}{@bad_opts};my$err_mode=delete$opts->{err_mode};$opts->{err_mode }='croak' ;$opts->{array_ref }=1 ;my$existing_data=eval {read_file($file_name,$opts)};if ($@){@_=({err_mode=>$err_mode },"edit_file_lines '$file_name' - read_file: $!");goto&_error }my@edited_data=map {$edit_code->();$_}@$existing_data ;$opts->{atomic}=1 ;my$write_result=eval {write_file($file_name,$opts,@edited_data)};if ($@){@_=({err_mode=>$err_mode },"edit_file_lines '$file_name' - write_file: $!");goto&_error }return$write_result }sub read_dir {my$dir=shift ;my$opts=(ref $_[0]eq 'HASH')? shift : {@_};local(*DIRH);unless (opendir(DIRH,$dir)){@_=($opts,"read_dir '$dir' - opendir: $!");goto&_error }my@dir_entries=readdir(DIRH);@dir_entries=grep($_ ne "." && $_ ne "..",@dir_entries)unless$opts->{'keep_dot_dot'};if ($opts->{'prefix'}){substr($_,0,0,"$dir/")for@dir_entries }return@dir_entries if wantarray ;return \@dir_entries }my%err_func=('carp'=>\&carp,'croak'=>\&croak,);sub _error {my($opts,$err_msg)=@_ ;my$func=$err_func{$opts->{'err_mode'}|| 'croak' };return unless$func ;$func->($err_msg)if$func ;return undef }1; + Can't find B.pm with this Perl: $!. + That module is needed to properly slurp the DATA handle. + ERR +FILE_SLURP + +$fatpacked{"File/chdir.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'FILE_CHDIR'; + package File::chdir;use 5.004;use strict;use vars qw($VERSION @ISA @EXPORT $CWD @CWD);our$VERSION='0.1010';require Exporter;@ISA=qw(Exporter);@EXPORT=qw(*CWD);use Carp;use Cwd 3.16;use File::Spec::Functions 3.27 qw/canonpath splitpath catpath splitdir catdir/;tie$CWD,'File::chdir::SCALAR' or die "Can't tie \$CWD";tie@CWD,'File::chdir::ARRAY' or die "Can't tie \@CWD";sub _abs_path {my($cwd)=Cwd::getcwd =~ /(.*)/s;return canonpath($cwd)}sub _split_cwd {my ($vol,$dir)=splitpath(_abs_path,1);my@dirs=splitdir($dir);shift@dirs;return ($vol,@dirs)}sub _catpath {my ($vol,@dirs)=@_;return catpath($vol,catdir(q{},@dirs),q{})}sub _chdir {my ($new_dir)=$_[0]=~ /(.*)/s;local$Carp::CarpLevel=$Carp::CarpLevel + 1;if (!CORE::chdir($new_dir)){croak "Failed to change directory to '$new_dir': $!"};return 1}{package File::chdir::SCALAR;use Carp;BEGIN {*_abs_path=\&File::chdir::_abs_path;*_chdir=\&File::chdir::_chdir;*_split_cwd=\&File::chdir::_split_cwd;*_catpath=\&File::chdir::_catpath}sub TIESCALAR {bless [],$_[0]}sub FETCH {return _abs_path}sub STORE {return unless defined $_[1];_chdir($_[1])}}{package File::chdir::ARRAY;use Carp;BEGIN {*_abs_path=\&File::chdir::_abs_path;*_chdir=\&File::chdir::_chdir;*_split_cwd=\&File::chdir::_split_cwd;*_catpath=\&File::chdir::_catpath}sub TIEARRAY {bless {},$_[0]}sub FETCH {my($self,$idx)=@_;my ($vol,@cwd)=_split_cwd;return$cwd[$idx]}sub STORE {my($self,$idx,$val)=@_;my ($vol,@cwd)=_split_cwd;if($self->{Cleared}){@cwd=();$self->{Cleared}=0}$cwd[$idx]=$val;my$dir=_catpath($vol,@cwd);_chdir($dir);return$cwd[$idx]}sub FETCHSIZE {my ($vol,@cwd)=_split_cwd;return scalar@cwd}sub STORESIZE {}sub PUSH {my($self)=shift;my$dir=_catpath(_split_cwd,@_);_chdir($dir);return$self->FETCHSIZE}sub POP {my($self)=shift;my ($vol,@cwd)=_split_cwd;my$popped=pop@cwd;my$dir=_catpath($vol,@cwd);_chdir($dir);return$popped}sub SHIFT {my($self)=shift;my ($vol,@cwd)=_split_cwd;my$shifted=shift@cwd;my$dir=_catpath($vol,@cwd);_chdir($dir);return$shifted}sub UNSHIFT {my($self)=shift;my ($vol,@cwd)=_split_cwd;my$dir=_catpath($vol,@_,@cwd);_chdir($dir);return$self->FETCHSIZE}sub CLEAR {my($self)=shift;$self->{Cleared}=1}sub SPLICE {my$self=shift;my$offset=shift || 0;my$len=shift || $self->FETCHSIZE - $offset;my@new_dirs=@_;my ($vol,@cwd)=_split_cwd;my@orig_dirs=splice@cwd,$offset,$len,@new_dirs;my$dir=_catpath($vol,@cwd);_chdir($dir);return@orig_dirs}sub EXTEND {}sub EXISTS {my($self,$idx)=@_;return$self->FETCHSIZE >= $idx ? 1 : 0}sub DELETE {my($self,$idx)=@_;croak "Can't delete except at the end of \@CWD" if$idx < $self->FETCHSIZE - 1;local$Carp::CarpLevel=$Carp::CarpLevel + 1;$self->POP}}1; +FILE_CHDIR + +$fatpacked{"List/MoreUtils.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS'; + package List::MoreUtils;use 5.008_001;use strict;use warnings;my$have_xs;our$VERSION='0.428';BEGIN {unless (defined($have_xs)){eval {require List::MoreUtils::XS}unless$ENV{LIST_MOREUTILS_PP};die $@ if $@ && defined$ENV{LIST_MOREUTILS_PP}&& $ENV{LIST_MOREUTILS_PP}==0;$have_xs=0+defined($INC{'List/MoreUtils/XS.pm'})}use List::MoreUtils::PP qw()}use Exporter::Tiny qw();my@junctions=qw(any all none notall);my@v0_22=qw(true false firstidx lastidx insert_after insert_after_string apply indexes after after_incl before before_incl firstval lastval each_array each_arrayref pairwise natatime mesh uniq minmax part _XScompiled);my@v0_24=qw(bsearch);my@v0_33=qw(sort_by nsort_by);my@v0_400=qw(one any_u all_u none_u notall_u one_u firstres onlyidx onlyval onlyres lastres singleton bsearchidx);my@v0_420=qw(arrayify duplicates minmaxstr samples zip6 reduce_0 reduce_1 reduce_u listcmp frequency occurrences mode binsert bremove equal_range lower_bound upper_bound qsort);my@all_functions=(@junctions,@v0_22,@v0_24,@v0_33,@v0_400,@v0_420);no strict "refs";if ($have_xs){my$x;for (@all_functions){List::MoreUtils->can($_)or *$_=$x if ($x=List::MoreUtils::XS->can($_))}}List::MoreUtils->can($_)or *$_=List::MoreUtils::PP->can($_)for (@all_functions);use strict;my%alias_list=(v0_22=>{first_index=>"firstidx",last_index=>"lastidx",first_value=>"firstval",last_value=>"lastval",zip=>"mesh",},v0_33=>{distinct=>"uniq",},v0_400=>{first_result=>"firstres",only_index=>"onlyidx",only_value=>"onlyval",only_result=>"onlyres",last_result=>"lastres",bsearch_index=>"bsearchidx",},v0_420=>{bsearch_insert=>"binsert",bsearch_remove=>"bremove",zip_unflatten=>"zip6",},);our@ISA=qw(Exporter::Tiny);our@EXPORT_OK=(@all_functions,map {keys %$_}values%alias_list);our%EXPORT_TAGS=(all=>\@EXPORT_OK,'like_0.22'=>[any_u=>{-as=>'any'},all_u=>{-as=>'all'},none_u=>{-as=>'none'},notall_u=>{-as=>'notall'},@v0_22,keys %{$alias_list{v0_22}},],'like_0.24'=>[any_u=>{-as=>'any'},all_u=>{-as=>'all'},notall_u=>{-as=>'notall'},'none',@v0_22,@v0_24,keys %{$alias_list{v0_22}},],'like_0.33'=>[@junctions,@v0_22,@v0_33,keys %{$alias_list{v0_22}},keys %{$alias_list{v0_33}},],);for my$set (values%alias_list){for my$alias (keys %$set){no strict qw(refs);*$alias=__PACKAGE__->can($set->{$alias})}}1; +LIST_MOREUTILS + +$fatpacked{"List/MoreUtils/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS_PP'; + package List::MoreUtils::PP;use 5.008_001;use strict;use warnings;our$VERSION='0.428';sub any (&@) {my$f=shift;for (@_){return 1 if$f->()}return 0}sub all (&@) {my$f=shift;for (@_){return 0 unless$f->()}return 1}sub none (&@) {my$f=shift;for (@_){return 0 if$f->()}return 1}sub notall (&@) {my$f=shift;for (@_){return 1 unless$f->()}return 0}sub one (&@) {my$f=shift;my$found=0;for (@_){$f->()and $found++ and return 0}$found}sub any_u (&@) {my$f=shift;return if!@_;$f->()and return 1 foreach (@_);return 0}sub all_u (&@) {my$f=shift;return if!@_;$f->()or return 0 foreach (@_);return 1}sub none_u (&@) {my$f=shift;return if!@_;$f->()and return 0 foreach (@_);return 1}sub notall_u (&@) {my$f=shift;return if!@_;$f->()or return 1 foreach (@_);return 0}sub one_u (&@) {my$f=shift;return if!@_;my$found=0;for (@_){$f->()and $found++ and return 0}$found}sub reduce_u(&@) {my$code=shift;my ($caller_a,$caller_b)=do {my$pkg=caller();no strict 'refs';\*{$pkg .'::a'},\*{$pkg .'::b'}};local (*$caller_a,*$caller_b);*$caller_a=\();for (0 .. $#_){*$caller_b=\$_[$_];*$caller_a=\($code->())}${*$caller_a}}sub reduce_0(&@) {my$code=shift;my ($caller_a,$caller_b)=do {my$pkg=caller();no strict 'refs';\*{$pkg .'::a'},\*{$pkg .'::b'}};local (*$caller_a,*$caller_b);*$caller_a=\0;for (0 .. $#_){*$caller_b=\$_[$_];*$caller_a=\($code->())}${*$caller_a}}sub reduce_1(&@) {my$code=shift;my ($caller_a,$caller_b)=do {my$pkg=caller();no strict 'refs';\*{$pkg .'::a'},\*{$pkg .'::b'}};local (*$caller_a,*$caller_b);*$caller_a=\1;for (0 .. $#_){*$caller_b=\$_[$_];*$caller_a=\($code->())}${*$caller_a}}sub true (&@) {my$f=shift;my$count=0;$f->()and ++$count foreach (@_);return$count}sub false (&@) {my$f=shift;my$count=0;$f->()or ++$count foreach (@_);return$count}sub firstidx (&@) {my$f=shift;for my$i (0 .. $#_){local*_=\$_[$i];return$i if$f->()}return -1}sub firstval (&@) {my$test=shift;for (@_){return $_ if$test->()}return undef}sub firstres (&@) {my$test=shift;for (@_){my$testval=$test->();$testval and return$testval}return undef}sub onlyidx (&@) {my$f=shift;my$found;for my$i (0 .. $#_){local*_=\$_[$i];$f->()or next;defined$found and return -1;$found=$i}return defined$found ? $found : -1}sub onlyval (&@) {my$test=shift;my$result=undef;my$found=0;for (@_){$test->()or next;$result=$_;$found++ and return undef}return$result}sub onlyres (&@) {my$test=shift;my$result=undef;my$found=0;for (@_){my$rv=$test->()or next;$result=$rv;$found++ and return undef}return$found ? $result : undef}sub lastidx (&@) {my$f=shift;for my$i (reverse 0 .. $#_){local*_=\$_[$i];return$i if$f->()}return -1}sub lastval (&@) {my$test=shift;my$ix;for ($ix=$#_;$ix >= 0;$ix--){local*_=\$_[$ix];my$testval=$test->();$_[$ix]=$_;return $_ if$testval}return undef}sub lastres (&@) {my$test=shift;my$ix;for ($ix=$#_;$ix >= 0;$ix--){local*_=\$_[$ix];my$testval=$test->();$_[$ix]=$_;return$testval if$testval}return undef}sub insert_after (&$\@) {my ($f,$val,$list)=@_;my$c=&firstidx($f,@$list);@$list=(@{$list}[0 .. $c],$val,@{$list}[$c + 1 .. $#$list],)and return 1 if$c!=-1;return 0}sub insert_after_string ($$\@) {my ($string,$val,$list)=@_;my$c=firstidx {defined $_ and $string eq $_}@$list;@$list=(@{$list}[0 .. $c],$val,@{$list}[$c + 1 .. $#$list],)and return 1 if$c!=-1;return 0}sub apply (&@) {my$action=shift;&$action foreach my@values=@_;wantarray ? @values : $values[-1]}sub after (&@) {my$test=shift;my$started;my$lag;grep$started ||= do {my$x=$lag;$lag=$test->();$x},@_}sub after_incl (&@) {my$test=shift;my$started;grep$started ||= $test->(),@_}sub before (&@) {my$test=shift;my$more=1;grep$more &&=!$test->(),@_}sub before_incl (&@) {my$test=shift;my$more=1;my$lag=1;grep$more &&= do {my$x=$lag;$lag=!$test->();$x},@_}sub indexes (&@) {my$test=shift;grep {local*_=\$_[$_];$test->()}0 .. $#_}sub pairwise (&\@\@) {my$op=shift;use vars qw{@A @B};local (*A,*B)=@_;my ($caller_a,$caller_b)=do {my$pkg=caller();no strict 'refs';\*{$pkg .'::a'},\*{$pkg .'::b'}};my$limit=$#A > $#B ? $#A : $#B;local (*$caller_a,*$caller_b);map {(*$caller_a,*$caller_b)=\($#A < $_ ? undef : $A[$_],$#B < $_ ? undef : $B[$_]);$op->()}0 .. $limit}sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {return each_arrayref(@_)}sub each_arrayref {my@list=@_;my$index=0;my$max=0;for (@list){unless (ref $_ eq 'ARRAY'){require Carp;Carp::croak("each_arrayref: argument is not an array reference\n")}$max=@$_ if @$_ > $max}return sub {if (@_){my$method=shift;unless ($method eq 'index'){require Carp;Carp::croak("each_array: unknown argument '$method' passed to iterator.")}return undef if$index==0 || $index > $max;return$index - 1}return if$index >= $max;my$i=$index++;return map $_->[$i],@list}}sub natatime ($@) {my$n=shift;my@list=@_;return sub {return splice@list,0,$n}}my$flatten;$flatten=sub {map {(ref $_ and ("ARRAY" eq ref $_ or overload::Method($_,'@{}')))? ($flatten->(@{$_})): ($_)}@_};sub arrayify {map {$flatten->($_)}@_}sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {my$max=-1;$max < $#$_ && ($max=$#$_)foreach @_;map {my$ix=$_;map $_->[$ix],@_}0 .. $max}sub zip6 (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {my$max=-1;$max < $#$_ && ($max=$#$_)foreach @_;map {my$ix=$_;[map $_->[$ix],@_]}0 .. $max}sub listcmp (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {my%ret;for (my$i=0;$i < scalar @_;++$i){my%seen;my$k;for my$w (grep {defined $_ and not $seen{$k=$_}++}@{$_[$i]}){$ret{$w}||= [];push @{$ret{$w}},$i}}%ret}sub uniq (@) {my%seen=();my$k;my$seen_undef;grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_}sub singleton (@) {my%seen=();my$k;my$seen_undef;grep {1==(defined $_ ? $seen{$k=$_}: $seen_undef)}grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_}sub duplicates (@) {my%seen=();my$k;my$seen_undef;grep {1 < (defined $_ ? $seen{$k=$_}: $seen_undef)}grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_}sub frequency (@) {my%seen=();my$k;my$seen_undef;my%h=map {defined $_ ? ($_=>$seen{$k=$_}): ()}grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_;wantarray or return (scalar keys%h)+ ($seen_undef ? 1 : 0);undef$k;(%h,$seen_undef ? (\$k=>$seen_undef): ())}sub occurrences (@) {my%seen=();my$k;my$seen_undef;my@ret;for my$l (map {$_}grep {defined $_ ? not $seen{$k=$_}++ : not $seen_undef++}@_){my$n=defined$l ? $seen{$l}: $seen_undef;defined$ret[$n]or $ret[$n]=[];push @{$ret[$n]},$l}@ret}sub mode (@) {my%seen=();my ($max,$k,$seen_undef)=(1);for (@_){defined $_ ? ($max < ++$seen{$k=$_}and ++$max): ($max < ++$seen_undef and ++$max)}wantarray or return$max;my@ret=($max);for my$l (grep {$seen{$_}==$max}keys%seen){push@ret,$l}$seen_undef and $seen_undef==$max and push@ret,undef;@ret}sub samples ($@) {my$n=shift;if ($n > @_){require Carp;Carp::croak(sprintf("Cannot get %d samples from %d elements",$n,scalar @_))}for (my$i=@_;@_ - $i > $n;){my$idx=@_ - $i;my$swp=$idx + int(rand(--$i));my$xchg=$_[$swp];$_[$swp]=$_[$idx];$_[$idx]=$xchg}return splice @_,0,$n}sub minmax (@) {return unless @_;my$min=my$max=$_[0];for (my$i=1;$i < @_;$i += 2){if ($_[$i - 1]<= $_[$i]){$min=$_[$i - 1]if$min > $_[$i - 1];$max=$_[$i]if$max < $_[$i]}else {$min=$_[$i]if$min > $_[$i];$max=$_[$i - 1]if$max < $_[$i - 1]}}if (@_ & 1){my$i=$#_;if ($_[$i - 1]<= $_[$i]){$min=$_[$i - 1]if$min > $_[$i - 1];$max=$_[$i]if$max < $_[$i]}else {$min=$_[$i]if$min > $_[$i];$max=$_[$i - 1]if$max < $_[$i - 1]}}return ($min,$max)}sub minmaxstr (@) {return unless @_;my$min=my$max=$_[0];for (my$i=1;$i < @_;$i += 2){if ($_[$i - 1]le $_[$i]){$min=$_[$i - 1]if$min gt $_[$i - 1];$max=$_[$i]if$max lt $_[$i]}else {$min=$_[$i]if$min gt $_[$i];$max=$_[$i - 1]if$max lt $_[$i - 1]}}if (@_ & 1){my$i=$#_;if ($_[$i - 1]le $_[$i]){$min=$_[$i - 1]if$min gt $_[$i - 1];$max=$_[$i]if$max lt $_[$i]}else {$min=$_[$i]if$min gt $_[$i];$max=$_[$i - 1]if$max lt $_[$i - 1]}}return ($min,$max)}sub part (&@) {my ($code,@list)=@_;my@parts;push @{$parts[$code->($_)]},$_ foreach@list;return@parts}sub bsearch(&@) {my$code=shift;my$rc;my$i=0;my$j=@_;do {my$k=int(($i + $j)/ 2);$k >= @_ and return;local*_=\$_[$k];$rc=$code->();$rc==0 and return wantarray ? $_ : 1;if ($rc < 0){$i=$k + 1}else {$j=$k - 1}}until$i > $j;return}sub bsearchidx(&@) {my$code=shift;my$rc;my$i=0;my$j=@_;do {my$k=int(($i + $j)/ 2);$k >= @_ and return -1;local*_=\$_[$k];$rc=$code->();$rc==0 and return$k;if ($rc < 0){$i=$k + 1}else {$j=$k - 1}}until$i > $j;return -1}sub lower_bound(&@) {my$code=shift;my$count=@_;my$first=0;while ($count > 0){my$step=$count >> 1;my$it=$first + $step;local*_=\$_[$it];if ($code->()< 0){$first=++$it;$count -= $step + 1}else {$count=$step}}$first}sub upper_bound(&@) {my$code=shift;my$count=@_;my$first=0;while ($count > 0){my$step=$count >> 1;my$it=$first + $step;local*_=\$_[$it];if ($code->()<= 0){$first=++$it;$count -= $step + 1}else {$count=$step}}$first}sub equal_range(&@) {my$lb=&lower_bound(@_);my$ub=&upper_bound(@_);($lb,$ub)}sub binsert (&$\@) {my$lb=&lower_bound($_[0],@{$_[2]});splice @{$_[2]},$lb,0,$_[1];$lb}sub bremove (&\@) {my$lb=&lower_bound($_[0],@{$_[1]});splice @{$_[1]},$lb,1}sub qsort(&\@) {require Carp;Carp::croak("It's insane to use a pure-perl qsort")}sub sort_by(&@) {my ($code,@list)=@_;return map {$_->[0]}sort {$a->[1]cmp $b->[1]}map {[$_,scalar($code->())]}@list}sub nsort_by(&@) {my ($code,@list)=@_;return map {$_->[0]}sort {$a->[1]<=> $b->[1]}map {[$_,scalar($code->())]}@list}sub _XScompiled {0}1; +LIST_MOREUTILS_PP + +$fatpacked{"List/MoreUtils/XS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'LIST_MOREUTILS_XS'; + package List::MoreUtils::XS;use 5.008_001;use strict;use warnings;use base ('Exporter');use vars qw{$VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS};$VERSION='0.428';@EXPORT=();@EXPORT_OK=qw(any all none notall one any_u all_u none_u notall_u one_u reduce_u reduce_0 reduce_1 true false insert_after insert_after_string apply indexes after after_incl before before_incl firstidx lastidx onlyidx firstval lastval onlyval firstres lastres onlyres singleton duplicates frequency occurrences mode each_array each_arrayref pairwise natatime arrayify mesh zip6 uniq listcmp samples minmax minmaxstr part bsearch bsearchidx binsert bremove lower_bound upper_bound equal_range qsort);%EXPORT_TAGS=(all=>\@EXPORT_OK);local$ENV{PERL_DL_NONLAZY}=0 if$ENV{PERL_DL_NONLAZY};use XSLoader ();XSLoader::load("List::MoreUtils::XS","$VERSION");1; +LIST_MOREUTILS_XS + +$fatpacked{"Module/Build.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD'; + package Module::Build;use 5.006;use strict;use warnings;use File::Spec ();use File::Path ();use File::Basename ();use Perl::OSType ();use Module::Build::Base;our@ISA=qw(Module::Build::Base);our$VERSION='0.4224';$VERSION=eval$VERSION;sub _interpose_module {my ($self,$mod)=@_;eval "use $mod";die $@ if $@;no strict 'refs';my$top_class=$mod;while (@{"${top_class}::ISA"}){last if ${"${top_class}::ISA"}[0]eq $ISA[0];$top_class=${"${top_class}::ISA"}[0]}@{"${top_class}::ISA"}=@ISA;@ISA=($mod)}if (grep {-e File::Spec->catfile($_,qw(Module Build Platform),$^O).'.pm'}@INC){__PACKAGE__->_interpose_module("Module::Build::Platform::$^O")}elsif (my$ostype=os_type()){__PACKAGE__->_interpose_module("Module::Build::Platform::$ostype")}else {warn "Unknown OS type '$^O' - using default settings\n"}sub os_type {return Perl::OSType::os_type()}sub is_vmsish {return Perl::OSType::is_os_type('VMS')}sub is_windowsish {return Perl::OSType::is_os_type('Windows')}sub is_unixish {return Perl::OSType::is_os_type('Unix')}1; +MODULE_BUILD + +$fatpacked{"Module/Build/Base.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_BASE'; + package Module::Build::Base;use 5.006;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Carp;use Cwd ();use File::Copy ();use File::Find ();use File::Path ();use File::Basename ();use File::Spec 0.82 ();use File::Compare ();use Module::Build::Dumper ();use Text::ParseWords ();use Module::Metadata;use Module::Build::Notes;use Module::Build::Config;use version;sub new {my$self=shift()->_construct(@_);$self->{invoked_action}=$self->{action}||= 'Build_PL';$self->cull_args(@ARGV);die "Too early to specify a build action '$self->{action}'. Do 'Build $self->{action}' instead.\n" if$self->{action}&& $self->{action}ne 'Build_PL';$self->check_manifest;$self->auto_require;if(grep {!$_}$self->check_prereq,$self->check_autofeatures){$self->log_warn(<dist_name eq 'Module-Build' || $ENV{PERL5_CPANPLUS_IS_RUNNING}|| $ENV{PERL5_CPAN_IS_RUNNING}){$self->log_warn("Run 'Build installdeps' to install missing prerequisites.\n\n")}}$self->{properties}{_added_to_INC}=[$self->_added_to_INC ];$self->set_bundle_inc;$self->dist_name;$self->dist_version;$self->release_status;$self->_guess_module_name unless$self->module_name;$self->_find_nested_builds;return$self}sub resume {my$package=shift;my$self=$package->_construct(@_);$self->read_config;my@added_earlier=@{$self->{properties}{_added_to_INC}|| []};@INC=($self->_added_to_INC,@added_earlier,$self->_default_INC);unless ($package->isa($self->build_class)){my$build_class=$self->build_class;my$config_dir=$self->config_dir || '_build';my$build_lib=File::Spec->catdir($config_dir,'lib');unshift(@INC,$build_lib);unless ($build_class->can('new')){eval "require $build_class; 1" or die "Failed to re-load '$build_class': $@"}return$build_class->resume(@_)}unless ($self->_perl_is_same($self->{properties}{perl})){my$perl=$self->find_perl_interpreter;die(<<"DIEFATAL")}$self->cull_args(@ARGV);unless ($self->allow_mb_mismatch){my$mb_version=$Module::Build::VERSION;if ($mb_version ne $self->{properties}{mb_version}){$self->log_warn(<<"MISMATCH")}}$self->{invoked_action}=$self->{action}||= 'build';return$self}sub new_from_context {my ($package,%args)=@_;$package->run_perl_script('Build.PL',[],[$package->unparse_args(\%args)]);return$package->resume}sub current {local@ARGV;return shift()->resume}sub _construct {my ($package,%input)=@_;my$args=delete$input{args}|| {};my$config=delete$input{config}|| {};my$self=bless {args=>{%$args},config=>Module::Build::Config->new(values=>$config),properties=>{base_dir=>$package->cwd,mb_version=>$Module::Build::VERSION,%input,},phash=>{},stash=>{},},$package;$self->_set_defaults;my ($p,$ph)=($self->{properties},$self->{phash});for (qw(notes config_data features runtime_params cleanup auto_features)){my$file=File::Spec->catfile($self->config_dir,$_);$ph->{$_}=Module::Build::Notes->new(file=>$file);$ph->{$_}->restore if -e $file;if (exists$p->{$_}){my$vals=delete$p->{$_};for my$k (sort keys %$vals){$self->$_($k,$vals->{$k})}}}$p->{perl}=$self->find_perl_interpreter or $self->log_warn("Warning: Can't locate your perl binary");my$blibdir=sub {File::Spec->catdir($p->{blib},@_)};$p->{bindoc_dirs}||= [$blibdir->("script")];$p->{libdoc_dirs}||= [$blibdir->("lib"),$blibdir->("arch")];$p->{dist_author}=[$p->{dist_author}]if defined$p->{dist_author}and not ref$p->{dist_author};$p->{requires}=delete$p->{prereq}if defined$p->{prereq};$p->{script_files}=delete$p->{scripts}if defined$p->{scripts};for ('extra_compiler_flags','extra_linker_flags'){$p->{$_}=[$self->split_like_shell($p->{$_})]if exists$p->{$_}}for ('include_dirs'){$p->{$_}=[$p->{$_}]if exists$p->{$_}&&!ref$p->{$_}}$self->add_to_cleanup(@{delete$p->{add_to_cleanup}})if$p->{add_to_cleanup};return$self}sub log_info {my$self=shift;print @_ if ref($self)&& ($self->verbose ||!$self->quiet)}sub log_verbose {my$self=shift;print @_ if ref($self)&& $self->verbose}sub log_debug {my$self=shift;print @_ if ref($self)&& $self->debug}sub log_warn {shift;if (@_ and $_[-1]!~ /\n$/){my (undef,$file,$line)=caller();warn @_," at $file line $line.\n"}else {warn @_}}sub _default_install_paths {my$self=shift;my$c=$self->{config};my$p={};my@libstyle=$c->get('installstyle')? File::Spec->splitdir($c->get('installstyle')): qw(lib perl5);my$arch=$c->get('archname');my$version=$c->get('version');my$bindoc=$c->get('installman1dir')|| undef;my$libdoc=$c->get('installman3dir')|| undef;my$binhtml=$c->get('installhtml1dir')|| $c->get('installhtmldir')|| undef;my$libhtml=$c->get('installhtml3dir')|| $c->get('installhtmldir')|| undef;$p->{install_sets}={core=>{lib=>$c->get('installprivlib'),arch=>$c->get('installarchlib'),bin=>$c->get('installbin'),script=>$c->get('installscript'),bindoc=>$bindoc,libdoc=>$libdoc,binhtml=>$binhtml,libhtml=>$libhtml,},site=>{lib=>$c->get('installsitelib'),arch=>$c->get('installsitearch'),bin=>$c->get('installsitebin')|| $c->get('installbin'),script=>$c->get('installsitescript')|| $c->get('installsitebin')|| $c->get('installscript'),bindoc=>$c->get('installsiteman1dir')|| $bindoc,libdoc=>$c->get('installsiteman3dir')|| $libdoc,binhtml=>$c->get('installsitehtml1dir')|| $binhtml,libhtml=>$c->get('installsitehtml3dir')|| $libhtml,},vendor=>{lib=>$c->get('installvendorlib'),arch=>$c->get('installvendorarch'),bin=>$c->get('installvendorbin')|| $c->get('installbin'),script=>$c->get('installvendorscript')|| $c->get('installvendorbin')|| $c->get('installscript'),bindoc=>$c->get('installvendorman1dir')|| $bindoc,libdoc=>$c->get('installvendorman3dir')|| $libdoc,binhtml=>$c->get('installvendorhtml1dir')|| $binhtml,libhtml=>$c->get('installvendorhtml3dir')|| $libhtml,},};$p->{original_prefix}={core=>$c->get('installprefixexp')|| $c->get('installprefix')|| $c->get('prefixexp')|| $c->get('prefix')|| '',site=>$c->get('siteprefixexp'),vendor=>$c->get('usevendorprefix')? $c->get('vendorprefixexp'): '',};$p->{original_prefix}{site}||= $p->{original_prefix}{core};$p->{install_base_relpaths}={lib=>['lib','perl5'],arch=>['lib','perl5',$arch],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],};$p->{prefix_relpaths}={core=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],},vendor=>{lib=>[@libstyle],arch=>[@libstyle,$version,$arch],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],},site=>{lib=>[@libstyle,'site_perl'],arch=>[@libstyle,'site_perl',$version,$arch],bin=>['bin'],script=>['bin'],bindoc=>['man','man1'],libdoc=>['man','man3'],binhtml=>['html'],libhtml=>['html'],},};return$p}sub _find_nested_builds {my$self=shift;my$r=$self->recurse_into or return;my ($file,@r);if (!ref($r)&& $r eq 'auto'){local*DH;opendir DH,$self->base_dir or die "Can't scan directory " .$self->base_dir ." for nested builds: $!";while (defined($file=readdir DH)){my$subdir=File::Spec->catdir($self->base_dir,$file);next unless -d $subdir;push@r,$subdir if -e File::Spec->catfile($subdir,'Build.PL')}}$self->recurse_into(\@r)}sub cwd {return Cwd::cwd()}sub _quote_args {my ($self,@args)=@_;my@quoted;for (@args){if (/^[^\s*?!\$<>;\\|'"\[\]\{\}]+$/){push@quoted,$_}else {s/('+)/'"$1"'/g;push@quoted,qq('$_')}}return join " ",@quoted}sub _backticks {my ($self,@cmd)=@_;if ($self->have_forkpipe){local*FH;my$pid=open*FH,"-|";if ($pid){return wantarray ? : join '',}else {die "Can't execute @cmd: $!\n" unless defined$pid;exec {$cmd[0]}@cmd}}else {my$cmd=$self->_quote_args(@cmd);return `$cmd`}}sub have_forkpipe {1}sub _perl_is_same {my ($self,$perl)=@_;my@cmd=($perl);if ($ENV{PERL_CORE}){push@cmd,'-I' .File::Spec->catdir(File::Basename::dirname($perl),'lib')}push@cmd,qw(-MConfig=myconfig -e print -e myconfig);return$self->_backticks(@cmd)eq Config->myconfig}{my$known_perl;sub find_perl_interpreter {my$self=shift;return$known_perl if defined($known_perl);return$known_perl=$self->_discover_perl_interpreter}}sub _discover_perl_interpreter {my$proto=shift;my$c=ref($proto)? $proto->{config}: 'Module::Build::Config';my$perl=$^X;my$perl_basename=File::Basename::basename($perl);my@potential_perls;push(@potential_perls,$perl)if File::Spec->file_name_is_absolute($perl);my$abs_perl=File::Spec->rel2abs($perl);push(@potential_perls,$abs_perl);if ($ENV{PERL_CORE}){require ExtUtils::CBuilder;my$perl_src=Cwd::realpath(ExtUtils::CBuilder->perl_src);if (defined($perl_src)&& length($perl_src)){my$uninstperl=File::Spec->rel2abs(File::Spec->catfile($perl_src,$perl_basename));push(@potential_perls,$uninstperl)}}else {push(@potential_perls,$c->get('perlpath'));push(@potential_perls,map File::Spec->catfile($_,$perl_basename),File::Spec->path())}my$exe=$c->get('exe_ext');for my$thisperl (@potential_perls){if (defined$exe){$thisperl .= $exe unless$thisperl =~ m/$exe$/i}if (-f $thisperl && $proto->_perl_is_same($thisperl)){return$thisperl}}my@paths=map File::Basename::dirname($_),@potential_perls;die "Can't locate the perl binary used to run this script " ."in (@paths)\n"}sub find_command {my ($self,$command)=@_;if(File::Spec->file_name_is_absolute($command)){return$self->_maybe_command($command)}else {for my$dir (File::Spec->path){my$abs=File::Spec->catfile($dir,$command);return$abs if$abs=$self->_maybe_command($abs)}}}sub _maybe_command {my($self,$file)=@_;return$file if -x $file &&!-d $file;return}sub _is_interactive {return -t STDIN && (-t STDOUT ||!(-f STDOUT || -c STDOUT))}sub _is_unattended {my$self=shift;return$ENV{PERL_MM_USE_DEFAULT}|| (!$self->_is_interactive && eof STDIN)}sub _readline {my$self=shift;return undef if$self->_is_unattended;my$answer=;chomp$answer if defined$answer;return$answer}sub prompt {my$self=shift;my$mess=shift or die "prompt() called without a prompt message";my@def;@def=(shift)if @_;my@dispdef=scalar(@def)? ('[',(defined($def[0])? $def[0].' ' : ''),']'): (' ','');local $|=1;print "$mess ",@dispdef;if ($self->_is_unattended &&!@def){die <_readline();if (!defined($ans)or!length($ans)){print "$dispdef[1]\n";$ans=scalar(@def)? $def[0]: ''}return$ans}sub y_n {my$self=shift;my ($mess,$def)=@_;die "y_n() called without a prompt message" unless$mess;die "Invalid default value: y_n() default must be 'y' or 'n'" if$def && $def !~ /^[yn]/i;my$answer;while (1){$answer=$self->prompt(@_);return 1 if$answer =~ /^y/i;return 0 if$answer =~ /^n/i;local $|=1;print "Please answer 'y' or 'n'.\n"}}sub current_action {shift->{action}}sub invoked_action {shift->{invoked_action}}sub notes {shift()->{phash}{notes}->access(@_)}sub config_data {shift()->{phash}{config_data}->access(@_)}sub runtime_params {shift->{phash}{runtime_params}->read(@_ ? shift : ())}sub auto_features {shift()->{phash}{auto_features}->access(@_)}sub features {my$self=shift;my$ph=$self->{phash};if (@_){my$key=shift;if ($ph->{features}->exists($key)){return$ph->{features}->access($key,@_)}if (my$info=$ph->{auto_features}->access($key)){my$disabled;for my$type (@{$self->prereq_action_types}){next if$type eq 'description' || $type eq 'recommends' ||!exists$info->{$type};my$prereqs=$info->{$type};for my$modname (sort keys %$prereqs){my$spec=$prereqs->{$modname};my$status=$self->check_installed_status($modname,$spec);if ((!$status->{ok})xor ($type =~ /conflicts$/)){return 0}if (!eval "require $modname; 1"){return 0}}}return 1}return$ph->{features}->access($key,@_)}my%features;my%auto_features=$ph->{auto_features}->access();while (my ($name,$info)=each%auto_features){my$failures=$self->prereq_failures($info);my$disabled=grep(/^(?:\w+_)?(?:requires|conflicts)$/,keys %$failures)? 1 : 0;$features{$name}=$disabled ? 0 : 1}%features=(%features,$ph->{features}->access());return wantarray ? %features : \%features}BEGIN {*feature=\&features}sub _mb_feature {my$self=shift;if (($self->module_name || '')eq 'Module::Build'){return$self->feature(@_)}else {require Module::Build::ConfigData;return Module::Build::ConfigData->feature(@_)}}sub _warn_mb_feature_deps {my$self=shift;my$name=shift;$self->log_warn("The '$name' feature is not available. Please install missing\n" ."feature dependencies and try again.\n".$self->_feature_deps_msg($name)."\n")}sub add_build_element {my ($self,$elem)=@_;my$elems=$self->build_elements;push @$elems,$elem unless grep {$_ eq $elem}@$elems}sub ACTION_config_data {my$self=shift;return unless$self->has_config_data;my$module_name=$self->module_name or die "The config_data feature requires that 'module_name' be set";my$notes_name=$module_name .'::ConfigData';my$notes_pm=File::Spec->catfile($self->blib,'lib',split /::/,"$notes_name.pm");return if$self->up_to_date(['Build.PL',$self->config_file('config_data'),$self->config_file('features')],$notes_pm);$self->log_verbose("Writing config notes to $notes_pm\n");File::Path::mkpath(File::Basename::dirname($notes_pm));Module::Build::Notes->write_config_data (file=>$notes_pm,module=>$module_name,config_module=>$notes_name,config_data=>scalar$self->config_data,feature=>scalar$self->{phash}{features}->access(),auto_features=>scalar$self->auto_features,)}{my%valid_properties=(__PACKAGE__,{});my%additive_properties;sub _mb_classes {my$class=ref($_[0])|| $_[0];return ($class,$class->mb_parents)}sub valid_property {my ($class,$prop)=@_;return grep exists($valid_properties{$_}{$prop}),$class->_mb_classes}sub valid_properties {return keys %{shift->valid_properties_defaults()}}sub valid_properties_defaults {my%out;for my$class (reverse shift->_mb_classes){@out{keys %{$valid_properties{$class}}}=map {$_->()}values %{$valid_properties{$class}}}return \%out}sub array_properties {map {exists$additive_properties{$_}->{ARRAY}? @{$additive_properties{$_}->{ARRAY}}: ()}shift->_mb_classes}sub hash_properties {map {exists$additive_properties{$_}->{HASH}? @{$additive_properties{$_}->{HASH}}: ()}shift->_mb_classes}sub add_property {my ($class,$property)=(shift,shift);die "Property '$property' already exists" if$class->valid_property($property);my%p=@_==1 ? (default=>shift): @_;my$type=ref$p{default};$valid_properties{$class}{$property}=$type eq 'CODE' ? $p{default}: $type eq 'HASH' ? sub {return {%{$p{default}}}}: $type eq 'ARRAY'? sub {return [@{$p{default}}]}: sub {return$p{default}};push @{$additive_properties{$class}->{$type}},$property if$type;unless ($class->can($property)){my$sub=$type eq 'HASH' ? _make_hash_accessor($property,\%p): _make_accessor($property,\%p);no strict 'refs';*{"$class\::$property"}=$sub}return$class}sub property_error {my$self=shift;die 'ERROR: ',@_}sub _set_defaults {my$self=shift;$self->{properties}{build_class}||= ref$self;$self->{properties}{orig_dir}||= $self->{properties}{base_dir};my$defaults=$self->valid_properties_defaults;for my$prop (keys %$defaults){$self->{properties}{$prop}=$defaults->{$prop}unless exists$self->{properties}{$prop}}for my$prop ($self->array_properties){$self->{properties}{$prop}=[@{$defaults->{$prop}}]unless exists$self->{properties}{$prop}}for my$prop ($self->hash_properties){$self->{properties}{$prop}={%{$defaults->{$prop}}}unless exists$self->{properties}{$prop}}}}sub _make_hash_accessor {my ($property,$p)=@_;my$check=$p->{check}|| sub {1};return sub {my$self=shift;unless(ref($self)){carp("\n$property not a class method (@_)");return}my$x=$self->{properties};return$x->{$property}unless @_;my$prop=$x->{$property};if (defined $_[0]&&!ref $_[0]){if (@_==1){return exists$prop->{$_[0]}? $prop->{$_[0]}: undef}elsif (@_ % 2==0){my%new=(%{$prop},@_);local $_=\%new;$x->{$property}=\%new if$check->($self);return$x->{$property}}else {die "Unexpected arguments for property '$property'\n"}}else {die "Unexpected arguments for property '$property'\n" if defined $_[0]&& ref $_[0]ne 'HASH';local $_=$_[0];$x->{$property}=shift if$check->($self)}}}sub _make_accessor {my ($property,$p)=@_;my$check=$p->{check}|| sub {1};return sub {my$self=shift;unless(ref($self)){carp("\n$property not a class method (@_)");return}my$x=$self->{properties};return$x->{$property}unless @_;local $_=$_[0];$x->{$property}=shift if$check->($self);return$x->{$property}}}__PACKAGE__->add_property(auto_configure_requires=>1);__PACKAGE__->add_property(blib=>'blib');__PACKAGE__->add_property(build_class=>'Module::Build');__PACKAGE__->add_property(build_elements=>[qw(PL support pm xs share_dir pod script)]);__PACKAGE__->add_property(build_script=>'Build');__PACKAGE__->add_property(build_bat=>0);__PACKAGE__->add_property(bundle_inc=>[]);__PACKAGE__->add_property(bundle_inc_preload=>[]);__PACKAGE__->add_property(config_dir=>'_build');__PACKAGE__->add_property(dynamic_config=>1);__PACKAGE__->add_property(include_dirs=>[]);__PACKAGE__->add_property(license=>'unknown');__PACKAGE__->add_property(metafile=>'META.yml');__PACKAGE__->add_property(mymetafile=>'MYMETA.yml');__PACKAGE__->add_property(metafile2=>'META.json');__PACKAGE__->add_property(mymetafile2=>'MYMETA.json');__PACKAGE__->add_property(recurse_into=>[]);__PACKAGE__->add_property(use_rcfile=>1);__PACKAGE__->add_property(create_packlist=>1);__PACKAGE__->add_property(allow_mb_mismatch=>0);__PACKAGE__->add_property(config=>undef);__PACKAGE__->add_property(test_file_exts=>['.t']);__PACKAGE__->add_property(use_tap_harness=>0);__PACKAGE__->add_property(cpan_client=>'cpan');__PACKAGE__->add_property(tap_harness_args=>{});__PACKAGE__->add_property(pureperl_only=>0);__PACKAGE__->add_property(allow_pureperl=>0);__PACKAGE__->add_property('installdirs',default=>'site',check=>sub {return 1 if /^(core|site|vendor)$/;return shift->property_error($_ eq 'perl' ? 'Perhaps you meant installdirs to be "core" rather than "perl"?' : 'installdirs must be one of "core", "site", or "vendor"');return shift->property_error("Perhaps you meant 'core'?")if $_ eq 'perl';return 0},);{__PACKAGE__->add_property(html_css=>'')}{my@prereq_action_types=qw(requires build_requires test_requires conflicts recommends);for my$type (@prereq_action_types){__PACKAGE__->add_property($type=>{})}__PACKAGE__->add_property(prereq_action_types=>\@prereq_action_types)}__PACKAGE__->add_property($_=>{})for qw(get_options install_base_relpaths install_path install_sets meta_add meta_merge original_prefix prefix_relpaths configure_requires);__PACKAGE__->add_property($_)for qw(PL_files autosplit base_dir bindoc_dirs c_source cover create_license create_makefile_pl create_readme debugger destdir dist_abstract dist_author dist_name dist_suffix dist_version dist_version_from extra_compiler_flags extra_linker_flags has_config_data install_base libdoc_dirs magic_number mb_version module_name needs_compiler orig_dir perl pm_files pod_files pollute prefix program_name quiet recursive_test_files release_status script_files scripts share_dir sign test_files verbose debug xs_files extra_manify_args);sub config {my$self=shift;my$c=ref($self)? $self->{config}: 'Module::Build::Config';return$c->all_config unless @_;my$key=shift;return$c->get($key)unless @_;my$val=shift;return$c->set($key=>$val)}sub mb_parents {my@in_stack=(shift);my%seen=($in_stack[0]=>1);my ($current,@out);while (@in_stack){next unless defined($current=shift@in_stack)&& $current->isa('Module::Build::Base');push@out,$current;next if$current eq 'Module::Build::Base';no strict 'refs';unshift@in_stack,map {my$c=$_;substr($c,0,2)="main::" if substr($c,0,2)eq '::';$seen{$c}++ ? (): $c}@{"$current\::ISA"}}shift@out;return@out}sub extra_linker_flags {shift->_list_accessor('extra_linker_flags',@_)}sub extra_compiler_flags {shift->_list_accessor('extra_compiler_flags',@_)}sub _list_accessor {(my$self,local $_)=(shift,shift);my$p=$self->{properties};$p->{$_}=[@_]if @_;$p->{$_}=[]unless exists$p->{$_};return ref($p->{$_})? $p->{$_}: [$p->{$_}]}sub subclass {my ($pack,%opts)=@_;my$build_dir='_build';$pack->delete_filetree($build_dir)if -e $build_dir;die "Must provide 'code' or 'class' option to subclass()\n" unless$opts{code}or $opts{class};$opts{code}||= '';$opts{class}||= 'MyModuleBuilder';my$filename=File::Spec->catfile($build_dir,'lib',split '::',$opts{class}).'.pm';my$filedir=File::Basename::dirname($filename);$pack->log_verbose("Creating custom builder $filename in $filedir\n");File::Path::mkpath($filedir);die "Can't create directory $filedir: $!" unless -d $filedir;open(my$fh,'>',$filename)or die "Can't create $filename: $!";print$fh <catdir(File::Spec->rel2abs($build_dir),'lib');eval "use $opts{class}";die $@ if $@;return$opts{class}}sub _guess_module_name {my$self=shift;my$p=$self->{properties};return if$p->{module_name};if ($p->{dist_version_from}&& -e $p->{dist_version_from}){my$mi=Module::Metadata->new_from_file($self->dist_version_from);$p->{module_name}=$mi->name}else {my$mod_path=my$mod_name=$p->{dist_name};$mod_name =~ s{-}{::}g;$mod_path =~ s{-}{/}g;$mod_path .= ".pm";if (-e $mod_path || -e "lib/$mod_path"){$p->{module_name}=$mod_name}else {$self->log_warn(<< 'END_WARN')}}}sub dist_name {my$self=shift;my$p=$self->{properties};my$me='dist_name';return$p->{$me}if defined$p->{$me};die "Can't determine distribution name, must supply either 'dist_name' or 'module_name' parameter" unless$self->module_name;($p->{$me}=$self->module_name)=~ s/::/-/g;return$p->{$me}}sub release_status {my ($self)=@_;my$me='release_status';my$p=$self->{properties};if (!defined$p->{$me}){$p->{$me}=$self->_is_dev_version ? 'testing' : 'stable'}unless ($p->{$me}=~ qr/\A(?:stable|testing|unstable)\z/){die "Illegal value '$p->{$me}' for $me\n"}if ($p->{$me}eq 'stable' && $self->_is_dev_version){my$version=$self->dist_version;die "Illegal value '$p->{$me}' with version '$version'\n"}return$p->{$me}}sub dist_suffix {my ($self)=@_;my$p=$self->{properties};my$me='dist_suffix';return$p->{$me}if defined$p->{$me};if ($self->release_status eq 'stable'){$p->{$me}=""}else {$p->{$me}=$self->_is_dev_version ? "" : "TRIAL" }return$p->{$me}}sub dist_version_from {my ($self)=@_;my$p=$self->{properties};my$me='dist_version_from';if ($self->module_name){$p->{$me}||= join('/','lib',split(/::/,$self->module_name)).'.pm'}return$p->{$me}|| undef}sub dist_version {my ($self)=@_;my$p=$self->{properties};my$me='dist_version';return$p->{$me}if defined$p->{$me};if (my$dist_version_from=$self->dist_version_from){my$version_from=File::Spec->catfile(split(qr{/},$dist_version_from));my$pm_info=Module::Metadata->new_from_file($version_from)or die "Can't find file $version_from to determine version";$p->{$me}=$self->normalize_version($pm_info->version());unless (defined$p->{$me}){die "Can't determine distribution version from $version_from"}}die ("Can't determine distribution version, must supply either 'dist_version',\n"."'dist_version_from', or 'module_name' parameter")unless defined$p->{$me};return$p->{$me}}sub _is_dev_version {my ($self)=@_;my$dist_version=$self->dist_version;my$version_obj=eval {version->new($dist_version)};return $@ ? 0 : $version_obj->is_alpha}sub dist_author {shift->_pod_parse('author')}sub dist_abstract {shift->_pod_parse('abstract')}sub _pod_parse {my ($self,$part)=@_;my$p=$self->{properties};my$member="dist_$part";return$p->{$member}if defined$p->{$member};my$docfile=$self->_main_docfile or return;open(my$fh,'<',$docfile)or return;require Module::Build::PodParser;my$parser=Module::Build::PodParser->new(fh=>$fh);my$method="get_$part";return$p->{$member}=$parser->$method()}sub version_from_file {return Module::Metadata->new_from_file($_[1])->version()}sub find_module_by_name {return Module::Metadata->find_module_by_name(@_[1,2])}{my%unlink_list_for_pid;sub _unlink_on_exit {my$self=shift;for my$f (@_){push @{$unlink_list_for_pid{$$}},$f if -f $f}return 1}END {for my$f (map glob($_),@{$unlink_list_for_pid{$$}|| []}){next unless -e $f;File::Path::rmtree($f,0,0)}}}sub add_to_cleanup {my$self=shift;my%files=map {$self->localize_file_path($_),1}@_;$self->{phash}{cleanup}->write(\%files)}sub cleanup {my$self=shift;my$all=$self->{phash}{cleanup}->read;return wantarray ? sort keys %$all : keys %$all}sub config_file {my$self=shift;return unless -d $self->config_dir;return File::Spec->catfile($self->config_dir,@_)}sub read_config {my ($self)=@_;my$file=$self->config_file('build_params')or die "Can't find 'build_params' in " .$self->config_dir;open(my$fh,'<',$file)or die "Can't read '$file': $!";my$ref=eval do {local $/;<$fh>};die if $@;close$fh;my$c;($self->{args},$c,$self->{properties})=@$ref;$self->{config}=Module::Build::Config->new(values=>$c)}sub has_config_data {my$self=shift;return scalar grep$self->{phash}{$_}->has_data(),qw(config_data features auto_features)}sub _write_data {my ($self,$filename,$data)=@_;my$file=$self->config_file($filename);open(my$fh,'>',$file)or die "Can't create '$file': $!";unless (ref($data)){print$fh $data;return}print {$fh}Module::Build::Dumper->_data_dump($data);close$fh}sub write_config {my ($self)=@_;File::Path::mkpath($self->{properties}{config_dir});-d $self->{properties}{config_dir}or die "Can't mkdir $self->{properties}{config_dir}: $!";my@items=@{$self->prereq_action_types};$self->_write_data('prereqs',{map {$_,$self->$_()}@items });$self->_write_data('build_params',[$self->{args},$self->{config}->values_set,$self->{properties}]);$self->_write_data('magicnum',$self->magic_number(int rand 1_000_000));$self->{phash}{$_}->write()foreach qw(notes cleanup features auto_features config_data runtime_params)}{my%packlist_map=('^File::Spec'=>'Cwd','^Devel::AssertOS'=>'Devel::CheckOS',);sub _find_packlist {my ($self,$inst,$mod)=@_;my$lookup=$mod;my$packlist=eval {$inst->packlist($lookup)};if (!$packlist){while (my ($re,$new_mod)=each%packlist_map){if ($mod =~ qr/$re/){$lookup=$new_mod;$packlist=eval {$inst->packlist($lookup)};last}}}return$packlist ? $lookup : undef}sub set_bundle_inc {my$self=shift;my$bundle_inc=$self->{properties}{bundle_inc};my$bundle_inc_preload=$self->{properties}{bundle_inc_preload};return unless inc::latest->can('loaded_modules');require ExtUtils::Installed;my$inst=eval {ExtUtils::Installed->new(extra_libs=>[@INC])};if ($@){$self->log_warn(<< "EUI_ERROR");return}my@bundle_list=map {[$_,0 ]}inc::latest->loaded_modules;while(@bundle_list){my ($mod,$prereq)=@{shift@bundle_list};my$lookup=$self->_find_packlist($inst,$mod);if (!$lookup){die << "NO_PACKLIST"}else {push @{$prereq ? $bundle_inc_preload : $bundle_inc},$lookup}}}}sub check_autofeatures {my ($self)=@_;my$features=$self->auto_features;return 1 unless %$features;my$longest=sub {my@str=@_ or croak("no strings given");my@len=map({length($_)}@str);my$max=0;my$longest;for my$i (0..$#len){($max,$longest)=($len[$i],$str[$i])if($len[$i]> $max)}return($longest)};my$max_name_len=length($longest->(keys %$features));my ($num_disabled,$log_text)=(0,"\nChecking optional features...\n");for my$name (sort keys %$features){$log_text .= $self->_feature_deps_msg($name,$max_name_len)}$num_disabled=()=$log_text =~ /disabled/g;if ($num_disabled){$self->log_warn($log_text);return 0}else {$self->log_verbose($log_text);return 1}}sub _feature_deps_msg {my ($self,$name,$max_name_len)=@_;$max_name_len ||= length$name;my$features=$self->auto_features;my$info=$features->{$name};my$feature_text="$name" .'.' x ($max_name_len - length($name)+ 4);my ($log_text,$disabled)=('','');if (my$failures=$self->prereq_failures($info)){$disabled=grep(/^(?:\w+_)?(?:requires|conflicts)$/,keys %$failures)? 1 : 0;$feature_text .= $disabled ? "disabled\n" : "enabled\n";for my$type (@{$self->prereq_action_types}){next unless exists$failures->{$type};$feature_text .= " $type:\n";my$prereqs=$failures->{$type};for my$module (sort keys %$prereqs){my$status=$prereqs->{$module};my$required=($type =~ /^(?:\w+_)?(?:requires|conflicts)$/)? 1 : 0;my$prefix=($required)? '!' : '*';$feature_text .= " $prefix $status->{message}\n"}}}else {$feature_text .= "enabled\n"}$log_text .= $feature_text if$disabled || $self->verbose;return$log_text}sub auto_config_requires {my ($self)=@_;my$p=$self->{properties};if ($self->dist_name ne 'Module-Build' && $self->auto_configure_requires &&!exists$p->{configure_requires}{'Module::Build'}){(my$ver=$VERSION)=~ s/^(\d+\.\d\d).*$/$1/;$self->log_warn(<_add_prereq('configure_requires','Module::Build',$ver)}if (inc::latest->can('loaded_module')){for my$mod (inc::latest->loaded_modules){next if exists$p->{configure_requires}{$mod};$self->_add_prereq('configure_requires',$mod,$mod->VERSION)}}return}sub auto_require {my ($self)=@_;my$p=$self->{properties};my$xs_files=$self->find_xs_files;if (!defined$p->{needs_compiler}){$self->needs_compiler(keys %$xs_files || defined$self->c_source)}if ($self->needs_compiler){$self->_add_prereq('build_requires','ExtUtils::CBuilder',0);if (!$self->have_c_compiler){$self->log_warn(<<'EOM')}}if ($self->share_dir){$self->_add_prereq('requires','File::ShareDir','1.00')}return}sub _add_prereq {my ($self,$type,$module,$version)=@_;my$p=$self->{properties};$version=0 unless defined$version;if (exists$p->{$type}{$module}){return if$self->compare_versions($version,'<=',$p->{$type}{$module})}$self->log_verbose("Adding to $type\: $module => $version\n");$p->{$type}{$module}=$version;return 1}sub prereq_failures {my ($self,$info)=@_;my@types=@{$self->prereq_action_types};$info ||= {map {$_,$self->$_()}@types};my$out;for my$type (@types){my$prereqs=$info->{$type};for my$modname (keys %$prereqs){my$spec=$prereqs->{$modname};my$status=$self->check_installed_status($modname,$spec);if ($type =~ /^(?:\w+_)?conflicts$/){next if!$status->{ok};$status->{conflicts}=delete$status->{need};$status->{message}="$modname ($status->{have}) conflicts with this distribution"}elsif ($type =~ /^(?:\w+_)?recommends$/){next if$status->{ok};$status->{message}=(!ref($status->{have})&& $status->{have}eq '' ? "$modname is not installed" : "$modname ($status->{have}) is installed, but we prefer to have $spec")}else {next if$status->{ok}}$out->{$type}{$modname}=$status}}return$out}sub _enum_prereqs {my$self=shift;my%prereqs;for my$type (@{$self->prereq_action_types}){if ($self->can($type)){my$prereq=$self->$type()|| {};$prereqs{$type}=$prereq if %$prereq}}return \%prereqs}sub check_prereq {my$self=shift;my$info=$self->_enum_prereqs;return 1 unless$info;my$log_text="Checking prerequisites...\n";my$failures=$self->prereq_failures($info);if ($failures){$self->log_warn($log_text);for my$type (@{$self->prereq_action_types}){my$prereqs=$failures->{$type};$self->log_warn(" ${type}:\n")if keys %$prereqs;for my$module (sort keys %$prereqs){my$status=$prereqs->{$module};my$prefix=($type =~ /^(?:\w+_)?recommends$/)? "* " : "! ";$self->log_warn(" $prefix $status->{message}\n")}}return 0}else {$self->log_verbose($log_text ."Looks good\n\n");return 1}}sub perl_version {my ($self)=@_;return $^V ? $self->perl_version_to_float(sprintf "%vd",$^V): $]}sub perl_version_to_float {my ($self,$version)=@_;return$version if grep(/\./,$version)< 2;$version =~ s/\./../;$version =~ s/\.(\d+)/sprintf '%03d', $1/eg;return$version}sub _parse_conditions {my ($self,$spec)=@_;return ">= 0" if not defined$spec;if ($spec =~ /^\s*([\w.]+)\s*$/){return (">= $spec")}else {return split /\s*,\s*/,$spec}}sub try_require {my ($self,$modname,$spec)=@_;my$status=$self->check_installed_status($modname,defined($spec)? $spec : 0);return unless$status->{ok};my$path=$modname;$path =~ s{::}{/}g;$path .= ".pm";if (defined$INC{$path}){return 1}elsif (exists$INC{$path}){return}else {return eval "require $modname"}}sub check_installed_status {my ($self,$modname,$spec)=@_;my%status=(need=>$spec);if ($modname eq 'perl'){$status{have}=$self->perl_version}elsif (eval {no strict;$status{have}=${"${modname}::VERSION"}}){}else {my$pm_info=Module::Metadata->new_from_module($modname);unless (defined($pm_info)){@status{qw(have message) }=('',"$modname is not installed");return \%status}$status{have}=eval {$pm_info->version()};if ($spec and!defined($status{have})){@status{qw(have message) }=(undef,"Couldn't find a \$VERSION in prerequisite $modname");return \%status}}my@conditions=$self->_parse_conditions($spec);for (@conditions){my ($op,$version)=/^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x or die "Invalid prerequisite condition '$_' for $modname";$version=$self->perl_version_to_float($version)if$modname eq 'perl';next if$op eq '>=' and!$version;unless ($self->compare_versions($status{have},$op,$version)){$status{message}="$modname ($status{have}) is installed, but we need version $op $version";return \%status}}$status{ok}=1;return \%status}sub compare_versions {my$self=shift;my ($v1,$op,$v2)=@_;$v1=version->new($v1)unless eval {$v1->isa('version')};my$eval_str="\$v1 $op \$v2";my$result=eval$eval_str;$self->log_warn("error comparing versions: '$eval_str' $@")if $@;return$result}sub check_installed_version {my ($self,$modname,$spec)=@_;my$status=$self->check_installed_status($modname,$spec);if ($status->{ok}){return$status->{have}if$status->{have}and "$status->{have}" ne '';return '0 but true'}$@=$status->{message};return 0}sub make_executable {my$self=shift;for (@_){my$current_mode=(stat $_)[2];chmod$current_mode | oct(111),$_}}sub is_executable {my ($self,$file)=@_;return -x $file}sub _startperl {shift()->config('startperl')}sub _added_to_INC {my$self=shift;my%seen;$seen{$_}++ foreach$self->_default_INC;return grep!$seen{$_}++,@INC}{my@default_inc;sub _default_INC {my$self=shift;return@default_inc if@default_inc;local$ENV{PERL5LIB};my$perl=ref($self)? $self->perl : $self->find_perl_interpreter;my@inc=$self->_backticks($perl,'-le','print for @INC');chomp@inc;return@default_inc=@inc}}sub print_build_script {my ($self,$fh)=@_;my$build_package=$self->build_class;my$closedata="";my$config_requires;if (-f $self->metafile){my$meta=eval {$self->read_metafile($self->metafile)};$config_requires=$meta && $meta->{prereqs}{configure}{requires}{'Module::Build'}}$config_requires ||= 0;my%q=map {$_,$self->$_()}qw(config_dir base_dir);$q{base_dir}=Win32::GetShortPathName($q{base_dir})if$self->is_windowsish;$q{magic_numfile}=$self->config_file('magicnum');my@myINC=$self->_added_to_INC;for (@myINC,values%q){$_=File::Spec->canonpath($_)unless$self->is_vmsish;s/([\\\'])/\\$1/g}my$quoted_INC=join ",\n",map " '$_'",@myINC;my$shebang=$self->_startperl;my$magic_number=$self->magic_number;my$dot_in_inc_code=$INC[-1]eq '.' ? <<'END' : '';print$fh <metafile2,$self->metafile,);my@mymetafiles=($self->mymetafile2,$self->mymetafile,);for my$f (@mymetafiles){if ($self->delete_filetree($f)){$self->log_verbose("Removed previous '$f'\n")}}if ($self->try_require("CPAN::Meta","2.142060")){for my$file (@metafiles){next unless -f $file;$meta_obj=eval {CPAN::Meta->load_file($file,{lazy_validation=>0 })};last if$meta_obj}}my$mymeta_obj;if ($meta_obj){my%updated=(%{$meta_obj->as_struct({version=>2.0 })},prereqs=>$self->_normalize_prereqs,dynamic_config=>0,generated_by=>"Module::Build version $Module::Build::VERSION",);$mymeta_obj=CPAN::Meta->new(\%updated,{lazy_validation=>0 })}else {$mymeta_obj=$self->_get_meta_object(quiet=>0,dynamic=>0,fatal=>1,auto=>0)}my@created=$self->_write_meta_files($mymeta_obj,'MYMETA');$self->log_warn("Could not create MYMETA files\n")unless@created;return 1}sub create_build_script {my ($self)=@_;$self->write_config;$self->create_mymeta;my ($build_script,$dist_name,$dist_version)=map$self->$_(),qw(build_script dist_name dist_version);if ($self->delete_filetree($build_script)){$self->log_verbose("Removed previous script '$build_script'\n")}$self->log_info("Creating new '$build_script' script for ","'$dist_name' version '$dist_version'\n");open(my$fh,'>',$build_script)or die "Can't create '$build_script': $!";$self->print_build_script($fh);close$fh;$self->make_executable($build_script);return 1}sub check_manifest {my$self=shift;return unless -e 'MANIFEST';require ExtUtils::Manifest;local ($^W,$ExtUtils::Manifest::Quiet)=(0,1);$self->log_verbose("Checking whether your kit is complete...\n");if (my@missed=ExtUtils::Manifest::manicheck()){$self->log_warn("WARNING: the following files are missing in your kit:\n","\t",join("\n\t",@missed),"\n","Please inform the author.\n\n")}else {$self->log_verbose("Looks good\n\n")}}sub dispatch {my$self=shift;local$self->{_completed_actions}={};if (@_){my ($action,%p)=@_;my$args=$p{args}? delete($p{args}): {};local$self->{invoked_action}=$action;local$self->{args}={%{$self->{args}},%$args};local$self->{properties}={%{$self->{properties}},%p};return$self->_call_action($action)}die "No build action specified" unless$self->{action};local$self->{invoked_action}=$self->{action};$self->_call_action($self->{action})}sub _call_action {my ($self,$action)=@_;return if$self->{_completed_actions}{$action}++;local$self->{action}=$action;my$method=$self->can_action($action);die "No action '$action' defined, try running the 'help' action.\n" unless$method;$self->log_debug("Starting ACTION_$action\n");my$rc=$self->$method();$self->log_debug("Finished ACTION_$action\n");return$rc}sub can_action {my ($self,$action)=@_;return$self->can("ACTION_$action")}sub cull_options {my$self=shift;my (@argv)=@_;return({},@argv)unless(ref($self));my$specs=$self->get_options;return({},@argv)unless($specs and %$specs);require Getopt::Long;my@specs;my$args={};for my$k (sort keys %$specs){my$v=$specs->{$k};die "Option specification '$k' conflicts with a " .ref$self ." option of the same name" if$self->valid_property($k);push@specs,$k .(defined$v->{type}? $v->{type}: '');push@specs,$v->{store}if exists$v->{store};$args->{$k}=$v->{default}if exists$v->{default}}local@ARGV=@argv;if (@specs){Getopt::Long::Configure('pass_through');Getopt::Long::GetOptions($args,@specs)}return$args,@ARGV}sub unparse_args {my ($self,$args)=@_;my@out;for my$k (sort keys %$args){my$v=$args->{$k};push@out,(ref$v eq 'HASH' ? map {+"--$k","$_=$v->{$_}"}sort keys %$v : ref$v eq 'ARRAY' ? map {+"--$k",$_}@$v : ("--$k",$v))}return@out}sub args {my$self=shift;return wantarray ? %{$self->{args}}: $self->{args}unless @_;my$key=shift;$self->{args}{$key}=shift if @_;return$self->{args}{$key}}sub _translate_option {my$self=shift;my$opt=shift;(my$tr_opt=$opt)=~ tr/-/_/;return$tr_opt if grep$tr_opt =~ /^(?:no_?)?$_$/,qw(create_license create_makefile_pl create_readme extra_compiler_flags extra_linker_flags install_base install_path meta_add meta_merge test_files use_rcfile use_tap_harness tap_harness_args cpan_client pureperl_only allow_pureperl);return$opt}my%singular_argument=map {($_=>1)}qw/install_base prefix destdir installdirs verbose quiet uninst debug sign/;sub _read_arg {my ($self,$args,$key,$val)=@_;$key=$self->_translate_option($key);if (exists$args->{$key}and not $singular_argument{$key}){$args->{$key}=[$args->{$key}]unless ref$args->{$key};push @{$args->{$key}},$val}else {$args->{$key}=$val}}sub _optional_arg {my$self=shift;my$opt=shift;my$argv=shift;$opt=$self->_translate_option($opt);my@bool_opts=qw(build_bat create_license create_readme pollute quiet uninst use_rcfile verbose debug sign use_tap_harness pureperl_only allow_pureperl);if (grep$opt =~ /^no[-_]?$_$/,@bool_opts){$opt =~ s/^no-?//;return ($opt,0)}return ($opt,shift(@$argv))unless grep $_ eq $opt,@bool_opts;my$arg=1;$arg=shift(@$argv)if @$argv && $argv->[0]=~ /^\d+$/;return ($opt,$arg)}sub read_args {my$self=shift;(my$args,@_)=$self->cull_options(@_);my%args=%$args;my$opt_re=qr/[\w\-]+/;my ($action,@argv);while (@_){local $_=shift;if (/^(?:--)?($opt_re)=(.*)$/){$self->_read_arg(\%args,$1,$2)}elsif (/^--($opt_re)$/){my($opt,$arg)=$self->_optional_arg($1,\@_);$self->_read_arg(\%args,$opt,$arg)}elsif (/^($opt_re)$/ and!defined($action)){$action=$1}else {push@argv,$_}}$args{ARGV}=\@argv;for ('extra_compiler_flags','extra_linker_flags'){$args{$_}=[$self->split_like_shell($args{$_})]if exists$args{$_}}for ('include_dirs'){$args{$_}=[$args{$_}]if exists$args{$_}&&!ref$args{$_}}for ($self->hash_properties,'config'){next unless exists$args{$_};my%hash;$args{$_}||= [];$args{$_}=[$args{$_}]unless ref$args{$_};for my$arg (@{$args{$_}}){$arg =~ /($opt_re)=(.*)/ or die "Malformed '$_' argument: '$arg' should be something like 'foo=bar'";$hash{$1}=$2}$args{$_}=\%hash}for my$key (qw(prefix install_base destdir)){next if!defined$args{$key};$args{$key}=$self->_detildefy($args{$key})}for my$key (qw(install_path)){next if!defined$args{$key};for my$subkey (keys %{$args{$key}}){next if!defined$args{$key}{$subkey};my$subkey_ext=$self->_detildefy($args{$key}{$subkey});if ($subkey eq 'html'){$args{$key}{binhtml}=$subkey_ext;$args{$key}{libhtml}=$subkey_ext}else {$args{$key}{$subkey}=$subkey_ext}}}if ($args{makefile_env_macros}){require Module::Build::Compat;%args=(%args,Module::Build::Compat->makefile_to_build_macros)}return \%args,$action}sub _detildefy {}sub _merge_arglist {my($self,$opts1,$opts2)=@_;$opts1 ||= {};$opts2 ||= {};my%new_opts=%$opts1;while (my ($key,$val)=each %$opts2){if (exists($opts1->{$key})){if (ref($val)eq 'HASH'){while (my ($k,$v)=each %$val){$new_opts{$key}{$k}=$v unless exists($opts1->{$key}{$k})}}}else {$new_opts{$key}=$val}}return%new_opts}sub _home_dir {my@home_dirs;push(@home_dirs,$ENV{HOME})if$ENV{HOME};push(@home_dirs,File::Spec->catpath($ENV{HOMEDRIVE},$ENV{HOMEPATH},''))if$ENV{HOMEDRIVE}&& $ENV{HOMEPATH};my@other_home_envs=qw(USERPROFILE APPDATA WINDIR SYS$LOGIN);push(@home_dirs,map$ENV{$_},grep$ENV{$_},@other_home_envs);my@real_home_dirs=grep -d,@home_dirs;return wantarray ? @real_home_dirs : shift(@real_home_dirs)}sub _find_user_config {my$self=shift;my$file=shift;for my$dir ($self->_home_dir){my$path=File::Spec->catfile($dir,$file);return$path if -e $path}return undef}sub read_modulebuildrc {my($self,$action)=@_;return ()unless$self->use_rcfile;my$modulebuildrc;if (exists($ENV{MODULEBUILDRC})&& $ENV{MODULEBUILDRC}eq 'NONE'){return ()}elsif (exists($ENV{MODULEBUILDRC})&& -e $ENV{MODULEBUILDRC}){$modulebuildrc=$ENV{MODULEBUILDRC}}elsif (exists($ENV{MODULEBUILDRC})){$self->log_warn("WARNING: Can't find resource file " ."'$ENV{MODULEBUILDRC}' defined in environment.\n" ."No options loaded\n");return ()}else {$modulebuildrc=$self->_find_user_config('.modulebuildrc');return ()unless$modulebuildrc}open(my$fh,'<',$modulebuildrc)or die "Can't open $modulebuildrc: $!";my%options;my$buffer='';while (defined(my$line=<$fh>)){chomp($line);$line =~ s/#.*$//;next unless length($line);if ($line =~ /^\S/){if ($buffer){my($action,$options)=split(/\s+/,$buffer,2);$options{$action}.= $options .' ';$buffer=''}$buffer=$line}else {$buffer .= $line}}if ($buffer){my($action,$options)=split(/\s+/,$buffer,2);$options{$action}.= $options .' '}my ($global_opts)=$self->read_args($self->split_like_shell($options{'*'}|| ''));if ($action eq 'fakeinstall' &&!exists$options{fakeinstall}){$action='install'}my ($action_opts)=$self->read_args($self->split_like_shell($options{$action}|| ''));return$self->_merge_arglist($action_opts,$global_opts)}sub merge_modulebuildrc {my($self,$action,%cmdline_opts)=@_;my%rc_opts=$self->read_modulebuildrc($action || $self->{action}|| 'build');my%new_opts=$self->_merge_arglist(\%cmdline_opts,\%rc_opts);$self->merge_args($action,%new_opts)}sub merge_args {my ($self,$action,%args)=@_;$self->{action}=$action if defined$action;my%additive=map {$_=>1}$self->hash_properties;while (my ($key,$val)=each%args){$self->{phash}{runtime_params}->access($key=>$val)if$self->valid_property($key);if ($key eq 'config'){$self->config($_=>$val->{$_})foreach keys %$val}else {my$add_to=$additive{$key}? $self->{properties}{$key}: $self->valid_property($key)? $self->{properties}: $self->{args};if ($additive{$key}){$add_to->{$_}=$val->{$_}foreach keys %$val}else {$add_to->{$key}=$val}}}}sub cull_args {my$self=shift;my@arg_list=@_;unshift@arg_list,$self->split_like_shell($ENV{PERL_MB_OPT})if$ENV{PERL_MB_OPT};my ($args,$action)=$self->read_args(@arg_list);$self->merge_args($action,%$args);$self->merge_modulebuildrc($action,%$args)}sub super_classes {my ($self,$class,$seen)=@_;$class ||= ref($self)|| $self;$seen ||= {};no strict 'refs';my@super=grep {not $seen->{$_}++}$class,@{$class .'::ISA'};return@super,map {$self->super_classes($_,$seen)}@super}sub known_actions {my ($self)=@_;my%actions;no strict 'refs';for my$class ($self->super_classes){for (keys %{$class .'::'}){$actions{$1}++ if /^ACTION_(\w+)/}}return wantarray ? sort keys%actions : \%actions}sub get_action_docs {my ($self,$action)=@_;my$actions=$self->known_actions;die "No known action '$action'" unless$actions->{$action};my ($files_found,@docs)=(0);for my$class ($self->super_classes){(my$file=$class)=~ s{::}{/}g;$file=$INC{$file .'.pm'}or next;open(my$fh,'<',$file)or next;$files_found++;local $_;while (<$fh>){last if /^=head1 ACTIONS\s/}my$style;while (<$fh>){last if /^=head1 /;if(/^=(item|head2)\s+\Q$action\E\b/){$style=$1;push@docs,$_;last}}$style or next;if($style eq 'item'){my ($found,$inlist)=(0,0);while (<$fh>){if (/^=(item|back)/){last unless$inlist}push@docs,$_;++$inlist if /^=over/;--$inlist if /^=back/}}else {while (<$fh>){last if(/^=(?:head[12]|cut)/);push@docs,$_}}}unless ($files_found){$@="Couldn't find any documentation to search";return}unless (@docs){$@="Couldn't find any docs for action '$action'";return}return join '',@docs}sub ACTION_prereq_report {my$self=shift;$self->log_info($self->prereq_report)}sub ACTION_prereq_data {my$self=shift;$self->log_info(Module::Build::Dumper->_data_dump($self->prereq_data))}sub prereq_data {my$self=shift;my@types=('configure_requires',@{$self->prereq_action_types});my$info={map {$_=>$self->$_()}grep {%{$self->$_()}}@types };return$info}sub prereq_report {my$self=shift;my$info=$self->prereq_data;my$output='';for my$type (sort keys %$info){my$prereqs=$info->{$type};$output .= "\n$type:\n";my$mod_len=2;my$ver_len=4;my%mods;for my$modname (sort keys %$prereqs){my$spec=$prereqs->{$modname};my$len=length$modname;$mod_len=$len if$len > $mod_len;$spec ||= '0';$len=length$spec;$ver_len=$len if$len > $ver_len;my$mod=$self->check_installed_status($modname,$spec);$mod->{name}=$modname;$mod->{ok}||= 0;$mod->{ok}=!$mod->{ok}if$type =~ /^(\w+_)?conflicts$/;$mods{lc$modname}=$mod}my$space=q{ } x ($mod_len - 3);my$vspace=q{ } x ($ver_len - 3);my$sline=q{-} x ($mod_len - 3);my$vline=q{-} x ($ver_len - 3);my$disposition=($type =~ /^(\w+_)?conflicts$/)? 'Clash' : 'Need';$output .= " Module $space $disposition $vspace Have\n"." ------$sline+------$vline-+----------\n";for my$k (sort keys%mods){my$mod=$mods{$k};my$space=q{ } x ($mod_len - length$k);my$vspace=q{ } x ($ver_len - length$mod->{need});my$f=$mod->{ok}? ' ' : '!';$output .= " $f $mod->{name} $space $mod->{need} $vspace ".(defined($mod->{have})? $mod->{have}: "")."\n"}}return$output}sub ACTION_help {my ($self)=@_;my$actions=$self->known_actions;if (@{$self->{args}{ARGV}}){my$msg=eval {$self->get_action_docs($self->{args}{ARGV}[0],$actions)};print $@ ? "$@\n" : $msg;return}print <_action_listing($actions);print "\nRun `Build help ` for details on an individual action.\n";print "See `perldoc Module::Build` for complete documentation.\n"}sub _action_listing {my ($self,$actions)=@_;my@actions=sort keys %$actions;@actions=map$actions[($_ + ($_ % 2)* @actions)/ 2],0..$#actions;my$out='';while (my ($one,$two)=splice@actions,0,2){$out .= sprintf(" %-12s %-12s\n",$one,$two||'')}$out =~ s{\s*$}{}mg;return$out}sub ACTION_retest {my ($self)=@_;local@INC=@INC;@INC=grep {ref()|| -d}@INC if@INC > 100;$self->do_tests}sub ACTION_testall {my ($self)=@_;my@types;for my$action (grep {$_ ne 'all'}$self->get_test_types){push(@types,$action)}$self->generic_test(types=>['default',@types])}sub get_test_types {my ($self)=@_;my$t=$self->{properties}->{test_types};return (defined$t ? (wantarray ? sort keys %$t : keys %$t): ())}sub ACTION_test {my ($self)=@_;$self->generic_test(type=>'default')}sub generic_test {my$self=shift;(@_ % 2)and croak('Odd number of elements in argument hash');my%args=@_;my$p=$self->{properties};my@types=((exists($args{type})? $args{type}: ()),(exists($args{types})? @{$args{types}}: ()),);@types or croak "need some types of tests to check";my%test_types=(default=>$p->{test_file_exts},(defined($p->{test_types})? %{$p->{test_types}}: ()),);for my$type (@types){croak "$type not defined in test_types!" unless defined$test_types{$type }}local$p->{test_file_exts}=[map {ref $_ ? @$_ : $_}@test_types{@types}];$self->depends_on('code');local@INC=@INC;unshift@INC,(File::Spec->catdir($p->{base_dir},$self->blib,'lib'),File::Spec->catdir($p->{base_dir},$self->blib,'arch'));@INC=grep {ref()|| -d}@INC if@INC > 100;$self->do_tests}sub do_tests {my$self=shift;my$tests=$self->find_test_files;local$ENV{PERL_DL_NONLAZY}=1;if(@$tests){my$args=$self->tap_harness_args;if($self->use_tap_harness or ($args and %$args)){my$aggregate=$self->run_tap_harness($tests);if ($aggregate->has_errors){die "Errors in testing. Cannot continue.\n"}}else {$self->run_test_harness($tests)}}else {$self->log_info("No tests defined.\n")}$self->run_visual_script}sub run_tap_harness {my ($self,$tests)=@_;require TAP::Harness::Env;my$aggregate=TAP::Harness::Env->create({lib=>[@INC],verbosity=>$self->{properties}{verbose},switches=>[$self->harness_switches ],%{$self->tap_harness_args},})->runtests(@$tests);return$aggregate}sub run_test_harness {my ($self,$tests)=@_;require Test::Harness;local$Test::Harness::verbose=$self->verbose || 0;local$Test::Harness::switches=join ' ',$self->harness_switches;Test::Harness::runtests(@$tests)}sub run_visual_script {my$self=shift;$self->run_perl_script('visual.pl','-Mblib='.$self->blib)if -e 'visual.pl'}sub harness_switches {my$self=shift;my@res;push@res,qw(-w -d) if$self->{properties}{debugger};push@res,'-MDevel::Cover' if$self->{properties}{cover};return@res}sub test_files {my$self=shift;my$p=$self->{properties};if (@_){return$p->{test_files}=(@_==1 ? shift : [@_])}return$self->find_test_files}sub expand_test_dir {my ($self,$dir)=@_;my$exts=$self->{properties}{test_file_exts};return sort map {@{$self->rscan_dir($dir,qr{^[^.].*\Q$_\E$})}}@$exts if$self->recursive_test_files;return sort map {glob File::Spec->catfile($dir,"*$_")}@$exts}sub ACTION_testdb {my ($self)=@_;local$self->{properties}{debugger}=1;$self->depends_on('test')}sub ACTION_testcover {my ($self)=@_;unless (Module::Metadata->find_module_by_name('Devel::Cover')){warn("Cannot run testcover action unless Devel::Cover is installed.\n");return}$self->add_to_cleanup('coverage','cover_db');$self->depends_on('code');if (-e 'cover_db'){my$pm_files=$self->rscan_dir (File::Spec->catdir($self->blib,'lib'),$self->file_qr('\.pm$'));my$cover_files=$self->rscan_dir('cover_db',sub {-f $_ and not /\.html$/});$self->do_system(qw(cover -delete))unless$self->up_to_date($pm_files,$cover_files)&& $self->up_to_date($self->test_files,$cover_files)}local$self->{properties}{cover}=1;$self->depends_on('test');$self->do_system('cover')}sub ACTION_code {my ($self)=@_;my$blib=$self->blib;$self->add_to_cleanup($blib);File::Path::mkpath(File::Spec->catdir($blib,'arch'));if (my$split=$self->autosplit){$self->autosplit_file($_,$blib)for ref($split)? @$split : ($split)}for my$element (@{$self->build_elements}){my$method="process_${element}_files";$method="process_files_by_extension" unless$self->can($method);$self->$method($element)}$self->depends_on('config_data')}sub ACTION_build {my$self=shift;$self->log_info("Building " .$self->dist_name ."\n");$self->depends_on('code');$self->depends_on('docs')}sub process_files_by_extension {my ($self,$ext)=@_;my$method="find_${ext}_files";my$files=$self->can($method)? $self->$method(): $self->_find_file_by_type($ext,'lib');for my$file (sort keys %$files){$self->copy_if_modified(from=>$file,to=>File::Spec->catfile($self->blib,$files->{$file}))}}sub process_support_files {my$self=shift;my$p=$self->{properties};return unless$p->{c_source};my$files;if (ref($p->{c_source})eq "ARRAY"){push @{$p->{include_dirs}},@{$p->{c_source}};for my$path (@{$p->{c_source}}){push @$files,@{$self->rscan_dir($path,$self->file_qr('\.c(c|p|pp|xx|\+\+)?$'))}}}else {push @{$p->{include_dirs}},$p->{c_source};$files=$self->rscan_dir($p->{c_source},$self->file_qr('\.c(c|p|pp|xx|\+\+)?$'))}for my$file (@$files){push @{$p->{objects}},$self->compile_c($file)}}sub process_share_dir_files {my$self=shift;my$files=$self->_find_share_dir_files;return unless$files;my$share_prefix=File::Spec->catdir($self->blib,qw/lib auto share/);for my$file (sort keys %$files){$self->copy_if_modified(from=>$file,to=>File::Spec->catfile($share_prefix,$files->{$file}))}}sub _find_share_dir_files {my$self=shift;my$share_dir=$self->share_dir;return unless$share_dir;my@file_map;if ($share_dir->{dist}){my$prefix="dist/".$self->dist_name;push@file_map,$self->_share_dir_map($prefix,$share_dir->{dist})}if ($share_dir->{module}){for my$mod (sort keys %{$share_dir->{module}}){(my$altmod=$mod)=~ s{::}{-}g;my$prefix="module/$altmod";push@file_map,$self->_share_dir_map($prefix,$share_dir->{module}{$mod})}}return {@file_map }}sub _share_dir_map {my ($self,$prefix,$list)=@_;my%files;for my$dir (@$list){for my$f (@{$self->rscan_dir($dir,sub {-f})}){$f =~ s{\A.*?\Q$dir\E/}{};$files{"$dir/$f"}="$prefix/$f"}}return%files}sub process_PL_files {my ($self)=@_;my$files=$self->find_PL_files;for my$file (sort keys %$files){my$to=$files->{$file};unless ($self->up_to_date($file,$to)){$self->run_perl_script($file,[],[@$to])or die "$file failed";$self->add_to_cleanup(@$to)}}}sub process_xs_files {my$self=shift;return if$self->pureperl_only && $self->allow_pureperl;my$files=$self->find_xs_files;croak 'Can\'t build xs files under --pureperl-only' if %$files && $self->pureperl_only;for my$from (sort keys %$files){my$to=$files->{$from};unless ($from eq $to){$self->add_to_cleanup($to);$self->copy_if_modified(from=>$from,to=>$to)}$self->process_xs($to)}}sub process_pod_files {shift()->process_files_by_extension(shift())}sub process_pm_files {shift()->process_files_by_extension(shift())}sub process_script_files {my$self=shift;my$files=$self->find_script_files;return unless keys %$files;my$script_dir=File::Spec->catdir($self->blib,'script');File::Path::mkpath($script_dir);for my$file (sort keys %$files){my$result=$self->copy_if_modified($file,$script_dir,'flatten')or next;$self->fix_shebang_line($result)unless$self->is_vmsish;$self->make_executable($result)}}sub find_PL_files {my$self=shift;if (my$files=$self->{properties}{PL_files}){if (ref$files eq 'ARRAY'){return {map {$_,[/^(.*)\.PL$/]}map$self->localize_file_path($_),@$files }}elsif (ref$files eq 'HASH'){my%out;while (my ($file,$to)=each %$files){$out{$self->localize_file_path($file)}=[map$self->localize_file_path($_),ref$to ? @$to : ($to)]}return \%out}else {die "'PL_files' must be a hash reference or array reference"}}return unless -d 'lib';return {map {$_,[/^(.*)\.PL$/i ]}@{$self->rscan_dir('lib',$self->file_qr('\.PL$'))}}}sub find_pm_files {shift->_find_file_by_type('pm','lib')}sub find_pod_files {shift->_find_file_by_type('pod','lib')}sub find_xs_files {shift->_find_file_by_type('xs','lib')}sub find_script_files {my$self=shift;if (my$files=$self->script_files){return {map {$self->localize_file_path($_),$files->{$_}}keys %$files }}return {}}sub find_test_files {my$self=shift;my$p=$self->{properties};if (my$files=$p->{test_files}){$files=[sort keys %$files]if ref$files eq 'HASH';$files=[map {-d $_ ? $self->expand_test_dir($_): $_}map glob,$self->split_like_shell($files)];return [map$self->localize_file_path($_),@$files ]}else {my@tests;push@tests,'test.pl' if -e 'test.pl';push@tests,$self->expand_test_dir('t')if -e 't' and -d _;return \@tests}}sub _find_file_by_type {my ($self,$type,$dir)=@_;if (my$files=$self->{properties}{"${type}_files"}){return {map$self->localize_file_path($_),%$files }}return {}unless -d $dir;return {map {$_,$_}map$self->localize_file_path($_),grep!/\.\#/,@{$self->rscan_dir($dir,$self->file_qr("\\.$type\$"))}}}sub localize_file_path {my ($self,$path)=@_;return File::Spec->catfile(split m{/},$path)}sub localize_dir_path {my ($self,$path)=@_;return File::Spec->catdir(split m{/},$path)}sub fix_shebang_line {my ($self,@files)=@_;my$c=ref($self)? $self->{config}: 'Module::Build::Config';my ($does_shbang)=$c->get('sharpbang')=~ /^\s*\#\!/;for my$file (@files){open(my$FIXIN,'<',$file)or die "Can't process '$file': $!";local $/="\n";chomp(my$line=<$FIXIN>);next unless$line =~ s/^\s*\#!\s*//;my ($cmd,$arg)=(split(' ',$line,2),'');next unless$cmd =~ /perl/i;my$interpreter=$self->{properties}{perl};$self->log_verbose("Changing sharpbang in $file to $interpreter\n");my$shb='';$shb .= $c->get('sharpbang')."$interpreter $arg\n" if$does_shbang;open(my$FIXOUT,'>',"$file.new")or die "Can't create new $file: $!\n";local $\;undef $/;print$FIXOUT $shb,<$FIXIN>;close$FIXIN;close$FIXOUT;rename($file,"$file.bak")or die "Can't rename $file to $file.bak: $!";rename("$file.new",$file)or die "Can't rename $file.new to $file: $!";$self->delete_filetree("$file.bak")or $self->log_warn("Couldn't clean up $file.bak, leaving it there");$self->do_system($c->get('eunicefix'),$file)if$c->get('eunicefix')ne ':'}}sub ACTION_testpod {my$self=shift;$self->depends_on('docs');eval q{use Test::Pod 0.95; 1} or die "The 'testpod' action requires Test::Pod version 0.95";my@files=sort keys %{$self->_find_pods($self->libdoc_dirs)},keys %{$self->_find_pods ($self->bindoc_dirs,exclude=>[$self->file_qr('\.bat$')])}or die "Couldn't find any POD files to test\n";{package Module::Build::PodTester;Test::Pod->import(tests=>scalar@files);pod_file_ok($_)foreach@files}}sub ACTION_testpodcoverage {my$self=shift;$self->depends_on('docs');eval q{use Test::Pod::Coverage 1.00; 1} or die "The 'testpodcoverage' action requires ","Test::Pod::Coverage version 1.00";local@INC=@INC;my$p=$self->{properties};unshift(@INC,File::Spec->catdir($p->{base_dir},$self->blib,'lib'),);all_pod_coverage_ok()}sub ACTION_docs {my$self=shift;$self->depends_on('code');$self->depends_on('manpages','html')}sub _is_default_installable {my$self=shift;my$type=shift;return ($self->install_destination($type)&& ($self->install_path($type)|| $self->install_sets($self->installdirs)->{$type}))? 1 : 0}sub _is_ActivePerl {my$self=shift;unless (exists($self->{_is_ActivePerl})){$self->{_is_ActivePerl}=(eval {require ActivePerl::DocTools}|| 0)}return$self->{_is_ActivePerl}}sub _is_ActivePPM {my$self=shift;unless (exists($self->{_is_ActivePPM})){$self->{_is_ActivePPM}=(eval {require ActivePerl::PPM}|| 0)}return$self->{_is_ActivePPM}}sub ACTION_manpages {my$self=shift;return unless$self->_mb_feature('manpage_support');$self->depends_on('code');my%extra_manify_args=$self->{properties}{'extra_manify_args'}? %{$self->{properties}{'extra_manify_args'}}: ();for my$type (qw(bin lib)){next unless ($self->invoked_action eq 'manpages' || $self->_is_default_installable("${type}doc"));my$files=$self->_find_pods($self->{properties}{"${type}doc_dirs"},exclude=>[$self->file_qr('\.bat$')]);next unless %$files;my$sub=$self->can("manify_${type}_pods");$self->$sub(%extra_manify_args)if defined($sub)}}sub manify_bin_pods {my$self=shift;my%podman_args=(section=>1,@_);my$files=$self->_find_pods($self->{properties}{bindoc_dirs},exclude=>[$self->file_qr('\.bat$')]);return unless keys %$files;my$mandir=File::Spec->catdir($self->blib,'bindoc');File::Path::mkpath($mandir,0,oct(777));require Pod::Man;for my$file (sort keys %$files){my$parser=Pod::Man->new(%podman_args);my$manpage=$self->man1page_name($file).'.' .$self->config('man1ext');my$outfile=File::Spec->catfile($mandir,$manpage);next if$self->up_to_date($file,$outfile);$self->log_verbose("Manifying $file -> $outfile\n");eval {$parser->parse_from_file($file,$outfile);1}or $self->log_warn("Error creating '$outfile': $@\n");$files->{$file}=$outfile}}sub manify_lib_pods {my$self=shift;my%podman_args=(section=>3,@_);my$files=$self->_find_pods($self->{properties}{libdoc_dirs});return unless keys %$files;my$mandir=File::Spec->catdir($self->blib,'libdoc');File::Path::mkpath($mandir,0,oct(777));require Pod::Man;for my$file (sort keys %$files){my$parser=Pod::Man->new(%podman_args);my$manpage=$self->man3page_name($files->{$file}).'.' .$self->config('man3ext');my$outfile=File::Spec->catfile($mandir,$manpage);next if$self->up_to_date($file,$outfile);$self->log_verbose("Manifying $file -> $outfile\n");eval {$parser->parse_from_file($file,$outfile);1}or $self->log_warn("Error creating '$outfile': $@\n");$files->{$file}=$outfile}}sub _find_pods {my ($self,$dirs,%args)=@_;my%files;for my$spec (@$dirs){my$dir=$self->localize_dir_path($spec);next unless -e $dir;FILE: foreach my$file (@{$self->rscan_dir($dir)}){for my$regexp (@{$args{exclude}}){next FILE if$file =~ $regexp}$file=$self->localize_file_path($file);$files{$file}=File::Spec->abs2rel($file,$dir)if$self->contains_pod($file)}}return \%files}sub contains_pod {my ($self,$file)=@_;return '' unless -T $file;open(my$fh,'<',$file)or die "Can't open $file: $!";while (my$line=<$fh>){return 1 if$line =~ /^\=(?:head|pod|item)/}return ''}sub ACTION_html {my$self=shift;return unless$self->_mb_feature('HTML_support');$self->depends_on('code');for my$type (qw(bin lib)){next unless ($self->invoked_action eq 'html' || $self->_is_default_installable("${type}html"));$self->htmlify_pods($type)}}sub htmlify_pods {my$self=shift;my$type=shift;my$htmldir=shift || File::Spec->catdir($self->blib,"${type}html");$self->add_to_cleanup('pod2htm*');my$pods=$self->_find_pods($self->{properties}{"${type}doc_dirs"},exclude=>[$self->file_qr('\.(?:bat|com|html)$')]);return unless %$pods;unless (-d $htmldir){File::Path::mkpath($htmldir,0,oct(755))or die "Couldn't mkdir $htmldir: $!"}my@rootdirs=($type eq 'bin')? qw(bin) : $self->installdirs eq 'core' ? qw(lib) : qw(site lib);my$podroot=$ENV{PERL_CORE}? File::Basename::dirname($ENV{PERL_CORE}): $self->original_prefix('core');my$htmlroot=$self->install_sets('core')->{libhtml};my$podpath;unless (defined$self->args('html_links')and!$self->args('html_links')){my@podpath=((map {File::Spec->abs2rel($_,$podroot)}grep {-d}($self->install_sets('core','lib'),$self->install_sets('core','bin'),$self->install_sets('site','lib'),)),File::Spec->rel2abs($self->blib));$podpath=$ENV{PERL_CORE}? File::Spec->catdir($podroot,'lib'): join(":",map {tr,:\\,|/,;$_}@podpath)}my$blibdir=join('/',File::Spec->splitdir((File::Spec->splitpath(File::Spec->rel2abs($htmldir),1))[1]),'');my ($with_ActiveState,$htmltool);if ($with_ActiveState=$self->_is_ActivePerl && eval {require ActivePerl::DocTools::Pod;1}){my$tool_v=ActiveState::DocTools::Pod->VERSION;$htmltool="ActiveState::DocTools::Pod";$htmltool .= " $tool_v" if$tool_v && length$tool_v}else {require Module::Build::PodParser;require Pod::Html;$htmltool="Pod::Html " .Pod::Html->VERSION}$self->log_verbose("Converting Pod to HTML with $htmltool\n");my$errors=0;POD: foreach my$pod (sort keys %$pods){my ($name,$path)=File::Basename::fileparse($pods->{$pod},$self->file_qr('\.(?:pm|plx?|pod)$'));my@dirs=File::Spec->splitdir(File::Spec->canonpath($path));pop(@dirs)if scalar(@dirs)&& $dirs[-1]eq File::Spec->curdir;my$fulldir=File::Spec->catdir($htmldir,@rootdirs,@dirs);my$tmpfile=File::Spec->catfile($fulldir,"${name}.tmp");my$outfile=File::Spec->catfile($fulldir,"${name}.html");my$infile=File::Spec->abs2rel($pod);next if$self->up_to_date($infile,$outfile);unless (-d $fulldir){File::Path::mkpath($fulldir,0,oct(755))or die "Couldn't mkdir $fulldir: $!"}$self->log_verbose("HTMLifying $infile -> $outfile\n");if ($with_ActiveState){my$depth=@rootdirs + @dirs;my%opts=(infile=>$infile,outfile=>$tmpfile,(defined($podpath)? (podpath=>$podpath): ()),podroot=>$podroot,index=>1,depth=>$depth,);eval {ActivePerl::DocTools::Pod::pod2html(map {($_,$opts{$_})}sort keys%opts);1}or $self->log_warn("[$htmltool] pod2html (" .join(", ",map {"q{$_} => q{$opts{$_}}"}(sort keys%opts)).") failed: $@")}else {my$path2root=File::Spec->catdir((File::Spec->updir)x @dirs);open(my$fh,'<',$infile)or die "Can't read $infile: $!";my$abstract=Module::Build::PodParser->new(fh=>$fh)->get_abstract();my$title=join('::',(@dirs,$name));$title .= " - $abstract" if$abstract;my@opts=("--title=$title",(defined($podpath)? "--podpath=$podpath" : ()),"--infile=$infile","--outfile=$tmpfile","--podroot=$podroot",($path2root ? "--htmlroot=$path2root" : ()),);unless (eval{Pod::Html->VERSION(1.12)}){push(@opts,('--flush'))}if (eval{Pod::Html->VERSION(1.12)}){push(@opts,('--header','--backlink'))}elsif (eval{Pod::Html->VERSION(1.03)}){push(@opts,('--header','--backlink=Back to Top'))}$self->log_verbose("P::H::pod2html @opts\n");{my$orig=Cwd::getcwd();eval {Pod::Html::pod2html(@opts);1}or $self->log_warn("[$htmltool] pod2html( " .join(", ",map {"q{$_}"}@opts).") failed: $@");chdir($orig)}}if (!-r $tmpfile){$errors++;next POD}open(my$fh,'<',$tmpfile)or die "Can't read $tmpfile: $!";my$html=join('',<$fh>);close$fh;if (!$self->_is_ActivePerl){$html =~ s#^##im;$html =~ s###i;$html =~ s##\n#i}$html =~ s/\Q$blibdir\E//g;open($fh,'>',$outfile)or die "Can't write $outfile: $!";print$fh $html;close$fh;unlink($tmpfile)}return!$errors}sub man1page_name {my$self=shift;return File::Basename::basename(shift)}sub man3page_name {my$self=shift;my ($vol,$dirs,$file)=File::Spec->splitpath(shift);my@dirs=File::Spec->splitdir(File::Spec->canonpath($dirs));$file =~ s/\.p(?:od|m|l)\z//i;return join($self->manpage_separator,@dirs,$file)}sub manpage_separator {return '::'}sub ACTION_diff {my$self=shift;$self->depends_on('build');my$local_lib=File::Spec->rel2abs('lib');my@myINC=grep {$_ ne $local_lib}@INC;push@myINC,map$self->install_destination($_),qw(lib arch);my@flags=@{$self->{args}{ARGV}};@flags=$self->split_like_shell($self->{args}{flags}|| '')unless@flags;my$installmap=$self->install_map;delete$installmap->{read};delete$installmap->{write};my$text_suffix=$self->file_qr('\.(pm|pod)$');for my$localdir (sort keys %$installmap){my@localparts=File::Spec->splitdir($localdir);my$files=$self->rscan_dir($localdir,sub {-f});for my$file (@$files){my@parts=File::Spec->splitdir($file);@parts=@parts[@localparts .. $#parts];my$installed=Module::Metadata->find_module_by_name(join('::',@parts),\@myINC);if (not $installed){print "Only in lib: $file\n";next}my$status=File::Compare::compare($installed,$file);next if$status==0;die "Can't compare $installed and $file: $!" if$status==-1;if ($file =~ $text_suffix){$self->do_system('diff',@flags,$installed,$file)}else {print "Binary files $file and $installed differ\n"}}}}sub ACTION_pure_install {shift()->depends_on('install')}sub ACTION_install {my ($self)=@_;require ExtUtils::Install;$self->depends_on('build');$self->_do_in_dir(".",sub {ExtUtils::Install::install($self->install_map,$self->verbose,0,$self->{args}{uninst}||0)});if ($self->_is_ActivePerl && $self->{_completed_actions}{html}){$self->log_info("Building ActivePerl Table of Contents\n");eval {ActivePerl::DocTools::WriteTOC(verbose=>$self->verbose ? 1 : 0);1}or $self->log_warn("AP::DT:: WriteTOC() failed: $@")}if ($self->_is_ActivePPM){my$F_perllocal=File::Spec->catfile($self->install_sets('core','lib'),'perllocal.pod');my$dt_stamp=time;$self->log_info("For ActivePerl's PPM: touch '$F_perllocal'\n");open my$perllocal,">>",$F_perllocal;close$perllocal;utime($dt_stamp,$dt_stamp,$F_perllocal)}}sub ACTION_fakeinstall {my ($self)=@_;require ExtUtils::Install;my$eui_version=ExtUtils::Install->VERSION;if ($eui_version < 1.32){$self->log_warn("The 'fakeinstall' action requires Extutils::Install 1.32 or later.\n" ."(You only have version $eui_version).");return}$self->depends_on('build');ExtUtils::Install::install($self->install_map,!$self->quiet,1,$self->{args}{uninst}||0)}sub ACTION_versioninstall {my ($self)=@_;die "You must have only.pm 0.25 or greater installed for this operation: $@\n" unless eval {require only;'only'->VERSION(0.25);1};$self->depends_on('build');my%onlyargs=map {exists($self->{args}{$_})? ($_=>$self->{args}{$_}): ()}qw(version versionlib);only::install::install(%onlyargs)}sub ACTION_installdeps {my ($self)=@_;my$info=$self->_enum_prereqs;if (!$info){$self->log_info("No prerequisites detected\n");return}my$failures=$self->prereq_failures($info);if (!$failures){$self->log_info("All prerequisites satisfied\n");return}my@install;for my$type (sort keys %$failures){my$prereqs=$failures->{$type};if($type =~ m/^(?:\w+_)?requires$/){push(@install,sort keys %$prereqs);next}$self->log_info("Checking optional dependencies:\n");for my$module (sort keys %$prereqs){push(@install,$module)if($self->y_n("Install $module?",'y'))}}return unless@install;my ($command,@opts)=$self->split_like_shell($self->cpan_client);if (!File::Spec->file_name_is_absolute($command)){my@loc=('site','vendor','');my@bindirs=File::Basename::dirname($self->perl);push@bindirs,map {($self->config->{"install${_}bin"},$self->config->{"install${_}script"})}@loc;for my$d (@bindirs){my$abs_cmd=$self->find_command(File::Spec->catfile($d,$command));if (defined$abs_cmd){$command=$abs_cmd;last}}}$self->do_system($command,@opts,@install)}sub ACTION_clean {my ($self)=@_;$self->log_info("Cleaning up build files\n");for my$item (map glob($_),$self->cleanup){$self->delete_filetree($item)}}sub ACTION_realclean {my ($self)=@_;$self->depends_on('clean');$self->log_info("Cleaning up configuration files\n");$self->delete_filetree($self->config_dir,$self->mymetafile,$self->mymetafile2,$self->build_script)}sub ACTION_ppd {my ($self)=@_;require Module::Build::PPMMaker;my$ppd=Module::Build::PPMMaker->new();my$file=$ppd->make_ppd(%{$self->{args}},build=>$self);$self->add_to_cleanup($file)}sub ACTION_ppmdist {my ($self)=@_;$self->depends_on('build');my$ppm=$self->ppm_name;$self->delete_filetree($ppm);$self->log_info("Creating $ppm\n");$self->add_to_cleanup($ppm,"$ppm.tar.gz");my%types=(lib=>'lib',arch=>'arch',bin=>'bin',script=>'script',bindoc=>'man1',libdoc=>'man3',binhtml=>undef,libhtml=>undef,);for my$type ($self->install_types){next if exists($types{$type})&&!defined($types{$type});my$dir=File::Spec->catdir($self->blib,$type);next unless -e $dir;my$files=$self->rscan_dir($dir);for my$file (@$files){next unless -f $file;my$rel_file=File::Spec->abs2rel(File::Spec->rel2abs($file),File::Spec->rel2abs($dir));my$to_file=File::Spec->catfile($ppm,'blib',exists($types{$type})? $types{$type}: $type,$rel_file);$self->copy_if_modified(from=>$file,to=>$to_file)}}for my$type (qw(bin lib)){$self->htmlify_pods($type,File::Spec->catdir($ppm,'blib','html'))}my$target=File::Spec->catfile(File::Spec->updir,$ppm);$self->_do_in_dir($ppm,sub {$self->make_tarball('blib',$target)});$self->depends_on('ppd');$self->delete_filetree($ppm)}sub ACTION_pardist {my ($self)=@_;if (not eval {require PAR::Dist;PAR::Dist->VERSION(0.17)}){$self->log_warn("In order to create .par distributions, you need to\n" ."install PAR::Dist first.");return()}$self->depends_on('build');return PAR::Dist::blib_to_par(name=>$self->dist_name,version=>$self->dist_version,)}sub ACTION_dist {my ($self)=@_;$self->dispatch('distdir');my$dist_dir=$self->dist_dir;$self->make_tarball($dist_dir);$self->delete_filetree($dist_dir)}sub ACTION_distcheck {my ($self)=@_;$self->_check_manifest_skip unless$self->invoked_action eq 'distclean';require ExtUtils::Manifest;local $^W;my ($missing,$extra)=ExtUtils::Manifest::fullcheck();return unless @$missing || @$extra;my$msg="MANIFEST appears to be out of sync with the distribution\n";if ($self->invoked_action eq 'distcheck'){die$msg}else {warn$msg}}sub _check_mymeta_skip {my$self=shift;my$maniskip=shift || 'MANIFEST.SKIP';require ExtUtils::Manifest;local $^W;my$skip_factory=ExtUtils::Manifest->can('maniskip')|| ExtUtils::Manifest->can('_maniskip');my$mymetafile=$self->mymetafile;for my$file ($self->mymetafile,$self->mymetafile2){unless ($skip_factory && $skip_factory->($maniskip)->($file)){$self->log_warn("File '$maniskip' does not include '$file'. Adding it now.\n");my$safe=quotemeta($file);$self->_append_maniskip("^$safe\$",$maniskip)}}}sub _add_to_manifest {my ($self,$manifest,$lines)=@_;$lines=[$lines]unless ref$lines;my$existing_files=$self->_read_manifest($manifest);return unless defined($existing_files);@$lines=grep {!exists$existing_files->{$_}}@$lines or return;my$mode=(stat$manifest)[2];chmod($mode | oct(222),$manifest)or die "Can't make $manifest writable: $!";open(my$fh,'<',$manifest)or die "Can't read $manifest: $!";my$last_line=(<$fh>)[-1]|| "\n";my$has_newline=$last_line =~ /\n$/;close$fh;open($fh,'>>',$manifest)or die "Can't write to $manifest: $!";print$fh "\n" unless$has_newline;print$fh map "$_\n",@$lines;close$fh;chmod($mode,$manifest);$self->log_verbose(map "Added to $manifest: $_\n",@$lines)}sub _sign_dir {my ($self,$dir)=@_;unless (eval {require Module::Signature;1}){$self->log_warn("Couldn't load Module::Signature for 'distsign' action:\n $@\n");return}{my$manifest=File::Spec->catfile($dir,'MANIFEST');die "Signing a distribution requires a MANIFEST file" unless -e $manifest;$self->_add_to_manifest($manifest,"SIGNATURE Added here by Module::Build")}$self->_do_in_dir($dir,sub {local$Module::Signature::Quiet=1;Module::Signature::sign()})}sub _do_in_dir {my ($self,$dir,$do)=@_;my$start_dir=File::Spec->rel2abs($self->cwd);chdir$dir or die "Can't chdir() to $dir: $!";eval {$do->()};my@err=$@ ? ($@): ();chdir$start_dir or push@err,"Can't chdir() back to $start_dir: $!";die join "\n",@err if@err}sub ACTION_distsign {my ($self)=@_;{local$self->{properties}{sign}=0;$self->depends_on('distdir')unless -d $self->dist_dir}$self->_sign_dir($self->dist_dir)}sub ACTION_skipcheck {my ($self)=@_;require ExtUtils::Manifest;local $^W;ExtUtils::Manifest::skipcheck()}sub ACTION_distclean {my ($self)=@_;$self->depends_on('realclean');$self->depends_on('distcheck')}sub do_create_makefile_pl {my$self=shift;require Module::Build::Compat;$self->log_info("Creating Makefile.PL\n");eval {Module::Build::Compat->create_makefile_pl($self->create_makefile_pl,$self,@_)};if ($@){1 while unlink 'Makefile.PL';die "$@\n"}$self->_add_to_manifest('MANIFEST','Makefile.PL')}sub do_create_license {my$self=shift;$self->log_info("Creating LICENSE file\n");if (!$self->_mb_feature('license_creation')){$self->_warn_mb_feature_deps('license_creation');die "Aborting.\n"}my$l=$self->license or die "Can't create LICENSE file: No license specified\n";my$license=$self->_software_license_object or die << "HERE";$self->delete_filetree('LICENSE');open(my$fh,'>','LICENSE')or die "Can't write LICENSE file: $!";print$fh $license->fulltext;close$fh;$self->_add_to_manifest('MANIFEST','LICENSE')}sub do_create_readme {my$self=shift;$self->delete_filetree('README');my$docfile=$self->_main_docfile;unless ($docfile){$self->log_warn(<can('new')}){$self->log_info("Creating README using Pod::Readme\n");my$parser=Pod::Readme->new;$parser->parse_from_file($docfile,'README',@_)}elsif (eval {require Pod::Text;1}){$self->log_info("Creating README using Pod::Text\n");if (open(my$fh,'>','README')){local $^W=0;no strict "refs";my$old_parse_file;$old_parse_file=\&{"Pod::Simple::parse_file"}and local *{"Pod::Simple::parse_file"}=sub {my$self=shift;$self->output_fh($_[1])if $_[1];$self->$old_parse_file($_[0])}if$Pod::Text::VERSION ==3.01;Pod::Text::pod2text($docfile,$fh);close$fh}else {$self->log_warn("Cannot create 'README' file: Can't open file for writing\n");return}}else {$self->log_warn("Can't load Pod::Readme or Pod::Text to create README\n");return}$self->_add_to_manifest('MANIFEST','README')}sub _main_docfile {my$self=shift;if (my$pm_file=$self->dist_version_from){(my$pod_file=$pm_file)=~ s/.pm$/.pod/;return (-e $pod_file ? $pod_file : $pm_file)}else {return undef}}sub do_create_bundle_inc {my$self=shift;my$dist_inc=File::Spec->catdir($self->dist_dir,'inc');require inc::latest;inc::latest->write($dist_inc,@{$self->bundle_inc_preload});inc::latest->bundle_module($_,$dist_inc)for @{$self->bundle_inc};return 1}sub ACTION_distdir {my ($self)=@_;if (@{$self->bundle_inc}&&!$self->_mb_feature('inc_bundling_support')){$self->_warn_mb_feature_deps('inc_bundling_support');die "Aborting.\n"}$self->depends_on('distmeta');my$dist_files=$self->_read_manifest('MANIFEST')or die "Can't create distdir without a MANIFEST file - run 'manifest' action first.\n";delete$dist_files->{SIGNATURE};die "No files found in MANIFEST - try running 'manifest' action?\n" unless ($dist_files and keys %$dist_files);my$metafile=$self->metafile;$self->log_warn("*** Did you forget to add $metafile to the MANIFEST?\n")unless exists$dist_files->{$metafile};my$dist_dir=$self->dist_dir;$self->delete_filetree($dist_dir);$self->log_info("Creating $dist_dir\n");$self->add_to_cleanup($dist_dir);for my$file (sort keys %$dist_files){next if$file =~ m{^MYMETA\.};my$new=$self->copy_if_modified(from=>$file,to_dir=>$dist_dir,verbose=>0)}$self->do_create_bundle_inc if @{$self->bundle_inc};$self->_sign_dir($dist_dir)if$self->{properties}{sign}}sub ACTION_disttest {my ($self)=@_;$self->depends_on('distdir');$self->_do_in_dir ($self->dist_dir,sub {local$ENV{AUTHOR_TESTING}=1;local$ENV{RELEASE_TESTING}=1;$self->run_perl_script('Build.PL')or die "Error executing 'Build.PL' in dist directory: $!";$self->run_perl_script($self->build_script)or die "Error executing $self->build_script in dist directory: $!";$self->run_perl_script($self->build_script,[],['test'])or die "Error executing 'Build test' in dist directory"})}sub ACTION_distinstall {my ($self,@args)=@_;$self->depends_on('distdir');$self->_do_in_dir ($self->dist_dir,sub {$self->run_perl_script('Build.PL')or die "Error executing 'Build.PL' in dist directory: $!";$self->run_perl_script($self->build_script)or die "Error executing $self->build_script in dist directory: $!";$self->run_perl_script($self->build_script,[],['install'])or die "Error executing 'Build install' in dist directory"})}sub _eumanifest_has_include {my$self=shift;require ExtUtils::Manifest;return eval {ExtUtils::Manifest->VERSION(1.50);1}}sub _default_maniskip {my$self=shift;my$default_maniskip;for my$dir (@INC){$default_maniskip=File::Spec->catfile($dir,"ExtUtils","MANIFEST.SKIP");last if -r $default_maniskip}return$default_maniskip}sub _slurp {my$self=shift;my$file=shift;my$mode=shift || "";open my$fh,"<$mode",$file or croak "Can't open $file for reading: $!";local $/;return <$fh>}sub _spew {my$self=shift;my$file=shift;my$content=shift || "";my$mode=shift || "";open my$fh,">$mode",$file or croak "Can't open $file for writing: $!";print {$fh}$content;close$fh}sub _case_tolerant {my$self=shift;if (ref$self){$self->{_case_tolerant}=File::Spec->case_tolerant unless defined($self->{_case_tolerant});return$self->{_case_tolerant}}else {return File::Spec->case_tolerant}}sub _append_maniskip {my$self=shift;my$skip=shift;my$file=shift || 'MANIFEST.SKIP';return unless defined$skip && length$skip;open(my$fh,'>>',$file)or die "Can't open $file: $!";print$fh "$skip\n";close$fh}sub _write_default_maniskip {my$self=shift;my$file=shift || 'MANIFEST.SKIP';open(my$fh,'>',$file)or die "Can't open $file: $!";my$content=$self->_eumanifest_has_include ? "#!include_default\n" : $self->_slurp($self->_default_maniskip);$content .= <<'EOF';$content .= '\b'.$self->dist_name.'-[\d\.\_]+'."\n";print$fh $content;close$fh;return}sub _check_manifest_skip {my ($self)=@_;my$maniskip='MANIFEST.SKIP';if (!-e $maniskip){$self->log_warn("File '$maniskip' does not exist: Creating a temporary '$maniskip'\n");$self->_write_default_maniskip($maniskip);$self->_unlink_on_exit($maniskip)}else {$self->_check_mymeta_skip($maniskip)}return}sub ACTION_manifest {my ($self)=@_;$self->_check_manifest_skip;require ExtUtils::Manifest;local ($^W,$ExtUtils::Manifest::Quiet)=(0,1);ExtUtils::Manifest::mkmanifest()}sub ACTION_manifest_skip {my ($self)=@_;if (-e 'MANIFEST.SKIP'){$self->log_warn("MANIFEST.SKIP already exists.\n");return 0}$self->log_info("Creating a new MANIFEST.SKIP file\n");return$self->_write_default_maniskip;return -e 'MANIFEST.SKIP'}sub file_qr {return shift->{_case_tolerant}? qr($_[0])i : qr($_[0])}sub dist_dir {my ($self)=@_;my$dir=join "-",$self->dist_name,$self->dist_version;$dir .= "-" .$self->dist_suffix if$self->dist_suffix;return$dir}sub ppm_name {my$self=shift;return 'PPM-' .$self->dist_dir}sub _files_in {my ($self,$dir)=@_;return unless -d $dir;local*DH;opendir DH,$dir or die "Can't read directory $dir: $!";my@files;while (defined (my$file=readdir DH)){my$full_path=File::Spec->catfile($dir,$file);next if -d $full_path;push@files,$full_path}return@files}sub share_dir {my$self=shift;my$p=$self->{properties};$p->{share_dir}=shift if @_;if (!defined$p->{share_dir}){return}elsif (!ref$p->{share_dir}){$p->{share_dir}={dist=>[$p->{share_dir}]}}elsif (ref$p->{share_dir}eq 'ARRAY'){$p->{share_dir}={dist=>$p->{share_dir}}}elsif (ref$p->{share_dir}eq 'HASH'){my$share_dir=$p->{share_dir};if (defined$share_dir->{dist}){if (!ref$share_dir->{dist}){$share_dir->{dist}=[$share_dir->{dist}]}elsif (ref$share_dir->{dist}ne 'ARRAY'){die "'dist' key in 'share_dir' must be scalar or arrayref"}}if (defined$share_dir->{module}){my$mod_hash=$share_dir->{module};if (ref$mod_hash eq 'HASH'){for my$k (sort keys %$mod_hash){if (!ref$mod_hash->{$k}){$mod_hash->{$k}=[$mod_hash->{$k}]}elsif(ref$mod_hash->{$k}ne 'ARRAY'){die "modules in 'module' key of 'share_dir' must be scalar or arrayref"}}}else {die "'module' key in 'share_dir' must be hashref"}}}else {die "'share_dir' must be hashref, arrayref or string"}return$p->{share_dir}}sub script_files {my$self=shift;for ($self->{properties}{script_files}){$_=shift if @_;next unless $_;return $_ if ref $_ eq 'HASH';return $_={map {$_,1}@$_ }if ref $_ eq 'ARRAY';die "'script_files' must be a hashref, arrayref, or string" if ref();return $_={map {$_,1}$self->_files_in($_)}if -d $_;return $_={$_=>1}}my%pl_files=map {File::Spec->canonpath($_)=>1}keys %{$self->PL_files || {}};my@bin_files=$self->_files_in('bin');my%bin_map=map {$_=>File::Spec->canonpath($_)}@bin_files;return $_={map {$_=>1}grep!$pl_files{$bin_map{$_}},@bin_files }}BEGIN {*scripts=\&script_files}{my%licenses=(perl=>'Perl_5',apache=>'Apache_2_0',apache_1_1=>'Apache_1_1',artistic=>'Artistic_1',artistic_2=>'Artistic_2',lgpl=>'LGPL_2_1',lgpl2=>'LGPL_2_1',lgpl3=>'LGPL_3_0',bsd=>'BSD',gpl=>'GPL_1',gpl2=>'GPL_2',gpl3=>'GPL_3',mit=>'MIT',mozilla=>'Mozilla_1_1',restrictive=>'Restricted',open_source=>undef,unrestricted=>undef,unknown=>undef,);my%license_urls=(perl=>'http://dev.perl.org/licenses/',apache=>'http://apache.org/licenses/LICENSE-2.0',apache_1_1=>'http://apache.org/licenses/LICENSE-1.1',artistic=>'http://opensource.org/licenses/artistic-license.php',artistic_2=>'http://opensource.org/licenses/artistic-license-2.0.php',lgpl=>'http://opensource.org/licenses/lgpl-license.php',lgpl2=>'http://opensource.org/licenses/lgpl-2.1.php',lgpl3=>'http://opensource.org/licenses/lgpl-3.0.html',bsd=>'http://opensource.org/licenses/bsd-license.php',gpl=>'http://opensource.org/licenses/gpl-license.php',gpl2=>'http://opensource.org/licenses/gpl-2.0.php',gpl3=>'http://opensource.org/licenses/gpl-3.0.html',mit=>'http://opensource.org/licenses/mit-license.php',mozilla=>'http://opensource.org/licenses/mozilla1.1.php',restrictive=>undef,open_source=>undef,unrestricted=>undef,unknown=>undef,);sub valid_licenses {return \%licenses}sub _license_url {return$license_urls{$_[1]}}}sub _software_license_class {my ($self,$license)=@_;if ($self->valid_licenses->{$license}&& eval {require Software::LicenseUtils;Software::LicenseUtils->VERSION(0.103009)}){my@classes=Software::LicenseUtils->guess_license_from_meta_key($license,1);if (@classes==1){eval "require $classes[0]";return$classes[0]}}LICENSE: for my$l ($self->valid_licenses->{$license },$license){next unless defined$l;my$trial="Software::License::" .$l;if (eval "require Software::License; Software::License->VERSION(0.014); require $trial; 1"){return$trial}}return}sub _software_license_object {my ($self)=@_;return unless defined(my$license=$self->license);my$class=$self->_software_license_class($license)or return;my$author=join(" & ",@{$self->dist_author})|| 'unknown';my$sl=eval {$class->new({holder=>$author})};if ($@){$self->log_warn("Error getting '$class' object: $@")}return$sl}sub _hash_merge {my ($self,$h,$k,$v)=@_;if (ref$h->{$k}eq 'ARRAY'){push @{$h->{$k}},ref$v ? @$v : $v}elsif (ref$h->{$k}eq 'HASH'){$h->{$k}{$_}=$v->{$_}foreach keys %$v}else {$h->{$k}=$v}}sub ACTION_distmeta {my ($self)=@_;$self->do_create_makefile_pl if$self->create_makefile_pl;$self->do_create_readme if$self->create_readme;$self->do_create_license if$self->create_license;$self->do_create_metafile}sub do_create_metafile {my$self=shift;return if$self->{wrote_metadata};my$p=$self->{properties};unless ($p->{license}){$self->log_warn("No license specified, setting license = 'unknown'\n");$p->{license}='unknown'}my@metafiles=($self->metafile,$self->metafile2);$self->delete_filetree($_)for@metafiles;local@INC=@INC;if (($self->module_name || '')eq 'Module::Build'){$self->depends_on('config_data');push@INC,File::Spec->catdir($self->blib,'lib')}my$meta_obj=$self->_get_meta_object(quiet=>1,fatal=>1,auto=>1);my@created=$self->_write_meta_files($meta_obj,'META');if (@created){$self->{wrote_metadata}=1;$self->_add_to_manifest('MANIFEST',$_)for@created}return 1}sub _write_meta_files {my$self=shift;my ($meta,$file)=@_;$file =~ s{\.(?:yml|json)$}{};my@created;push@created,"$file\.yml" if$meta && $meta->save("$file\.yml",{version=>"1.4"});push@created,"$file\.json" if$meta && $meta->save("$file\.json");if (@created){$self->log_info("Created " .join(" and ",@created)."\n")}return@created}sub _get_meta_object {my$self=shift;my%args=@_;return unless$self->try_require("CPAN::Meta","2.142060");my$meta;eval {my$data=$self->get_metadata(fatal=>$args{fatal},auto=>$args{auto},);$data->{dynamic_config}=$args{dynamic}if defined$args{dynamic};$meta=CPAN::Meta->create($data)};if ($@ &&!$args{quiet}){$self->log_warn("Could not get valid metadata. Error is: $@\n")}return$meta}sub read_metafile {my$self=shift;my ($metafile)=@_;return unless$self->try_require("CPAN::Meta","2.110420");my$meta=CPAN::Meta->load_file($metafile);return$meta->as_struct({version=>"2.0"})}sub normalize_version {my ($self,$version)=@_;$version=0 unless defined$version and length$version;if ($version =~ /[=<>!,]/){}elsif (ref$version eq 'version'){$version=$version->is_qv ? $version->normal : $version->stringify}elsif ($version =~ /^[^v][^.]*\.[^.]+\./){$version="v$version"}else {}return$version}my%prereq_map=(requires=>[qw/runtime requires/],configure_requires=>[qw/configure requires/],build_requires=>[qw/build requires/ ],test_requires=>[qw/test requires/ ],test_recommends=>[qw/test recommends/ ],recommends=>[qw/runtime recommends/ ],conflicts=>[qw/runtime conflicts/ ],);sub _normalize_prereqs {my ($self)=@_;my$p=$self->{properties};my%prereq_types;for my$type ('configure_requires',@{$self->prereq_action_types}){if (exists$p->{$type}and keys %{$p->{$type}}){my ($phase,$relation)=@{$prereq_map{$type}};for my$mod (keys %{$p->{$type}}){$prereq_types{$phase}{$relation}{$mod}=$self->normalize_version($p->{$type}{$mod})}}}return \%prereq_types}sub _get_license {my$self=shift;my$license=$self->license;my ($meta_license,$meta_license_url);my$valid_licenses=$self->valid_licenses();if (my$sl=$self->_software_license_object){$meta_license=$sl->meta2_name;$meta_license_url=$sl->url}elsif (exists$valid_licenses->{$license}){$meta_license=$valid_licenses->{$license}? lc$valid_licenses->{$license}: $license;$meta_license_url=$self->_license_url($license)}else {$self->log_warn("Can not determine license type for '" .$self->license ."'\nSetting META license field to 'unknown'.\n");$meta_license='unknown'}return ($meta_license,$meta_license_url)}sub get_metadata {my ($self,%args)=@_;my$fatal=$args{fatal}|| 0;my$p=$self->{properties};$self->auto_config_requires if$args{auto};for my$f (qw(dist_name dist_version dist_author dist_abstract license)){my$field=$self->$f();unless (defined$field and length$field){my$err="ERROR: Missing required field '$f' for metafile\n";if ($fatal){die$err}else {$self->log_warn($err)}}}my%metadata=(name=>$self->dist_name,version=>$self->normalize_version($self->dist_version),author=>$self->dist_author,abstract=>$self->dist_abstract,generated_by=>"Module::Build version $Module::Build::VERSION",'meta-spec'=>{version=>'2',url=>'http://search.cpan.org/perldoc?CPAN::Meta::Spec',},dynamic_config=>exists$p->{dynamic_config}? $p->{dynamic_config}: 1,release_status=>$self->release_status,);my ($meta_license,$meta_license_url)=$self->_get_license;$metadata{license}=[$meta_license ];$metadata{resources}{license}=[$meta_license_url ]if defined$meta_license_url;$metadata{prereqs}=$self->_normalize_prereqs;if (exists$p->{no_index}){$metadata{no_index}=$p->{no_index}}elsif (my$pkgs=eval {$self->find_dist_packages}){$metadata{provides}=$pkgs if %$pkgs}else {$self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" ."Nothing to enter for 'provides' field in metafile.\n")}if (my$add=$self->meta_add){if (not exists$add->{'meta-spec'}or $add->{'meta-spec'}{version}!=2){require CPAN::Meta::Converter;if (CPAN::Meta::Converter->VERSION('2.141170')){$add=CPAN::Meta::Converter->new($add)->upgrade_fragment;delete$add->{prereqs}}else {$self->log_warn("Can't meta_add without CPAN::Meta 2.141170")}}while (my($k,$v)=each %{$add}){$metadata{$k}=$v}}if (my$merge=$self->meta_merge){if (eval {require CPAN::Meta::Merge}){%metadata=%{CPAN::Meta::Merge->new(default_version=>'1.4')->merge(\%metadata,$merge)}}else {$self->log_warn("Can't merge without CPAN::Meta::Merge")}}return \%metadata}sub prepare_metadata {my ($self,$node,$keys,$args)=@_;unless (ref$node eq 'HASH'){croak "prepare_metadata() requires a hashref argument to hold output\n"}croak 'Keys argument to prepare_metadata is no longer supported' if$keys;%{$node}=%{$self->get_meta(%{$args})};return$node}sub _read_manifest {my ($self,$file)=@_;return undef unless -e $file;require ExtUtils::Manifest;local ($^W,$ExtUtils::Manifest::Quiet)=(0,1);return scalar ExtUtils::Manifest::maniread($file)}sub find_dist_packages {my$self=shift;my$manifest=$self->_read_manifest('MANIFEST')or die "Can't find dist packages without a MANIFEST file\nRun 'Build manifest' to generate one\n";my%dist_files=map {$self->localize_file_path($_)=>$_}keys %$manifest;my@pm_files=sort grep {$_ !~ m{^t}}grep {exists$dist_files{$_}}keys %{$self->find_pm_files};return$self->find_packages_in_files(\@pm_files,\%dist_files)}sub find_packages_in_files {my ($self,$file_list,$filename_map)=@_;my(%prime,%alt);for my$file (@{$file_list}){my$mapped_filename=$filename_map->{$file};my@path=split(/\//,$mapped_filename);(my$prime_package=join('::',@path[1..$#path]))=~ s/\.pm$//;my$pm_info=Module::Metadata->new_from_file($file);for my$package ($pm_info->packages_inside){next if$package eq 'main';next if$package eq 'DB';next if grep /^_/,split(/::/,$package);my$version=$pm_info->version($package);if ($package eq $prime_package){if (exists($prime{$package})){die "Unexpected conflict in '$package'; multiple versions found.\n"}else {$prime{$package}{file}=$mapped_filename;$prime{$package}{version}=$version if defined($version)}}else {push(@{$alt{$package}},{file=>$mapped_filename,version=>$version,})}}}for my$package (sort keys(%alt)){my$result=$self->_resolve_module_versions($alt{$package});if (exists($prime{$package})){if ($result->{err}){$self->log_warn("Found conflicting versions for package '$package'\n" ." $prime{$package}{file} ($prime{$package}{version})\n" .$result->{err})}elsif (defined($result->{version})){if (exists($prime{$package}{version})&& defined($prime{$package}{version})){if ($self->compare_versions($prime{$package}{version},'!=',$result->{version})){$self->log_warn("Found conflicting versions for package '$package'\n" ." $prime{$package}{file} ($prime{$package}{version})\n" ." $result->{file} ($result->{version})\n")}}else {$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}}}else {}}else {if ($result->{err}){$self->log_warn("Found conflicting versions for package '$package'\n" .$result->{err})}$prime{$package}{file}=$result->{file};$prime{$package}{version}=$result->{version}if defined($result->{version})}}for my$provides (values%prime){if ($provides->{version}){$provides->{version}=$self->normalize_version($provides->{version})}else {delete$provides->{version}}}return \%prime}sub _resolve_module_versions {my$self=shift;my$packages=shift;my($file,$version);my$err='';for my$p (@$packages){if (defined($p->{version})){if (defined($version)){if ($self->compare_versions($version,'!=',$p->{version})){$err .= " $p->{file} ($p->{version})\n"}else {}}else {$file=$p->{file};$version=$p->{version}}}$file ||= $p->{file}if defined($p->{file})}if ($err){$err=" $file ($version)\n" .$err}my%result=(file=>$file,version=>$version,err=>$err);return \%result}sub make_tarball {my ($self,$dir,$file)=@_;$file ||= $dir;$self->log_info("Creating $file.tar.gz\n");if ($self->{args}{tar}){my$tar_flags=$self->verbose ? 'cvf' : 'cf';$self->do_system($self->split_like_shell($self->{args}{tar}),$tar_flags,"$file.tar",$dir);$self->do_system($self->split_like_shell($self->{args}{gzip}),"$file.tar")if$self->{args}{gzip}}else {eval {require Archive::Tar && Archive::Tar->VERSION(1.09);1}or die "You must install Archive::Tar 1.09+ to make a distribution tarball\n"."or specify a binary tar program with the '--tar' option.\n"."See the documentation for the 'dist' action.\n";my$files=$self->rscan_dir($dir);$Archive::Tar::DO_NOT_USE_PREFIX=(grep {length($_)>= 100}@$files)? 0 : 1;my$tar=Archive::Tar->new;$tar->add_files(@$files);for my$f ($tar->get_files){$f->mode($f->mode & ~022)}$tar->write("$file.tar.gz",1)}}sub install_path {my$self=shift;my($type,$value)=(@_,'');Carp::croak('Type argument missing')unless defined($type);my$map=$self->{properties}{install_path};return$map unless @_;unless (defined($value)){delete($map->{$type});return undef}if ($value eq ''){return undef unless exists$map->{$type};return$map->{$type}}return$map->{$type}=$value}sub install_sets {my ($self,$dirs,$key,$value)=@_;$dirs=$self->installdirs unless defined$dirs;if (@_==4 && defined$dirs && defined$key){$self->{properties}{install_sets}{$dirs}{$key}=$value}my$map={$self->_merge_arglist($self->{properties}{install_sets},$self->_default_install_paths->{install_sets})};if (defined$dirs && defined$key){return$map->{$dirs}{$key}}elsif (defined$dirs){return$map->{$dirs}}else {croak "Can't determine installdirs for install_sets()"}}sub original_prefix {my ($self,$key,$value)=@_;if (@_==3 && defined$key){$self->{properties}{original_prefix}{$key}=$value}my$map={$self->_merge_arglist($self->{properties}{original_prefix},$self->_default_install_paths->{original_prefix})};return$map unless defined$key;return$map->{$key}}sub install_base_relpaths {my$self=shift;if (@_ > 1){$self->_set_relpaths($self->{properties}{install_base_relpaths},@_)}my$map={$self->_merge_arglist($self->{properties}{install_base_relpaths},$self->_default_install_paths->{install_base_relpaths})};return$map unless @_;my$relpath=$map->{$_[0]};return defined$relpath ? File::Spec->catdir(@$relpath): undef}sub prefix_relpaths {my$self=shift;my$installdirs=shift || $self->installdirs or croak "Can't determine installdirs for prefix_relpaths()";if (@_ > 1){$self->{properties}{prefix_relpaths}{$installdirs}||= {};$self->_set_relpaths($self->{properties}{prefix_relpaths}{$installdirs},@_)}my$map={$self->_merge_arglist($self->{properties}{prefix_relpaths}{$installdirs},$self->_default_install_paths->{prefix_relpaths}{$installdirs})};return$map unless @_;my$relpath=$map->{$_[0]};return defined$relpath ? File::Spec->catdir(@$relpath): undef}sub _set_relpaths {my$self=shift;my($map,$type,$value)=@_;Carp::croak('Type argument missing')unless defined($type);if (!defined($value)){$map->{$type}=undef;return}else {Carp::croak("Value must be a relative path")if File::Spec::Unix->file_name_is_absolute($value);my@value=split(/\//,$value);$map->{$type}=\@value}}sub prefix_relative {my ($self,$type)=@_;my$installdirs=$self->installdirs;my$relpath=$self->install_sets($installdirs)->{$type};return$self->_prefixify($relpath,$self->original_prefix($installdirs),$type,)}sub _prefixify {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;$rprefix .= '/' if$sprefix =~ m|/$|;$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n")if defined($path)&& length($path);if(!defined($path)|| (length($path)==0)){$self->log_verbose(" no path to prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}elsif(!File::Spec->file_name_is_absolute($path)){$self->log_verbose(" path is relative, not prefixifying.\n")}elsif($path !~ s{^\Q$sprefix\E\b}{}s){$self->log_verbose(" cannot prefixify, falling back to default.\n");return$self->_prefixify_default($type,$rprefix)}$self->log_verbose(" now $path in $rprefix\n");return$path}sub _prefixify_default {my$self=shift;my$type=shift;my$rprefix=shift;my$default=$self->prefix_relpaths($self->installdirs,$type);if(!$default){$self->log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n");return$rprefix}else {return$default}}sub install_destination {my ($self,$type)=@_;return$self->install_path($type)if$self->install_path($type);if ($self->install_base){my$relpath=$self->install_base_relpaths($type);return$relpath ? File::Spec->catdir($self->install_base,$relpath): undef}if ($self->prefix){my$relpath=$self->prefix_relative($type);return$relpath ? File::Spec->catdir($self->prefix,$relpath): undef}return$self->install_sets($self->installdirs)->{$type}}sub install_types {my$self=shift;my%types;if ($self->install_base){%types=%{$self->install_base_relpaths}}elsif ($self->prefix){%types=%{$self->prefix_relpaths}}else {%types=%{$self->install_sets($self->installdirs)}}%types=(%types,%{$self->install_path});return sort keys%types}sub install_map {my ($self,$blib)=@_;$blib ||= $self->blib;my(%map,@skipping);for my$type ($self->install_types){my$localdir=File::Spec->catdir($blib,$type);next unless -e $localdir;if (my$dest=$self->install_destination($type)){$map{$localdir}=$dest}else {push(@skipping,$type)}}$self->log_warn("WARNING: Can't figure out install path for types: @skipping\n" ."Files will not be installed.\n")if@skipping;if ($self->create_packlist and my$module_name=$self->module_name){my$archdir=$self->install_destination('arch');my@ext=split /::/,$module_name;$map{write}=File::Spec->catfile($archdir,'auto',@ext,'.packlist')}if (length(my$destdir=$self->destdir || '')){for (keys%map){my ($volume,$path,$file)=File::Spec->splitpath($map{$_},0);my@dirs=File::Spec->splitdir($path);$path=File::Spec->catdir($destdir,@dirs);if ($file ne ''){$map{$_}=File::Spec->catfile($path,$file)}else {$map{$_}=$path}}}$map{read}='';return \%map}sub depends_on {my$self=shift;for my$action (@_){$self->_call_action($action)}}sub rscan_dir {my ($self,$dir,$pattern)=@_;my@result;local $_;my$subr=!$pattern ? sub {push@result,$File::Find::name}: !ref($pattern)|| (ref$pattern eq 'Regexp')? sub {push@result,$File::Find::name if /$pattern/}: ref($pattern)eq 'CODE' ? sub {push@result,$File::Find::name if$pattern->()}: die "Unknown pattern type";File::Find::find({wanted=>$subr,no_chdir=>1,preprocess=>sub {sort @_}},$dir);return \@result}sub delete_filetree {my$self=shift;my$deleted=0;for (@_){next unless -e $_;$self->log_verbose("Deleting $_\n");File::Path::rmtree($_,0,0);die "Couldn't remove '$_': $!\n" if -e $_;$deleted++}return$deleted}sub autosplit_file {my ($self,$file,$to)=@_;require AutoSplit;my$dir=File::Spec->catdir($to,'lib','auto');AutoSplit::autosplit($file,$dir)}sub cbuilder {my$self=shift;my$s=$self->{stash};return$s->{_cbuilder}if$s->{_cbuilder};require ExtUtils::CBuilder;return$s->{_cbuilder}=ExtUtils::CBuilder->new(config=>$self->config,($self->quiet ? (quiet=>1): ()),)}sub have_c_compiler {my ($self)=@_;my$p=$self->{properties};return$p->{_have_c_compiler}if defined$p->{_have_c_compiler};$self->log_verbose("Checking if compiler tools configured... ");my$b=$self->cbuilder;my$have=$b && eval {$b->have_compiler};$self->log_verbose($have ? "ok.\n" : "failed.\n");return$p->{_have_c_compiler}=$have}sub compile_c {my ($self,$file,%args)=@_;if (!$self->have_c_compiler){die "Error: no compiler detected to compile '$file'. Aborting\n"}my$b=$self->cbuilder;my$obj_file=$b->object_file($file);$self->add_to_cleanup($obj_file);return$obj_file if$self->up_to_date($file,$obj_file);$b->compile(source=>$file,defines=>$args{defines},object_file=>$obj_file,include_dirs=>$self->include_dirs,extra_compiler_flags=>$self->extra_compiler_flags,);return$obj_file}sub link_c {my ($self,$spec)=@_;my$p=$self->{properties};$self->add_to_cleanup($spec->{lib_file});my$objects=$p->{objects}|| [];return$spec->{lib_file}if$self->up_to_date([$spec->{obj_file},@$objects],$spec->{lib_file});my$module_name=$spec->{module_name}|| $self->module_name;$self->cbuilder->link(module_name=>$module_name,objects=>[$spec->{obj_file},@$objects],lib_file=>$spec->{lib_file},extra_linker_flags=>$self->extra_linker_flags);return$spec->{lib_file}}sub compile_xs {my ($self,$file,%args)=@_;$self->log_verbose("$file -> $args{outfile}\n");if (eval {require ExtUtils::ParseXS;1}){ExtUtils::ParseXS::process_file(filename=>$file,prototypes=>0,output=>$args{outfile},)}else {my$xsubpp=Module::Metadata->find_module_by_name('ExtUtils::xsubpp')or die "Can't find ExtUtils::xsubpp in INC (@INC)";my@typemaps;push@typemaps,Module::Metadata->find_module_by_name('ExtUtils::typemap',\@INC);my$lib_typemap=Module::Metadata->find_module_by_name('typemap',[File::Basename::dirname($file),File::Spec->rel2abs('.')]);push@typemaps,$lib_typemap if$lib_typemap;@typemaps=map {+'-typemap',$_}@typemaps;my$cf=$self->{config};my$perl=$self->{properties}{perl};my@command=($perl,"-I".$cf->get('installarchlib'),"-I".$cf->get('installprivlib'),$xsubpp,'-noprototypes',@typemaps,$file);$self->log_info("@command\n");open(my$fh,'>',$args{outfile})or die "Couldn't write $args{outfile}: $!";print {$fh}$self->_backticks(@command);close$fh}}sub split_like_shell {my ($self,$string)=@_;return ()unless defined($string);return @$string if ref$string eq 'ARRAY';$string =~ s/^\s+|\s+$//g;return ()unless length($string);return Text::ParseWords::shellwords($string)}sub oneliner {my($self,$cmd,$switches,$args)=@_;$switches=[]unless defined$switches;$args=[]unless defined$args;$cmd =~ s{^\n+}{};$cmd =~ s{\n+$}{};my$perl=ref($self)? $self->perl : $self->find_perl_interpreter;return$self->_quote_args($perl,@$switches,'-e',$cmd,@$args)}sub run_perl_script {my ($self,$script,$preargs,$postargs)=@_;for ($preargs,$postargs){$_=[$self->split_like_shell($_)]unless ref()}return$self->run_perl_command([@$preargs,$script,@$postargs])}sub run_perl_command {my ($self,$args)=@_;$args=[$self->split_like_shell($args)]unless ref($args);my$perl=ref($self)? $self->perl : $self->find_perl_interpreter;local$ENV{PERL5LIB}=join$self->config('path_sep'),$self->_added_to_INC;return$self->do_system($perl,@$args)}sub _infer_xs_spec {my$self=shift;my$file=shift;my$cf=$self->{config};my%spec;my($v,$d,$f)=File::Spec->splitpath($file);my@d=File::Spec->splitdir($d);(my$file_base=$f)=~ s/\.[^.]+$//i;$spec{base_name}=$file_base;$spec{src_dir}=File::Spec->catpath($v,$d,'');shift(@d)while@d && ($d[0]eq 'lib' || $d[0]eq '');pop(@d)while@d && $d[-1]eq '';$spec{module_name}=join('::',(@d,$file_base));$spec{archdir}=File::Spec->catdir($self->blib,'arch','auto',@d,$file_base);$spec{c_file}=File::Spec->catfile($spec{src_dir},"${file_base}.c");$spec{obj_file}=File::Spec->catfile($spec{src_dir},"${file_base}".$cf->get('obj_ext'));require DynaLoader;my$modfname=defined&DynaLoader::mod2fname ? DynaLoader::mod2fname([@d,$file_base]): $file_base;$spec{bs_file}=File::Spec->catfile($spec{archdir},"$modfname.bs");$spec{lib_file}=File::Spec->catfile($spec{archdir},"$modfname.".$cf->get('dlext'));return \%spec}sub process_xs {my ($self,$file)=@_;my$spec=$self->_infer_xs_spec($file);(my$file_base=$file)=~ s/\.[^.]+$//;$self->add_to_cleanup($spec->{c_file});unless ($self->up_to_date($file,$spec->{c_file})){$self->compile_xs($file,outfile=>$spec->{c_file})}my$v=$self->dist_version;$self->compile_c($spec->{c_file},defines=>{VERSION=>qq{"$v"},XS_VERSION=>qq{"$v"}});File::Path::mkpath($spec->{archdir},0,oct(777))unless -d $spec->{archdir};$self->add_to_cleanup($spec->{bs_file});unless ($self->up_to_date($file,$spec->{bs_file})){require ExtUtils::Mkbootstrap;$self->log_info("ExtUtils::Mkbootstrap::Mkbootstrap('$spec->{bs_file}')\n");ExtUtils::Mkbootstrap::Mkbootstrap($spec->{bs_file});open(my$fh,'>>',$spec->{bs_file});utime((time)x2,$spec->{bs_file})}$self->link_c($spec)}sub do_system {my ($self,@cmd)=@_;$self->log_verbose("@cmd\n");my%seen;my$sep=$self->config('path_sep');local$ENV{PERL5LIB}=(!exists($ENV{PERL5LIB})? '' : length($ENV{PERL5LIB})< 500 ? $ENV{PERL5LIB}: join$sep,grep {!$seen{$_}++ and -d $_}split($sep,$ENV{PERL5LIB}));my$status=system(@cmd);if ($status and $! =~ /Argument list too long/i){my$env_entries='';for (sort keys%ENV){$env_entries .= "$_=>".length($ENV{$_})."; "}warn "'Argument list' was 'too long', env lengths are $env_entries"}return!$status}sub copy_if_modified {my$self=shift;my%args=(@_ > 3 ? (@_): (from=>shift,to_dir=>shift,flatten=>shift));$args{verbose}=!$self->quiet unless exists$args{verbose};my$file=$args{from};unless (defined$file and length$file){die "No 'from' parameter given to copy_if_modified"}$args{flatten}=1 if File::Spec->file_name_is_absolute($file);my$to_path;if (defined$args{to}and length$args{to}){$to_path=$args{to}}elsif (defined$args{to_dir}and length$args{to_dir}){$to_path=File::Spec->catfile($args{to_dir},$args{flatten}? File::Basename::basename($file): $file)}else {die "No 'to' or 'to_dir' parameter given to copy_if_modified"}return if$self->up_to_date($file,$to_path);{local$self->{properties}{quiet}=1;$self->delete_filetree($to_path)}File::Path::mkpath(File::Basename::dirname($to_path),0,oct(777));$self->log_verbose("Copying $file -> $to_path\n");if ($^O eq 'os2'){chmod 0666,$to_path;File::Copy::syscopy($file,$to_path,0x1)or die "Can't copy('$file', '$to_path'): $!"}else {File::Copy::copy($file,$to_path)or die "Can't copy('$file', '$to_path'): $!"}my$mode=oct(444)| ($self->is_executable($file)? oct(111): 0);chmod($mode,$to_path);return$to_path}sub up_to_date {my ($self,$source,$derived)=@_;$source=[$source]unless ref$source;$derived=[$derived]unless ref$derived;return 0 if @$source &&!@$derived || grep {not -e}@$derived;my$most_recent_source=time / (24*60*60);for my$file (@$source){unless (-e $file){$self->log_warn("Can't find source file $file for up-to-date check");next}$most_recent_source=-M _ if -M _ < $most_recent_source}for my$derived (@$derived){return 0 if -M $derived > $most_recent_source}return 1}sub dir_contains {my ($self,$first,$second)=@_;($first,$second)=map File::Spec->canonpath($_),($first,$second);my@first_dirs=File::Spec->splitdir($first);my@second_dirs=File::Spec->splitdir($second);return 0 if@second_dirs < @first_dirs;my$is_same=($self->_case_tolerant ? sub {lc(shift())eq lc(shift())}: sub {shift()eq shift()});while (@first_dirs){return 0 unless$is_same->(shift@first_dirs,shift@second_dirs)}return 1}1; + + ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions + of the modules indicated above before proceeding with this installation + + EOF + * FATAL ERROR: Perl interpreter mismatch. Configuration was initially + created with '$self->{properties}{perl}' + but we are now using '$perl'. You must + run 'Build realclean' or 'make realclean' and re-configure. + DIEFATAL + * WARNING: Configuration was initially created with Module::Build + version '$self->{properties}{mb_version}' but we are now using version '$mb_version'. + If errors occur, you must re-run the Build.PL or Makefile.PL script. + MISMATCH + ERROR: This build seems to be unattended, but there is no default value + for this question. Aborting. + EOF + package $opts{class}; + use $pack; + \@ISA = qw($pack); + $opts{code} + 1; + EOF + No 'module_name' was provided and it could not be inferred + from other properties. This will prevent a packlist from + being written for this file. Please set either 'module_name' + or 'dist_version_from' in Build.PL. + END_WARN + Bundling in inc/ is disabled because ExtUtils::Installed could not + create a list of your installed modules. Here is the error: + $@ + EUI_ERROR + Could not find a packlist for '$mod'. If it's a core module, try + force installing it from CPAN. + NO_PACKLIST + Module::Build was not found in configure_requires! Adding it now + automatically as: configure_requires => { 'Module::Build' => $ver } + EOM + Warning: ExtUtils::CBuilder not installed or no compiler detected + Proceeding with configuration, but compilation may fail during Build + + EOM + if ($INC[-1] ne '.') { + push @INC, '.'; + } + END + $shebang + + use strict; + use Cwd; + use File::Basename; + use File::Spec; + + sub magic_number_matches { + return 0 unless -e '$q{magic_numfile}'; + my \$FH; + open \$FH, '<','$q{magic_numfile}' or return 0; + my \$filenum = <\$FH>; + close \$FH; + return \$filenum == $magic_number; + } + + my \$progname; + my \$orig_dir; + BEGIN { + \$^W = 1; # Use warnings + \$progname = basename(\$0); + \$orig_dir = Cwd::cwd(); + my \$base_dir = '$q{base_dir}'; + if (!magic_number_matches()) { + unless (chdir(\$base_dir)) { + die ("Couldn't chdir(\$base_dir), aborting\\n"); + } + unless (magic_number_matches()) { + die ("Configuration seems to be out of date, please re-run 'perl Build.PL' again.\\n"); + } + } + unshift \@INC, + ( + $quoted_INC + ); + $dot_in_inc_code + } + + close(*DATA) unless eof(*DATA); # ensure no open handles to this script + + use $build_package; + Module::Build->VERSION(q{$config_requires}); + + # Some platforms have problems setting \$^X in shebang contexts, fix it up here + \$^X = Module::Build->find_perl_interpreter; + + if (-e 'Build.PL' and not $build_package->up_to_date('Build.PL', \$progname)) { + warn "Warning: Build.PL has been altered. You may need to run 'perl Build.PL' again.\\n"; + } + + # This should have just enough arguments to be able to bootstrap the rest. + my \$build = $build_package->resume ( + properties => { + config_dir => '$q{config_dir}', + orig_dir => \$orig_dir, + }, + ); + + \$build->dispatch; + EOF + + Usage: $0 --arg1=value --arg2=value ... + Example: $0 test --verbose=1 + + Actions defined: + EOF + Can't create LICENSE file: '$l' is not a valid license key + or Software::License subclass; + HERE + Cannot create README: can't determine which file contains documentation; + Must supply either 'dist_version_from', or 'module_name' parameter. + EOF + # Avoid configuration metadata file + ^MYMETA\. + + # Avoid Module::Build generated and utility files. + \bBuild$ + \bBuild.bat$ + \b_build + \bBuild.COM$ + \bBUILD.COM$ + \bbuild.com$ + ^MANIFEST\.SKIP + + # Avoid archives of this distribution + EOF +MODULE_BUILD_BASE + +$fatpacked{"Module/Build/Compat.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_COMPAT'; + package Module::Build::Compat;use strict;use warnings;our$VERSION='0.4224';use File::Basename ();use File::Spec;use Config;use Module::Build;use Module::Metadata;use version;use Data::Dumper;my%convert_installdirs=(PERL=>'core',SITE=>'site',VENDOR=>'vendor',);my%makefile_to_build=(TEST_VERBOSE=>'verbose',VERBINST=>'verbose',INC=>sub {map {(extra_compiler_flags=>$_)}Module::Build->split_like_shell(shift)},POLLUTE=>sub {(extra_compiler_flags=>'-DPERL_POLLUTE')},INSTALLDIRS=>sub {(installdirs=>$convert_installdirs{uc shift()})},LIB=>sub {my$lib=shift;my%config=(installprivlib=>$lib,installsitelib=>$lib,installarchlib=>"$lib/$Config{archname}",installsitearch=>"$lib/$Config{archname}");return map {(config=>"$_=$config{$_}")}sort keys%config},(map {my$name=$_;$name=>sub {my@ret=(config=>lc($name)."=" .shift);print STDERR "# Converted to @ret\n";return@ret}}qw(INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INSTALLSCRIPT INSTALLSITESCRIPT INSTALLVENDORSCRIPT INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR)),map {$_,lc($_)}qw(DESTDIR PREFIX INSTALL_BASE UNINST),);my%macro_to_build=%makefile_to_build;delete$macro_to_build{LIB};sub _merge_prereq {my ($req,$breq)=@_;$req ||= {};$breq ||= {};for my$p ($req,$breq){for my$k (sort keys %$p){next if$k eq 'perl';my$v_obj=eval {version->new($p->{$k})};if (!defined$v_obj){die "A prereq of the form '$p->{$k}' for '$k' is not supported by Module::Build::Compat ( use a simpler version like '0.05' or 'v1.4.25' )\n"}if ($v_obj->is_qv){my$proper_ver=$v_obj->numify;warn "Dotted-decimal prereq '$p->{$k}' for '$k' is not portable - converting it to '$proper_ver'\n";$p->{$k}=$proper_ver}}}my$merge={%$req };for my$k (keys %$breq){my$v1=$merge->{$k}|| 0;my$v2=$breq->{$k};$merge->{$k}=$v1 > $v2 ? $v1 : $v2}return %$merge}sub create_makefile_pl {my ($package,$type,$build,%args)=@_;die "Don't know how to build Makefile.PL of type '$type'" unless$type =~ /^(small|passthrough|traditional)$/;if ($type eq 'passthrough'){$build->log_warn(<<"HERE")}my$fh;if ($args{fh}){$fh=$args{fh}}else {$args{file}||= 'Makefile.PL';local$build->{properties}{quiet}=1;$build->delete_filetree($args{file});open($fh,'>',"$args{file}")or die "Can't write $args{file}: $!"}print {$fh}"# Note: this file was auto-generated by ",__PACKAGE__," version $VERSION\n";my$requires=$build->requires;if (my$minimum_perl=$requires->{perl}){my$min_ver=version->new($minimum_perl)->numify;print {$fh}"require $min_ver;\n"}my$subclass_load='';if (ref($build)ne "Module::Build"){my$subclass_dir=$package->subclass_dir($build);if (File::Spec->file_name_is_absolute($subclass_dir)){my$base_dir=$build->base_dir;if ($build->dir_contains($base_dir,$subclass_dir)){$subclass_dir=File::Spec->abs2rel($subclass_dir,$base_dir);$subclass_dir=$package->unixify_dir($subclass_dir);$subclass_load="use lib '$subclass_dir';"}}else {$subclass_dir=$package->unixify_dir($subclass_dir);$subclass_load="use lib '$subclass_dir';"}}if ($type eq 'small'){printf {$fh}<<'EOF',$subclass_load,ref($build),ref($build)}elsif ($type eq 'passthrough'){printf {$fh}<<'EOF',$subclass_load,ref($build),ref($build)}elsif ($type eq 'traditional'){my (%MM_Args,%prereq);if (eval "use Tie::IxHash 1.2; 1"){tie%MM_Args,'Tie::IxHash';tie%prereq,'Tie::IxHash'}my%name=($build->module_name ? (NAME=>$build->module_name): (DISTNAME=>$build->dist_name));my%version=($build->dist_version_from ? (VERSION_FROM=>$build->dist_version_from): (VERSION=>$build->dist_version));%MM_Args=(%name,%version);%prereq=_merge_prereq($build->requires,$build->build_requires);%prereq=map {$_,$prereq{$_}}sort keys%prereq;delete$prereq{perl};$MM_Args{PREREQ_PM}=\%prereq;$MM_Args{INSTALLDIRS}=$build->installdirs eq 'core' ? 'perl' : $build->installdirs;$MM_Args{EXE_FILES}=[sort keys %{$build->script_files}]if$build->script_files;$MM_Args{PL_FILES}=$build->PL_files || {};if ($build->recursive_test_files){$MM_Args{test}={TESTS=>join q{ },$package->_test_globs($build)}}local$Data::Dumper::Terse=1;my$args=Data::Dumper::Dumper(\%MM_Args);$args =~ s/\{(.*)\}/($1)/s;print$fh <<"EOF"}}sub _test_globs {my ($self,$build)=@_;return map {File::Spec->catfile($_,'*.t')}@{$build->rscan_dir('t',sub {-d $File::Find::name})}}sub subclass_dir {my ($self,$build)=@_;return (Module::Metadata->find_module_dir_by_name(ref$build)|| File::Spec->catdir($build->config_dir,'lib'))}sub unixify_dir {my ($self,$path)=@_;return join '/',File::Spec->splitdir($path)}sub makefile_to_build_args {my$class=shift;my@out;for my$arg (@_){next if$arg eq '';my ($key,$val)=($arg =~ /^(\w+)=(.+)/ ? ($1,$2): die "Malformed argument '$arg'");($val)=Module::Build->_detildefy($val)if$val =~ /^~/;if (exists$makefile_to_build{$key}){my$trans=$makefile_to_build{$key};push@out,$class->_argvify(ref($trans)? $trans->($val): ($trans=>$val))}elsif (exists$Config{lc($key)}){push@out,$class->_argvify(config=>lc($key)."=$val")}else {push@out,$class->_argvify("\L$key"=>$val)}}return@out}sub _argvify {my ($self,@pairs)=@_;my@out;while (@pairs){my ($k,$v)=splice@pairs,0,2;push@out,("--$k",$v)}return@out}sub makefile_to_build_macros {my@out;my%config;for my$macro (sort keys%macro_to_build){my$trans=$macro_to_build{$macro};next unless exists$ENV{$macro}&& length$ENV{$macro};my$val=$ENV{$macro};my@args=ref($trans)? $trans->($val): ($trans=>$val);while (@args){my ($k,$v)=splice(@args,0,2);if ($k eq 'config'){if ($v =~ /^([^=]+)=(.*)$/){$config{$1}=$2}else {warn "Couldn't parse config '$v'\n"}}else {push@out,($k=>$v)}}}push@out,(config=>\%config)if%config;return@out}sub run_build_pl {my ($pack,%in)=@_;$in{script}||= 'Build.PL';my@args=$in{args}? $pack->makefile_to_build_args(@{$in{args}}): ();print "# running $in{script} @args\n";Module::Build->run_perl_script($in{script},[],\@args)or die "Couldn't run $in{script}: $!"}sub fake_makefile {my ($self,%args)=@_;unless (exists$args{build_class}){warn "Unknown 'build_class', defaulting to 'Module::Build'\n";$args{build_class}='Module::Build'}my$class=$args{build_class};my$perl=$class->find_perl_interpreter;$perl='MCR ' .$perl if$self->_is_vms_mms;my$noop=($class->is_windowsish ? 'rem>nul' : $self->_is_vms_mms ? 'Continue' : 'true');my$filetype=$class->is_vmsish ? '.COM' : '';my$Build='Build' .$filetype .' --makefile_env_macros 1';my$unlink=$class->oneliner('1 while unlink $ARGV[0]',[],[$args{makefile}]);$unlink =~ s/\$/\$\$/g unless$class->is_vmsish;my$maketext=join '',map {"$_=\n"}sort keys%macro_to_build;$maketext .= ($^O eq 'os2' ? "SHELL = sh\n\n" : $^O eq 'MSWin32' && $Config{make}=~ /gmake/ ? "SHELL = $ENV{COMSPEC}\n\n" : "\n\n");$maketext .= <<"EOF";for my$action ($class->known_actions){next if$action =~ /^(all|distclean|realclean|force_do_it)$/;$maketext .= <<"EOF"}if ($self->_is_vms_mms){$maketext .= "\n.FIRST\n\t\@ $noop\n";for my$macro (sort keys%macro_to_build){$maketext .= ".IFDEF $macro\n\tDEFINE $macro \"\$($macro)\"\n.ENDIF\n"}$maketext .= "\n"}else {$maketext .= "\n.EXPORT : " .join(' ',sort keys%macro_to_build)."\n\n"}return$maketext}sub fake_prereqs {my$file=File::Spec->catfile('_build','prereqs');open(my$fh,'<',"$file")or die "Can't read $file: $!";my$prereqs=eval do {local $/;<$fh>};close$fh;my%merged=_merge_prereq($prereqs->{requires},$prereqs->{build_requires});my@prereq;for (sort keys%merged){next if $_ eq 'perl';push@prereq,"$_=>q[$merged{$_}]"}return unless@prereq;return "# PREREQ_PM => { " .join(", ",@prereq)." }\n\n"}sub write_makefile {my ($pack,%in)=@_;unless (exists$in{build_class}){warn "Unknown 'build_class', defaulting to 'Module::Build'\n";$in{build_class}='Module::Build'}my$class=$in{build_class};$in{makefile}||= $pack->_is_vms_mms ? 'Descrip.MMS' : 'Makefile';open MAKE,"> $in{makefile}" or die "Cannot write $in{makefile}: $!";print MAKE$pack->fake_prereqs;print MAKE$pack->fake_makefile(%in);close MAKE}sub _is_vms_mms {return Module::Build->is_vmsish && ($Config{make}=~ m/MM[SK]/i)}1; + + IMPORTANT NOTE: The '$type' style of Makefile.PL is deprecated and + may be removed in a future version of Module::Build in favor of the + 'configure_requires' property. See Module::Build::Compat + documentation for details. + + HERE + use Module::Build::Compat 0.02; + %s + Module::Build::Compat->run_build_pl(args => \@ARGV); + require %s; + Module::Build::Compat->write_makefile(build_class => '%s'); + EOF + + unless (eval "use Module::Build::Compat 0.02; 1" ) { + print "This module requires Module::Build to install itself.\n"; + + require ExtUtils::MakeMaker; + my $yn = ExtUtils::MakeMaker::prompt + (' Install Module::Build now from CPAN?', 'y'); + + unless ($yn =~ /^y/i) { + die " *** Cannot install without Module::Build. Exiting ...\n"; + } + + require Cwd; + require File::Spec; + require CPAN; + + # Save this 'cause CPAN will chdir all over the place. + my $cwd = Cwd::cwd(); + + CPAN::Shell->install('Module::Build::Compat'); + CPAN::Shell->expand("Module", "Module::Build::Compat")->uptodate + or die "Couldn't install Module::Build, giving up.\n"; + + chdir $cwd or die "Cannot chdir() back to $cwd: $!"; + } + eval "use Module::Build::Compat 0.02; 1" or die $@; + %s + Module::Build::Compat->run_build_pl(args => \@ARGV); + my $build_script = 'Build'; + $build_script .= '.com' if $^O eq 'VMS'; + exit(0) unless(-e $build_script); # cpantesters convention + require %s; + Module::Build::Compat->write_makefile(build_class => '%s'); + EOF + use ExtUtils::MakeMaker; + WriteMakefile + $args; + EOF + all : force_do_it + $perl $Build + realclean : force_do_it + $perl $Build realclean + $unlink + distclean : force_do_it + $perl $Build distclean + $unlink + + + force_do_it : + @ $noop + EOF + $action : force_do_it + $perl $Build $action + EOF +MODULE_BUILD_COMPAT + +$fatpacked{"Module/Build/Config.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_CONFIG'; + package Module::Build::Config;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Config;sub new {my ($pack,%args)=@_;return bless {stack=>{},values=>$args{values}|| {},},$pack}sub get {my ($self,$key)=@_;return$self->{values}{$key}if ref($self)&& exists$self->{values}{$key};return$Config{$key}}sub set {my ($self,$key,$val)=@_;$self->{values}{$key}=$val}sub push {my ($self,$key,$val)=@_;push @{$self->{stack}{$key}},$self->{values}{$key}if exists$self->{values}{$key};$self->{values}{$key}=$val}sub pop {my ($self,$key)=@_;my$val=delete$self->{values}{$key};if (exists$self->{stack}{$key}){$self->{values}{$key}=pop @{$self->{stack}{$key}};delete$self->{stack}{$key}unless @{$self->{stack}{$key}}}return$val}sub values_set {my$self=shift;return undef unless ref($self);return$self->{values}}sub all_config {my$self=shift;my$v=ref($self)? $self->{values}: {};return {%Config,%$v}}1; +MODULE_BUILD_CONFIG + +$fatpacked{"Module/Build/ConfigData.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_CONFIGDATA'; + package Module::Build::ConfigData;use strict;my$arrayref=eval do {local $/;}or die "Couldn't load ConfigData data: $@";close DATA;my ($config,$features,$auto_features)=@$arrayref;sub config {$config->{$_[1]}}sub set_config {$config->{$_[1]}=$_[2]}sub set_feature {$features->{$_[1]}=0+!!$_[2]}sub auto_feature_names {sort grep!exists$features->{$_},keys %$auto_features}sub feature_names {my@features=(sort keys %$features,auto_feature_names());@features}sub config_names {sort keys %$config}sub write {my$me=__FILE__;require Data::Dumper;my$mode_orig=(stat$me)[2]& 07777;chmod($mode_orig | 0222,$me);open(my$fh,'+<',$me)or die "Can't rewrite $me: $!";seek($fh,0,0);while (<$fh>){last if /^__DATA__$/}die "Couldn't find __DATA__ token in $me" if eof($fh);seek($fh,tell($fh),0);my$data=[$config,$features,$auto_features];print($fh 'do{ my ' .Data::Dumper->new([$data],['x'])->Purity(1)->Dump().'$x; }');truncate($fh,tell($fh));close$fh;chmod($mode_orig,$me)or warn "Couldn't restore permissions on $me: $!"}sub feature {my ($package,$key)=@_;return$features->{$key}if exists$features->{$key};my$info=$auto_features->{$key}or return 0;require Module::Build;for my$type (sort keys %$info){my$prereqs=$info->{$type};next if$type eq 'description' || $type eq 'recommends';for my$modname (sort keys %$prereqs){my$status=Module::Build->check_installed_status($modname,$prereqs->{$modname});if ((!$status->{ok})xor ($type =~ /conflicts$/)){return 0}if (!eval "require $modname; 1"){return 0}}}return 1}__DATA__ do{ my $x = [ + {}, + {}, + { + 'HTML_support' => { + 'description' => 'Create HTML documentation', + 'requires' => { + 'Pod::Html' => 0 + } + }, + 'PPM_support' => { + 'description' => 'Generate PPM files for distributions' + }, + 'dist_authoring' => { + 'description' => 'Create new distributions', + 'recommends' => { + 'Module::Signature' => '0.21', + 'Pod::Readme' => '0.04' + }, + 'requires' => { + 'Archive::Tar' => '1.09' + } + }, + 'inc_bundling_support' => { + 'description' => 'Bundle Module::Build in inc/', + 'requires' => { + 'ExtUtils::Install' => '1.54', + 'ExtUtils::Installed' => '1.999', + 'inc::latest' => '0.5' + } + }, + 'license_creation' => { + 'description' => 'Create licenses automatically in distributions', + 'requires' => { + 'Software::License' => '0.103009' + } + }, + 'manpage_support' => { + 'description' => 'Create Unix man pages', + 'requires' => { + 'Pod::Man' => 0 + } + } + } + ]; + $x; } +MODULE_BUILD_CONFIGDATA + +$fatpacked{"Module/Build/Cookbook.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_COOKBOOK'; + package Module::Build::Cookbook;use strict;use warnings;our$VERSION='0.4224'; +MODULE_BUILD_COOKBOOK + +$fatpacked{"Module/Build/Dumper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_DUMPER'; + package Module::Build::Dumper;use strict;use warnings;our$VERSION='0.4224';use Data::Dumper;sub _data_dump {my ($self,$data)=@_;return ("do{ my " .Data::Dumper->new([$data],['x'])->Purity(1)->Terse(0)->Sortkeys(1)->Dump().'$x; }')}1; +MODULE_BUILD_DUMPER + +$fatpacked{"Module/Build/Notes.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_NOTES'; + package Module::Build::Notes;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Data::Dumper;use Module::Build::Dumper;sub new {my ($class,%args)=@_;my$file=delete$args{file}or die "Missing required parameter 'file' to new()";my$self=bless {disk=>{},new=>{},file=>$file,%args,},$class}sub restore {my$self=shift;open(my$fh,'<',$self->{file})or die "Can't read $self->{file}: $!";$self->{disk}=eval do {local $/;<$fh>};die $@ if $@;close$fh;$self->{new}={}}sub access {my$self=shift;return$self->read()unless @_;my$key=shift;return$self->read($key)unless @_;my$value=shift;$self->write({$key=>$value });return$self->read($key)}sub has_data {my$self=shift;return keys %{$self->read()}> 0}sub exists {my ($self,$key)=@_;return exists($self->{new}{$key})|| exists($self->{disk}{$key})}sub read {my$self=shift;if (@_){my$key=shift;return$self->{new}{$key}if exists$self->{new}{$key};return$self->{disk}{$key}}my$out=(keys %{$self->{new}}? {%{$self->{disk}},%{$self->{new}}}: $self->{disk});return wantarray ? %$out : $out}sub _same {my ($self,$x,$y)=@_;return 1 if!defined($x)and!defined($y);return 0 if!defined($x)or!defined($y);return$x eq $y}sub write {my ($self,$href)=@_;$href ||= {};@{$self->{new}}{keys %$href }=values %$href;for my$key (keys %{$self->{new}}){next if ref$self->{new}{$key};next if ref$self->{disk}{$key}or!exists$self->{disk}{$key};delete$self->{new}{$key}if$self->_same($self->{new}{$key},$self->{disk}{$key})}if (my$file=$self->{file}){my ($vol,$dir,$base)=File::Spec->splitpath($file);$dir=File::Spec->catpath($vol,$dir,'');return unless -e $dir && -d $dir;return if -e $file and!keys %{$self->{new}};@{$self->{disk}}{keys %{$self->{new}}}=values %{$self->{new}};$self->_dump($file,$self->{disk});$self->{new}={}}return$self->read}sub _dump {my ($self,$file,$data)=@_;open(my$fh,'>',$file)or die "Can't create '$file': $!";print {$fh}Module::Build::Dumper->_data_dump($data);close$fh}my$orig_template=do {local $/;};close DATA;sub write_config_data {my ($self,%args)=@_;my$template=$orig_template;$template =~ s/NOTES_NAME/$args{config_module}/g;$template =~ s/MODULE_NAME/$args{module}/g;$template =~ s/=begin private\n//;$template =~ s/=end private/=cut/;$template =~ s{$_\n}{} for '=begin private','=end private';open(my$fh,'>',$args{file})or die "Can't create '$args{file}': $!";print {$fh}$template;print {$fh}"\n__DATA__\n";print {$fh}Module::Build::Dumper->_data_dump([$args{config_data},$args{feature},$args{auto_features}]);close$fh}1;__DATA__ package NOTES_NAME; + use strict; + my $arrayref = eval do {local $/; } + or die "Couldn't load ConfigData data: $@"; + close DATA; + my ($config, $features, $auto_features) = @$arrayref; + + sub config { $config->{$_[1]} } + + sub set_config { $config->{$_[1]} = $_[2] } + sub set_feature { $features->{$_[1]} = 0+!!$_[2] } # Constrain to 1 or 0 + + sub auto_feature_names { sort grep !exists $features->{$_}, keys %$auto_features } + + sub feature_names { + my @features = (sort keys %$features, auto_feature_names()); + @features; + } + + sub config_names { sort keys %$config } + + sub write { + my $me = __FILE__; + + # Can't use Module::Build::Dumper here because M::B is only a + # build-time prereq of this module + require Data::Dumper; + + my $mode_orig = (stat $me)[2] & 07777; + chmod($mode_orig | 0222, $me); # Make it writeable + open(my $fh, '+<', $me) or die "Can't rewrite $me: $!"; + seek($fh, 0, 0); + while (<$fh>) { + last if /^__DATA__$/; + } + die "Couldn't find __DATA__ token in $me" if eof($fh); + + seek($fh, tell($fh), 0); + my $data = [$config, $features, $auto_features]; + print($fh 'do{ my ' + . Data::Dumper->new([$data],['x'])->Purity(1)->Dump() + . '$x; }' ); + truncate($fh, tell($fh)); + close $fh; + + chmod($mode_orig, $me) + or warn "Couldn't restore permissions on $me: $!"; + } + + sub feature { + my ($package, $key) = @_; + return $features->{$key} if exists $features->{$key}; + + my $info = $auto_features->{$key} or return 0; + + require Module::Build; # XXX should get rid of this + foreach my $type (sort keys %$info) { + my $prereqs = $info->{$type}; + next if $type eq 'description' || $type eq 'recommends'; + + foreach my $modname (sort keys %$prereqs) { + my $status = Module::Build->check_installed_status($modname, $prereqs->{$modname}); + if ((!$status->{ok}) xor ($type =~ /conflicts$/)) { return 0; } + if ( ! eval "require $modname; 1" ) { return 0; } + } + } + return 1; + } + + =begin private + + =head1 NAME + + NOTES_NAME - Configuration for MODULE_NAME + + =head1 SYNOPSIS + + use NOTES_NAME; + $value = NOTES_NAME->config('foo'); + $value = NOTES_NAME->feature('bar'); + + @names = NOTES_NAME->config_names; + @names = NOTES_NAME->feature_names; + + NOTES_NAME->set_config(foo => $new_value); + NOTES_NAME->set_feature(bar => $new_value); + NOTES_NAME->write; # Save changes + + + =head1 DESCRIPTION + + This module holds the configuration data for the C + module. It also provides a programmatic interface for getting or + setting that configuration data. Note that in order to actually make + changes, you'll have to have write access to the C + module, and you should attempt to understand the repercussions of your + actions. + + + =head1 METHODS + + =over 4 + + =item config($name) + + Given a string argument, returns the value of the configuration item + by that name, or C if no such item exists. + + =item feature($name) + + Given a string argument, returns the value of the feature by that + name, or C if no such feature exists. + + =item set_config($name, $value) + + Sets the configuration item with the given name to the given value. + The value may be any Perl scalar that will serialize correctly using + C. This includes references, objects (usually), and + complex data structures. It probably does not include transient + things like filehandles or sockets. + + =item set_feature($name, $value) + + Sets the feature with the given name to the given boolean value. The + value will be converted to 0 or 1 automatically. + + =item config_names() + + Returns a list of all the names of config items currently defined in + C, or in scalar context the number of items. + + =item feature_names() + + Returns a list of all the names of features currently defined in + C, or in scalar context the number of features. + + =item auto_feature_names() + + Returns a list of all the names of features whose availability is + dynamically determined, or in scalar context the number of such + features. Does not include such features that have later been set to + a fixed value. + + =item write() + + Commits any changes from C and C to disk. + Requires write access to the C module. + + =back + + + =head1 AUTHOR + + C was automatically created using C. + C was written by Ken Williams, but he holds no + authorship claim or copyright claim to the contents of C. + + =end private + +MODULE_BUILD_NOTES + +$fatpacked{"Module/Build/PPMMaker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PPMMAKER'; + package Module::Build::PPMMaker;use strict;use warnings;use Config;our$VERSION='0.4224';$VERSION=eval$VERSION;sub new {my$package=shift;return bless {@_},$package}sub make_ppd {my ($self,%args)=@_;my$build=delete$args{build};my@codebase;if (exists$args{codebase}){@codebase=ref$args{codebase}? @{$args{codebase}}: ($args{codebase})}else {my$distfile=$build->ppm_name .'.tar.gz';print "Using default codebase '$distfile'\n";@codebase=($distfile)}my%dist;for my$info (qw(name author abstract version)){my$method="dist_$info";$dist{$info}=$build->$method()or die "Can't determine distribution's $info\n"}$self->_simple_xml_escape($_)foreach$dist{abstract},@{$dist{author}};my$ppd=<<"PPD";for my$type (qw(requires)){my$prereq=$build->$type();for my$modname (sort keys %$prereq){next if$modname eq 'perl';my$min_version='0.0';for my$c ($build->_parse_conditions($prereq->{$modname})){my ($op,$version)=$c =~ /^\s* (<=?|>=?|==|!=) \s* ([\w.]+) \s*$/x;if ($op eq '>='){$min_version=$version;last}}$modname .= '::' unless$modname =~ /::/;$ppd .= qq! \n!}}if (keys %{$build->find_xs_files}){my$perl_version=$self->_ppd_version($build->perl_version);$ppd .= sprintf(<<'EOF',$self->_varchname($build->config))}for my$codebase (@codebase){$self->_simple_xml_escape($codebase);$ppd .= sprintf(<<'EOF',$codebase)}$ppd .= <<'EOF';my$ppd_file="$dist{name}.ppd";open(my$fh,'>',$ppd_file)or die "Cannot write to $ppd_file: $!";binmode($fh,":utf8")if $] >= 5.008 && $Config{useperlio};print$fh $ppd;close$fh;return$ppd_file}sub _ppd_version {my ($self,$version)=@_;return join ',',(split(/\./,$version),(0)x4)[0..3]}sub _varchname {my ($self,$config)=@_;my$varchname=$config->{archname};if ($] >= 5.008){my$vstring=sprintf "%vd",$^V;$vstring =~ s/\.\d+$//;$varchname .= "-$vstring"}return$varchname}{my%escapes=("\n"=>"\\n",'"'=>'"','&'=>'&','>'=>'>','<'=>'<',);my$rx=join '|',keys%escapes;sub _simple_xml_escape {$_[1]=~ s/($rx)/$escapes{$1}/go}}1; + + $dist{abstract} + @{[ join "\n", map " $_", @{$dist{author}} ]} + + PPD + + EOF + + EOF + + + EOF +MODULE_BUILD_PPMMAKER + +$fatpacked{"Module/Build/Platform/Default.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_DEFAULT'; + package Module::Build::Platform::Default;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;our@ISA=qw(Module::Build::Base);1; +MODULE_BUILD_PLATFORM_DEFAULT + +$fatpacked{"Module/Build/Platform/MacOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_MACOS'; + package Module::Build::Platform::MacOS;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;our@ISA=qw(Module::Build::Base);use ExtUtils::Install;sub have_forkpipe {0}sub new {my$class=shift;my$self=$class->SUPER::new(@_);for ('sitelib','sitearch'){$self->config($_=>$self->config("install$_"))unless$self->config($_)}(my$sp=$self->config('startperl'))=~ s/.*Exit \{Status\}\s//;$self->config(startperl=>$sp);return$self}sub make_executable {my$self=shift;require MacPerl;for (@_){MacPerl::SetFileInfo('McPL','TEXT',$_)}}sub dispatch {my$self=shift;if(!@_ and!@ARGV){require MacPerl;my@action_list=qw(build test install);my%actions=map {+($_,1)}$self->known_actions;delete@actions{@action_list};push@action_list,sort {$a cmp $b}keys%actions;my%toolserver=map {+$_=>1}qw(test disttest diff testdb);for (@action_list){$_ .= ' *' if$toolserver{$_}}my$cmd=MacPerl::Pick("What build command? ('*' requires ToolServer)",@action_list);return unless defined$cmd;$cmd =~ s/ \*$//;$ARGV[0]=($cmd);my$args=MacPerl::Ask('Any extra arguments? (ie. verbose=1)','');return unless defined$args;push@ARGV,$self->split_like_shell($args)}$self->SUPER::dispatch(@_)}sub ACTION_realclean {my$self=shift;chmod 0666,$self->{properties}{build_script};$self->SUPER::ACTION_realclean}sub ACTION_install {my$self=shift;return$self->SUPER::ACTION_install(@_)if eval {ExtUtils::Install->VERSION('1.30');1};local $^W=0;local*ExtUtils::Install::find=sub {my ($code,@dirs)=@_;@dirs=map {$_ eq '.' ? File::Spec->curdir : $_}@dirs;return File::Find::find($code,@dirs)};return$self->SUPER::ACTION_install(@_)}1; +MODULE_BUILD_PLATFORM_MACOS + +$fatpacked{"Module/Build/Platform/Unix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_UNIX'; + package Module::Build::Platform::Unix;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;our@ISA=qw(Module::Build::Base);sub is_executable {my ($self,$file)=@_;return +(stat$file)[2]& 0100}sub _startperl {"#! " .shift()->perl}sub _construct {my$self=shift()->SUPER::_construct(@_);my$c=$self->{config};for (qw(siteman1 siteman3 vendorman1 vendorman3)){$c->{"install${_}dir"}||= $c->{"install${_}"}}return$self}sub _detildefy {my ($self,$value)=@_;$value =~ s[^~([^/]+)?(?=/|$)] # tilde with optional username [$1 ? (eval{(getpwnam $1)[7]}|| "~$1"): ($ENV{HOME}|| eval{(getpwuid $>)[7]}|| glob("~"))]ex;return$value}1; +MODULE_BUILD_PLATFORM_UNIX + +$fatpacked{"Module/Build/Platform/VMS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_VMS'; + package Module::Build::Platform::VMS;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;use Config;our@ISA=qw(Module::Build::Base);sub _set_defaults {my$self=shift;$self->SUPER::_set_defaults(@_);$self->{properties}{build_script}='Build.com'}sub cull_args {my$self=shift;my($action,$args)=$self->SUPER::cull_args(@_);my@possible_actions=grep {lc $_ eq lc$action}$self->known_actions;die "Ambiguous action '$action'. Could be one of @possible_actions" if@possible_actions > 1;return ($possible_actions[0],$args)}sub manpage_separator {return '__'}sub _catprefix {my($self,$rprefix,$default)=@_;my($rvol,$rdirs)=File::Spec->splitpath($rprefix);if($rvol){return File::Spec->catpath($rvol,File::Spec->catdir($rdirs,$default),'')}else {return File::Spec->catdir($rdirs,$default)}}sub _prefixify {my($self,$path,$sprefix,$type)=@_;my$rprefix=$self->prefix;return '' unless defined$path;$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");$rprefix=VMS::Filespec::vmspath($rprefix)if$rprefix;$sprefix=VMS::Filespec::vmspath($sprefix)if$sprefix;$self->log_verbose(" rprefix translated to $rprefix\n"." sprefix translated to $sprefix\n");if(length($path)==0){$self->log_verbose(" no path to prefixify.\n")}elsif(!File::Spec->file_name_is_absolute($path)){$self->log_verbose(" path is relative, not prefixifying.\n")}elsif($sprefix eq $rprefix){$self->log_verbose(" no new prefix.\n")}else {my($path_vol,$path_dirs)=File::Spec->splitpath($path);my$vms_prefix=$self->config('vms_prefix');if($path_vol eq $vms_prefix.':'){$self->log_verbose(" $vms_prefix: seen\n");$path_dirs =~ s{^\[}{\[.} unless$path_dirs =~ m{^\[\.};$path=$self->_catprefix($rprefix,$path_dirs)}else {$self->log_verbose(" cannot prefixify.\n");return$self->prefix_relpaths($self->installdirs,$type)}}$self->log_verbose(" now $path\n");return$path}sub _quote_args {my ($self,@args)=@_;my$got_arrayref=(scalar(@args)==1 && ref$args[0]eq 'ARRAY')? 1 : 0;map {if (!/^\//){$_ =~ s/\"/""/g;$_=q(").$_.q(")}}($got_arrayref ? @{$args[0]}: @args);return$got_arrayref ? $args[0]: join(' ',@args)}sub have_forkpipe {0}sub _backticks {my ($self,@cmd)=@_;my$cmd=shift@cmd;my$args=$self->_quote_args(@cmd);return `$cmd $args`}sub find_command {my ($self,$command)=@_;if ($^O eq 'VMS'){require VMS::DCLsym;my$syms=VMS::DCLsym->new;return$command if scalar$syms->getsym(uc$command)}$self->SUPER::find_command($command)}sub _maybe_command {my($self,$file)=@_;return$file if -x $file &&!-d _;my(@dirs)=('');my(@exts)=('',$Config{'exe_ext'},'.exe','.com');if ($file !~ m![/:>\]]!){for (my$i=0;defined$ENV{"DCL\$PATH;$i"};$i++){my$dir=$ENV{"DCL\$PATH;$i"};$dir .= ':' unless$dir =~ m%[\]:]$%;push(@dirs,$dir)}push(@dirs,'Sys$System:');for my$dir (@dirs){my$sysfile="$dir$file";for my$ext (@exts){return$file if -x "$sysfile$ext" &&!-d _}}}return}sub do_system {my ($self,@cmd)=@_;$self->log_verbose("@cmd\n");my$cmd=shift@cmd;my$args=$self->_quote_args(@cmd);return!system("$cmd $args")}sub oneliner {my$self=shift;my$oneliner=$self->SUPER::oneliner(@_);$oneliner =~ s/^\"\S+\"//;return "MCR $^X $oneliner"}sub rscan_dir {my ($self,$dir,$pattern)=@_;my$result=$self->SUPER::rscan_dir($dir,$pattern);for my$file (@$result){if (!_efs()&& ($file =~ m#/#)){$file =~ s/\.$//}}return$result}sub dist_dir {my$self=shift;my$dist_dir=$self->SUPER::dist_dir;$dist_dir =~ s/\./_/g unless _efs();return$dist_dir}sub man3page_name {my$self=shift;my$mpname=$self->SUPER::man3page_name(shift);my$sep=$self->manpage_separator;$mpname =~ s/^$sep//;return$mpname}sub expand_test_dir {my ($self,$dir)=@_;my@reldirs=$self->SUPER::expand_test_dir($dir);for my$eachdir (@reldirs){my ($v,$d,$f)=File::Spec->splitpath($eachdir);my$reldir=File::Spec->abs2rel(File::Spec->catpath($v,$d,''));$eachdir=File::Spec->catfile($reldir,$f)}return@reldirs}sub _detildefy {my ($self,$arg)=@_;return$arg if ($arg =~ /^~~/);return$arg if ($arg =~ /^~ /);if ($arg =~ /^~/){my$spec=$arg;$spec =~ s/^~//;$spec =~ s#^/##;my$home=VMS::Filespec::unixify($ENV{HOME});$home .= '/' unless$home =~ m#/$#;if ($spec eq ''){$home =~ s#/$##;return$home}my ($hvol,$hdir,$hfile)=File::Spec::Unix->splitpath($home);if ($hdir eq ''){$hdir=$hfile}my ($vol,$dir,$file)=File::Spec::Unix->splitpath($spec);my@hdirs=File::Spec::Unix->splitdir($hdir);my@dirs=File::Spec::Unix->splitdir($dir);unless ($arg =~ m#^~/#){shift@dirs}my$newdirs=File::Spec::Unix->catdir(@hdirs,@dirs);$arg=File::Spec::Unix->catpath($hvol,$newdirs,$file)}return$arg}sub find_perl_interpreter {return VMS::Filespec::vmsify($^X)}sub localize_file_path {my ($self,$path)=@_;$path=VMS::Filespec::vmsify($path);$path =~ s/\.\z//;return$path}sub localize_dir_path {my ($self,$path)=@_;return VMS::Filespec::vmspath($path)}sub ACTION_clean {my ($self)=@_;for my$item (map glob(VMS::Filespec::rmsexpand($_,'.;0')),$self->cleanup){$self->delete_filetree($item)}}my$use_feature;BEGIN {if (eval {local$SIG{__DIE__};require VMS::Feature}){$use_feature=1}}sub _unix_rpt {my$unix_rpt;if ($use_feature){$unix_rpt=VMS::Feature::current("filename_unix_report")}else {my$env_unix_rpt=$ENV{'DECC$FILENAME_UNIX_REPORT'}|| '';$unix_rpt=$env_unix_rpt =~ /^[ET1]/i}return$unix_rpt}sub _efs {my$efs;if ($use_feature){$efs=VMS::Feature::current("efs_charset")}else {my$env_efs=$ENV{'DECC$EFS_CHARSET'}|| '';$efs=$env_efs =~ /^[ET1]/i}return$efs}1; +MODULE_BUILD_PLATFORM_VMS + +$fatpacked{"Module/Build/Platform/VOS.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_VOS'; + package Module::Build::Platform::VOS;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Base;our@ISA=qw(Module::Build::Base);1; +MODULE_BUILD_PLATFORM_VOS + +$fatpacked{"Module/Build/Platform/Windows.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_WINDOWS'; + package Module::Build::Platform::Windows;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Config;use File::Basename;use File::Spec;use Module::Build::Base;our@ISA=qw(Module::Build::Base);sub manpage_separator {return '.'}sub have_forkpipe {0}sub _detildefy {my ($self,$value)=@_;$value =~ s,^~(?= [/\\] | $ ),$ENV{HOME},x if$ENV{HOME};return$value}sub ACTION_realclean {my ($self)=@_;$self->SUPER::ACTION_realclean();my$basename=basename($0);$basename =~ s/(?:\.bat)?$//i;if (lc$basename eq lc$self->build_script){if ($self->build_bat){$self->log_verbose("Deleting $basename.bat\n");my$full_progname=$0;$full_progname =~ s/(?:\.bat)?$/.bat/i;require Win32;my$null_arg=(Win32::IsWinNT())? '""' : '';my$cmd=qq(start $null_arg /min "\%comspec\%" /c del "$full_progname");open(my$fh,'>>',"$basename.bat")or die "Can't create $basename.bat: $!";print$fh $cmd;close$fh }else {$self->delete_filetree($self->build_script .'.bat')}}}sub make_executable {my$self=shift;$self->SUPER::make_executable(@_);for my$script (@_){if ($script =~ /\.(bat|cmd)$/){$self->SUPER::make_executable($script);next}else {my%opts=();if ($script eq $self->build_script){$opts{ntargs}=q(-x -S %0 --build_bat %*);$opts{otherargs}=q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9)}my$out=eval {$self->pl2bat(in=>$script,update=>1,%opts)};if ($@){$self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@")}else {$self->SUPER::make_executable($out)}}}}sub pl2bat {my$self=shift;my%opts=@_;$opts{ntargs}='-x -S %0 %*' unless exists$opts{ntargs};$opts{otherargs}='-x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9' unless exists$opts{otherargs};$opts{stripsuffix}='/\\.plx?/' unless exists$opts{stripsuffix};$opts{stripsuffix}=($opts{stripsuffix}=~ m{^/([^/]*[^/\$]|)\$?/?$} ? $1 : "\Q$opts{stripsuffix}\E");unless (exists$opts{out}){$opts{out}=$opts{in};$opts{out}=~ s/$opts{stripsuffix}$//oi;$opts{out}.= '.bat' unless$opts{in}=~ /\.bat$/i or $opts{in}=~ /^-$/}my$head=<;close($in);for my$line (@file){$linenum++;if ($line =~ /^:endofperl\b/){if (!exists$opts{update}){warn "$opts{in} has already been converted to a batch file!\n";return}$taildone++}if (not $linedone and $line =~ /^#!.*perl/){if (exists$opts{update}){$skiplines=$linenum - 1;$line .= "#line ".(1+$headlines)."\n"}else {$line .= "#line ".($linenum+$headlines)."\n"}$linedone++}if ($line =~ /^#\s*line\b/ and $linenum==2 + $skiplines){$line=""}}open(my$out,'>',"$opts{out}")or die "Can't open $opts{out}: $!";print$out $head;print$out $start,($opts{usewarnings}? " -w" : ""),"\n#line ",($headlines+1),"\n" unless$linedone;print$out @file[$skiplines..$#file];print$out $tail unless$taildone;close($out);return$opts{out}}sub _quote_args {my ($self,@args)=@_;my@quoted;for (@args){if (/^[^\s*?!\$<>;|'"\[\]\{\}]+$/){push@quoted,$_}else {s/"/\\"/g;push@quoted,qq("$_")}}return join " ",@quoted}sub split_like_shell {(my$self,local $_)=@_;return @$_ if defined()&& ref()eq 'ARRAY';my@argv;return@argv unless defined()&& length();my$length=length;m/\G\s*/gc;ARGS: until (pos==$length){my$quote_mode;my$arg='';CHARS: until (pos==$length){if (m/\G((?:\\\\)+)(?=\\?(")?)/gc){if (defined $2){$arg .= '\\' x (length($1)/ 2)}else {$arg .= $1}}elsif (m/\G\\"/gc){$arg .= '"'}elsif (m/\G"/gc){if ($quote_mode && m/\G"/gc){$arg .= '"'}$quote_mode=!$quote_mode}elsif (!$quote_mode && m/\G\s+/gc){last}elsif (m/\G(.)/sgc){$arg .= $1}}push@argv,$arg}return@argv}sub do_system {my ($self,@cmd)=@_;my$cmd=$self->_quote_args(@cmd);my$status=system($cmd);if ($status and $! =~ /Argument list too long/i){my$env_entries='';for (sort keys%ENV){$env_entries .= "$_=>".length($ENV{$_})."; "}warn "'Argument list' was 'too long', env lengths are $env_entries"}return!$status}sub _maybe_command {my($self,$file)=@_;my@e=exists($ENV{'PATHEXT'})? split(/;/,$ENV{PATHEXT}): qw(.com .exe .bat .cmd);my$e='';for (@e){$e .= "\Q$_\E|"}chop$e;if ($file =~ /($e)$/i){return$file if -e $file}else {for (@e){return "$file$_" if -e "$file$_"}}return}1; + \@rem = '--*-Perl-*-- + \@echo off + if "%OS%" == "Windows_NT" goto WinNT + perl $opts{otherargs} + goto endofperl + :WinNT + perl $opts{ntargs} + if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl + if %errorlevel% == 9009 echo You do not have Perl in your PATH. + if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul + goto endofperl + \@rem '; + EOT +MODULE_BUILD_PLATFORM_WINDOWS + +$fatpacked{"Module/Build/Platform/aix.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_AIX'; + package Module::Build::Platform::aix;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Platform::Unix;our@ISA=qw(Module::Build::Platform::Unix);1; +MODULE_BUILD_PLATFORM_AIX + +$fatpacked{"Module/Build/Platform/cygwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_CYGWIN'; + package Module::Build::Platform::cygwin;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Platform::Unix;our@ISA=qw(Module::Build::Platform::Unix);sub manpage_separator {'.'}sub _maybe_command {my ($self,$file)=@_;if ($file =~ m{^/cygdrive/}i){require Module::Build::Platform::Windows;return Module::Build::Platform::Windows->_maybe_command($file)}return$self->SUPER::_maybe_command($file)}1; +MODULE_BUILD_PLATFORM_CYGWIN + +$fatpacked{"Module/Build/Platform/darwin.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_DARWIN'; + package Module::Build::Platform::darwin;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Platform::Unix;our@ISA=qw(Module::Build::Platform::Unix);1; +MODULE_BUILD_PLATFORM_DARWIN + +$fatpacked{"Module/Build/Platform/os2.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PLATFORM_OS2'; + package Module::Build::Platform::os2;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;use Module::Build::Platform::Unix;our@ISA=qw(Module::Build::Platform::Unix);sub manpage_separator {'.'}sub have_forkpipe {0}sub _maybe_command {my($self,$file)=@_;$file =~ s,[/\\]+,/,g;return$file if -x $file &&!-d _;return "$file.exe" if -x "$file.exe" &&!-d _;return "$file.cmd" if -x "$file.cmd" &&!-d _;return}1; +MODULE_BUILD_PLATFORM_OS2 + +$fatpacked{"Module/Build/PodParser.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_PODPARSER'; + package Module::Build::PodParser;use strict;use warnings;our$VERSION='0.4224';$VERSION=eval$VERSION;sub new {my$package=shift;my$self;$self=bless {have_pod_parser=>0,@_},$package;unless ($self->{fh}){die "No 'file' or 'fh' parameter given" unless$self->{file};open($self->{fh},'<',$self->{file})or die "Couldn't open $self->{file}: $!"}return$self}sub parse_from_filehandle {my ($self,$fh)=@_;local $_;while (<$fh>){next unless /^=(?!cut)/ .. /^=cut/;last if ($self->{abstract})=/^ (?: [a-z_0-9:]+ | [BCIF] < [a-z_0-9:]+ > ) \s+ - \s+ (.*\S) /ix}my@author;while (<$fh>){next unless /^=head1\s+AUTHORS?/i ... /^=/;next if /^=/;push@author,$_ if /\@/}return unless@author;s/^\s+|\s+$//g foreach@author;$self->{author}=\@author;return}sub get_abstract {my$self=shift;return$self->{abstract}if defined$self->{abstract};$self->parse_from_filehandle($self->{fh});return$self->{abstract}}sub get_author {my$self=shift;return$self->{author}if defined$self->{author};$self->parse_from_filehandle($self->{fh});return$self->{author}|| []} +MODULE_BUILD_PODPARSER + +$fatpacked{"Module/Build/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'MODULE_BUILD_TINY'; + package Module::Build::Tiny;$Module::Build::Tiny::VERSION='0.039';use strict;use warnings;use Exporter 5.57 'import';our@EXPORT=qw/Build Build_PL/;use CPAN::Meta;use ExtUtils::Config 0.003;use ExtUtils::Helpers 0.020 qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;use ExtUtils::Install qw/pm_to_blib install/;use ExtUtils::InstallPaths 0.002;use File::Basename qw/basename dirname/;use File::Find ();use File::Path qw/mkpath rmtree/;use File::Spec::Functions qw/catfile catdir rel2abs abs2rel splitdir curdir/;use Getopt::Long 2.36 qw/GetOptionsFromArray/;use JSON::PP 2 qw/encode_json decode_json/;sub write_file {my ($filename,$content)=@_;open my$fh,'>',$filename or die "Could not open $filename: $!\n";print$fh $content}sub read_file {my ($filename,$mode)=@_;open my$fh,'<',$filename or die "Could not open $filename: $!\n";return do {local $/;<$fh>}}sub get_meta {my ($metafile)=grep {-e $_}qw/META.json META.yml/ or die "No META information provided\n";return CPAN::Meta->load_file($metafile)}sub manify {my ($input_file,$output_file,$section,$opts)=@_;return if -e $output_file && -M $input_file <= -M $output_file;my$dirname=dirname($output_file);mkpath($dirname,$opts->{verbose})if not -d $dirname;require Pod::Man;Pod::Man->new(section=>$section)->parse_from_file($input_file,$output_file);print "Manifying $output_file\n" if$opts->{verbose}&& $opts->{verbose}> 0;return}sub process_xs {my ($source,$options)=@_;die "Can't build xs files under --pureperl-only\n" if$options->{'pureperl-only'};my (undef,@parts)=splitdir(dirname($source));push@parts,my$file_base=basename($source,'.xs');my$archdir=catdir(qw/blib arch auto/,@parts);my$tempdir='temp';my$c_file=catfile($tempdir,"$file_base.c");require ExtUtils::ParseXS;mkpath($tempdir,$options->{verbose},oct '755');ExtUtils::ParseXS::process_file(filename=>$source,prototypes=>0,output=>$c_file);my$version=$options->{meta}->version;require ExtUtils::CBuilder;my$builder=ExtUtils::CBuilder->new(config=>$options->{config}->values_set);my$ob_file=$builder->compile(source=>$c_file,defines=>{VERSION=>qq/"$version"/,XS_VERSION=>qq/"$version"/ },include_dirs=>[curdir,dirname($source)]);require DynaLoader;my$mod2fname=defined&DynaLoader::mod2fname ? \&DynaLoader::mod2fname : sub {return $_[0][-1]};mkpath($archdir,$options->{verbose},oct '755')unless -d $archdir;my$lib_file=catfile($archdir,$mod2fname->(\@parts).'.' .$options->{config}->get('dlext'));return$builder->link(objects=>$ob_file,lib_file=>$lib_file,module_name=>join '::',@parts)}sub find {my ($pattern,$dir)=@_;my@ret;File::Find::find(sub {push@ret,$File::Find::name if /$pattern/ && -f},$dir)if -d $dir;return@ret}my%actions=(build=>sub {my%opt=@_;for my$pl_file (find(qr/\.PL$/,'lib')){(my$pm=$pl_file)=~ s/\.PL$//;system $^X,$pl_file,$pm and die "$pl_file returned $?\n"}my%modules=map {$_=>catfile('blib',$_)}find(qr/\.p(?:m|od)$/,'lib');my%scripts=map {$_=>catfile('blib',$_)}find(qr//,'script');my%shared=map {$_=>catfile(qw/blib lib auto share dist/,$opt{meta}->name,abs2rel($_,'share'))}find(qr//,'share');pm_to_blib({%modules,%scripts,%shared},catdir(qw/blib lib auto/));make_executable($_)for values%scripts;mkpath(catdir(qw/blib arch/),$opt{verbose});process_xs($_,\%opt)for find(qr/.xs$/,'lib');if ($opt{install_paths}->install_destination('bindoc')&& $opt{install_paths}->is_default_installable('bindoc')){manify($_,catfile('blib','bindoc',man1_pagename($_)),$opt{config}->get('man1ext'),\%opt)for keys%scripts}if ($opt{install_paths}->install_destination('libdoc')&& $opt{install_paths}->is_default_installable('libdoc')){manify($_,catfile('blib','libdoc',man3_pagename($_)),$opt{config}->get('man3ext'),\%opt)for keys%modules}},test=>sub {my%opt=@_;die "Must run `./Build build` first\n" if not -d 'blib';require TAP::Harness::Env;my%test_args=((verbosity=>$opt{verbose})x!!exists$opt{verbose},(jobs=>$opt{jobs})x!!exists$opt{jobs},(color=>1)x!!-t STDOUT,lib=>[map {rel2abs(catdir(qw/blib/,$_))}qw/arch lib/ ],);my$tester=TAP::Harness::Env->create(\%test_args);$tester->runtests(sort +find(qr/\.t$/,'t'))->has_errors and exit 1},install=>sub {my%opt=@_;die "Must run `./Build build` first\n" if not -d 'blib';install($opt{install_paths}->install_map,@opt{qw/verbose dry_run uninst/})},clean=>sub {my%opt=@_;rmtree($_,$opt{verbose})for qw/blib temp/},realclean=>sub {my%opt=@_;rmtree($_,$opt{verbose})for qw/blib temp Build _build_params MYMETA.yml MYMETA.json/},);sub Build {my$action=@ARGV && $ARGV[0]=~ /\A\w+\z/ ? shift@ARGV : 'build';die "No such action '$action'\n" if not $actions{$action};my($env,$bargv)=@{decode_json(read_file('_build_params'))};my%opt;GetOptionsFromArray($_,\%opt,qw/install_base=s install_path=s% installdirs=s destdir=s prefix=s config=s% uninst:1 verbose:1 dry_run:1 pureperl-only:1 create_packlist=i jobs=i/)for ($env,$bargv,\@ARGV);$_=detildefy($_)for grep {defined}@opt{qw/install_base destdir prefix/},values %{$opt{install_path}};@opt{'config','meta' }=(ExtUtils::Config->new($opt{config}),get_meta());$actions{$action}->(%opt,install_paths=>ExtUtils::InstallPaths->new(%opt,dist_name=>$opt{meta}->name))}sub Build_PL {my$meta=get_meta();printf "Creating new 'Build' script for '%s' version '%s'\n",$meta->name,$meta->version;my$dir=$meta->name eq 'Module-Build-Tiny' ? "use lib 'lib';" : '';write_file('Build',"#!perl\n$dir\nuse Module::Build::Tiny;\nBuild();\n");make_executable('Build');my@env=defined$ENV{PERL_MB_OPT}? split_like_shell($ENV{PERL_MB_OPT}): ();write_file('_build_params',encode_json([\@env,\@ARGV ]));$meta->save(@$_)for ['MYMETA.json'],['MYMETA.yml'=>{version=>1.4 }]}1; +MODULE_BUILD_TINY + +$fatpacked{"PadWalker.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PADWALKER'; + package PadWalker;use strict;use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);require Exporter;require DynaLoader;require 5.008;@ISA=qw(Exporter DynaLoader);@EXPORT_OK=qw(peek_my peek_our closed_over peek_sub var_name set_closed_over);%EXPORT_TAGS=(all=>\@EXPORT_OK);$VERSION='2.3';bootstrap PadWalker$VERSION;sub peek_my;sub peek_our;sub closed_over;sub peek_sub;sub var_name;1; +PADWALKER + +$fatpacked{"Path/Tiny.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'PATH_TINY'; + use 5.008001;use strict;use warnings;package Path::Tiny;our$VERSION='0.104';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_BSD=>(scalar $^O =~ /bsd$/),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 {!!eval {require Unicode::UTF8;Unicode::UTF8->VERSION(0.58);1}}my$HAS_PU;sub _check_PU {!!eval {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 if Path::Tiny::IS_BSD(),'warnings::register'}my$WARNED_BSD_NFS=0;sub _throw {my ($self,$function,$file,$msg)=@_;if (IS_BSD()&& $function =~ /^flock/ && $! =~ /operation not supported/i &&!warnings::fatal_enabled('flock')){if (!$WARNED_BSD_NFS){warnings::warn(flock=>"No flock for NFS on BSD: continuing in unsafe mode");$WARNED_BSD_NFS++}}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}){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; +PATH_TINY + +$fatpacked{"Smart/Options.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SMART_OPTIONS'; + package Smart::Options;use strict;use warnings;use 5.010001;our$VERSION='0.061';require Exporter;our@ISA=qw(Exporter);our@EXPORT=qw(argv);use List::MoreUtils qw(uniq);use Text::Table;use File::Slurp;sub new {my$pkg=shift;my%opt=@_;my$self=bless {alias=>{},default=>{},boolean=>{},demand=>{},usage=>"Usage: $0",describe=>{},type=>{},subcmd=>{},coerce=>{},env=>{},env_prefix=>'',},$pkg;if ($opt{add_help}// 1){$self->options(h=>{alias=>'help',describe=>'show help',});$self->{add_help}=1}$self}sub argv {Smart::Options->new->parse(@_)}sub _set {my$self=shift;my$param=shift;my%args=@_;for my$option (keys%args){$self->{$param}->{$option}=$args{$option}}$self}sub alias {shift->_set('alias',@_)}sub default {shift->_set('default',@_)}sub describe {shift->_set('describe',@_)}sub type {shift->_set('type',@_)}sub subcmd {shift->_set('subcmd',@_)}sub _set_flag {my$self=shift;my$param=shift;for my$option (@_){$self->{$param}->{$option}=1}$self}sub boolean {shift->_set_flag('boolean',@_)}sub demand {shift->_set_flag('demand',@_)}sub env {shift->_set_flag('env',@_)}sub options {my$self=shift;my%args=@_;while (my($opt,$setting)=each%args){for my$key (keys %$setting){$self->$key($opt,$setting->{$key})}}$self}sub coerce {my ($self,$isa,$type,$generater)=@_;$self->{coerce}->{$isa}={type=>$type,generater=>$generater,};$self}sub usage {$_[0]->{usage}=$_[1];$_[0]}sub env_prefix {$_[0]->{env_prefix}=$_[1];$_[0]}sub _get_opt_desc {my ($self,$option)=@_;my@opts=($option);while (my($opt,$val)=each %{$self->{alias}}){push@opts,$opt if$val eq $option}return join(', ',map {(length($_)==1 ? '-' : '--').$_}sort@opts)}sub _get_describe {my ($self,$option)=@_;my$desc=$self->{describe}->{$option};while (my($opt,$val)=each %{$self->{alias}}){$desc ||= $self->{describe}->{$opt}if$val eq $option}return$desc ? ucfirst($desc): ''}sub _get_default {my ($self,$option)=@_;my$value=$self->{default}->{$option};while (my($opt,$val)=each %{$self->{alias}}){$value ||= $self->{default}->{$opt}if$val eq $option}$value}sub help {my$self=shift;my$alias=$self->{alias};my$demand=$self->{demand};my$describe=$self->{describe};my$default=$self->{default};my$boolean=$self->{boolean};my$help=$self->{usage}."\n";if (scalar(keys %$demand)or scalar(keys %$describe)){my@opts;for my$opt (uniq sort keys %$demand,keys %$describe,keys %$default,keys %$boolean,values %$alias){next if$alias->{$opt};push@opts,[$self->_get_opt_desc($opt),$self->_get_describe($opt),$boolean->{$opt}? '[boolean]' : '',$demand->{$opt}? '[required]' : '',$self->_get_default($opt)? "[default: @{[$self->_get_default($opt)]}]" : '',]}my$sep=\' ';$help .= "\nOptions:\n";$help .= Text::Table->new($sep,'',$sep,'',$sep,'',$sep,'',$sep,'')->load(@opts)->stringify ."\n";if (keys %{$self->{subcmd}}){$help .= "Implemented commands are:\n";$help .= " " .join(', ',sort keys %{$self->{subcmd}})."\n\n"}}$help}sub showHelp {my ($self,$fh)=@_;$fh //= *STDERR;print$fh $self->help}sub _set_v2a {my ($argv,$key,$value,$k)=@_;if ($k){$argv->{$key}//= {};_set_v2a($argv->{$key},$k,$value)}elsif (exists$argv->{$key}){if (ref($argv->{$key})){push @{$argv->{$key}},$value}else {$argv->{$key}=[$argv->{$key},$value ]}}else {$argv->{$key}=$value}}sub _get_real_name {my ($self,$opt)=@_;while (my$name=$self->{alias}->{$opt}){$opt=$name}return$opt}sub _load_config {my ($self,$argv,$file)=@_;for my$line (read_file($file)){next if$line =~ /^\[/;next if$line =~ /^;/;next if$line !~ /=/;chomp($line);if ($line =~ /^(.+?[^\\])=(.*)$/){$argv->{$1}=$2}}}sub parse {my$self=shift;push @_,@ARGV unless @_;my$argv={};my@args;my$boolean=$self->{boolean};my$key;my$nest_key;my$stop=0;for my$arg (@_){if ($stop){push@args,$arg;next}if ($arg =~ /^--((?:\w|-|\.)+)=(.+)$/){my ($opt,$k)=split(/\./,$1);my$option=$self->_get_real_name($opt);if ($k){_set_v2a($argv,$option,$2,$k)}else {_set_v2a($argv,$option,$2)}}elsif ($arg =~ /^(-(\w)|--((?:\w|-|\.)+))$/){if ($key){$argv->{$key}=1}my$opt=$2 // $3;if ($opt =~ /^no\-(.+)$/){my$option=$self->_get_real_name($1);$argv->{$option}=0;next}($opt,my$k)=split(/\./,$opt);my$option=$self->_get_real_name($opt);if ($boolean->{$option}){if ($k){$argv->{$option}//= {};$argv->{$option}->{$k}=1}else {$argv->{$option}=1}}else {$key=$option;$nest_key=$k}}elsif ($arg =~ /^-(\w(?:\w|-|\.)+)$/){if ($key){$argv->{$key}=1}my$opt_str=$1;if ($opt_str =~ /^(.)([0-9])+$/){my$option=$self->_get_real_name($1);$argv->{$option}=$2}else {for (split //,$opt_str){my$option=$self->_get_real_name($_);$argv->{$option}=1}}}elsif ($arg =~ /^--$/){$stop=1;next}else {if ($key){if ($nest_key){_set_v2a($argv,$key,$arg,$nest_key)}else {_set_v2a($argv,$key,$arg)}$key=$nest_key=undef}else {if (!scalar(@args)&& keys %{$self->{subcmd}}){if ($self->{subcmd}->{$arg}){$argv->{command}=$arg;$stop=1;next}else {die "sub command '$arg' not defined."}}push@args,$arg}}}if ($key){if ($nest_key){$argv->{$key}//= {};$argv->{$key}->{$nest_key}=1}else {$argv->{$key}=1}}if (my$parser=$self->{subcmd}->{$argv->{command}||''}){$argv->{cmd_option}=$parser->parse(@args)}else {$argv->{_}=\@args}for my$env (keys %{$self->{env}}){if (defined($ENV{uc($self->{env_prefix}."_$env")})){my$option=$self->_get_real_name($env);$argv->{$option}//= $ENV{uc($self->{env_prefix}."_$env")}}}while (my ($key,$val)=each %{$self->{default}}){my$opt=$self->_get_real_name($key);if (ref($val)&& ref($val)eq 'CODE'){$argv->{$opt}//= $val->()}else {$argv->{$opt}//= $val}}while (my ($key,$val)=each %{$self->{type}}){next if$val ne 'Config';next if!($argv->{$key})||!(-f $argv->{$key});$self->_load_config($argv,delete$argv->{$key})}for my$key (keys %{$self->{demand}}){my$opt=$self->_get_real_name($key);if (!$argv->{$opt}){$self->showHelp;print STDERR "\nMissing required arguments: $opt\n";die}}for my$key (keys %{$self->{type}}){my$opt=$self->_get_real_name($key);my$type=$self->{type}->{$key};if (my$c=$self->{coerce}->{$type}){$type=$c->{type};$argv->{$opt}=$c->{generater}->($argv->{$opt})}my$check=0;if ($type eq 'Bool'){$argv->{$opt}//= 0;$check=($argv->{$opt}=~ /^(0|1)$/)? 1 : 0}elsif ($type eq 'Str'){$check=1}elsif ($type eq 'Int'){if ($argv->{$opt}){$check=($argv->{$opt}=~ /^\-?\d+$/)? 1 : 0}else {$check=1}}elsif ($type eq 'Num'){if ($argv->{$opt}){$check=($argv->{$opt}=~ /^\-?\d+(\.\d+)$/)? 1 : 0}else {$check=1}}elsif ($type eq 'ArrayRef'){$argv->{$opt}//= [];unless (ref($argv->{$opt})){$argv->{$opt}=[$argv->{$opt}]}$check=(ref($argv->{$opt})eq 'ARRAY')? 1 : 0}elsif ($type eq 'HashRef'){$argv->{$opt}//= {};$check=(ref($argv->{$opt})eq 'HASH')? 1 : 0}elsif ('Config'){if ($argv->{$opt}&&!(-f $argv->{$opt})){die "cannot load config file '@{[$argv->{$opt}]}\n"}$check=1}else {die "cannot find type constraint '$type'\n"}unless ($check){die "Value '@{[$argv->{$opt}]}' invalid for option $opt($type)\n"}}if ($argv->{help}&& $self->{add_help}){$self->showHelp;die}$argv}1; +SMART_OPTIONS + +$fatpacked{"Smart/Options/Declare.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'SMART_OPTIONS_DECLARE'; + package Smart::Options::Declare;use strict;use warnings;use Exporter 'import';use Smart::Options;use PadWalker qw/var_name/;our@EXPORT=qw(opts opts_coerce);our$COERCE={Multiple=>{type=>'ArrayRef',generater=>sub {if (defined $_[0]){return [split(qr{,},ref($_[0])eq 'ARRAY' ? join(q{,},@{$_[0]}): $_[0])]}else {return $_[0]}}}};my%is_invocant=map{$_=>undef}qw($self $class);sub opts {{package DB;()=caller(1)}if (exists$is_invocant{var_name(1,\$_[0])|| '' }){$_[0]=shift@DB::args;shift}my$opt=Smart::Options->new();$opt->type(config=>'Config');for (my$i=0 ;$i < @_ ;$i++ ){(my$name=var_name(1,\$_[$i]))or Carp::croak('usage: opts my $var => TYPE, ...');$name =~ s/^\$//;if ($name =~ /_/){(my$newname=$name)=~ s/_/-/g;$opt->alias($newname=>$name);$name=$newname}my$rule=$_[$i+1];if ($rule){if (ref($rule)&& ref($rule)eq 'HASH'){if ($rule->{default}){$opt->default($name=>$rule->{default})}if ($rule->{required}){$opt->demand($name)}if ($rule->{alias}){$opt->alias($rule->{alias}=>$name)}if ($rule->{comment}){$opt->describe($name=>$rule->{comment})}if (my$isa=$rule->{isa}){if ($isa eq 'Bool'){$opt->boolean($name)}$opt->type($name=>$isa)}}else {if ($rule eq 'Bool'){$opt->boolean($name)}$opt->type($name=>$rule)}}if (length($name)> 1){$opt->alias(substr($name,0,1)=>$name)}$i++ if defined $_[$i+1]}while (my ($isa,$c)=each(%$COERCE)){$opt->coerce($isa=>$c->{type},$c->{generater})}my$argv=$opt->parse;for (my$i=0 ;$i < @_ ;$i++ ){(my$name=var_name(1,\$_[$i]))or Carp::croak('usage: opts my $var => TYPE, ...');$name =~ s/^\$//;$_[$i]=$argv->{$name};$i++ if defined $_[$i+1]}}sub opts_coerce {my ($isa,$type,$generater)=@_;$COERCE->{$isa}={type=>$type,generater=>$generater }}1; +SMART_OPTIONS_DECLARE + +$fatpacked{"Text/Aligner.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_ALIGNER'; + 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; +TEXT_ALIGNER + +$fatpacked{"Text/Table.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEXT_TABLE'; + 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 /(?_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}} +TEXT_TABLE + +s/^ //mg for values %fatpacked; + +my $class = 'FatPacked::'.(0+\%fatpacked); +no strict 'refs'; +*{"${class}::files"} = sub { keys %{$_[0]} }; + +if ($] < 5.008) { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + my $pos = 0; + my $last = length $fat; + return (sub { + return 0 if $pos == $last; + my $next = (1 + index $fat, "\n", $pos) || $last; + $_ .= substr $fat, $pos, $next - $pos; + $pos = $next; + return 1; + }); + } + }; +} + +else { + *{"${class}::INC"} = sub { + if (my $fat = $_[0]{$_[1]}) { + open my $fh, '<', \$fat + or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; + return $fh; + } + return; + }; +} + +unshift @INC, bless \%fatpacked, $class; + } # END OF FATPACK CODE + +use strict; +use warnings; + +use lib 'lib'; +use CLI; + +CLI->new(template => $ENV{CR_TEMPLATE}, root_dir => $ENV{CR_ROOT_DIR})->run(@ARGV); diff -r 5f949b153f65 -r 73b27e5c1d79 slide-cr.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slide-cr.pl Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,8 @@ +#!/usr/bin/env perl +use strict; +use warnings; + +use lib 'lib'; +use CLI; + +CLI->new(template => $ENV{CR_TEMPLATE}, root_dir => $ENV{CR_ROOT_DIR})->run(@ARGV); diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/04/27/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/04/27/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,106 @@ +`+dalmore+one ./Configure.pl --cc /usr/local/x86-cbc/bin/gcc --debug --compiler gcc --prefix=/mnt/dalmore-home/one/src/build_perl6/MoarVM` + +実行 + +`make -j 70` + +何故かsrc側にlinkされていないmoarが生成される + +`make install` で両方にリンクが離れる + +とりあえずこれでbuildが通る + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar + +Creating tools/build/install-jvm-runner.pl ... + +===SORRY!=== +Found /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar version 2018.04-1-g577857a, which is too old. Wanted at least 2018.04-18-ge7d79d869 + +No suitable MoarVM (moar executable) found using the --prefix +(You can get a MoarVM built automatically with --gen-moar.) +``` + +MoarVMが古いと何を付けられる + + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar + +Creating tools/build/install-jvm-runner.pl ... +Cleaning up ... +You can now use 'make' to build NQP. +After that, 'make test' will run some tests and +'make install' will install NQP. ++dalmore+one make install +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/how/Archetypes.nqp src/how/RoleToRoleApplier.nqp src/how/NQPConcreteRoleHOW.nqp src/how/RoleToClassApplier.nqp src/how/NQPCurriedRoleHOW.nqp src/how/NQPParametricRoleHOW.nqp src/how/NQPClassHO +W.nqp src/how/NQPNativeHOW.nqp src/how/NQPAttribute.nqp src/how/NQPModuleHOW.nqp src/how/EXPORTHOW.nqp > gen/moar/stage1/nqpmo.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/nqpmo.moarvm gen/moar/stage1/nqpmo.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/ModuleLoader.moarvm src/vm/moar/ModuleLoader.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/core/NativeTypes.nqp src/core/NQPRoutine.nqp src/core/NQPMu.nqp src/core/NQPCapture.nqp src/core/IO.nqp src/core/Regex.nqp src/core/Hash.nqp src/core/NQPLock.nqp src/core/testing.nqp src/core/ +YOUAREHERE.nqp > gen/moar/stage1/NQPCORE.setting +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPCORE.setting.moarvm gen/moar/stage1/NQPCORE.setting +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QAST/CompileTimeValue.nqp src/QAST/SpecialArg.nqp src/QAST/Children.nqp src/QAST/Node.nqp src/QAST/NodeList.nqp src/QAST/Regex.nqp src/QAST/IVal.nqp src/QAST/NVal.nqp src/QAST/SVal.nqp src/QAS +T/BVal.nqp src/QAST/WVal.nqp src/QAST/Want.nqp src/QAST/Var.nqp src/QAST/VarWithFallback.nqp src/QAST/ParamTypeCheck.nqp src/QAST/Op.nqp src/QAST/VM.nqp src/QAST/Stmts.nqp src/QAST/Stmt.nqp src/QAST/Block.nqp src/QAST/Unquote.nqp src/QAST +/CompUnit.nqp src/QAST/InlinePlaceholder.nqp > gen/moar/stage1/QASTNode.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QASTNode.moarvm gen/moar/stage1/QASTNode.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QRegex/NFA.nqp src/QRegex/Cursor.nqp > gen/moar/stage1/QRegex.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QRegex.moarvm gen/moar/stage1/QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/vm/moar/HLL/Backend.nqp src/HLL/Grammar.nqp src/HLL/Actions.nqp src/HLL/Compiler.nqp src/HLL/CommandLine.nqp src/HLL/World.nqp src/HLL/sprintf.nqp > gen/moar/stage1/NQPHLL.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPHLL.moarvm gen/moar/stage1/NQPHLL.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/MASTOps.moarvm /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/../share/nqp/lib/MAST/Ops.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/MASTNodes.moarvm /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/../share/nqp/lib/MAST/Nodes.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/vm/moar/QAST/QASTRegexCompilerMAST.nqp src/vm/moar/QAST/QASTOperationsMAST.nqp src/vm/moar/QAST/QASTCompilerMAST.nqp > gen/moar/stage1/QAST.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QAST.moarvm gen/moar/stage1/QAST.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QRegex/P6Regex/Grammar.nqp src/QRegex/P6Regex/Actions.nqp src/QRegex/P6Regex/Compiler.nqp src/QRegex/P6Regex/Optimizer.nqp > gen/moar/stage1/NQPP6QRegex.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPP6QRegex.moarvm gen/moar/stage1/NQPP6QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-version.pl /mnt/dalmore-home/one/src/build_perl6/nqp /mnt/dalmore-home/one/src/build_perl6/nqp/share/nqp/lib > gen/moar/stage1/nqp-config.nqp +Can't locate Digest/SHA.pm in @INC (@INC contains: /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at tools/build/gen-version.pl line 9. +BEGIN failed--compilation aborted at tools/build/gen-version.pl line 9. +make: *** [gen/moar/stage1/nqp.moarvm] Error 2 +``` + + +# cpanmを入れようとしたところ終了 + +``` ++dalmore+one curl -L https://cpanmin.us | perl - --sudo App::cpanminus % Total % Received % Xferd Average Speed Time Time Time Current + Dload Upload Total Spent Left Speed +100 295k 100 295k 0 0 864k 0 --:--:-- --:--:-- --:--:-- 864k +--> Working on App::cpanminus +Fetching http://www.cpan.org/authors/id/M/MI/MIYAGAWA/App-cpanminus-1.7044.tar.gz ... OK +==> Found dependencies: ExtUtils::MakeMaker +--> Working on ExtUtils::MakeMaker +Fetching http://www.cpan.org/authors/id/B/BI/BINGOS/ExtUtils-MakeMaker-7.34.tar.gz ... OK +Configuring ExtUtils-MakeMaker-7.34 ... OK +Can't locate ExtUtils/Manifest.pm in @INC (@INC contains: FatPacked::13507464=HASH(0xce1b88) /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at - line 132. +``` + +どうも 'perl-devel' が入っていないのが原因の用 + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/01/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/01/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,142 @@ +作業ログ +- one/src以下で実行 + +`git clone https://github.com/MoarVM/MoarVM.git` + +- MoarVMをclone +MoarVMの書き換え + +(dalmore) `./Configure.pl --cc /usr/local/cbclang/bin/clang` +make -j 70 + +# セグフォで死ぬ + +0. Program arguments: /net/open/CentOS/local/cbclang/bin/clang-7.0 -cc1 -triple x86_64-unknown-linux-gnu -emit-obj -disable-free -main-file-name io.c -mrelocation-model pic -pic-level 2 -mthread-model posix -fmath-errno -masm-verbose -mconstructor-aliases -munwind-tables -fuse-init-array -target-cpu x86-64 -dwarf-column-info -debug-info-kind=limited -dwarf-version=4 -debugger-tuning=gdb -momit-leaf-frame-pointer -coverage-notes-file /mnt/dalmore-home/one/src/MoarVM/src/platform/posix/io.gcno -resource-dir /net/open/CentOS/local/cbclang/lib/clang/7.0.0 -D NDEBUG -D _REENTRANT -D _FILE_OFFSET_BITS=64 -D DEBUG_HELPERS -D MVM_TRACING=0 -D MVM_CGOTO=1 -D MVM_RDTSCP=1 -D MVM_BUILD_SHARED -I 3rdparty/libuv/include -I 3rdparty/libuv/src -I 3rdparty/libatomicops/src -I 3rdparty/libtommath -I 3rdparty/dyncall/dynload -I 3rdparty/dyncall/dyncall -I 3rdparty/dyncall/dyncallback -I 3rdparty/sha1 -I 3rdparty/tinymt -I 3rdparty/dynasm -I 3rdparty/cmp -I 3rdparty -I src -internal-isystem /usr/local/include -internal-isystem /net/open/CentOS/local/cbclang/lib/clang/7.0.0/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O3 -Werror=declaration-after-statement -Werror=pointer-arith -fdebug-compilation-dir /mnt/dalmore-home/one/src/MoarVM -ferror-limit 19 -fmessage-length 136 -fobjc-runtime=gcc -fdiagnostics-show-option -fcolor-diagnostics -vectorize-loops -vectorize-slp -o src/platform/posix/io.o -x c src/platform/posix/io.c +1. parser at end of file +clang-7.0: error: unable to execute command: Segmentation fault +clang-7.0: error: clang frontend command failed due to signal (use -v to see invocation) +clang version 7.0.0 +Target: x86_64-unknown-linux-gnu +Thread model: posix +InstalledDir: /usr/local/cbclang/bin +clang-7.0: note: diagnostic msg: PLEASE submit a bug report to https://bugs.llvm.org/ and include the crash backtrace, preprocessed source, and associated run script. +clang-7.0: note: diagnostic msg: +******************** + +PLEASE ATTACH THE FOLLOWING FILES TO THE BUG REPORT: +Preprocessed source(s) and associated run script(s) are located at: +clang-7.0: note: diagnostic msg: /tmp/io-e696e2.c +clang-7.0: note: diagnostic msg: /tmp/io-e696e2.sh +clang-7.0: note: diagnostic msg: + +******************** + +`./Configure.pl --cc /usr/local/x86-cbc/bin/gcc --debug --compiler gcc --prefix=/mnt/dalmore-home/one/src/build_MoarVM` +` make -C ../MoarVM -j 70` +` make install` +`+dalmore+one ./Configure.pl --cc /usr/local/x86-cbc/bin/gcc --debug --compiler gcc --prefix=/mnt/dalmore-home/one/src/build_perl6/MoarVM` + +実行 + +`make -j 70` + +何故かsrc側にlinkされていないmoarが生成される + +`make install` で両方にリンクが離れる + +とりあえずこれでbuildが通る + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar + +Creating tools/build/install-jvm-runner.pl ... + +===SORRY!=== +Found /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar version 2018.04-1-g577857a, which is too old. Wanted at least 2018.04-18-ge7d79d869 + +No suitable MoarVM (moar executable) found using the --prefix +(You can get a MoarVM built automatically with --gen-moar.) +``` + +MoarVMが古いと何を付けられる + + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar + +Creating tools/build/install-jvm-runner.pl ... +Cleaning up ... +You can now use 'make' to build NQP. +After that, 'make test' will run some tests and +'make install' will install NQP. ++dalmore+one make install +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/how/Archetypes.nqp src/how/RoleToRoleApplier.nqp src/how/NQPConcreteRoleHOW.nqp src/how/RoleToClassApplier.nqp src/how/NQPCurriedRoleHOW.nqp src/how/NQPParametricRoleHOW.nqp src/how/NQPClassHO +W.nqp src/how/NQPNativeHOW.nqp src/how/NQPAttribute.nqp src/how/NQPModuleHOW.nqp src/how/EXPORTHOW.nqp > gen/moar/stage1/nqpmo.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/nqpmo.moarvm gen/moar/stage1/nqpmo.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/ModuleLoader.moarvm src/vm/moar/ModuleLoader.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/core/NativeTypes.nqp src/core/NQPRoutine.nqp src/core/NQPMu.nqp src/core/NQPCapture.nqp src/core/IO.nqp src/core/Regex.nqp src/core/Hash.nqp src/core/NQPLock.nqp src/core/testing.nqp src/core/ +YOUAREHERE.nqp > gen/moar/stage1/NQPCORE.setting +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPCORE.setting.moarvm gen/moar/stage1/NQPCORE.setting +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QAST/CompileTimeValue.nqp src/QAST/SpecialArg.nqp src/QAST/Children.nqp src/QAST/Node.nqp src/QAST/NodeList.nqp src/QAST/Regex.nqp src/QAST/IVal.nqp src/QAST/NVal.nqp src/QAST/SVal.nqp src/QAS +T/BVal.nqp src/QAST/WVal.nqp src/QAST/Want.nqp src/QAST/Var.nqp src/QAST/VarWithFallback.nqp src/QAST/ParamTypeCheck.nqp src/QAST/Op.nqp src/QAST/VM.nqp src/QAST/Stmts.nqp src/QAST/Stmt.nqp src/QAST/Block.nqp src/QAST/Unquote.nqp src/QAST +/CompUnit.nqp src/QAST/InlinePlaceholder.nqp > gen/moar/stage1/QASTNode.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QASTNode.moarvm gen/moar/stage1/QASTNode.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QRegex/NFA.nqp src/QRegex/Cursor.nqp > gen/moar/stage1/QRegex.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QRegex.moarvm gen/moar/stage1/QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/vm/moar/HLL/Backend.nqp src/HLL/Grammar.nqp src/HLL/Actions.nqp src/HLL/Compiler.nqp src/HLL/CommandLine.nqp src/HLL/World.nqp src/HLL/sprintf.nqp > gen/moar/stage1/NQPHLL.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPHLL.moarvm gen/moar/stage1/NQPHLL.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/MASTOps.moarvm /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/../share/nqp/lib/MAST/Ops.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/MASTNodes.moarvm /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/../share/nqp/lib/MAST/Nodes.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/vm/moar/QAST/QASTRegexCompilerMAST.nqp src/vm/moar/QAST/QASTOperationsMAST.nqp src/vm/moar/QAST/QASTCompilerMAST.nqp > gen/moar/stage1/QAST.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QAST.moarvm gen/moar/stage1/QAST.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QRegex/P6Regex/Grammar.nqp src/QRegex/P6Regex/Actions.nqp src/QRegex/P6Regex/Compiler.nqp src/QRegex/P6Regex/Optimizer.nqp > gen/moar/stage1/NQPP6QRegex.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPP6QRegex.moarvm gen/moar/stage1/NQPP6QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-version.pl /mnt/dalmore-home/one/src/build_perl6/nqp /mnt/dalmore-home/one/src/build_perl6/nqp/share/nqp/lib > gen/moar/stage1/nqp-config.nqp +Can't locate Digest/SHA.pm in @INC (@INC contains: /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at tools/build/gen-version.pl line 9. +BEGIN failed--compilation aborted at tools/build/gen-version.pl line 9. +make: *** [gen/moar/stage1/nqp.moarvm] Error 2 +``` + + +# cpanmを入れようとしたところ終了 + +``` ++dalmore+one curl -L https://cpanmin.us | perl - --sudo App::cpanminus % Total % Received % Xferd Average Speed Time Time Time Current + Dload Upload Total Spent Left Speed +100 295k 100 295k 0 0 864k 0 --:--:-- --:--:-- --:--:-- 864k +--> Working on App::cpanminus +Fetching http://www.cpan.org/authors/id/M/MI/MIYAGAWA/App-cpanminus-1.7044.tar.gz ... OK +==> Found dependencies: ExtUtils::MakeMaker +--> Working on ExtUtils::MakeMaker +Fetching http://www.cpan.org/authors/id/B/BI/BINGOS/ExtUtils-MakeMaker-7.34.tar.gz ... OK +Configuring ExtUtils-MakeMaker-7.34 ... OK +Can't locate ExtUtils/Manifest.pm in @INC (@INC contains: FatPacked::13507464=HASH(0xce1b88) /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at - line 132. +``` + +どうも 'perl-devel' が入っていないのが原因の用 + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/01/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/01/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,213 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究内容 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- またPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- 本研究では継続を中心に開発されたContinuation based Cを用いてMoarVMの改良を検討する． + +# 今週の進捗 + +- dalmoreでCbCgccでMoarVM/NQPが動きました + +# MoarVMのclone + +- MoarVMをgithubからcloneする + +``` +$ git clone https://github.com/MoarVM/MoarVM.git +``` + +# MoarVMのmake + +- Perlの`Configure.pl`を叩いてMakefileを生成する + - 別のディレクトリからは叩け無い仕様に成っていた + +``` +./Configure.pl --cc /usr/local/x86-cbc/bin/gcc --debug --compiler gcc --prefix=/mnt/dalmore-home/one/src/build_perl6/MoarVM` +``` + +- オプション +- cc + - コンパイラのパスを設定する +- debug + - debugオプション +- compiler + - コンパイラの種類を指定する + - gcc, clang, clをサポートしている +- toolchain + - "posix", "gnu", "bsd" and "msvc"のツールチェインを選択可能 +- prefix + - make installの先を指定 + +# llvmでの実行 + +``` +(dalmore) ./Configure.pl --cc /usr/local/cbclang/bin/clang +``` + +- セグフォで死ぬ + +``` +0. Program arguments: /net/open/CentOS/local/cbclang/bin/clang-7.0 -cc1 -triple x86_64-unknown-linux-gnu -emit-obj -disable-free -main-f +ile-name io.c -mrelocation-model pic -pic-level 2 -mthread-model posix -fmath-errno -masm-verbose -mconstructor-aliases -munwind-tables -fuse +-init-array -target-cpu x86-64 -dwarf-column-info -debug-info-kind=limited -dwarf-version=4 -debugger-tuning=gdb -momit-leaf-frame-pointer -c +overage-notes-file /mnt/dalmore-home/one/src/MoarVM/src/platform/posix/io.gcno -resource-dir /net/open/CentOS/local/cbclang/lib/clang/7.0.0 - +D NDEBUG -D _REENTRANT -D _FILE_OFFSET_BITS=64 -D DEBUG_HELPERS -D MVM_TRACING=0 -D MVM_CGOTO=1 -D MVM_RDTSCP=1 -D MVM_BUILD_SHARED -I 3rdpar +ty/libuv/include -I 3rdparty/libuv/src -I 3rdparty/libatomicops/src -I 3rdparty/libtommath -I 3rdparty/dyncall/dynload -I 3rdparty/dyncall/dy +ncall -I 3rdparty/dyncall/dyncallback -I 3rdparty/sha1 -I 3rdparty/tinymt -I 3rdparty/dynasm -I 3rdparty/cmp -I 3rdparty -I src -internal-isy +stem /usr/local/include -internal-isystem /net/open/CentOS/local/cbclang/lib/clang/7.0.0/include -internal-externc-isystem /include -internal +-externc-isystem /usr/include -O3 -Werror=declaration-after-statement -Werror=pointer-arith -fdebug-compilation-dir /mnt/dalmore-home/one/src +/MoarVM -ferror-limit 19 -fmessage-length 136 -fobjc-runtime=gcc -fdiagnostics-show-option -fcolor-diagnostics -vectorize-loops -vectorize-sl +p -o src/platform/posix/io.o -x c src/platform/posix/io.c +1. parser at end of file +clang-7.0: error: unable to execute command: Segmentation fault +clang-7.0: error: clang frontend command failed due to signal (use -v to see invocation) +clang version 7.0.0 +Target: x86_64-unknown-linux-gnu +Thread model: posix +InstalledDir: /usr/local/cbclang/bin +clang-7.0: note: diagnostic msg: PLEASE submit a bug report to https://bugs.llvm.org/ and include the crash backtrace, preprocessed source, a +nd associated run script. +clang-7.0: note: diagnostic msg: +******************** + +PLEASE ATTACH THE FOLLOWING FILES TO THE BUG REPORT: +Preprocessed source(s) and associated run script(s) are located at: +clang-7.0: note: diagnostic msg: /tmp/io-e696e2.c +clang-7.0: note: diagnostic msg: /tmp/io-e696e2.sh +clang-7.0: note: diagnostic msg: + +******************** +``` + +# make + +``` +$ make -j 50 && make install +``` + +- 何故かsrc側にもmoarのバイナリが生成された +- `/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin`にMoarのバイナリが生成 + + +# NQPのmake + + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar +``` + +- オプション +- `prefix` + - ビルド先 +- `backends` + - NQPが走るVMを選択する +- `--with-moar` + - MoarVMを使う場合MoarVMのパス + +# バージョン + +``` +Creating tools/build/install-jvm-runner.pl ... + +===SORRY!=== +Found /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar version 2018.04-1-g577857a, which is too old. Wanted at least 2018.04-18-ge7d79d8 +69 + +No suitable MoarVM (moar executable) found using the --prefix +(You can get a MoarVM built automatically with --gen-moar.) +``` + +- MoarVMとバージョンが異なるらしくエラーが発生した + +``` +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=ge +n/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPP6QRegex.moarvm gen/moar/stage1/NQPP6QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-version.pl /mnt/dalmore-home/one/src/build_perl6/nqp /mnt/dalmore-home/one/src/build_perl6/nqp/share/nqp/lib > +gen/moar/stage1/nqp-config.nqp +Can't locate Digest/SHA.pm in @INC (@INC contains: /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl +5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at tools/build/gen-version.pl line 9. +BEGIN failed--compilation aborted at tools/build/gen-version.pl line 9. +make: *** [gen/moar/stage1/nqp.moarvm] Error 2 +``` + +- バージョンを更新したところ`Digest::SHA`が入っていないエラーが発生した + +# Perlモジュールの追加 + +- 最近のPerlのモジュールinstallツールのcpanmをoneにいれました +- `yum install perl-devel`を実行してperlのコアモジュールを追加した +- `curl -L https://cpanmin.us | perl - --sudo App::cpanminus ` +- `cpanm --force Digest::SHA` + + +# MacOSX上でのgccのエラー + +``` +$./Configure.pl --prefix=/Users/anatofuz/workspace/cr/Basic/build_perl6 --cc /Users/anatofuz/workspace/cr/build_gcc/bin/gcc --compiler gcc +``` + +これを実行すると + +``` +compiling 3rdparty/libuv/src/unix/darwin-proctitle.o +compiling 3rdparty/libuv/src/unix/fsevents.o +In file included from /System/Library/Frameworks/Security.framework/Headers/AuthSession.h:32:0, + from /System/Library/Frameworks/Security.framework/Headers/Security.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/CSIdentity.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/OSServices.h:27, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/IconsCore.h:23, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/LaunchServices.h:22, + from /System/Library/Frameworks/CoreServices.framework/Headers/CoreServices.h:39, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:23, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/Security.framework/Headers/Authorization.h:193:7: error: variably modified 'bytes' at file scope + char bytes[kAuthorizationExternalFormLength]; + ^~~~~ +In file included from /System/Library/Frameworks/Security.framework/Headers/AuthSession.h:32:0, + from /System/Library/Frameworks/Security.framework/Headers/Security.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/CSIdentity.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/OSServices.h:27, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/IconsCore.h:23, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/LaunchServices.h:22, + from /System/Library/Frameworks/CoreServices.framework/Headers/CoreServices.h:39, + from 3rdparty/libuv/src/unix/fsevents.c:49: +/System/Library/Frameworks/Security.framework/Headers/Authorization.h:193:7: error: variably modified 'bytes' at file scope + char bytes[kAuthorizationExternalFormLength]; + ^~~~~ +make: *** [3rdparty/libuv/src/unix/fsevents.o] Error 1 +make: *** Waiting for unfinished jobs.... +In file included from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGContext.h:18:0, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGBitmapContext.h:9, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CoreGraphics.h:11, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:35, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGFont.h:53:40: error: initializer element is not constant + static const CGFontIndex kCGGlyphMax = kCGFontIndexMax; + ^~~~~~~~~~~~~~~ +In file included from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGContext.h:21:0, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGBitmapContext.h:9, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CoreGraphics.h:11, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:35, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGPath.h:391:15: error: expected identifier or '(' before '^' token + typedef void (^CGPathApplyBlock)(const CGPathElement * element); + ^ +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGPath.h:393:53: error: unknown type name 'CGPathApplyBlock' + CG_EXTERN void CGPathApplyWithBlock(CGPathRef path, CGPathApplyBlock CF_NOESCAPE block) + ^~~~~~~~~~~~~~~~ +make: *** [3rdparty/libuv/src/unix/darwin-proctitle.o] Error 1 +``` + + +とフレームワークのコンパイルエラーが発生する． +これはbrew経由で入れたgcc-7でも発生した diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/07/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/07/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,1 @@ +remo diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/07/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/07/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,12 @@ +title: 近況報告 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究内容 +* OS + +# hoge +* foo + * puyo diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/07/zip.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/07/zip.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,149 @@ +2018-05-01---- +作業ログ +- one/src以下で実行 + +`git clone https://github.com/MoarVM/MoarVM.git` + +- MoarVMをclone +MoarVMの書き換え + +(dalmore) `./Configure.pl --cc /usr/local/cbclang/bin/clang` +make -j 70 + +# セグフォで死ぬ + +0. Program arguments: /net/open/CentOS/local/cbclang/bin/clang-7.0 -cc1 -triple x86_64-unknown-linux-gnu -emit-obj -disable-free -main-file-name io.c -mrelocation-model pic -pic-level 2 -mthread-model posix -fmath-errno -masm-verbose -mconstructor-aliases -munwind-tables -fuse-init-array -target-cpu x86-64 -dwarf-column-info -debug-info-kind=limited -dwarf-version=4 -debugger-tuning=gdb -momit-leaf-frame-pointer -coverage-notes-file /mnt/dalmore-home/one/src/MoarVM/src/platform/posix/io.gcno -resource-dir /net/open/CentOS/local/cbclang/lib/clang/7.0.0 -D NDEBUG -D _REENTRANT -D _FILE_OFFSET_BITS=64 -D DEBUG_HELPERS -D MVM_TRACING=0 -D MVM_CGOTO=1 -D MVM_RDTSCP=1 -D MVM_BUILD_SHARED -I 3rdparty/libuv/include -I 3rdparty/libuv/src -I 3rdparty/libatomicops/src -I 3rdparty/libtommath -I 3rdparty/dyncall/dynload -I 3rdparty/dyncall/dyncall -I 3rdparty/dyncall/dyncallback -I 3rdparty/sha1 -I 3rdparty/tinymt -I 3rdparty/dynasm -I 3rdparty/cmp -I 3rdparty -I src -internal-isystem /usr/local/include -internal-isystem /net/open/CentOS/local/cbclang/lib/clang/7.0.0/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O3 -Werror=declaration-after-statement -Werror=pointer-arith -fdebug-compilation-dir /mnt/dalmore-home/one/src/MoarVM -ferror-limit 19 -fmessage-length 136 -fobjc-runtime=gcc -fdiagnostics-show-option -fcolor-diagnostics -vectorize-loops -vectorize-slp -o src/platform/posix/io.o -x c src/platform/posix/io.c +1. parser at end of file +clang-7.0: error: unable to execute command: Segmentation fault +clang-7.0: error: clang frontend command failed due to signal (use -v to see invocation) +clang version 7.0.0 +Target: x86_64-unknown-linux-gnu +Thread model: posix +InstalledDir: /usr/local/cbclang/bin +clang-7.0: note: diagnostic msg: PLEASE submit a bug report to https://bugs.llvm.org/ and include the crash backtrace, preprocessed source, and associated run script. +clang-7.0: note: diagnostic msg: +******************** + +PLEASE ATTACH THE FOLLOWING FILES TO THE BUG REPORT: +Preprocessed source(s) and associated run script(s) are located at: +clang-7.0: note: diagnostic msg: /tmp/io-e696e2.c +clang-7.0: note: diagnostic msg: /tmp/io-e696e2.sh +clang-7.0: note: diagnostic msg: + +******************** + +`./Configure.pl --cc /usr/local/x86-cbc/bin/gcc --debug --compiler gcc --prefix=/mnt/dalmore-home/one/src/build_MoarVM` +` make -C ../MoarVM -j 70` +` make install` +`+dalmore+one ./Configure.pl --cc /usr/local/x86-cbc/bin/gcc --debug --compiler gcc --prefix=/mnt/dalmore-home/one/src/build_perl6/MoarVM` + +実行 + +`make -j 70` + +何故かsrc側にlinkされていないmoarが生成される + +`make install` で両方にリンクが離れる + +とりあえずこれでbuildが通る + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar + +Creating tools/build/install-jvm-runner.pl ... + +===SORRY!=== +Found /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar version 2018.04-1-g577857a, which is too old. Wanted at least 2018.04-18-ge7d79d869 + +No suitable MoarVM (moar executable) found using the --prefix +(You can get a MoarVM built automatically with --gen-moar.) +``` + +MoarVMが古いと何を付けられる + + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar + +Creating tools/build/install-jvm-runner.pl ... +Cleaning up ... +You can now use 'make' to build NQP. +After that, 'make test' will run some tests and +'make install' will install NQP. ++dalmore+one make install +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/how/Archetypes.nqp src/how/RoleToRoleApplier.nqp src/how/NQPConcreteRoleHOW.nqp src/how/RoleToClassApplier.nqp src/how/NQPCurriedRoleHOW.nqp src/how/NQPParametricRoleHOW.nqp src/how/NQPClassHO +W.nqp src/how/NQPNativeHOW.nqp src/how/NQPAttribute.nqp src/how/NQPModuleHOW.nqp src/how/EXPORTHOW.nqp > gen/moar/stage1/nqpmo.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/nqpmo.moarvm gen/moar/stage1/nqpmo.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/ModuleLoader.moarvm src/vm/moar/ModuleLoader.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/core/NativeTypes.nqp src/core/NQPRoutine.nqp src/core/NQPMu.nqp src/core/NQPCapture.nqp src/core/IO.nqp src/core/Regex.nqp src/core/Hash.nqp src/core/NQPLock.nqp src/core/testing.nqp src/core/ +YOUAREHERE.nqp > gen/moar/stage1/NQPCORE.setting +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPCORE.setting.moarvm gen/moar/stage1/NQPCORE.setting +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QAST/CompileTimeValue.nqp src/QAST/SpecialArg.nqp src/QAST/Children.nqp src/QAST/Node.nqp src/QAST/NodeList.nqp src/QAST/Regex.nqp src/QAST/IVal.nqp src/QAST/NVal.nqp src/QAST/SVal.nqp src/QAS +T/BVal.nqp src/QAST/WVal.nqp src/QAST/Want.nqp src/QAST/Var.nqp src/QAST/VarWithFallback.nqp src/QAST/ParamTypeCheck.nqp src/QAST/Op.nqp src/QAST/VM.nqp src/QAST/Stmts.nqp src/QAST/Stmt.nqp src/QAST/Block.nqp src/QAST/Unquote.nqp src/QAST +/CompUnit.nqp src/QAST/InlinePlaceholder.nqp > gen/moar/stage1/QASTNode.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QASTNode.moarvm gen/moar/stage1/QASTNode.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QRegex/NFA.nqp src/QRegex/Cursor.nqp > gen/moar/stage1/QRegex.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QRegex.moarvm gen/moar/stage1/QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/vm/moar/HLL/Backend.nqp src/HLL/Grammar.nqp src/HLL/Actions.nqp src/HLL/Compiler.nqp src/HLL/CommandLine.nqp src/HLL/World.nqp src/HLL/sprintf.nqp > gen/moar/stage1/NQPHLL.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPHLL.moarvm gen/moar/stage1/NQPHLL.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/MASTOps.moarvm /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/../share/nqp/lib/MAST/Ops.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/MASTNodes.moarvm /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/../share/nqp/lib/MAST/Nodes.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/vm/moar/QAST/QASTRegexCompilerMAST.nqp src/vm/moar/QAST/QASTOperationsMAST.nqp src/vm/moar/QAST/QASTCompilerMAST.nqp > gen/moar/stage1/QAST.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QAST.moarvm gen/moar/stage1/QAST.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QRegex/P6Regex/Grammar.nqp src/QRegex/P6Regex/Actions.nqp src/QRegex/P6Regex/Compiler.nqp src/QRegex/P6Regex/Optimizer.nqp > gen/moar/stage1/NQPP6QRegex.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPP6QRegex.moarvm gen/moar/stage1/NQPP6QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-version.pl /mnt/dalmore-home/one/src/build_perl6/nqp /mnt/dalmore-home/one/src/build_perl6/nqp/share/nqp/lib > gen/moar/stage1/nqp-config.nqp +Can't locate Digest/SHA.pm in @INC (@INC contains: /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at tools/build/gen-version.pl line 9. +BEGIN failed--compilation aborted at tools/build/gen-version.pl line 9. +make: *** [gen/moar/stage1/nqp.moarvm] Error 2 +``` + + +# cpanmを入れようとしたところ終了 + +``` ++dalmore+one curl -L https://cpanmin.us | perl - --sudo App::cpanminus % Total % Received % Xferd Average Speed Time Time Time Current + Dload Upload Total Spent Left Speed +100 295k 100 295k 0 0 864k 0 --:--:-- --:--:-- --:--:-- 864k +--> Working on App::cpanminus +Fetching http://www.cpan.org/authors/id/M/MI/MIYAGAWA/App-cpanminus-1.7044.tar.gz ... OK +==> Found dependencies: ExtUtils::MakeMaker +--> Working on ExtUtils::MakeMaker +Fetching http://www.cpan.org/authors/id/B/BI/BINGOS/ExtUtils-MakeMaker-7.34.tar.gz ... OK +Configuring ExtUtils-MakeMaker-7.34 ... OK +Can't locate ExtUtils/Manifest.pm in @INC (@INC contains: FatPacked::13507464=HASH(0xce1b88) /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at - line 132. +``` + +どうも 'perl-devel' が入っていないのが原因の用 + + +---------- +2018-05-07---- +remo + +---------- diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/08/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/08/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,4 @@ +今日の進捗 + +- MoarVMの資料を読み解く +- CbCで実装するべき場所を考察する diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/08/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/08/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,138 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 研究内容 +- MoarVMの主にCase文をCbCに書き換える +- ちょっと早くしたい + +# 今週の進捗 + +- YAPC::EUで発表されたMoarVMの資料を読んでいました + - cf. http://www.jnthn.net/papers/2013-yapceu-moarvm.pdf +- MoarVMの実装を読み始めました + - mercurialにMoarVMをあげました +- オープンソースカンファレンスについては何も出来てないです… +- 進捗管理君を書いてました + +# 6model + +- Perl6のオブジェクトパターン +- `Object` +- `Stable` + - How(Meta-object) + - REPR + - WHAT + - WHO + - Method キャッシュ + - 型キャッシュ +- `Flags,owner` +- `GC stuff` +- ``からなる + +# CbCの書き換え + +- case文の書き換え +- なるべく巨大なものを選択 +- spesh以下のファイルが比較的巨大なcase文 +- `static void optimize_bb_switch` + - `spesh/optimize.c` + - 最適化のスイッチ部分 + - かなり巨大 +- 他には + - `containers.c` + - `serialization.c` + - unicodeの文字処理部分 + +# 書き換えている箇所 + +```c +static void optimize_bb_switch(MVMThreadContext *tc, MVMSpeshGraph *g, MVMSpeshBB *bb, + MVMSpeshPlanned *p) { + MVMSpeshCallInfo arg_info; + /* Look for instructions that are interesting to optimize. */ + MVMSpeshIns *ins = bb->first_ins; + while (ins) { + switch (ins->info->opcode) { + case MVM_SSA_PHI: + analyze_phi(tc, g, ins); + break; + case MVM_OP_set: + copy_facts(tc, g, ins->operands[0], ins->operands[1]); + break; + case MVM_OP_isnull: + optimize_isnull(tc, g, bb, ins); + break; + case MVM_OP_istrue: + case MVM_OP_isfalse: + optimize_istrue_isfalse(tc, g, bb, ins); + break; + case MVM_OP_if_i: + case MVM_OP_unless_i: + case MVM_OP_if_n: + case MVM_OP_unless_n: + optimize_iffy(tc, g, ins, bb); + break; + case MVM_OP_if_o: + case MVM_OP_unless_o: + optimize_object_conditional(tc, g, ins, bb); + break; + case MVM_OP_not_i: + optimize_not_i(tc, g, ins, bb); + break; + case MVM_OP_prepargs: + arg_info.cs = g->sf->body.cu->body.callsites[ins->operands[0].callsite_idx]; + arg_info.prepargs_ins = ins; + arg_info.prepargs_bb = bb; + break; + case MVM_OP_arg_i: + case MVM_OP_arg_n: + case MVM_OP_arg_s: + case MVM_OP_arg_o: { + +``` + +# 現在 + +- case文の書き換えの部分をどうするか悩んでいます + +```c + +//XXX TODO 書き換えてる +__code optimize_bb_switch_cbc(MVMThreadContext *tc, MVMSpeshGraph *g, MVMSpeshBB *bb, + MVMSpeshPlanned *p) { + MVMSpeshCallInfo arg_info; + /* Look for instructions that are interesting to optimize. */ + MVMSpeshIns *ins = bb->first_ins; + + if (ins){ + goto optimize_bb_switch_cbc_ins(ins->next); + } +} + +__code optimize_bb_switch_cbc_ins(MVMSpeshIns *ins){ + + if (ins){ + goto optimize_bb_switch_cbc_ins(ins->next); + } + + + goto optimize_bb_switch_cbc_ins(ins->next); +} + +``` + +# 今週のTODO + +- case文をどうにかして書き換える +- 試しにコンパイル diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/08/zip.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/08/zip.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,156 @@ +2018-05-01---- +作業ログ +- one/src以下で実行 + +`git clone https://github.com/MoarVM/MoarVM.git` + +- MoarVMをclone +MoarVMの書き換え + +(dalmore) `./Configure.pl --cc /usr/local/cbclang/bin/clang` +make -j 70 + +# セグフォで死ぬ + +0. Program arguments: /net/open/CentOS/local/cbclang/bin/clang-7.0 -cc1 -triple x86_64-unknown-linux-gnu -emit-obj -disable-free -main-file-name io.c -mrelocation-model pic -pic-level 2 -mthread-model posix -fmath-errno -masm-verbose -mconstructor-aliases -munwind-tables -fuse-init-array -target-cpu x86-64 -dwarf-column-info -debug-info-kind=limited -dwarf-version=4 -debugger-tuning=gdb -momit-leaf-frame-pointer -coverage-notes-file /mnt/dalmore-home/one/src/MoarVM/src/platform/posix/io.gcno -resource-dir /net/open/CentOS/local/cbclang/lib/clang/7.0.0 -D NDEBUG -D _REENTRANT -D _FILE_OFFSET_BITS=64 -D DEBUG_HELPERS -D MVM_TRACING=0 -D MVM_CGOTO=1 -D MVM_RDTSCP=1 -D MVM_BUILD_SHARED -I 3rdparty/libuv/include -I 3rdparty/libuv/src -I 3rdparty/libatomicops/src -I 3rdparty/libtommath -I 3rdparty/dyncall/dynload -I 3rdparty/dyncall/dyncall -I 3rdparty/dyncall/dyncallback -I 3rdparty/sha1 -I 3rdparty/tinymt -I 3rdparty/dynasm -I 3rdparty/cmp -I 3rdparty -I src -internal-isystem /usr/local/include -internal-isystem /net/open/CentOS/local/cbclang/lib/clang/7.0.0/include -internal-externc-isystem /include -internal-externc-isystem /usr/include -O3 -Werror=declaration-after-statement -Werror=pointer-arith -fdebug-compilation-dir /mnt/dalmore-home/one/src/MoarVM -ferror-limit 19 -fmessage-length 136 -fobjc-runtime=gcc -fdiagnostics-show-option -fcolor-diagnostics -vectorize-loops -vectorize-slp -o src/platform/posix/io.o -x c src/platform/posix/io.c +1. parser at end of file +clang-7.0: error: unable to execute command: Segmentation fault +clang-7.0: error: clang frontend command failed due to signal (use -v to see invocation) +clang version 7.0.0 +Target: x86_64-unknown-linux-gnu +Thread model: posix +InstalledDir: /usr/local/cbclang/bin +clang-7.0: note: diagnostic msg: PLEASE submit a bug report to https://bugs.llvm.org/ and include the crash backtrace, preprocessed source, and associated run script. +clang-7.0: note: diagnostic msg: +******************** + +PLEASE ATTACH THE FOLLOWING FILES TO THE BUG REPORT: +Preprocessed source(s) and associated run script(s) are located at: +clang-7.0: note: diagnostic msg: /tmp/io-e696e2.c +clang-7.0: note: diagnostic msg: /tmp/io-e696e2.sh +clang-7.0: note: diagnostic msg: + +******************** + +`./Configure.pl --cc /usr/local/x86-cbc/bin/gcc --debug --compiler gcc --prefix=/mnt/dalmore-home/one/src/build_MoarVM` +` make -C ../MoarVM -j 70` +` make install` +`+dalmore+one ./Configure.pl --cc /usr/local/x86-cbc/bin/gcc --debug --compiler gcc --prefix=/mnt/dalmore-home/one/src/build_perl6/MoarVM` + +実行 + +`make -j 70` + +何故かsrc側にlinkされていないmoarが生成される + +`make install` で両方にリンクが離れる + +とりあえずこれでbuildが通る + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar + +Creating tools/build/install-jvm-runner.pl ... + +===SORRY!=== +Found /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar version 2018.04-1-g577857a, which is too old. Wanted at least 2018.04-18-ge7d79d869 + +No suitable MoarVM (moar executable) found using the --prefix +(You can get a MoarVM built automatically with --gen-moar.) +``` + +MoarVMが古いと何を付けられる + + +``` ++dalmore+one ./Configure.pl --prefix=/mnt/dalmore-home/one/src/build_perl6/nqp --backends=moar --with-moar=/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar + +Creating tools/build/install-jvm-runner.pl ... +Cleaning up ... +You can now use 'make' to build NQP. +After that, 'make test' will run some tests and +'make install' will install NQP. ++dalmore+one make install +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/how/Archetypes.nqp src/how/RoleToRoleApplier.nqp src/how/NQPConcreteRoleHOW.nqp src/how/RoleToClassApplier.nqp src/how/NQPCurriedRoleHOW.nqp src/how/NQPParametricRoleHOW.nqp src/how/NQPClassHO +W.nqp src/how/NQPNativeHOW.nqp src/how/NQPAttribute.nqp src/how/NQPModuleHOW.nqp src/how/EXPORTHOW.nqp > gen/moar/stage1/nqpmo.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/nqpmo.moarvm gen/moar/stage1/nqpmo.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/ModuleLoader.moarvm src/vm/moar/ModuleLoader.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/core/NativeTypes.nqp src/core/NQPRoutine.nqp src/core/NQPMu.nqp src/core/NQPCapture.nqp src/core/IO.nqp src/core/Regex.nqp src/core/Hash.nqp src/core/NQPLock.nqp src/core/testing.nqp src/core/ +YOUAREHERE.nqp > gen/moar/stage1/NQPCORE.setting +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting=NULL --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPCORE.setting.moarvm gen/moar/stage1/NQPCORE.setting +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QAST/CompileTimeValue.nqp src/QAST/SpecialArg.nqp src/QAST/Children.nqp src/QAST/Node.nqp src/QAST/NodeList.nqp src/QAST/Regex.nqp src/QAST/IVal.nqp src/QAST/NVal.nqp src/QAST/SVal.nqp src/QAS +T/BVal.nqp src/QAST/WVal.nqp src/QAST/Want.nqp src/QAST/Var.nqp src/QAST/VarWithFallback.nqp src/QAST/ParamTypeCheck.nqp src/QAST/Op.nqp src/QAST/VM.nqp src/QAST/Stmts.nqp src/QAST/Stmt.nqp src/QAST/Block.nqp src/QAST/Unquote.nqp src/QAST +/CompUnit.nqp src/QAST/InlinePlaceholder.nqp > gen/moar/stage1/QASTNode.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QASTNode.moarvm gen/moar/stage1/QASTNode.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QRegex/NFA.nqp src/QRegex/Cursor.nqp > gen/moar/stage1/QRegex.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QRegex.moarvm gen/moar/stage1/QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/vm/moar/HLL/Backend.nqp src/HLL/Grammar.nqp src/HLL/Actions.nqp src/HLL/Compiler.nqp src/HLL/CommandLine.nqp src/HLL/World.nqp src/HLL/sprintf.nqp > gen/moar/stage1/NQPHLL.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPHLL.moarvm gen/moar/stage1/NQPHLL.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/MASTOps.moarvm /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/../share/nqp/lib/MAST/Ops.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/MASTNodes.moarvm /mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/../share/nqp/lib/MAST/Nodes.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/vm/moar/QAST/QASTRegexCompilerMAST.nqp src/vm/moar/QAST/QASTOperationsMAST.nqp src/vm/moar/QAST/QASTCompilerMAST.nqp > gen/moar/stage1/QAST.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/QAST.moarvm gen/moar/stage1/QAST.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-cat.pl moar src/QRegex/P6Regex/Grammar.nqp src/QRegex/P6Regex/Actions.nqp src/QRegex/P6Regex/Compiler.nqp src/QRegex/P6Regex/Optimizer.nqp > gen/moar/stage1/NQPP6QRegex.nqp +/mnt/dalmore-home/one/src/build_perl6/MoarVM/bin/moar --libpath=src/vm/moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --module-path=gen/moar/stage1 --setting-path=gen/moar/stage1 \ + --setting=NQPCORE --no-regex-lib --target=mbc \ + --output=gen/moar/stage1/NQPP6QRegex.moarvm gen/moar/stage1/NQPP6QRegex.nqp +/usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen +/usr/bin/perl tools/build/gen-version.pl /mnt/dalmore-home/one/src/build_perl6/nqp /mnt/dalmore-home/one/src/build_perl6/nqp/share/nqp/lib > gen/moar/stage1/nqp-config.nqp +Can't locate Digest/SHA.pm in @INC (@INC contains: /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at tools/build/gen-version.pl line 9. +BEGIN failed--compilation aborted at tools/build/gen-version.pl line 9. +make: *** [gen/moar/stage1/nqp.moarvm] Error 2 +``` + + +# cpanmを入れようとしたところ終了 + +``` ++dalmore+one curl -L https://cpanmin.us | perl - --sudo App::cpanminus % Total % Received % Xferd Average Speed Time Time Time Current + Dload Upload Total Spent Left Speed +100 295k 100 295k 0 0 864k 0 --:--:-- --:--:-- --:--:-- 864k +--> Working on App::cpanminus +Fetching http://www.cpan.org/authors/id/M/MI/MIYAGAWA/App-cpanminus-1.7044.tar.gz ... OK +==> Found dependencies: ExtUtils::MakeMaker +--> Working on ExtUtils::MakeMaker +Fetching http://www.cpan.org/authors/id/B/BI/BINGOS/ExtUtils-MakeMaker-7.34.tar.gz ... OK +Configuring ExtUtils-MakeMaker-7.34 ... OK +Can't locate ExtUtils/Manifest.pm in @INC (@INC contains: FatPacked::13507464=HASH(0xce1b88) /usr/local/lib64/perl5 /usr/local/share/perl5 /usr/lib64/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib64/perl5 /usr/share/perl5 .) at - line 132. +``` + +どうも 'perl-devel' が入っていないのが原因の用 + + +---------- +2018-05-07---- +remo + +---------- +2018-05-08---- +今日の進捗 + +- MoarVMの資料を読み解く +- CbCで実装するべき場所を考察する + +---------- diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/14/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/14/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,40 @@ +今日の進捗 + +# MoarVMのJIT +* [Docs](https://github.com/MoarVM/MoarVM/tree/master/docs)を見る + +# Lego +* MoarMVのJITはLegoと呼ばれているらしい + +# DynASM +* Dynamic Assemler + * http://luajit.org/dynasm.html +* [luajit](http://luajit.org/)プロジェクトで作られているもの +* MoarVMには `3rdparty`ディレクトリ以下に展開されている +* x86アーキテクチャのJITコンパイル用のアセンブラのようなものらしい + * luaが`dasc`と呼ばれるCに近いアセンブラをCを出力する前に実行 + * Cのヘッダーの `#include` している部分を機械語にランタイムで翻訳 +* [GitHubのcommit](https://github.com/MoarVM/MoarVM/commit/372d0582ab90d4ddfc43553bbebe4e553a42278d) + +# DynASM + + +- To get you started, here is a simple code snippet to be pre-processed. The lines starting with '|' (the pipe symbol) are for DynASM: + +``` + if (ptr != NULL) { + | mov eax, foo+17 + | mov edx, [eax+esi*2+0x20] + | add ebx, [ecx+bar(ptr, 9)] + } +``` + +- After pre-processing you get: + +``` + if (ptr != NULL) { + dasm_put(Dst, 123, foo+17, bar(ptr, 9)); + } +``` + + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/14/zip.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/14/zip.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,50 @@ +2018-05-08---- +今日の進捗 + +- MoarVMの資料を読み解く +- CbCで実装するべき場所を考察する + +---------- +2018-05-14---- +今日の進捗 + +# MoarVMのJIT +* [Docs](https://github.com/MoarVM/MoarVM/tree/master/docs)を見る + +# Lego +* MoarMVのJITはLegoと呼ばれているらしい + +# DynASM +* Dynamic Assemler + * http://luajit.org/dynasm.html +* [luajit](http://luajit.org/)プロジェクトで作られているもの +* MoarVMには `3rdparty`ディレクトリ以下に展開されている +* x86アーキテクチャのJITコンパイル用のアセンブラのようなものらしい + * luaが`dasc`と呼ばれるCに近いアセンブラをCを出力する前に実行 + * Cのヘッダーの `#include` している部分を機械語にランタイムで翻訳 +* [GitHubのcommit](https://github.com/MoarVM/MoarVM/commit/372d0582ab90d4ddfc43553bbebe4e553a42278d) + +# DynASM + + +- To get you started, here is a simple code snippet to be pre-processed. The lines starting with '|' (the pipe symbol) are for DynASM: + +``` + if (ptr != NULL) { + | mov eax, foo+17 + | mov edx, [eax+esi*2+0x20] + | add ebx, [ecx+bar(ptr, 9)] + } +``` + +- After pre-processing you get: + +``` + if (ptr != NULL) { + dasm_put(Dst, 123, foo+17, bar(ptr, 9)); + } +``` + + + +---------- diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/15/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/15/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,33 @@ +# ゼミ + +- 論文自体は昔のもの +- MoarVMどこが遅いのか? JITがアレ? +- 直接バイナリを吐かない理由は? + +- Comon Lisp Cに変換して生成したオブジェクトを作る + - その他の最適化はCコンパイラに投げる + - 京都で開発された 京都CommonLisp + - Lisp中でread evalループを持っていた + - interpretするルーチンがLISPで書かれている + - -->普段はCコンパイラが呼ばれない + - stack をlistの管理で行う + +- JITが遅いならCbCの入る場所がなさそう + +- 直接アセンブラを書いても良さそう + - MoarVMからCbCを吐く + +- 帯域脱出が問題 + - スタックの管理ならCbCでいけるかもしれない + - MoarVMの + +- 行き先を渡す +- 厳しいなら構造体にいれてあげる + - diコンテナ + - 見かけ上関数呼び出しっぽく書ける + +- Cの再実装 + - 比較して見る + - 頻度の高いif文を先に持っていって再構築 + +- CbC側を書き換えるのをどうするか diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/15/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/15/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,150 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 + +- MoarVMのJITのドキュメントを読み始めました + +# MoarVMのJIT +* [Docs](https://github.com/MoarVM/MoarVM/tree/master/docs)を見る +* JitCompiler overview +* Expression 'Tree' Intermedite Representation +* Runtime Configuration +* JIT Todo + + +# Lego +* MoarMVのJITはLegoと呼ばれているらしい + +# DynASM +* Dynamic Assemler + * http://luajit.org/dynasm.html + * [luajit](http://luajit.org/)プロジェクトで作られているもの + * MoarVMには `3rdparty`ディレクトリ以下に展開されている + * x86アーキテクチャのJITコンパイル用のアセンブラのようなものらしい + * luaが`dasc`と呼ばれるCに近いアセンブラをCを出力する前に実行 + * Cのヘッダーの `#include` している部分を機械語にランタイムで翻訳 + * [GitHubのcommit](https://github.com/MoarVM/MoarVM/commit/372d0582ab90d4ddfc43553bbebe4e553a42278d) + + +# DynASM + + + - To get you started, here is a simple code snippet to be pre-processed. The lines starting with '|' (the pipe symbol) are for DynASM: + + ``` + if (ptr != NULL) { + | mov eax, foo+17 + | mov edx, [eax+esi*2+0x20] + | add ebx, [ecx+bar(ptr, 9)] + } +``` + +- After pre-processing you get: + +``` + if (ptr != NULL) { + dasm_put(Dst, 123, foo+17, bar(ptr, 9)); + } +``` + +# Expression Tree + +- まだ翻訳出来てない... + +## syntax +- `(` と`)`で括っていくLISPスタイル +- wordはPerlの正規表現 `[^\s\(\)#:"']`で表現されるもの +- keywordは `:` が途中につく +- 先頭に`$`が来るとリファレンスであり，MoarVMのオペランドもしくは宣言済みの変数 +- `^`が先頭に来るとマクロであり，`macro:`で宣言可能 +- 先頭に`&`だと関数のマクロ + +``` +(template: sp_p6oget_o + (let: (($val (load (add (^p6obody $1) $2) ptr_sz))) + (if (nz $val) $val (^vmnull)))) +``` + +# Instruction Selection + +* シーケンスを実際にx86に変換する部分 +* [Aho etal](https://dl.acm.org/citation.cfm?id=75700)の論文が基本となっているらしい + + +# 書き換え + +- `spesh/facts.c`を書き換えていこうかなとしています +- case文で分岐した後の返り値をstackにどうやって積むかが問題 +- 遷移を担当するテーブルの設計 + +# 書き換え地点 + +``` + case MVM_OP_const_i64_32: + case MVM_OP_const_i64_16: + case MVM_OP_const_s: + literal_facts(tc, g, ins); + //XXX 書き換え + goto literal_facts_cbc(tc,g,ins,__return); + goto literal_facts(tc, g, ins); + break; +``` + +# target + +``` +__code literal_facts_cbc(MVMThreadContext *tc, MVMSpeshGraph *g, MVMSpeshIns *ins,__code(*exit)()) { + MVMSpeshFacts *tgt_facts = &g->facts[ins->operands[0].reg.orig][ins->operands[0].reg.i]; + switch (ins->info->opcode) { + case MVM_OP_const_i64: + tgt_facts->value.i = ins->operands[1].lit_i64; + break; + case MVM_OP_const_i32: + tgt_facts->value.i = ins->operands[1].lit_i32; + break; + case MVM_OP_const_i16: + tgt_facts->value.i = ins->operands[1].lit_i16; + break; + case MVM_OP_const_i8: + tgt_facts->value.i = ins->operands[1].lit_i8; + break; + case MVM_OP_const_n32: + tgt_facts->value.n = ins->operands[1].lit_n32; + break; + case MVM_OP_const_n64: + tgt_facts->value.n = ins->operands[1].lit_n64; + break; + case MVM_OP_const_i64_32: + tgt_facts->value.i = ins->operands[1].lit_i32; + break; + case MVM_OP_const_i64_16: + tgt_facts->value.i = ins->operands[1].lit_i16; + break; + case MVM_OP_const_s: + tgt_facts->value.s = MVM_cu_string(tc, g->sf->body.cu, + ins->operands[1].lit_str_idx); + break; + default: + return; + } + tgt_facts->flags |= MVM_SPESH_FACT_KNOWN_VALUE; + goto (*exit1)(); +} +``` + +# 来週の予定 + +* JITもう少し読む +* JITから書き換える? diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/16/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/16/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,110 @@ + MVMSpeshFactsが主に使われている構造体 + + 宣言元はfacts.h + +```c + struct MVMSpeshFacts { + /* Flags indicating things we know. */ + MVMint32 flags; + + /* The number of usages it has. */ + MVMint32 usages; + + /* Known type, if any. */ + MVMObject *type; + + /* Known type post-decontainerization, if any. */ + MVMObject *decont_type; + + /* Known value, if any. */ + union { + MVMObject *o; + MVMint64 i; + MVMnum64 n; + MVMString *s; + } value; + + /* The instruction that writes the register (noting we're in SSA form, so + * this is unique). */ + MVMSpeshIns *writer; + + /* The deoptimization index in effect at the point of declaration, or -1 + * if none yet. */ + MVMint32 deopt_idx; + + /* The log guard the facts depend on, if any. */ + MVMuint32 log_guard; + + /* Has the instruction that wrote this value been deleted? */ + MVMuint32 dead_writer; + }; +``` + +fact のflag一覧 + +```c +/* Various fact flags. */ +#define MVM_SPESH_FACT_KNOWN_TYPE 1 /* Has a known type. */ +#define MVM_SPESH_FACT_KNOWN_VALUE 2 /* Has a known value. */ +#define MVM_SPESH_FACT_DECONTED 4 /* Know it's decontainerized. */ +#define MVM_SPESH_FACT_CONCRETE 8 /* Know it's a concrete object. */ +#define MVM_SPESH_FACT_TYPEOBJ 16 /* Know it's a type object. */ +#define MVM_SPESH_FACT_KNOWN_DECONT_TYPE 32 /* Has a known type after decont. */ +#define MVM_SPESH_FACT_DECONT_CONCRETE 64 /* Is concrete after decont. */ +#define MVM_SPESH_FACT_DECONT_TYPEOBJ 128 /* Is a type object after decont. */ +#define MVM_SPESH_FACT_FROM_LOG_GUARD 256 /* Depends on a guard being met. */ +#define MVM_SPESH_FACT_HASH_ITER 512 /* Is an iter over hashes. */ +#define MVM_SPESH_FACT_ARRAY_ITER 1024 /* Is an iter over arrays + (mutually exclusive with HASH_ITER, but neither of them is nece ssarily set) */ +#define MVM_SPESH_FACT_KNOWN_BOX_SRC 2048 /* We know what register this value was boxed from */ +#define MVM_SPESH_FACT_MERGED_WITH_LOG_GUARD 4096 /* These facts were merged at a PHI node, but at least one of the incoming facts had a "from log guard" flag set, so we'll have to look for that fact and increment its uses if we u se this here fact. */ +#define MVM_SPESH_FACT_RW_CONT 8192 /* Known to be an rw container */ + +void MVM_spesh_facts_discover(MVMThreadContext *tc, MVMSpeshGraph *g, MVMSpeshPlanned *p); +void MVM_spesh_facts_depend(MVMThreadContext *tc, MVMSpeshGraph *g, + MVMSpeshFacts *target, MVMSpeshFacts *source); + +``` + + +`spesh/graph.h`の箇所 + +``` +/* An instruction in the spesh graph. */ +struct MVMSpeshIns { + /* Instruction information. */ + const MVMOpInfo *info; + + /* Operand information. */ + MVMSpeshOperand *operands; + + /* Previous and next instructions, within a basic block boundary. */ + MVMSpeshIns *prev; + MVMSpeshIns *next; + + /* Any annotations on the instruction. */ + MVMSpeshAnn *annotations; +}; + +``` + +`core/interp.h` + +``` +/* Information about an opcode. */ +struct MVMOpInfo { + MVMuint16 opcode; + const char *name; + char mark[2]; + MVMuint16 num_operands; + MVMuint8 pure; + MVMuint8 deopt_point; + MVMuint8 logged; + MVMuint8 no_inline; + MVMuint8 jittivity; + MVMuint8 uses_hll; + MVMuint8 operands[MVM_MAX_OPERANDS]; +}; + + +``` diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/18/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/18/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,52 @@ + +moar.h + + +l.41あたり + +```c + /* Sized types. */ + typedef int8_t MVMint8; + typedef uint8_t MVMuint8; + typedef int16_t MVMint16; + typedef uint16_t MVMuint16; + typedef int32_t MVMint32; + typedef uint32_t MVMuint32; + typedef int64_t MVMint64; + typedef uint64_t MVMuint64; + typedef float MVMnum32; + typedef double MVMnum64; +``` + +ただのtypes のSizedのフラグ + +src/core/ops.h でdefineされている + + +ただの変数 + +``` +/* This file is generated from src/core/oplist by tools/update_ops.p6. */ + +/* Op name defines. */ +#define MVM_OP_no_op 0 +#define MVM_OP_const_i8 1 +#define MVM_OP_const_i16 2 +#define MVM_OP_const_i32 3 +#define MVM_OP_const_i64 4 +#define MVM_OP_const_n32 5 +#define MVM_OP_const_n64 6 +#define MVM_OP_const_s 7 +#define MVM_OP_set 8 +#define MVM_OP_extend_u8 9 +#define MVM_OP_extend_u16 10 +#define MVM_OP_extend_u32 11 +#define MVM_OP_extend_i8 12 +#define MVM_OP_extend_i16 13 +#define MVM_OP_extend_i32 14 +#define MVM_OP_trunc_u8 15 +#define MVM_OP_trunc_u16 16 +``` + +`ops.h`は874行でそれぞれの数に対してdefineされている． +わりと厳しい diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/18/zip.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/18/zip.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,244 @@ +2018-05-14---- +今日の進捗 + +# MoarVMのJIT +* [Docs](https://github.com/MoarVM/MoarVM/tree/master/docs)を見る + +# Lego +* MoarMVのJITはLegoと呼ばれているらしい + +# DynASM +* Dynamic Assemler + * http://luajit.org/dynasm.html +* [luajit](http://luajit.org/)プロジェクトで作られているもの +* MoarVMには `3rdparty`ディレクトリ以下に展開されている +* x86アーキテクチャのJITコンパイル用のアセンブラのようなものらしい + * luaが`dasc`と呼ばれるCに近いアセンブラをCを出力する前に実行 + * Cのヘッダーの `#include` している部分を機械語にランタイムで翻訳 +* [GitHubのcommit](https://github.com/MoarVM/MoarVM/commit/372d0582ab90d4ddfc43553bbebe4e553a42278d) + +# DynASM + + +- To get you started, here is a simple code snippet to be pre-processed. The lines starting with '|' (the pipe symbol) are for DynASM: + +``` + if (ptr != NULL) { + | mov eax, foo+17 + | mov edx, [eax+esi*2+0x20] + | add ebx, [ecx+bar(ptr, 9)] + } +``` + +- After pre-processing you get: + +``` + if (ptr != NULL) { + dasm_put(Dst, 123, foo+17, bar(ptr, 9)); + } +``` + + + +---------- +2018-05-15---- +# ゼミ + +- 論文自体は昔のもの +- MoarVMどこが遅いのか? JITがアレ? +- 直接バイナリを吐かない理由は? + +- Comon Lisp Cに変換して生成したオブジェクトを作る + - その他の最適化はCコンパイラに投げる + - 京都で開発された 京都CommonLisp + - Lisp中でread evalループを持っていた + - interpretするルーチンがLISPで書かれている + - -->普段はCコンパイラが呼ばれない + - stack をlistの管理で行う + +- JITが遅いならCbCの入る場所がなさそう + +- 直接アセンブラを書いても良さそう + - MoarVMからCbCを吐く + +- 帯域脱出が問題 + - スタックの管理ならCbCでいけるかもしれない + - MoarVMの + +- 行き先を渡す +- 厳しいなら構造体にいれてあげる + - diコンテナ + - 見かけ上関数呼び出しっぽく書ける + +- Cの再実装 + - 比較して見る + - 頻度の高いif文を先に持っていって再構築 + +- CbC側を書き換えるのをどうするか + +---------- +2018-05-16---- + MVMSpeshFactsが主に使われている構造体 + + 宣言元はfacts.h + +```c + struct MVMSpeshFacts { + /* Flags indicating things we know. */ + MVMint32 flags; + + /* The number of usages it has. */ + MVMint32 usages; + + /* Known type, if any. */ + MVMObject *type; + + /* Known type post-decontainerization, if any. */ + MVMObject *decont_type; + + /* Known value, if any. */ + union { + MVMObject *o; + MVMint64 i; + MVMnum64 n; + MVMString *s; + } value; + + /* The instruction that writes the register (noting we're in SSA form, so + * this is unique). */ + MVMSpeshIns *writer; + + /* The deoptimization index in effect at the point of declaration, or -1 + * if none yet. */ + MVMint32 deopt_idx; + + /* The log guard the facts depend on, if any. */ + MVMuint32 log_guard; + + /* Has the instruction that wrote this value been deleted? */ + MVMuint32 dead_writer; + }; +``` + +fact のflag一覧 + +```c +/* Various fact flags. */ +#define MVM_SPESH_FACT_KNOWN_TYPE 1 /* Has a known type. */ +#define MVM_SPESH_FACT_KNOWN_VALUE 2 /* Has a known value. */ +#define MVM_SPESH_FACT_DECONTED 4 /* Know it's decontainerized. */ +#define MVM_SPESH_FACT_CONCRETE 8 /* Know it's a concrete object. */ +#define MVM_SPESH_FACT_TYPEOBJ 16 /* Know it's a type object. */ +#define MVM_SPESH_FACT_KNOWN_DECONT_TYPE 32 /* Has a known type after decont. */ +#define MVM_SPESH_FACT_DECONT_CONCRETE 64 /* Is concrete after decont. */ +#define MVM_SPESH_FACT_DECONT_TYPEOBJ 128 /* Is a type object after decont. */ +#define MVM_SPESH_FACT_FROM_LOG_GUARD 256 /* Depends on a guard being met. */ +#define MVM_SPESH_FACT_HASH_ITER 512 /* Is an iter over hashes. */ +#define MVM_SPESH_FACT_ARRAY_ITER 1024 /* Is an iter over arrays + (mutually exclusive with HASH_ITER, but neither of them is nece ssarily set) */ +#define MVM_SPESH_FACT_KNOWN_BOX_SRC 2048 /* We know what register this value was boxed from */ +#define MVM_SPESH_FACT_MERGED_WITH_LOG_GUARD 4096 /* These facts were merged at a PHI node, but at least one of the incoming facts had a "from log guard" flag set, so we'll have to look for that fact and increment its uses if we u se this here fact. */ +#define MVM_SPESH_FACT_RW_CONT 8192 /* Known to be an rw container */ + +void MVM_spesh_facts_discover(MVMThreadContext *tc, MVMSpeshGraph *g, MVMSpeshPlanned *p); +void MVM_spesh_facts_depend(MVMThreadContext *tc, MVMSpeshGraph *g, + MVMSpeshFacts *target, MVMSpeshFacts *source); + +``` + + +`spesh/graph.h`の箇所 + +``` +/* An instruction in the spesh graph. */ +struct MVMSpeshIns { + /* Instruction information. */ + const MVMOpInfo *info; + + /* Operand information. */ + MVMSpeshOperand *operands; + + /* Previous and next instructions, within a basic block boundary. */ + MVMSpeshIns *prev; + MVMSpeshIns *next; + + /* Any annotations on the instruction. */ + MVMSpeshAnn *annotations; +}; + +``` + +`core/interp.h` + +``` +/* Information about an opcode. */ +struct MVMOpInfo { + MVMuint16 opcode; + const char *name; + char mark[2]; + MVMuint16 num_operands; + MVMuint8 pure; + MVMuint8 deopt_point; + MVMuint8 logged; + MVMuint8 no_inline; + MVMuint8 jittivity; + MVMuint8 uses_hll; + MVMuint8 operands[MVM_MAX_OPERANDS]; +}; + + +``` + +---------- +2018-05-18---- + +moar.h + + +l.41あたり + +```c + /* Sized types. */ + typedef int8_t MVMint8; + typedef uint8_t MVMuint8; + typedef int16_t MVMint16; + typedef uint16_t MVMuint16; + typedef int32_t MVMint32; + typedef uint32_t MVMuint32; + typedef int64_t MVMint64; + typedef uint64_t MVMuint64; + typedef float MVMnum32; + typedef double MVMnum64; +``` + +ただのtypes のSizedのフラグ + +src/core/ops.h でdefineされている + + +ただの変数 + +``` +/* This file is generated from src/core/oplist by tools/update_ops.p6. */ + +/* Op name defines. */ +#define MVM_OP_no_op 0 +#define MVM_OP_const_i8 1 +#define MVM_OP_const_i16 2 +#define MVM_OP_const_i32 3 +#define MVM_OP_const_i64 4 +#define MVM_OP_const_n32 5 +#define MVM_OP_const_n64 6 +#define MVM_OP_const_s 7 +#define MVM_OP_set 8 +#define MVM_OP_extend_u8 9 +#define MVM_OP_extend_u16 10 +#define MVM_OP_extend_u32 11 +#define MVM_OP_extend_i8 12 +#define MVM_OP_extend_i16 13 +#define MVM_OP_extend_i32 14 +#define MVM_OP_trunc_u8 15 +#define MVM_OP_trunc_u16 16 +``` + +---------- diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/19/memo.txt diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/19/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/19/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,27 @@ +title: Perl入学式 +author: Takahiro Shimizu +profile: +lang: Japanese + +## SSID + +- `perl-entrance` + +## PW + +- `metacpan` + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* foo + * puyohoge + +# 来週の予定 + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/21/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/21/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,75 @@ +VMMを用いて重要サービス + +- 多くの計算機では重要サービスが動作している +- 仮想計算機モニタ(VMM) + - OSへの通信要求を補足 + - 代理実行 + - 結果を返却 +- レジスタ値をもとに通信要求の内容を取得 + - レジスタ値で出来るのか + - レジスタ終了後のPCをシステムコール終了後のものにする +- ハイパーコール Xenのprocy Interface +- VMMの処理流れ + - socketやcloseを経由してFDを判別 + + 保護対象VMではシステムコール終了処理から再開する + - 代理実行処理が**事象待ち**を含むかどうか + +- socketとcloseの繰り返しでタイムスタンプを生成している + +1ms OSのスケジューラの感覚 + +特定されるプロセスがあるとダメなのでは...? + + +---- +# キャッシュファイルシステムによる下位キャッシュのアクセスの局所性の改善によるVM I/O性能の向上 + + + - 物理HDDへはページキャッシュが二重になっている + + - 下位キャッシュには最近使われていないデータ要求が溜まっている + - LRUが効果的に機能しない + + - 本来ならページキャッシュを変えていくのが望ましいが，今回は手前だけを実装する + - 先行研究 + - Chace FS + - missとhitを厳格にゲストFSでくくる為に強い局所性を持ち，I/O性能を高めている + - LFU Cache FS + - キャッシュ格納対象を動的に拡張 + - ホットスポットが既知でなくても実現される + - 時間的に局所性が高まっている + - ページキャッシュ内に実装することで性能が向上するのではないか + + - キャッシュの公平性は? + - 今現在は考えていない + +--- + +# オンライン処理とバッチ処理が混在する環境におけるディスクI/O制御方式 + +- オンライン処理とバッチ処理は異なる計算機とすることが多い +- オンライン処理とバッチ処理で計算機資源を十分に利用しないケースが多い + +- 計算機資源の利用効率向上を期待している + - バッチ処理ではdiscへのアクセスが多いが，オンライン処理では低い + + ===> 計算機資源をフラットにしたい + +- ディスクドライバはI/O要求を並列して処理できない + - オンライン処理では1,000バイト以下のものが多い + +- オンライン処理では同時実行処理が増えるとwriteシステムコールが発生し，待機される + +- I/O要求を細分化しキューにいれて順次処理を行う +- ディスクビジー率と処理時間の関係をシュミレーションする + + +- バッチ処理ではCPU優先制御が機能しているが，I/O制御を加えたほうが時間が大幅に減少している + +--- +# GearsOSのAgdaによる記述と検証 + + +--- + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/22/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/22/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,102 @@ +# Approximateネットワークに対する速性と計算精度の最適化基盤 + +- 2000年くらいから計算機は高速化を考えてきたが，クロックや消費電力などの問題があった +- そろそろこのトレードオフだけでは辛くなってきた + +- ムーア時代 + - 性能/電力効率を探求 +- 厳密さ + - 数の丸め誤差 + - 複数の出力が解となるアプリ ==> Perfect Executionは不要 +- ニューラルネットワークをアナログ演算回路で実現している + +- 昨今 + - 不真面目な計算機*真面目なネットワーク +- データ通信帯域が増加するにつれてエラー訂正がレイテンシを低下させてしまう +- Approximate Network + - 帯域10倍 + - 遅延増えない + - エラー放置 +- アプリによってビット誤りの許容が異なる + - ビットの保護する場所が変動する + - 保護するビットをマスクしてあげることで，エラーを考慮しない部分と見ていく +- 正しくない実行結果が出力されるパターンの近くを探索しない + +- OpenTunerによる探索空間を定義している + + + +# 大規模ソフトウェアにおけるコンパイル時間の定量的分析と高速化手法の提案 + +- 90%以上がコンパイラで締められている +- edit-compile-testのサイクルで開発を行っているので厳しい +- Incrementaal BuilDing + - GNU Make + - Ninja + - CMake +- ccache + - key-value-storeで管理している +- WebKit + - ほぼ毎日大規模ファイルをコンパイルする必要が出てきている +- コンパイラ単体のスループットを上げる必要がある + - 同一ヘッダーファイルのコンパイルが2千件行われている +- 再利用時には一貫性が保たれている必要がある +- Hello Worldのコンパイルが最大8.7倍 + +=> もともと並列性の高いものをターゲットにした場合 + --> オーバーヘッドを考える事はあまり無いのではないのか + +# Christie + +- ファイルシステムの問題点 + - 型がない + - トランザクションが提供されてない + - SQLですら厳しい + - 分散環境でアクセス方式が定まってない +- Christie + - Linda +- Christieの + +- ファイルシステムの型 + - 不整合時にどうするかの処理を付けないといけない +- annotationを使ったput/takeのもの + +- unixファイルシステムは木構造の名前管理構造を持っている + - ファイル自体もi-nodeを使った木構造が導入されている +- トランザクションの失敗の扱いを上手い具合にする + + + + +- メモリ自信のハードエラーは提案論文が少ない + +# カーネル内部データのプロセス間分離による堅牢性の向上 + +## Kernel Failure + +- エラー伝搬が発生するとKernel Failureを引き起こす可能性がある +- プロセスコンテキストに閉じて発生する +- プロセスローカルデータ(単一のプロセスコンテキストで使用されるデータ) + - カーネル内で共有するデータにエラーが伝搬した場合修復が難しい +- プロセスを強制終了させることでプログセスコンテキストを切り離す事ができる +- Software failer +- 'プロセスローカルエラー' + + +# 耐ビザンチン障害性を持つ分散合意手法の調査 + +- 決済システムなどでブロックチェーン技術が利用されている +- PoW +- PBFT ( Practical Byzantine Fault Tol) + - http://pmg.csail.mit.edu/papers/osdi99.pdf +- "スループット" +- rsocketをもちいた場合 + +[[Perl6]] + +* 具体的に遅い箇所を計測した方がいい +* どうやって計測を図るか +* コンパイラ構成論の資料を読んでオブジェクトパターンを理解しておく + +- Key Value Store + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/25/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/25/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,6 @@ +Perl6 + +- [助成金貰って高速化](http://news.perlfoundation.org/2017/11/perl-6-performance-and-reliabi-4.html) + - インライン展開周り + - インラインclosureが実装された + - dead codeを削除 diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/26/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/26/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,3 @@ + +marking +- distributed snapshot diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/27/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/27/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,3 @@ +- trap_swi + - システムコール + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/28/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/28/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,45 @@ +マシンを変えたからgccでコンパイルしようとすると厳しい + + +compiling 3rdparty/libuv/src/unix/fsevents.o +compiling 3rdparty/libuv/src/unix/timer.o +compiling 3rdparty/libuv/src/unix/tty.o +compiling 3rdparty/libuv/src/unix/udp.o +/Users/anatofuz/.plenv/versions/5.24.4/bin/perl5.24.4 build/mk-moar-pc.pl pkgconfig/moar.pc +In file included from /System/Library/Frameworks/Security.framework/Headers/AuthSession.h:32, + from /System/Library/Frameworks/Security.framework/Headers/Security.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/CSIdentity.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/OSServices.h:27, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/IconsCore.h:23, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/LaunchServices.h:22, + from /System/Library/Frameworks/CoreServices.framework/Headers/CoreServices.h:39, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:23, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/Security.framework/Headers/Authorization.h:193:7: error: variably modified 'bytes' at file scope + char bytes[kAuthorizationExternalFormLength]; + ^~~~~ +In file included from /System/Library/Frameworks/Security.framework/Headers/AuthSession.h:32, + from /System/Library/Frameworks/Security.framework/Headers/Security.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/CSIdentity.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/OSServices.h:27, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/IconsCore.h:23, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/LaunchServices.h:22, + from /System/Library/Frameworks/CoreServices.framework/Headers/CoreServices.h:39, + from 3rdparty/libuv/src/unix/fsevents.c:49: +/System/Library/Frameworks/Security.framework/Headers/Authorization.h:193:7: error: variably modified 'bytes' at file scope + char bytes[kAuthorizationExternalFormLength]; + ^~~~~ +In file included from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGContext.h:21, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGBitmapContext.h:9, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CoreGraphics.h:11, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:35, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGPath.h:391:15: error: expected identifier or '(' before '^' token + typedef void (^CGPathApplyBlock)(const CGPathElement * element); + ^ +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGPath.h:393:53: error: unknown type name 'CGPathApplyBlock' + CG_EXTERN void CGPathApplyWithBlock(CGPathRef path, CGPathApplyBlock CF_NOESCAPE block) + ^~~~~~~~~~~~~~~~ +make: *** [3rdparty/libuv/src/unix/fsevents.o] Error 1 +make: *** Waiting for unfinished jobs.... +make: *** [3rdparty/libuv/src/unix/darwin-proctitle.o] Error 1 diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/29/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/29/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,166 @@ + ❯ lldb -- /Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar nqp.moarvm examples/hello_world.nqp [13:52:54] +(lldb) target create "/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar" +Current executable set to '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64). +(lldb) settings set -- target.run-args "nqp.moarvm" "examples/hello_world.nqp" +(lldb) b add_bb_facts +Breakpoint 1: where = libmoar.dylib`add_bb_facts + 32 at facts.c:362, address = 0x0000000000118540 +(lldb) c +error: invalid process +(lldb) run +Process 8479 launched: '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64) +Process 8479 stopped +* thread #2, stop reason = breakpoint 1.1 + frame #0: 0x00000001001bb540 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:362 + 359 MVMint32 i, is_phi; + 360 + 361 /* Look for instructions that provide or propagate facts. */ +-> 362 MVMSpeshIns *ins = bb->first_ins; + 363 while (ins) { + 364 /* See if there's deopt and logged annotations. Sync cur_deopt_idx + 365 * and, for logged+deopt-one, add logged facts and guards. */ +Target 0: (moar) stopped. +(lldb) bt +* thread #2, stop reason = breakpoint 1.1 + * frame #0: 0x00000001001bb540 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:362 + frame #1: 0x00000001001bb503 libmoar.dylib`MVM_spesh_facts_discover(tc=0x0000000100802e30, g=0x0000000100f4efe0, p=0x0000000100f514d0) at facts.c:659 + frame #2: 0x00000001001b4eb7 libmoar.dylib`MVM_spesh_candidate_add(tc=0x0000000100802e30, p=0x0000000100f514d0) at candidate.c:61 + frame #3: 0x00000001001cf991 libmoar.dylib`worker(tc=0x0000000100802e30, callsite=0x00000001006c9150, args=0x0000000000000000) at worker.c:16 + frame #4: 0x000000010014e8e2 libmoar.dylib`invoke_handler(tc=0x0000000100802e30, invokee=0x0000000102014840, callsite=0x00000001006c9150, args=0x0000000000000000) at MVMCFunction.c:9 + frame #5: 0x00000001000e8494 libmoar.dylib`thread_initial_invoke(tc=0x0000000100802e30, data=0x0000000100802050) at threads.c:59 + frame #6: 0x00000001000aefee libmoar.dylib`MVM_interp_run(tc=0x0000000100802e30, initial_invoke=(libmoar.dylib`thread_initial_invoke at threads.c:50), invoke_data=0x0000000100802050) at interp.c:93 + frame #7: 0x00000001000e7a35 libmoar.dylib`start_thread(data=0x0000000100802050) at threads.c:87 + frame #8: 0x00007fff7b9fe661 libsystem_pthread.dylib`_pthread_body + 340 + frame #9: 0x00007fff7b9fe50d libsystem_pthread.dylib`_pthread_start + 377 + frame #10: 0x00007fff7b9fdbf9 libsystem_pthread.dylib`thread_start + 13 + +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb579 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:370 + 367 MVMSpeshAnn *ann_deopt_one = NULL; + 368 MVMSpeshAnn *ann_logged = NULL; + 369 MVMint32 is_deopt_ins = 0; +-> 370 while (ann) { + 371 switch (ann->type) { + 372 case MVM_SPESH_ANN_DEOPT_ONE_INS: + 373 ann_deopt_one = ann; +Target 0: (moar) stopped. +(lldb) +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb620 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:385 + 382 } + 383 ann = ann->next; + 384 } +-> 385 if (ann_deopt_one && ann_logged) + 386 log_facts(tc, g, bb, ins, p, ann_deopt_one, ann_logged); + 387 + 388 /* Look through operands for reads and writes. */ +Target 0: (moar) stopped. +(lldb) l + 389 is_phi = ins->info->opcode == MVM_SSA_PHI; + 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ + 393 if ((is_phi && i > 0) + 394 || (!is_phi && (ins->info->operands[i] & MVM_operand_rw_mask) == MVM_operand_read_reg)) { + 395 MVMSpeshFacts *facts = &(g->facts[ins->operands[i].reg.orig][ins->operands[i].reg.i]); +(lldb) l + 396 facts->usages += facts->deopt_idx == cur_deopt_idx ? 1 : 2; + 397 } + 398 + 399 /* Writes need the current deopt index and the writing instruction + 400 * to be specified. A write that's on a deopt instruction bumps + 401 * the usage too. */ + 402 if ((is_phi && i == 0) +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb65b libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:389 + 386 log_facts(tc, g, bb, ins, p, ann_deopt_one, ann_logged); + 387 + 388 /* Look through operands for reads and writes. */ +-> 389 is_phi = ins->info->opcode == MVM_SSA_PHI; + 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ +Target 0: (moar) stopped. +(lldb) p MVM_SSA_PHI +error: use of undeclared identifier 'MVM_SSA_PHI' +(lldb) nexr +error: 'nexr' is not a valid command. +error: Unrecognized command 'nexr'. +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb677 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:390 + 387 + 388 /* Look through operands for reads and writes. */ + 389 is_phi = ins->info->opcode == MVM_SSA_PHI; +-> 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ + 393 if ((is_phi && i > 0) +Target 0: (moar) stopped. +(lldb) p is_phi +(MVMint32) $14 = 0 +(lldb) p ins +(MVMSpeshIns *) $15 = 0x0000000102115e60 +(lldb) p *ins +(MVMSpeshIns) $16 = { + info = 0x00000001005757c0 + operands = 0x0000000000000000 + prev = 0x0000000000000000 + next = 0x0000000000000000 + annotations = 0x0000000000000000 +} +(lldb) p *ins->info +(MVMOpInfo) $17 = { + opcode = 0 + name = 0x00000001002def92 "no_op" + mark = { + [0] = ' ' + [1] = ' ' + } + num_operands = 0 + pure = '\0' + deopt_point = '\0' + logged = '\0' + no_inline = '\0' + jittivity = '\0' + uses_hll = '\0' + operands = ([0] = '\0', [1] = '\0', [2] = '\0', [3] = '\0', [4] = '\0', [5] = '\0', [6] = '\0', [7] = '\0') +} + + +* profilingの箇所を見ていく + +* perlスクリプトをperl6に移植する +* markdownのparserみたいなのを書き換えてみるなど +* タイトループを早くするのか，ここのハッシュを早くするのか，オブジェクトのオペレーションを早くするのか… +* 手近な場所をとにかく見ていきたい + +* native codeをやるのかvmをやるのか + +* bytecode interpureter, gc関連を書き直すという手もある + +* gcc vs clang + +* llvm側でtail coll呼び出す時はフラグを見ている + * code grarであるというフラグを渡している感じ + +* script言語--> 上手く並列化出来ない + +* targetとしてCbCのコードを吐く + * 継続コード(meta level) + * 継続コードを見て計算結果を見て変えていく + * MoarVMのJIT，nqpのコンパイラにcbcを生成する部分を入れる + * perlccみたいなものをいれる + * targetのアプリケーション...whileでstring matchをする部分を最適化する + +* 正規表現の箇所をターゲットとして書くのも手…!? + * fileをmmapを使うかどうかなど +* 並列のgrep + * 早くなるには早くなる + * cache prefetchの処理でも高速化出来る + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/29/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/29/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,146 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なswitch-case文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 + +* Perl6のnqpで遊んでいました +* いくつか記事を発見しました +* perl5の `perl-build` モジュールにPull Request送りました +* lldbでMoarVMを読んでいました + +# Perl6の過去の研究 + +* ある程度高速化はされているらしい +* [助成金貰って高速化が検討されていた](http://news.perlfoundation.org/2017/11/perl-6-performance-and-reliabi-4.html) + * インライン展開周り + * インラインclosureが実装された + * dead codeを削除 + * ...etc + + +# MoarVMのオペコード +* `src/core/ops.h` で定義されている +* `add_bb_facts` ではこのオペコードを使いswitch文を生成している +* トータル868個ほどのオペコードが設定されている + +``` + 4 #define MVM_OP_no_op 0 + 5 #define MVM_OP_const_i8 1 + 6 #define MVM_OP_const_i16 2 + 7 #define MVM_OP_const_i32 3 + 8 #define MVM_OP_const_i64 4 + 9 #define MVM_OP_const_n32 5 + 10 #define MVM_OP_const_n64 6 + 11 #define MVM_OP_const_s 7 + 12 #define MVM_OP_set 8 + 13 #define MVM_OP_extend_u8 9 + 14 #define MVM_OP_extend_u16 10 + 15 #define MVM_OP_extend_u32 11 +``` + +# debug用のMoarVM + +* gccでデバッグしよとすると相変わらず死ぬ + +``` +...skipping... + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/IconsCore.h:23, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/LaunchServices.h:22 + from /System/Library/Frameworks/CoreServices.framework/Headers/CoreServices.h:39, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:23, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/Security.framework/Headers/Authorization.h:193:7: error: variably modified 'bytes' at file scope + char bytes[kAuthorizationExternalFormLength]; + ^~~~~ +In file included from /System/Library/Frameworks/Security.framework/Headers/AuthSession.h:32, + from /System/Library/Frameworks/Security.framework/Headers/Security.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/CSIdentity.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/OSServices.h:27, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/IconsCore.h:23, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/LaunchServices.h:22 + from /System/Library/Frameworks/CoreServices.framework/Headers/CoreServices.h:39, + from 3rdparty/libuv/src/unix/fsevents.c:49: +/System/Library/Frameworks/Security.framework/Headers/Authorization.h:193:7: error: variably modified 'bytes' at file scope + char bytes[kAuthorizationExternalFormLength]; + ^~~~~ +In file included from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGContext.h:21, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGBitmapContext.h:9, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CoreGraphics.h:11, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:35, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGPath.h:391:15: error: expected identifier or '(' before '^' token + typedef void (^CGPathApplyBlock)(const CGPathElement * element); + ^ +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGPath.h:393:53: error: unknown type name 'CGPathApplyBlock' + CG_EXTERN void CGPathApplyWithBlock(CGPathRef path, CGPathApplyBlock CF_NOESCAPE block) + ^~~~~~~~~~~~~~~~ +make: *** [3rdparty/libuv/src/unix/fsevents.o] Error 1 +make: *** Waiting for unfinished jobs.... +make: *** [3rdparty/libuv/src/unix/darwin-proctitle.o] Error 1 +``` + +# やるべきこと + +* 具体的に遅い箇所を計測した方がいい +* どうやって計測を図るか +* コンパイラ構成論の資料を読んでオブジェクトパターンを理解しておく + + +# perl6の小ネタ + +* スマートマッチャー演算子 `~~` + +``` +> 'hoge' ~~ Str +True +``` + +* 継承一覧を取り出すには `.^mro` + +``` +> 'hoge'.^mro +((Str) (Cool) (Any) (Mu)) +> +``` + +* `^name` か `.WHAT` でクラスを取得できる + +``` +> 'hoge'.^name +Str +``` + +* `my @env_path = qx/echo $PATH/.split(':'); # Unix-based systems` + * `q:x` か `qq:x` でシェルを実行できる + +``` + my @env_path = qx/echo $PATH/.split(':') + [/usr/local/opt/qt/bin /Users/anatofuz/src/google-cloud-sdk/bin /Users/anatofuz/.pyenv/versions/3.6.5/bin /Users/anatofuz/.pyenv/shims /Users/anatofuz/.pyenv/bin /Users/anatofuz/.nodebrew/current/bin /Users/anatofuz/.rbenv/shims /usr/local/opt/gpg-agent/bin /Users/anatofuz/.plenv/shims /Users/anatofuz/.plenv/bin /usr/local/bin /usr/local/sbin /usr/bin /bin /usr/sbin /sbin /Library/TeX/texbin /opt/X11/bin /usr/local/opt/qt/bin /Users/anatofuz/src/google-cloud-sdk/bin /Users/anatofuz/.pyenv/versions/3.6.5/bin /Users/anatofuz/.pyenv/shims /Users/anatofuz/.pyenv/bin /Users/anatofuz/.nodebrew/current/bin /Users/anatofuz/.rbenv/shims /usr/local/opt/gpg-agent/bin /Users/anatofuz/.plenv/shims /Users/anatofuz/.plenv/bin /Users/anatofuz/workspace/go/bin /Users/anatofuz/workspace/go/bin + ] +``` + +# perl-build + +* plenvで使用しているモジュール +* cpanからPerlの最新バージョンを取得する +* search.cpanがshut downするのでmeta.cpanに移行したがhttps通信になったのでtarが入手できなくなった +* その部分のパッチを書いて送りました + + +# 来週の予定 + +* 明日から仙台に行ってきます + * 日曜日には戻ってきます +* OSCのネタとスライドをそろそろ作成していきます + * cbc周りの情報がほしい!! diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/05/29/zip.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/05/29/zip.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,311 @@ +2018-05-22---- +# Approximateネットワークに対する速性と計算精度の最適化基盤 + +- 2000年くらいから計算機は高速化を考えてきたが，クロックや消費電力などの問題があった +- そろそろこのトレードオフだけでは辛くなってきた + +- ムーア時代 + - 性能/電力効率を探求 +- 厳密さ + - 数の丸め誤差 + - 複数の出力が解となるアプリ ==> Perfect Executionは不要 +- ニューラルネットワークをアナログ演算回路で実現している + +- 昨今 + - 不真面目な計算機*真面目なネットワーク +- データ通信帯域が増加するにつれてエラー訂正がレイテンシを低下させてしまう +- Approximate Network + - 帯域10倍 + - 遅延増えない + - エラー放置 +- アプリによってビット誤りの許容が異なる + - ビットの保護する場所が変動する + - 保護するビットをマスクしてあげることで，エラーを考慮しない部分と見ていく +- 正しくない実行結果が出力されるパターンの近くを探索しない + +- OpenTunerによる探索空間を定義している + + + +# 大規模ソフトウェアにおけるコンパイル時間の定量的分析と高速化手法の提案 + +- 90%以上がコンパイラで締められている +- edit-compile-testのサイクルで開発を行っているので厳しい +- Incrementaal BuilDing + - GNU Make + - Ninja + - CMake +- ccache + - key-value-storeで管理している +- WebKit + - ほぼ毎日大規模ファイルをコンパイルする必要が出てきている +- コンパイラ単体のスループットを上げる必要がある + - 同一ヘッダーファイルのコンパイルが2千件行われている +- 再利用時には一貫性が保たれている必要がある +- Hello Worldのコンパイルが最大8.7倍 + +=> もともと並列性の高いものをターゲットにした場合 + --> オーバーヘッドを考える事はあまり無いのではないのか + +# Christie + +- ファイルシステムの問題点 + - 型がない + - トランザクションが提供されてない + - SQLですら厳しい + - 分散環境でアクセス方式が定まってない +- Christie + - Linda +- Christieの + +- ファイルシステムの型 + - 不整合時にどうするかの処理を付けないといけない +- annotationを使ったput/takeのもの + +- unixファイルシステムは木構造の名前管理構造を持っている + - ファイル自体もi-nodeを使った木構造が導入されている +- トランザクションの失敗の扱いを上手い具合にする + + + + +- メモリ自信のハードエラーは提案論文が少ない + +# カーネル内部データのプロセス間分離による堅牢性の向上 + +## Kernel Failure + +- エラー伝搬が発生するとKernel Failureを引き起こす可能性がある +- プロセスコンテキストに閉じて発生する +- プロセスローカルデータ(単一のプロセスコンテキストで使用されるデータ) + - カーネル内で共有するデータにエラーが伝搬した場合修復が難しい +- プロセスを強制終了させることでプログセスコンテキストを切り離す事ができる +- Software failer +- 'プロセスローカルエラー' + + +# 耐ビザンチン障害性を持つ分散合意手法の調査 + +- 決済システムなどでブロックチェーン技術が利用されている +- PoW +- PBFT ( Practical Byzantine Fault Tol) + - http://pmg.csail.mit.edu/papers/osdi99.pdf +- "スループット" +- rsocketをもちいた場合 + +[[Perl6]] + +* 具体的に遅い箇所を計測した方がいい +* どうやって計測を図るか +* コンパイラ構成論の資料を読んでオブジェクトパターンを理解しておく + +- Key Value Store + + +---------- +2018-05-25---- +Perl6 + +- [助成金貰って高速化](http://news.perlfoundation.org/2017/11/perl-6-performance-and-reliabi-4.html) + - インライン展開周り + - インラインclosureが実装された + - dead codeを削除 + +---------- +2018-05-26---- + +marking +- distributed snapshot + +---------- +2018-05-27---- +- trap_swi + - システムコール + + +---------- +2018-05-28---- +マシンを変えたからgccでコンパイルしようとすると厳しい + + +compiling 3rdparty/libuv/src/unix/fsevents.o +compiling 3rdparty/libuv/src/unix/timer.o +compiling 3rdparty/libuv/src/unix/tty.o +compiling 3rdparty/libuv/src/unix/udp.o +/Users/anatofuz/.plenv/versions/5.24.4/bin/perl5.24.4 build/mk-moar-pc.pl pkgconfig/moar.pc +In file included from /System/Library/Frameworks/Security.framework/Headers/AuthSession.h:32, + from /System/Library/Frameworks/Security.framework/Headers/Security.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/CSIdentity.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/OSServices.h:27, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/IconsCore.h:23, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/LaunchServices.h:22, + from /System/Library/Frameworks/CoreServices.framework/Headers/CoreServices.h:39, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:23, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/Security.framework/Headers/Authorization.h:193:7: error: variably modified 'bytes' at file scope + char bytes[kAuthorizationExternalFormLength]; + ^~~~~ +In file included from /System/Library/Frameworks/Security.framework/Headers/AuthSession.h:32, + from /System/Library/Frameworks/Security.framework/Headers/Security.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/CSIdentity.h:43, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/OSServices.framework/Headers/OSServices.h:27, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/IconsCore.h:23, + from /System/Library/Frameworks/CoreServices.framework/Frameworks/LaunchServices.framework/Headers/LaunchServices.h:22, + from /System/Library/Frameworks/CoreServices.framework/Headers/CoreServices.h:39, + from 3rdparty/libuv/src/unix/fsevents.c:49: +/System/Library/Frameworks/Security.framework/Headers/Authorization.h:193:7: error: variably modified 'bytes' at file scope + char bytes[kAuthorizationExternalFormLength]; + ^~~~~ +In file included from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGContext.h:21, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CGBitmapContext.h:9, + from /System/Library/Frameworks/CoreGraphics.framework/Headers/CoreGraphics.h:11, + from /System/Library/Frameworks/ApplicationServices.framework/Headers/ApplicationServices.h:35, + from 3rdparty/libuv/src/unix/darwin-proctitle.c:33: +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGPath.h:391:15: error: expected identifier or '(' before '^' token + typedef void (^CGPathApplyBlock)(const CGPathElement * element); + ^ +/System/Library/Frameworks/CoreGraphics.framework/Headers/CGPath.h:393:53: error: unknown type name 'CGPathApplyBlock' + CG_EXTERN void CGPathApplyWithBlock(CGPathRef path, CGPathApplyBlock CF_NOESCAPE block) + ^~~~~~~~~~~~~~~~ +make: *** [3rdparty/libuv/src/unix/fsevents.o] Error 1 +make: *** Waiting for unfinished jobs.... +make: *** [3rdparty/libuv/src/unix/darwin-proctitle.o] Error 1 + +---------- +2018-05-29---- + ❯ lldb -- /Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar nqp.moarvm examples/hello_world.nqp [13:52:54] +(lldb) target create "/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar" +Current executable set to '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64). +(lldb) settings set -- target.run-args "nqp.moarvm" "examples/hello_world.nqp" +(lldb) b add_bb_facts +Breakpoint 1: where = libmoar.dylib`add_bb_facts + 32 at facts.c:362, address = 0x0000000000118540 +(lldb) c +error: invalid process +(lldb) run +Process 8479 launched: '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64) +Process 8479 stopped +* thread #2, stop reason = breakpoint 1.1 + frame #0: 0x00000001001bb540 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:362 + 359 MVMint32 i, is_phi; + 360 + 361 /* Look for instructions that provide or propagate facts. */ +-> 362 MVMSpeshIns *ins = bb->first_ins; + 363 while (ins) { + 364 /* See if there's deopt and logged annotations. Sync cur_deopt_idx + 365 * and, for logged+deopt-one, add logged facts and guards. */ +Target 0: (moar) stopped. +(lldb) bt +* thread #2, stop reason = breakpoint 1.1 + * frame #0: 0x00000001001bb540 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:362 + frame #1: 0x00000001001bb503 libmoar.dylib`MVM_spesh_facts_discover(tc=0x0000000100802e30, g=0x0000000100f4efe0, p=0x0000000100f514d0) at facts.c:659 + frame #2: 0x00000001001b4eb7 libmoar.dylib`MVM_spesh_candidate_add(tc=0x0000000100802e30, p=0x0000000100f514d0) at candidate.c:61 + frame #3: 0x00000001001cf991 libmoar.dylib`worker(tc=0x0000000100802e30, callsite=0x00000001006c9150, args=0x0000000000000000) at worker.c:16 + frame #4: 0x000000010014e8e2 libmoar.dylib`invoke_handler(tc=0x0000000100802e30, invokee=0x0000000102014840, callsite=0x00000001006c9150, args=0x0000000000000000) at MVMCFunction.c:9 + frame #5: 0x00000001000e8494 libmoar.dylib`thread_initial_invoke(tc=0x0000000100802e30, data=0x0000000100802050) at threads.c:59 + frame #6: 0x00000001000aefee libmoar.dylib`MVM_interp_run(tc=0x0000000100802e30, initial_invoke=(libmoar.dylib`thread_initial_invoke at threads.c:50), invoke_data=0x0000000100802050) at interp.c:93 + frame #7: 0x00000001000e7a35 libmoar.dylib`start_thread(data=0x0000000100802050) at threads.c:87 + frame #8: 0x00007fff7b9fe661 libsystem_pthread.dylib`_pthread_body + 340 + frame #9: 0x00007fff7b9fe50d libsystem_pthread.dylib`_pthread_start + 377 + frame #10: 0x00007fff7b9fdbf9 libsystem_pthread.dylib`thread_start + 13 + +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb579 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:370 + 367 MVMSpeshAnn *ann_deopt_one = NULL; + 368 MVMSpeshAnn *ann_logged = NULL; + 369 MVMint32 is_deopt_ins = 0; +-> 370 while (ann) { + 371 switch (ann->type) { + 372 case MVM_SPESH_ANN_DEOPT_ONE_INS: + 373 ann_deopt_one = ann; +Target 0: (moar) stopped. +(lldb) +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb620 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:385 + 382 } + 383 ann = ann->next; + 384 } +-> 385 if (ann_deopt_one && ann_logged) + 386 log_facts(tc, g, bb, ins, p, ann_deopt_one, ann_logged); + 387 + 388 /* Look through operands for reads and writes. */ +Target 0: (moar) stopped. +(lldb) l + 389 is_phi = ins->info->opcode == MVM_SSA_PHI; + 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ + 393 if ((is_phi && i > 0) + 394 || (!is_phi && (ins->info->operands[i] & MVM_operand_rw_mask) == MVM_operand_read_reg)) { + 395 MVMSpeshFacts *facts = &(g->facts[ins->operands[i].reg.orig][ins->operands[i].reg.i]); +(lldb) l + 396 facts->usages += facts->deopt_idx == cur_deopt_idx ? 1 : 2; + 397 } + 398 + 399 /* Writes need the current deopt index and the writing instruction + 400 * to be specified. A write that's on a deopt instruction bumps + 401 * the usage too. */ + 402 if ((is_phi && i == 0) +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb65b libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:389 + 386 log_facts(tc, g, bb, ins, p, ann_deopt_one, ann_logged); + 387 + 388 /* Look through operands for reads and writes. */ +-> 389 is_phi = ins->info->opcode == MVM_SSA_PHI; + 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ +Target 0: (moar) stopped. +(lldb) p MVM_SSA_PHI +error: use of undeclared identifier 'MVM_SSA_PHI' +(lldb) nexr +error: 'nexr' is not a valid command. +error: Unrecognized command 'nexr'. +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb677 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:390 + 387 + 388 /* Look through operands for reads and writes. */ + 389 is_phi = ins->info->opcode == MVM_SSA_PHI; +-> 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ + 393 if ((is_phi && i > 0) +Target 0: (moar) stopped. +(lldb) p is_phi +(MVMint32) $14 = 0 +(lldb) p ins +(MVMSpeshIns *) $15 = 0x0000000102115e60 +(lldb) p *ins +(MVMSpeshIns) $16 = { + info = 0x00000001005757c0 + operands = 0x0000000000000000 + prev = 0x0000000000000000 + next = 0x0000000000000000 + annotations = 0x0000000000000000 +} +(lldb) p *ins->info +(MVMOpInfo) $17 = { + opcode = 0 + name = 0x00000001002def92 "no_op" + mark = { + [0] = ' ' + [1] = ' ' + } + num_operands = 0 + pure = '\0' + deopt_point = '\0' + logged = '\0' + no_inline = '\0' + jittivity = '\0' + uses_hll = '\0' + operands = ([0] = '\0', [1] = '\0', [2] = '\0', [3] = '\0', [4] = '\0', [5] = '\0', [6] = '\0', [7] = '\0') +} + + +---------- diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/05/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/05/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,56 @@ +MoarVMが実際にインタプリタとして走っているのはMVM_interp_runという関数らしい． +これはスレッド毎に用意されるらしい + +定義自体は `src/core/interp.c`に書かれている + + MVMInstancとかいう構造体に全ての情報が入っている + + MVM_cu_map_from_fileでスレッド情報とファイルから生成した結果をMVMCompUnit構造体として生成している + + DISPATCHでNEXT_OPを判断している，これはオペランドリストとswitch文が同じオーダーで書かれているので + 最適化しやすいらしい + + MVM_interp_runの後DISPATCHというマクロでNEXT_OPというマクロに応じて処理を行っているが + これがMoarVMのバイトコードを一対一対応しているので5000行のcase文が生成されている + + --- + +- Ruby のJITはunreadableなので，とりあえずCbCで実装しても良いのでは +- ()の中にいるなどの情報 +- コンパイラをデーモン化してオブジェクトファイルなどを共通化 +- パースの並列化 + - パースに当てられる箇所 +- gccのパスは50個くらい，その内の1つがパーサーっぽい + +- FileIOを食う例題とFileIOを食わないでCPUを食う例題 + - HTMLジェネレーターとかでも良いのでは + +- Perl5 to Perl6的なのは無い? +- Rustのメモリ管理周り + +- Perl5との互換性? + - JIT + - MoarVM ByteCode + +- 実測する!!! +- Perl5からMoarVMに変換するスクリプトを作成する!? + - JIT + - 並列処理 + - パイプライン処理(コンパイラ) + - 前段の処理を止めないといけない + - 1つのコンパイラがCPUを異常に使うと帰って遅くなるのでは?? +- ローカルな作業を分割しても全体としては遅くなるのでは? +- JIT + +- アプリケーションをCbCで書く +- それが早くなるまでチューニングする + - 最初はコンパイルしちゃって良いのでは? + - いきなりCbCを吐く感じにする +- (いかに早い正規表現を書くか) + +- 作った文だけメモリをallocateして返却しない(linear memory) + - 一旦メモリを保存させて渡す(OBject table, OBlist) + - Copying GC conversation + - incrementalに出来ない為，中途半端にコピーされた状況になる可能性がある + - 1MBのファイルを読み込んで処理するレベルではGCがそんなに走らないので無視しても良いのでは…!? + - GC memory allocate diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/05/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/05/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,56 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 + +* 仙台行ってきました +* Perl6のプロファイラと巨大なcase文を発見しました + + +# RubyKaigi + +* Rubyの言語自体の話が多かったです +* 型とJITと処理系のトークが多かったです + * ついにRubyもASTを操作出来る用になりました + * Ruby3ではGuildという実装でより簡単な並列化もサポートしていくそうです +* JITに関してはRubyのJITは一度Cに変換するらしいです + * Cコードで拡張を書いてJITするよりRubyをJITした方が現段階では早いらしい + * C language is dead +* ぱるすさんと宮國さん(gongo)さんとエンカウントしました +* Rubyのコードも比較で読んでいます + + +# プロファイラ + +nqpで実行する際に `--prpfile` を指定するとhtmlでプロファイル結果が生成される + +- `./nqp --profile examples/hello_world.nqp` + - 最適化 +- `./nqp --profile-compile examples/hello_world.nqp` + - 最適化される + +# MoarVMの処理 + +- MVMInstancとかいう構造体に全ての情報が入っている +- MoarVMが実際にインタプリタとして走っているのは`MVM_interp_run`という関数らしい． + - これはスレッド毎に用意されるらしい +- 定義自体は `src/core/interp.c`に書かれている +- `MVM_interp_run`の後DISPATCHというマクロで`NEXT_OP`というマクロに応じて処理を行っている + - これはオペランドリストとswitch文が同じオーダーで書かれているので最適化しやすいらしい +- これがMoarVMのバイトコードを一対一対応しているので5000行のcase文が生成されている +- 状態遷移自体はgotoで書かれているがかなりの量を動いており探しづらい + +# OSC + +* **特に何もしてない!!** diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/05/zip.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/05/zip.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,187 @@ +2018-05-29---- + ❯ lldb -- /Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar nqp.moarvm examples/hello_world.nqp [13:52:54] +(lldb) target create "/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar" +Current executable set to '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64). +(lldb) settings set -- target.run-args "nqp.moarvm" "examples/hello_world.nqp" +(lldb) b add_bb_facts +Breakpoint 1: where = libmoar.dylib`add_bb_facts + 32 at facts.c:362, address = 0x0000000000118540 +(lldb) c +error: invalid process +(lldb) run +Process 8479 launched: '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64) +Process 8479 stopped +* thread #2, stop reason = breakpoint 1.1 + frame #0: 0x00000001001bb540 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:362 + 359 MVMint32 i, is_phi; + 360 + 361 /* Look for instructions that provide or propagate facts. */ +-> 362 MVMSpeshIns *ins = bb->first_ins; + 363 while (ins) { + 364 /* See if there's deopt and logged annotations. Sync cur_deopt_idx + 365 * and, for logged+deopt-one, add logged facts and guards. */ +Target 0: (moar) stopped. +(lldb) bt +* thread #2, stop reason = breakpoint 1.1 + * frame #0: 0x00000001001bb540 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:362 + frame #1: 0x00000001001bb503 libmoar.dylib`MVM_spesh_facts_discover(tc=0x0000000100802e30, g=0x0000000100f4efe0, p=0x0000000100f514d0) at facts.c:659 + frame #2: 0x00000001001b4eb7 libmoar.dylib`MVM_spesh_candidate_add(tc=0x0000000100802e30, p=0x0000000100f514d0) at candidate.c:61 + frame #3: 0x00000001001cf991 libmoar.dylib`worker(tc=0x0000000100802e30, callsite=0x00000001006c9150, args=0x0000000000000000) at worker.c:16 + frame #4: 0x000000010014e8e2 libmoar.dylib`invoke_handler(tc=0x0000000100802e30, invokee=0x0000000102014840, callsite=0x00000001006c9150, args=0x0000000000000000) at MVMCFunction.c:9 + frame #5: 0x00000001000e8494 libmoar.dylib`thread_initial_invoke(tc=0x0000000100802e30, data=0x0000000100802050) at threads.c:59 + frame #6: 0x00000001000aefee libmoar.dylib`MVM_interp_run(tc=0x0000000100802e30, initial_invoke=(libmoar.dylib`thread_initial_invoke at threads.c:50), invoke_data=0x0000000100802050) at interp.c:93 + frame #7: 0x00000001000e7a35 libmoar.dylib`start_thread(data=0x0000000100802050) at threads.c:87 + frame #8: 0x00007fff7b9fe661 libsystem_pthread.dylib`_pthread_body + 340 + frame #9: 0x00007fff7b9fe50d libsystem_pthread.dylib`_pthread_start + 377 + frame #10: 0x00007fff7b9fdbf9 libsystem_pthread.dylib`thread_start + 13 + +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb579 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:370 + 367 MVMSpeshAnn *ann_deopt_one = NULL; + 368 MVMSpeshAnn *ann_logged = NULL; + 369 MVMint32 is_deopt_ins = 0; +-> 370 while (ann) { + 371 switch (ann->type) { + 372 case MVM_SPESH_ANN_DEOPT_ONE_INS: + 373 ann_deopt_one = ann; +Target 0: (moar) stopped. +(lldb) +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb620 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:385 + 382 } + 383 ann = ann->next; + 384 } +-> 385 if (ann_deopt_one && ann_logged) + 386 log_facts(tc, g, bb, ins, p, ann_deopt_one, ann_logged); + 387 + 388 /* Look through operands for reads and writes. */ +Target 0: (moar) stopped. +(lldb) l + 389 is_phi = ins->info->opcode == MVM_SSA_PHI; + 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ + 393 if ((is_phi && i > 0) + 394 || (!is_phi && (ins->info->operands[i] & MVM_operand_rw_mask) == MVM_operand_read_reg)) { + 395 MVMSpeshFacts *facts = &(g->facts[ins->operands[i].reg.orig][ins->operands[i].reg.i]); +(lldb) l + 396 facts->usages += facts->deopt_idx == cur_deopt_idx ? 1 : 2; + 397 } + 398 + 399 /* Writes need the current deopt index and the writing instruction + 400 * to be specified. A write that's on a deopt instruction bumps + 401 * the usage too. */ + 402 if ((is_phi && i == 0) +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb65b libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:389 + 386 log_facts(tc, g, bb, ins, p, ann_deopt_one, ann_logged); + 387 + 388 /* Look through operands for reads and writes. */ +-> 389 is_phi = ins->info->opcode == MVM_SSA_PHI; + 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ +Target 0: (moar) stopped. +(lldb) p MVM_SSA_PHI +error: use of undeclared identifier 'MVM_SSA_PHI' +(lldb) nexr +error: 'nexr' is not a valid command. +error: Unrecognized command 'nexr'. +(lldb) n +Process 8479 stopped +* thread #2, stop reason = step over + frame #0: 0x00000001001bb677 libmoar.dylib`add_bb_facts(tc=0x0000000100802e30, g=0x0000000100f4efe0, bb=0x0000000102115e00, p=0x0000000100f514d0, cur_deopt_idx=-1) at facts.c:390 + 387 + 388 /* Look through operands for reads and writes. */ + 389 is_phi = ins->info->opcode == MVM_SSA_PHI; +-> 390 for (i = 0; i < ins->info->num_operands; i++) { + 391 /* Reads need usage tracking; if the read is after a deopt point + 392 * relative to the write then give it an extra usage bump. */ + 393 if ((is_phi && i > 0) +Target 0: (moar) stopped. +(lldb) p is_phi +(MVMint32) $14 = 0 +(lldb) p ins +(MVMSpeshIns *) $15 = 0x0000000102115e60 +(lldb) p *ins +(MVMSpeshIns) $16 = { + info = 0x00000001005757c0 + operands = 0x0000000000000000 + prev = 0x0000000000000000 + next = 0x0000000000000000 + annotations = 0x0000000000000000 +} +(lldb) p *ins->info +(MVMOpInfo) $17 = { + opcode = 0 + name = 0x00000001002def92 "no_op" + mark = { + [0] = ' ' + [1] = ' ' + } + num_operands = 0 + pure = '\0' + deopt_point = '\0' + logged = '\0' + no_inline = '\0' + jittivity = '\0' + uses_hll = '\0' + operands = ([0] = '\0', [1] = '\0', [2] = '\0', [3] = '\0', [4] = '\0', [5] = '\0', [6] = '\0', [7] = '\0') +} + + +* profilingの箇所を見ていく + +* perlスクリプトをperl6に移植する +* markdownのparserみたいなのを書き換えてみるなど +* タイトループを早くするのか，ここのハッシュを早くするのか，オブジェクトのオペレーションを早くするのか… +* 手近な場所をとにかく見ていきたい + +* native codeをやるのかvmをやるのか + +* bytecode interpureter, gc関連を書き直すという手もある + +* gcc vs clang + +* llvm側でtail coll呼び出す時はフラグを見ている + * code grarであるというフラグを渡している感じ + +* script言語--> 上手く並列化出来ない + +* targetとしてCbCのコードを吐く + * 継続コード(meta level) + * 継続コードを見て計算結果を見て変えていく + * MoarVMのJIT，nqpのコンパイラにcbcを生成する部分を入れる + * perlccみたいなものをいれる + * targetのアプリケーション...whileでstring matchをする部分を最適化する + +* 正規表現の箇所をターゲットとして書くのも手…!? + * fileをmmapを使うかどうかなど +* 並列のgrep + * 早くなるには早くなる + * cache prefetchの処理でも高速化出来る + + +---------- +2018-06-05---- +MoarVMが実際にインタプリタとして走っているのはMVM_interp_runという関数らしい． +これはスレッド毎に用意されるらしい + +定義自体は `src/core/interp.c`に書かれている + + MVMInstancとかいう構造体に全ての情報が入っている + + MVM_cu_map_from_fileでスレッド情報とファイルから生成した結果をMVMCompUnit構造体として生成している + + DISPATCHでNEXT_OPを判断している，これはオペランドリストとswitch文が同じオーダーで書かれているので + 最適化しやすいらしい + + MVM_interp_runの後DISPATCHというマクロでNEXT_OPというマクロに応じて処理を行っているが + これがMoarVMのバイトコードを一対一対応しているので5000行のcase文が生成されている + + +---------- diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/12/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/12/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,29 @@ +javaのreflection + +explation handling + +* 自分がどこにいるのかわかるためにサブルーチンコール +* とっかかりは見つけたい +* MoarVM自体のパフォーマンスが問題では...!? + +* Javaの高速化Inline展開 +* Javaverで動かしてみる? + +* コンパイラ書く時 + +--- +* squick + * small talkの再実装 +* golang +* code-segmentをnqpで書いてみるという手もある +* Cのサブルーチンコールを最適化しても上手くはたらかないのでは...!? +* 膨大なライブラリの共有問題 +* 言語のライブラリを共有的にロードするデーモンを作成するという手もありそう + * アムダールの法則 + * Lantime Server or Language Server +* GraalVM + + +--- +* bytecode ではないので可読性がある +* CbCへのJITコンパイルを書くという手もある diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/12/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/12/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,69 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* Perl5のプロファイラを用意 + * ついでにPerl5もlldbで追ってみていました +* nqpのメソッド一覧を発見しました +* nqpでプログラミングの為にテキスト読んでいます + +# nqp +* [Opcode list](https://github.com/perl6/nqp/blob/master/docs/ops.markdown)を見つける + * 謎だったメソッド周りが定義 + * `nqp::`にメソッドが生えているのでこれを使う + +# Perl5 + +## Profiler +* 最近は `Devel::NYTProfile` が良いらしい + * `cpanm Devel::NYTProfile` + +``` +perl -d:NYTProfile hoge.pl +nytptofhtml --open +``` + +## lldb + +* git clone git@github.com:Perl/perl5.git +* ./Configure -DDEBUGGING=-g -Doptimize=-O0 +* 中々難解であまり良くわからなかった… + +# NQP +* moarVMのプロファイラを利用可能 + * 他のプロファイラに関しては[Wanted Modules](https://github.com/perl6/perl6-most-wanted/blob/master/most-wanted/modules.md)にも書かれているのでおそらく無い… +* `nqp::time_n()`でnqpで時間が計測出来るのでこれを使うのも単純には良さそう +* 残りは[スライド](http://edumentab.github.io/rakudo-and-nqp-internals-course/slides-day1.pdf)読み勧めてました + +# NQPの文法 + +* Perl6のベースなので制約がわりと多い +* 基本束縛で変数を定義していく + * `my $hoge := "foo";` +* 配列のpop/pushは専用のメソッドを経由して行う + +``` +my @hoge := ('1','2','3'); +nqp::push(@hoge,4); +``` + +# 今週のTODO + +* 評価用のプログラムを作成 + * 極力モジュールを使わない +* NQPで一回書くかどうか +* CbCをJITで吐き出したいのでJITの調査 + * 確かLuaJitを使っていたような… + * [YouTube](https://www.youtube.com/watch?v=N5_drt7TEqE) + * [Controlled Stack Hacking for the MoarVM JIT Compiler](http://brrt-to-the-future.blogspot.com/2018/06/controlled-stack-hacking-for-moarvm-jit.html) diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/14/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/14/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,24 @@ +RakudoのBuild + + +./Configure.pl --prefix=/Users/anatofuz/workspace/cr/Basic/build_perl6 --backends=moar --with-nqp=//Users/anatofuz/workspace/cr/Basic/build_perl6/bin/nqp + +謎のシェルスクリプトが生成されている + +``` +#!/bin/sh +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar --execname="$0" --libpath="." --libpath="blib" --libpath="/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" --libpath="/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" /Users/anatofuz/workspace/cr/Basic/perl6/MoarVM_basic/rakudo/perl6.moarvm --nqp-lib=blib -e ' +say "=" x 96; + +say "This is Rakudo Perl 6 running in the LLVM debugger, which often allows the user to generate useful back-\ntraces to debug or report issues in Rakudo, the MoarVM backend or the currently running code.\n"; + +unless $*VM.config { say "The currently used MoarVM backend is not compiled with debugging symbols, you might want to\nreconfigure and reinstall MoarVM with --debug enabled.\n" } + +say "This Rakudo version is $*PERL.compiler.version() built on MoarVM version $*VM.version(),"; +say "running on $*DISTRO.gist() / $*KERNEL.gist()\n"; + +say "Type `bt full` to generate a backtrace if applicable, type `q` to quit or `help` for help."; + +say "-" x 96;' +lldb /Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar -- --execname="$0" --libpath="." --libpath="blib" --libpath="/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" --libpath="/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" /Users/anatofuz/workspace/cr/Basic/perl6/MoarVM_basic/rakudo/perl6.moarvm --nqp-lib=blib "$@" +``` diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/23/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/23/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,28 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + +!SLIDE +## SSID + +`perl-entrance` + +## PW + +`metacpan` + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* foo + * puyohoge + +# 来週の予定 + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/26/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/26/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,14 @@ +JIT読むなら + +byte codeからネイティブを生成してメモリにかきこむところ + +データ領域のものを実行するのはOSが禁止しているのでそこを得部分 + +JITがはしった後VMに戻ってくる箇所 +(おそらくreturn) + +fpr フローティングポイント + +コード生成し終わった後に呼び出す箇所をリンクしているのでは139 + +enter_code diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/06/26/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/06/26/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,319 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* 暑くて死んでました +* OSCの資料をwebにあげました +* Perl6のコンパイルとJITのトレースをしました +* 院試対策し始めてます + +# お知らせ + +* [並列研の公式page](http://www.cr.ie.u-ryukyu.ac.jp/)にスライド置き場を作りました +* CSS力はなかった + + +# Perl6のbuild + +* JITのトレースがしたかったのでPerl6をbuildしました + +./Configure.pl --prefix=/Users/anatofuz/workspace/cr/Basic/build_perl6 --backends=moar --with-nqp=//Users/anatofuz/workspace/cr/Basic/build_perl6/bin/nqp + +# Perl6-lldb-m + +* `Perl6-lldb-m`というデバッグ用のスクリプトが生成されていた + +``` +#!/bin/sh +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar --execname="$0" --libpath="." --libpath="blib" --libpath="/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" --libpath="/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" /Users/anatofuz/workspace/cr/Basic/perl6/MoarVM_basic/rakudo/perl6.moarvm --nqp-lib=blib -e ' +say "=" x 96; + +say "This is Rakudo Perl 6 running in the LLVM debugger, which often allows the user to generate useful back-\ntraces to debug or report issues in Rakudo, the MoarVM backend or the currently running code.\n"; + +unless $*VM.config { say "The currently used MoarVM backend is not compiled with debugging symbols, you might want to\nreconfigure and reinstall MoarVM with --debug enabled.\n" } + +say "This Rakudo version is $*PERL.compiler.version() built on MoarVM version $*VM.version(),"; +say "running on $*DISTRO.gist() / $*KERNEL.gist()\n"; + +say "Type `bt full` to generate a backtrace if applicable, type `q` to quit or `help` for help."; + +say "-" x 96;' +lldb /Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar -- --execname="$0" --libpath="." --libpath="blib" --libpath="/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" --libpath="/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" /Users/anatofuz/workspace/cr/Basic/perl6/MoarVM_basic/rakudo/perl6.moarvm --nqp-lib=blib "$@" +``` + +# JITのトレース + +* 何も実行しないとBreakpointに引っかかる + +``` + $ ./perl6-lldb-m +================================================================================================ +This is Rakudo Perl 6 running in the LLVM debugger, which often allows the user to generate useful back- +traces to debug or report issues in Rakudo, the MoarVM backend or the currently running code. + +This Rakudo version is 2018.04.1 built on MoarVM version 2018.04.1, +running on macosx (10.13.5) / darwin (17.6.0) + +Type `bt full` to generate a backtrace if applicable, type `q` to quit or `help` for help. +------------------------------------------------------------------------------------------------ +b (lldb) target create "/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar" +Current executable set to '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64). +(lldb) settings set -- target.run-args "--execname=./perl6-lldb-m" "--libpath=/Users/anatofuz/workspace/cr/Basic/build_perl6/share/nqp/lib" "--libpath=/Users/anatofuz/workspace/cr/Basic/build_perl6/share/perl6/lib" "--libpath=/Users/anatofuz/workspace/cr/Basic/build_perl6/share/perl6/runtime" "/Users/anatofuz/workspace/cr/Basic/build_perl6/share/perl6/runtime/perl6.moarvm" +(lldb) b MVM_jit_compiler_init +Breakpoint 1: where = libmoar.dylib`MVM_jit_compiler_init + 20 at compile.c:17, address = 0x00000000001e4d54 +(lldb) run +Process 4185 launched: '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64) +Process 4185 stopped +* thread #2, stop reason = breakpoint 1.1 + frame #0: 0x0000000100287d54 libmoar.dylib`MVM_jit_compiler_init(tc=0x000000010084db80, cl=0x0000700007fa1c60, jg=0x000000010345ca7a) at compile.c:17 + 14 static const MVMuint16 MAGIC_BYTECODE[] = { MVM_OP_sp_jit_enter, 0 }; + 15 + 16 void MVM_jit_compiler_init(MVMThreadContext *tc, MVMJitCompiler *cl, MVMJitGraph *jg) { +-> 17 MVMint32 num_globals = MVM_jit_num_globals(); + 18 /* Create dasm state */ + 19 dasm_init(cl, 2); + 20 cl->dasm_globals = MVM_malloc(num_globals * sizeof(void*)); +Target 0: (moar) stopped. +``` + +# JIT用のコード + +``` +#!/usr/bin/env perl6 +use v6; + +my @hoge = (1..300); + +sub foo(@a){ + @a[0] = @a.elems; +} + +say foo(@hoge); +``` + + +``` +(lldb) run jit.p6 +Process 4223 launched: '/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/moar' (x86_64) +Unhandled exception: Bytecode stream corrupt (missing magic string) +Process 4223 exited with status = 1 (0x00000001) +``` + +* Bytecode stream corruptのエラーが発生する + +# missing magic string + +* `src/core/bytecode.c` 135行目で定義されているエラーらしい + +``` + /* Dissects the bytecode stream and hands back a reader pointing to the + * various parts of it. */ + static ReaderState * dissect_bytecode(MVMThreadContext *tc, MVMCompUnit *cu) { + MVMCompUnitBody *cu_body = &cu->body; + ReaderState *rs = NULL; + MVMuint32 version, offset, size; + + /* Sanity checks. */ + if (cu_body->data_size < HEADER_SIZE) + MVM_exception_throw_adhoc(tc, "Bytecode stream shorter than header"); + if (memcmp(cu_body->data_start, "MOARVM\r\n", 8) != 0) + MVM_exception_throw_adhoc(tc, "Bytecode stream corrupt (missing magic string)"); + version = read_int32(cu_body->data_start, 8); + if (version < MIN_BYTECODE_VERSION) + MVM_exception_throw_adhoc(tc, "Bytecode stream version too low"); + if (version > MAX_BYTECODE_VERSION) + MVM_exception_throw_adhoc(tc, "Bytecode stream version too high"); + + /* Allocate reader state. */ + rs = (ReaderState *)MVM_calloc(1, sizeof(ReaderState)); + rs->version = version; + rs->read_limit = cu_body->data_start + cu_body->data_size; + cu->body.bytecode_version = version; + + /* Locate SC dependencies segment. */ + offset = read_int32(cu_body->data_start, SCDEP_HEADER_OFFSET); + if (offset > cu_body->data_size) { + cleanup_all(tc, rs); + MVM_exception_throw_adhoc(tc, "Serialization contexts segment starts after end of stream"); + } + rs->sc_seg = cu_body->data_start + offset; + rs->expected_scs = read_int32(cu_body->data_start, SCDEP_HEADER_OFFSET + 4); + +``` + +# エラーの原因 + +* `memcmp(cu_body->data_start, "MOARVM\r\n", 8) != 0` でMoarVMと文字列比較をしているが，この部分でスクリプトすべてが流れ込んでいた + +``` +(lldb) p *cu_body +(MVMCompUnitBody) $1 = { + data_start = 0x00000001007e5000 "#!/usr/bin/env perl6\nuse v6;\n\nmy @hoge = (1..300);\n\nsub foo(@a){\n @a[0] = @a.elems;\n}\n\nsay foo(@hoge);\n" + data_size = 106 + num_extops = 0 +``` + + +# + +``` +(MVMCompUnitBody) $2 = { + data_start = 0x00000001007e5000 "#!/usr/bin/env perl6\nuse v6;\n\nmy @hoge = (1..300);\n\nsub foo(@a){\n @a[0] = @a.elems;\n}\n\nsay foo(@hoge);\n" + data_size = 106 + num_extops = 0 + max_callsite_size = 0 + coderefs = 0x0000000000000000 + num_frames = 0 + orig_frames = 0 + main_frame = 0x0000000000000000 + load_frame = 0x0000000000000000 + deserialize_frame = 0x0000000000000000 + callsites = 0x0000000000000000 + num_callsites = 0 + orig_callsites = 0 + extops = 0x0000000000000000 + strings = 0x0000000000000000 + num_strings = 0 + orig_strings = 0 + string_heap_fast_table = 0x0000000000000000 + string_heap_fast_table_top = 0 + serialized_size = 0 + string_heap_start = 0x0000000000000000 + string_heap_read_limit = 0x0000000000000000 + serialized = 0x0000000000000000 + scs = 0x0000000000000000 + num_scs = 0 + deallocate = MVM_DEALLOCATE_NOOP + scs_to_resolve = 0x0000000000000000 + sc_handle_idxs = 0x0000000000000000 + hll_config = 0x0000000000000000 + hll_name = 0x0000000000000000 + filename = 0x0000000000000000 + handle = 0x0000000000000000 + inline_tweak_mutex = 0x000000010084e040 + deserialize_frame_mutex = 0x0000000101017900 + bytecode_version = 0 + invoked = '\0' +} +``` + +# cuの生成部分 + +* compunit.cの `MVM_cu_map_from_file`から読んでいる`MVM_cu_from_bytes`で生成している + +``` +(lldb) f +frame #4: 0x00000001000d4238 libmoar.dylib`MVM_cu_map_from_file(tc=0x0000000100802100, filename="jit.p6") at compunit.c:64 + 61 } + 62 + 63 /* Turn it into a compilation unit. */ +-> 64 cu = MVM_cu_from_bytes(tc, (MVMuint8 *)block, (MVMuint32)size); + 65 cu->body.handle = handle; + 66 cu->body.deallocate = MVM_DEALLOCATE_UNMAP; + 67 return cu; +``` + +* 問題となっている箇所はこの時点で `block`に記録されている + + +# blockの生成部分 + +``` + 33 /* Loads a compilation unit from a bytecode file, mapping it into memory. */ + 34 MVMCompUnit * MVM_cu_map_from_file(MVMThreadContext *tc, const char *filename) { + 35 MVMCompUnit *cu = NULL; + 36 void *block = NULL; + 37 void *handle = NULL; + 38 uv_file fd; + 39 MVMuint64 size; +(lldb) + 40 uv_fs_t req; + 41 + 42 /* Ensure the file exists, and get its size. */ + 43 if (uv_fs_stat(tc->loop, &req, filename, NULL) < 0) { + 44 MVM_exception_throw_adhoc(tc, "While looking for '%s': %s", filename, uv_strerror(req.result)); + 45 } + 46 + 47 size = req.statbuf.st_size; + 48 + 49 /* Map the bytecode file into memory. */ +(lldb) + 50 if ((fd = uv_fs_open(tc->loop, &req, filename, O_RDONLY, 0, NULL)) < 0) { + 51 MVM_exception_throw_adhoc(tc, "While trying to open '%s': %s", filename, uv_strerror(req.result)); + 52 } + 53 + 54 if ((block = MVM_platform_map_file(fd, &handle, (size_t)size, 0)) == NULL) { + 55 /* FIXME: check errno or GetLastError() */ + 56 MVM_exception_throw_adhoc(tc, "Could not map file '%s' into memory: %s", filename, "FIXME"); + 57 } + 58 + 59 if (uv_fs_close(tc->loop, &req, fd, NULL) < 0) { +(lldb) + 60 MVM_exception_throw_adhoc(tc, "Failed to close filehandle: %s", uv_strerror(req.result)); + 61 } + 62 + 63 /* Turn it into a compilation unit. */ + 64 cu = MVM_cu_from_bytes(tc, (MVMuint8 *)block, (MVMuint32)size); + 65 cu->body.handle = handle; + 66 cu->body.deallocate = MVM_DEALLOCATE_UNMAP; + 67 return cu; + 68 } +``` + +* 54行目 + +# 生成箇所？ + +``` + 63 void *MVM_platform_map_file(int fd, void **handle, size_t size, int writable) + 64 { + 65 void *block = mmap(NULL, size, + 66 writable ? PROT_READ | PROT_WRITE : PROT_READ, + 67 writable ? MAP_SHARED : MAP_PRIVATE, fd, 0); + 68 +(lldb) + 69 (void)handle; + 70 return block != MAP_FAILED ? block : NULL; + 71 } +``` + +# 実際に作成している箇所 + +``` +(lldb) l 10 + 10 MVMCompUnit * MVM_cu_from_bytes(MVMThreadContext *tc, MVMuint8 *bytes, MVMuint32 size) { + 11 /* Create compilation unit data structure. Allocate it in gen2 always, so + 12 * it will never move (the JIT relies on this). */ + 13 MVMCompUnit *cu; + 14 MVM_gc_allocate_gen2_default_set(tc); + 15 cu = (MVMCompUnit *)MVM_repr_alloc_init(tc, tc->instance->boot_types.BOOTCompUnit); + 16 cu->body.data_start = bytes; + 17 cu->body.data_size = size; + 18 MVM_gc_allocate_gen2_default_clear(tc); +``` + +``` + 16 MVMObject * MVM_repr_alloc_init(MVMThreadContext *tc, MVMObject *type) { + 17 MVMObject *obj = REPR(type)->allocate(tc, STABLE(type)); + 18 + 19 if (REPR(obj)->initialize) { + 20 MVMROOT(tc, obj, { + 21 REPR(obj)->initialize(tc, STABLE(obj), obj, OBJECT_BODY(obj)); +(lldb) + 22 }); + 23 } + 24 + 25 return obj; + 26 } +``` diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/02/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/02/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,21 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 + +|現代的な|方法| +|について|hoge| + +# 来週の予定 + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/03/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/03/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,18 @@ + +LLVMのプロファイラ + +とりあえず測定する + +llvm true profiler +perl6にLLVMを直接つけてしまうという手もありそう +--> VMの中から直接読んでいる所 + +GC--> stack上のオブジェクトを全県探索しないといけない +Cでプログラムすると関数呼び出しはstackに乗るけれど変更になるのでは + +通常のallockルーチンのベースでmmapされている + +ログ解析ツールをPerl5/Perl6で書いてみる +* Rakudoで直接CbCを吐く + +llvm IRを吐き出す diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/03/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/03/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,371 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* 油断していたら一週間経ってました +* DynAsmに手がかりが無いかなと思って読んでいます + +# DynAsm + +* minilua経由で`dynasm.lua`などが呼ばれている模様 +* `dasm_init`でbreak pointを書けたら止まった + +``` +(lldb) bt +* thread #2, stop reason = breakpoint 1.1 + * frame #0: 0x000000010029982f libmoar.dylib`dasm_init(compiler=0x00007000010bbc60, maxsection=2) at dasm_x86.h:93 + frame #1: 0x0000000100287d6a libmoar.dylib`MVM_jit_compiler_init(tc=0x0000000100a4b8f0, cl=0x00007000010bbc60, jg=0x000000010183ac7a) at compile.c:19 + frame #2: 0x0000000100287ff5 libmoar.dylib`MVM_jit_compile_graph(tc=0x0000000100a4b8f0, jg=0x000000010183ac7a) at compile.c:52 + frame #3: 0x00000001001b50da libmoar.dylib`MVM_spesh_candidate_add(tc=0x0000000100a4b8f0, p=0x0000000100a4c480) at candidate.c:101 + frame #4: 0x00000001001cf991 libmoar.dylib`worker(tc=0x0000000100a4b8f0, callsite=0x00000001006c9150, args=0x0000000000000000) at worker.c:16 + frame #5: 0x000000010014e8e2 libmoar.dylib`invoke_handler(tc=0x0000000100a4b8f0, invokee=0x000000010181ae40, callsite=0x00000001006c9150, args=0x0000000000000000) at MVMCFunction.c:9 + frame #6: 0x00000001000e8494 libmoar.dylib`thread_initial_invoke(tc=0x0000000100a4b8f0, data=0x0000000100a4c070) at threads.c:59 + frame #7: 0x00000001000aefee libmoar.dylib`MVM_interp_run(tc=0x0000000100a4b8f0, initial_invoke=(libmoar.dylib`thread_initial_invoke at threads.c:50), invoke_data=0x0000000100a4c070) at interp.c:93 + frame #8: 0x00000001000e7a35 libmoar.dylib`start_thread(data=0x0000000100a4c070) at threads.c:87 + frame #9: 0x00007fff7abf8661 libsystem_pthread.dylib`_pthread_body + 340 + frame #10: 0x00007fff7abf850d libsystem_pthread.dylib`_pthread_start + 377 + frame #11: 0x00007fff7abf7bf9 libsystem_pthread.dylib`thread_start + 13 +``` + +# dasm_free + +* freeしている箇所で一度止めてupしていく + +``` +(lldb) b dasm_free +Breakpoint 2: where = libmoar.dylib`dasm_free + 12 at dasm_x86.h:118, address = 0x0000000100299a0c +(lldb) c +Process 42568 resuming +Process 42568 stopped +* thread #2, stop reason = breakpoint 2.1 + frame #0: 0x0000000100299a0c libmoar.dylib`dasm_free(compiler=0x00007000010bbc60) at dasm_x86.h:118 + 115 void + 116 dasm_free (Dst_DECL) + 117 { +-> 118 dasm_State *D = Dst_REF; + 119 int i; + 120 for (i = 0; i < D->maxsection; i++) + 121 if (D->sections[i].buf) +Target 0: (moar) stopped. +(lldb) bt +* thread #2, stop reason = breakpoint 2.1 + * frame #0: 0x0000000100299a0c libmoar.dylib`dasm_free(compiler=0x00007000010bbc60) at dasm_x86.h:118 + frame #1: 0x0000000100287f39 libmoar.dylib`MVM_jit_compiler_deinit(tc=0x0000000100a4b8f0, cl=0x00007000010bbc60) at compile.c:40 + frame #2: 0x00000001002881d7 libmoar.dylib`MVM_jit_compile_graph(tc=0x0000000100a4b8f0, jg=0x000000010183ac7a) at compile.c:99 + frame #3: 0x00000001001b50da libmoar.dylib`MVM_spesh_candidate_add(tc=0x0000000100a4b8f0, p=0x0000000100a4c480) at candidate.c:101 + frame #4: 0x00000001001cf991 libmoar.dylib`worker(tc=0x0000000100a4b8f0, callsite=0x00000001006c9150, args=0x0000000000000000) at worker.c:16 + frame #5: 0x000000010014e8e2 libmoar.dylib`invoke_handler(tc=0x0000000100a4b8f0, invokee=0x000000010181ae40, callsite=0x00000001006c9150, args=0x0000000000000000) at MVMCFunction.c:9 + frame #6: 0x00000001000e8494 libmoar.dylib`thread_initial_invoke(tc=0x0000000100a4b8f0, data=0x0000000100a4c070) at threads.c:59 + frame #7: 0x00000001000aefee libmoar.dylib`MVM_interp_run(tc=0x0000000100a4b8f0, initial_invoke=(libmoar.dylib`thread_initial_invoke at threads.c:50), invoke_data=0x0000000100a4c070) at interp.c:93 + frame #8: 0x00000001000e7a35 libmoar.dylib`start_thread(data=0x0000000100a4c070) at threads.c:87 + frame #9: 0x00007fff7abf8661 libsystem_pthread.dylib`_pthread_body + 340 + frame #10: 0x00007fff7abf850d libsystem_pthread.dylib`_pthread_start + 377 + frame #11: 0x00007fff7abf7bf9 libsystem_pthread.dylib`thread_start + 13 +``` + +# MBM_jit__compile_graph + +``` +(lldb) f +frame #2: 0x00000001002881d7 libmoar.dylib`MVM_jit_compile_graph(tc=0x0000000100a4b8f0, jg=0x000000010183ac7a) at compile.c:99 + 96 code = MVM_jit_compiler_assemble(tc, &cl, jg); + 97 + 98 /* Clear up the compiler */ +-> 99 MVM_jit_compiler_deinit(tc, &cl); + 100 + 101 /* Logging for insight */ + 102 if (tc->instance->jit_bytecode_dir) { +(lldb) +``` + +``` +(lldb) p code +(MVMJitCode *) $2 = 0x00000001047196a0 +(lldb) p *code +(MVMJitCode) $3 = { + func_ptr = 0x00000001007ff000 + size = 1723 + bytecode = 0x0000000100560cf0 "R\x03" + sf = 0x0000000103248300 + local_types = 0x0000000104719920 + num_locals = 18 + num_labels = 7 + labels = 0x0000000102902530 + num_deopts = 0 + num_inlines = 0 + num_handlers = 0 + deopts = 0x0000000000000000 + inlines = 0x0000000000000000 + handlers = 0x0000000000000000 + spill_size = 1 + seq_nr = 0 +} +``` + +# disassしてみる + +* `MAGIC_BYTECODE`という謎のbytecodeを吐いている + +``` +(lldb) disass -a code->bytecode +libmoar.dylib`MAGIC_BYTECODE: + 0x100560cf0 <+0>: pushq %rdx + 0x100560cf1 <+1>: addl (%rax), %eax + 0x100560cf3 <+3>: addb %al, (%rax) + 0x100560cf5 <+5>: addb %al, (%rax) + 0x100560cf7 <+7>: addb %al, (%rax) + 0x100560cf9 <+9>: addb %al, (%rax) + 0x100560cfb <+11>: addb %al, (%rax) + 0x100560cfd <+13>: addb %al, (%rax) + 0x100560cff <+15>: addb %al, (%rbx) + 0x100560d01 <+17>: addb %al, (%rax) + 0x100560d03 <+19>: addb %al, (%rax) + 0x100560d05 <+21>: addb %al, (%rax) + 0x100560d07 <+23>: addb %al, (%rax) + 0x100560d09 <+25>: addb %al, (%rax) + 0x100560d0b <+27>: addb %al, (%rax) + 0x100560d0d <+29>: addb %al, (%rax) + 0x100560d0f <+31>: addb %al, (%rax) + 0x100560d11 <+33>: addb %al, (%rax) + 0x100560d13 <+35>: addb %al, (%rax) + 0x100560d15 <+37>: addb %al, (%rax) + 0x100560d17 <+39>: addb %al, (%rax) + 0x100560d19 <+41>: addb %al, (%rax) + 0x100560d1b <+43>: addb %al, (%rax) + 0x100560d1d <+45>: addb %al, (%rax) +``` + +# 作っていそう + +``` + 45 MVMJitCode * MVM_jit_compile_graph(MVMThreadContext *tc, MVMJitGraph *jg) { + 46 MVMJitCompiler cl; + 47 MVMJitCode *code; + 48 MVMJitNode *node = jg->first_node; + 49 + 50 MVM_jit_log(tc, "Starting compilation\n"); +(lldb) + 51 /* initialation */ + 52 MVM_jit_compiler_init(tc, &cl, jg); + 53 /* generate code */ + 54 MVM_jit_emit_prologue(tc, &cl, jg); + 55 while (node) { + 56 switch(node->type) { + 57 case MVM_JIT_NODE_LABEL: + 58 MVM_jit_emit_label(tc, &cl, jg, node->u.label.name); + 59 break; + 60 case MVM_JIT_NODE_PRIMITIVE: + 61 MVM_jit_emit_primitive(tc, &cl, jg, &node->u.prim); +(lldb) + 62 break; + 63 case MVM_JIT_NODE_BRANCH: + 64 MVM_jit_emit_block_branch(tc, &cl, jg, &node->u.branch); + 65 break; + 66 case MVM_JIT_NODE_CALL_C: + 67 MVM_jit_emit_call_c(tc, &cl, jg, &node->u.call); + 68 break; + 69 case MVM_JIT_NODE_GUARD: + 70 MVM_jit_emit_guard(tc, &cl, jg, &node->u.guard); + 71 break; + 72 case MVM_JIT_NODE_INVOKE: +(lldb) + 73 MVM_jit_emit_invoke(tc, &cl, jg, &node->u.invoke); + 74 break; + 75 case MVM_JIT_NODE_JUMPLIST: + 76 MVM_jit_emit_jumplist(tc, &cl, jg, &node->u.jumplist); + 77 break; + 78 case MVM_JIT_NODE_CONTROL: + 79 MVM_jit_emit_control(tc, &cl, &node->u.control, NULL); + 80 break; + 81 case MVM_JIT_NODE_EXPR_TREE: + 82 MVM_jit_compile_expr_tree(tc, &cl, jg, node->u.tree); + 83 break; +(lldb) + 84 case MVM_JIT_NODE_DATA: + 85 MVM_jit_emit_data(tc, &cl, &node->u.data); + 86 break; + 87 case MVM_JIT_NODE_SAVE_RV: + 88 MVM_jit_emit_save_rv(tc, &cl, node->u.stack.slot); + 89 break; + 90 } + 91 node = node->next; + 92 } + 93 MVM_jit_emit_epilogue(tc, &cl, jg); + 94 +(lldb) + 95 /* Generate code */ + 96 code = MVM_jit_compiler_assemble(tc, &cl, jg); + 97 + 98 /* Clear up the compiler */ + 99 MVM_jit_compiler_deinit(tc, &cl); + 100 + 101 /* Logging for insight */ + 102 if (tc->instance->jit_bytecode_dir) { + 103 MVM_jit_log_bytecode(tc, code); + 104 } + 105 if (tc->instance->jit_log_fh) +(lldb) + 106 fflush(tc->instance->jit_log_fh); + 107 return code; + 108 } + 109 +``` + +# 実際にアセンブルしている箇所 + +``` +110 MVMJitCode * MVM_jit_compiler_assemble(MVMThreadContext *tc, MVMJitCompiler *cl, MVMJitGraph *jg) { +111 MVMJitCode * code; +112 MVMint32 i; +113 char * memory; +114 size_t codesize; +115 +116 MVMint32 dasm_error = 0; +117 +118 /* compile the function */ +119 if ((dasm_error = dasm_link(cl, &codesize)) != 0) { +120 MVM_jit_log(tc, "DynASM could not link, error: %d\n", dasm_error); +121 return NULL; +122 } +123 +124 memory = MVM_platform_alloc_pages(codesize, MVM_PAGE_READ|MVM_PAGE_WRITE); +125 if ((dasm_error = dasm_encode(cl, memory)) != 0) { +126 MVM_jit_log(tc, "DynASM could not encode, error: %d\n", dasm_error); +127 return NULL; +128 } +129 +130 /* set memory readable + executable */ +131 if (!MVM_platform_set_page_mode(memory, codesize, MVM_PAGE_READ|MVM_PAGE_EXEC)) { +132 MVM_jit_log(tc, "Setting jit page executable failed or was denied. deactivating jit.\n"); +133 /* our caller allocated the compiler and our caller must clean it up */ +134 tc->instance->jit_enabled = 0; +135 return NULL; +136 } +137 +138 MVM_jit_log(tc, "Bytecode size: %"MVM_PRSz"\n", codesize); +139 +140 /* Create code segment */ +141 code = MVM_malloc(sizeof(MVMJitCode)); +142 code->func_ptr = (void (*)(MVMThreadContext*,MVMCompUnit*,void*)) memory; +143 code->size = codesize; +144 code->bytecode = (MVMuint8*)MAGIC_BYTECODE; +145 code->sf = jg->sg->sf; +146 code->spill_size = cl->spills_num; +147 if (cl->spills_num > 0) { +148 MVMint32 sg_num_locals = jg->sg->num_locals; +149 code->num_locals = sg_num_locals + cl->spills_num; +150 code->local_types = MVM_malloc(code->num_locals * sizeof(MVMuint16)); +151 if (jg->sg->local_types != NULL) { +152 memcpy(code->local_types, jg->sg->local_types, sizeof(MVMuint16)*sg_num_locals); +153 } else { +154 memcpy(code->local_types, code->sf->body.local_types, sizeof(MVMuint16)*sg_num_locals); +155 } +156 for (i = 0; i < cl->spills_num; i++) { +157 code->local_types[sg_num_locals + i] = cl->spills[i].reg_type; +158 } +159 } else { +160 code->local_types = NULL; +161 code->num_locals = 0; +162 } +``` + + +# メモリのプロテクトを解除 + +* `memory = MVM_platform_alloc_pages(codesize, MVM_PAGE_READ|MVM_PAGE_WRITE);`で呼び出している +* `platform/posix/mmap.c`で主に定義されている + +``` + 42 void *MVM_platform_alloc_pages(size_t size, int page_mode) + 43 { + 44 int prot_mode = page_mode_to_prot_mode(page_mode); + 45 void *block = mmap(NULL, size, prot_mode, MVM_MAP_ANON | MAP_PRIVATE, -1, 0); + 46 + 47 if (block == MAP_FAILED) + 48 MVM_panic(1, "MVM_platform_alloc_pages failed: %d", errno); + 49 + 50 return block; + 51 } +``` + +* mmapを変数をラップする用に使用している + +``` + 21 static int page_mode_to_prot_mode(int page_mode) { + 22 switch (page_mode) { + 23 case MVM_PAGE_READ: + 24 return PROT_READ; + 25 case MVM_PAGE_WRITE: + 26 return PROT_WRITE; + 27 case (MVM_PAGE_READ|MVM_PAGE_WRITE): + 28 return PROT_READ|PROT_WRITE; + 29 case MVM_PAGE_EXEC: + 30 return PROT_EXEC; + 31 case (MVM_PAGE_READ|MVM_PAGE_EXEC): + 32 return PROT_READ|PROT_EXEC; + 33 case (MVM_PAGE_WRITE|MVM_PAGE_EXEC): + 34 return PROT_WRITE|PROT_EXEC; + 35 case (MVM_PAGE_READ|MVM_PAGE_WRITE|MVM_PAGE_EXEC): + 36 return PROT_READ|PROT_WRITE|PROT_EXEC; + 37 default: + 38 return PROT_NONE; + 39 } + 40 } +``` + + +# JITに突入する箇所 + +* ` MVM_jit_enter_code`が怪しいが複数宣言されている +* `src/jit/compile.c` + +``` +324 /* Enter the JIT code segment. The label is a continuation point where control +325 * is resumed after the frame is properly setup. */ +326 void MVM_jit_enter_code(MVMThreadContext *tc, MVMCompUnit *cu, +327 MVMJitCode *code) { +328 void *label = tc->cur_frame->jit_entry_label; +329 MVMint32 ofs = (char*)label - (char*)code->func_ptr; +330 if (ofs < 0 || ofs >= code->size) +331 MVM_oops(tc, "JIT entry label out of range for code!\n" +332 "(label %p, func_ptr %p, code size %lui, offset %li, frame_nr %i, seq nr %i)", +333 label, code->func_ptr, code->size, ((char*)label) - ((char*)code->func_ptr), +334 tc->cur_frame->sequence_nr, code->seq_nr); +335 code->func_ptr(tc, cu, label); +336 } +``` + +# コード実行箇所 + +* `code->func_ptr`でgrepした +* src/core/nativecall.cがそれっぽい + +``` +1149 void MVM_nativecall_invoke_jit(MVMThreadContext *tc, MVMObject *site) { +1150 MVMNativeCallBody *body = MVM_nativecall_get_nc_body(tc, site); +1151 MVMJitCode * const jitcode = body->jitcode; +1152 +1153 jitcode->func_ptr(tc, *tc->interp_cu, jitcode->labels[0]); +1154 } +``` + +* ただしサンプルコードでは止まらない + * JITされてない? +* 呼ばれている箇所を探索 + * jit/graph.c + * op_to_funcで呼ばれているが巨大なcase文 + * opcodeによって判定している + * これ自体は`consume_reprop`で呼ばれているが謎 +* 多分`MVM_interp_run`をちゃんと読む必要がありそう + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/07/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/07/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,82 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 復習回 +- ssid `perl-entrance` pw `metacpan` +- 復習していきます +- 一応スライドも作りながらやっているので講義をするかもしれません +- 基本各自で復習や予習をやってみてください +- わからないことがあれば適宜サポーターに聞いてください +- 今日の終わりに今日の成果をちょっと発表してみましょう(できれば) + + + +# シェルコマンド + +- `pwd` + - カレントディレクトリを表示 +- `ls` + - カレントディレクトリの中身を表示 +- `cd` + - ディレクトリを移動する + +# 引っかかりポイント +- unixはカレントディレクトリという概念がある + - finderで今見ているディレクトリの表示と対応している +- `pwd`はカレントディレクトリの場所を表示する +___ +# お約束 + + +```perl +#!/usr/bin/env perl +use ustrict; +use warnings; +``` + +- シェバン +- `use strict` + - 行儀の良い文法 +- `use warnings` + - 間違った時に警告 + + +# 変数 +- スカラ変数 +- 配列 +- ハッシュ + +# スカラ変数 + +- 宣言するときは`my`をつける +- シジルは`$` +- `my $hoge = 4;`みたいに宣言する +- `=`は右を左に代入する + + +# if文 + +- 条件で処理を分岐させたい時に使う +- `if ()`の`()`の部分が真か偽か判定する + - 真の時にブロックが実行される +- これじゃないとき==> `elsif ( )` + +# 真偽値 + +- perlの偽は +- 0 +- undef +- "" +- `()` + + +# 配列 + +- 変数のまとまり的なもの +- シジルは`@` +- 配列の要素にアクセスするときはスカラー変数なので`$` +- `my @array = (1..10)` +- `print $array[3]` diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/10/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/10/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,26 @@ +* if文とJIT +* ログアナライザー /var/log/ をエイヤッと見てみる + * この中から特定のパターンを確認する + * デーモンを判定 + * 日付を判定 + * 回数を数えるか + +* ファイルを分割して並列実行 +* golang + +* for文の中で+するなら一旦受け皿を用意しておけば良さそう +* javaのstreamingで分割すると良さそう + +* バッカス-> FP (データ並列を実行する) +* 並列シンタックスをいれるか + +* 並列処理しても + +* 指針-->Javaの代わりのCbCを吐く + +CbCなので最初はGCいれなくても作って良さそう + +* どんな風なCbCを吐くか--> Basic Block単位で生成すると良さそう +Basic blockをcode segment + +if文とかcallまでの間の部分をbasic blockという diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/10/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/10/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,123 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* 評価用のスクリプトを作成して計測していました + +# 評価の例題 +* 青空文庫のテキストファイルを1つ読み込んで，かなと漢字を正規表現でキャプチャ，総数をカウントする +* 例 `蜜蜂《みつばち》` +* 今回はPerl5,Perl6,Rubyで実装しベンチマークを計測した + +# Perl5実装 + +```perl +#!/usr/bin/env perl +use strict; +use warnings; +use utf8; +use feature 'say'; +use Encode; + +my $filename = "./dogura_magura.txt"; +open my $fh,'<:encoding(utf-8)',$filename or die qw/can't open/; + +my @kana; + +while (my $line = <$fh>) { + chomp $line; + while( $line =~ m![、。]?(\p{Han}+)《(\p{Hiragana}+)》!g){ + push @kana,[$1,$2]; + } +} + +print scalar @kana; +``` + +# Ruby実装 + +```ruby +#!/usr/bin/env ruby + +File.open("./dogura_magura.txt",'r') do |f| + hoge = f.read.scan(/[、。]?(\p{Han}+)《(\p{Hiragana}+)》/) + p hoge.count +end +``` + +# Perl6実装 + +``` +#!/usr/bin/env perl6 +use v6; + +my $file = "./dogura_magura.txt"; +my $fh = open $file, :r; +my $hoge; + +for $fh.lines -> $line { + if ($line ~~ m:g/<[、。]>?(<:Han>+)"《"(<:Hiragana>+)"》"/ ) { + say $/[0]; + $hoge += $/.conj; + } +} + +say $hoge; + +$fh.close; +``` + +# 測定結果 + +``` +sh test.sh +perl +6726 + +real 0m0.209s +user 0m0.153s +sys 0m0.045s + +ruby +6726 + +real 0m0.206s +user 0m0.147s +sys 0m0.048s + +perl6 +6726 + +real 0m3.052s +user 0m3.176s +sys 0m0.057s +``` + +# 測定結果 + +``` + zsh test.zsh +perl +6726 +perl test.pl 0.15s user 0.04s system 95% cpu 0.196 total +ruby +6726 +ruby test.rb 0.17s user 0.06s system 94% cpu 0.235 total +perl6 +6726 +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/perl6 test.p6 3.21s user 0.07s system 106% cpu 3.090 total +``` + +* Perl6ではuser timeが圧倒的にかかっているが,systemは他と同レベル +* 生成されたprofilerを見た所JITも吐いているらしい diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/13/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/13/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,23 @@ +C +Files=142, Tests=12933, 47 wallclock secs ( 1.18 usr 0.33 sys + 55.57 cusr 3.40 csys = 60.48 CPU) + +tags/2018/04.1の状態ではJVMのmoarはtestで死ぬことがわかった + +nqp ) perl Configure.pl --backends=jvm +rakudo ) perl Configure.pl --backends=jvm --with-nqp=/Users/anatofuz/workspace/cr/Basic/jvm/nqp/install/bin/nqp --prefix=/Users/anatofuz/workspace/cr/Basic/jvm/jvm_install + + +書いた + +perl6 +950 +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/perl6 log_analyze.p6 0.94s user 0.05s system 128% cpu 0.769 total +perl5 +950 +perl log_analyze.pl 0.04s user 0.04s system 86% cpu 0.098 total +ruby +950 +ruby log_analyze.rb 0.16s user 0.06s system 92% cpu 0.243 total + + +驚きの20倍遅い!!!! diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/14/memo.txt diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/15/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/15/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,8 @@ +jvm +./perl6 ~/workspace/cr/Basic/perl6/sandbox/log/log_analyze.p6 17.51s user 0.61s system 439% cpu 4.118 total + +moar +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/perl6 log_analyze.p6 0.72s user 0.07s system 114% cpu 0.689 total + +perl5 +perl log_analyze.pl 0.04s user 0.04s system 77% cpu 0.103 total diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/17/memo.txt diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/17/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/17/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,334 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 + +* JVM版Perl6をBuildしました +* logアナライザーを作成して時間計測を行いました +* 院試出願しました +* 趣味でPerl2をbuildしてます + +# ログアナライザー(Perl5) + +```perl5 +#!/usr/bin/env perl +use strict; +use warnings; +use Time::HiRes qw/gettimeofday tv_interval/; + +my $t0 = [gettimeofday]; + +my $file = "/var/log/system.log"; + +if(@ARGV == 2){ + if ( $ARGV[0] eq "-f"){ + $file = $ARGV[1]; + } +} + +my $user_name = qr/anatofuzMBP|anatofuz-15/; +open my $fh, "<",$file; +my $count = {}; + +while (my $line = <$fh>) { + if ( $line =~ /\w \d{0,2} (?:\d{2}:?){3} $user_name ([\w.]+)\[\d+\]/){ + $count->{$1}++; + } +} + +my $sum = 0; + +for my $key (keys %$count){ + $sum += $count->{$key}; +} + +print "$sum\n"; +my $t1 = [gettimeofday]; + +my $evec_time = tv_interval($t0,$t1); +print "$evec_time\n"; + +``` + +# ログアナライザー(Ruby) + +```ruby +#!/usr/bin/env ruby + +require 'benchmark' + +result = Benchmark.realtime do + file = "/var/log/system.log" + + user_name = Regexp.new("anatofuzMBP|anatofuz-15") + count = Hash.new(0) + + File.open(file,'r') do |f| + f.each_line do |line| + if line =~ /\w+ \d{0,2} (?:\d{2}:?){3} #{user_name} ([\w.]+)\[\d+\]/ + count[$1] += 1 + end + end + end + + + sum = 0 + + for key in count.keys + sum += count[key] + end + + p sum +end +#p "#{Time.now - start_time}" +puts "#{result}" + +``` + +# ログアナライザー(Perl6) + +```perl6 +#!/usr/bin/env perl +use v6; + +my $start = DateTime.now; + +unit sub MAIN(:f($file) where { .IO.f } = '/var/log/system.log'); + +my $user_name = /'anatofuzMBP'|'anatofuz-15'/; +my $fh = open $file,:r; +my %count =(); + +for $fh.lines -> $line { + if ( $line ~~ /\w+ \s \d**0..3 \s [\d**2\:?]**3 \s $user_name \s (<[\w.]>+)\[\d+\]/) { + %count{$0}++; + } +} +$fh.close; +my $sum = 0; + +for %count.keys -> $key { + $sum += %count{$key}; +} + +$sum.say; + +my $end = DateTime.now; + +my $time = $end - $start; +say $time; + +``` + +# ログアナライザー(Python) + +```python +#!/usr/bin/env python +import re +import sys +from collections import defaultdict +import time + +start_time = time.time() + +file_path = "/var/log/system.log" +args = sys.argv + +if args == 3: + if args[1] == "-f": + file_path = args[2] + +count = defaultdict(int) + +with open(file_path) as f: + for line in f: + match = re.search(r'\w+ \d{0,2} (?:\d{2}:?){3} (?:anatofuzMBP|anatofuz-15) ([\w.]+)\[\d+\]',line) + if match: + count[match.group(1)]+=1 + +total = 0 + +for key in count.keys(): + total +=count[key] + +print(total) + +end_time = time.time() + +print(end_time - start_time) + +``` + +# ログアナライザー(java) + +```java +package com.google.anatofuz; + +import java.io.File; +import java.io.FileReader; +import java.io.BufferedReader; +import java.io.FileNotFoundException; +import java.io.IOException; +import java.util.*; +import java.util.regex.Pattern; +import java.util.regex.Matcher; + +public class LogAnalyzer { + + public static void main(String args[]) { + + long start = System.currentTimeMillis(); + File file = new File("/var/log/system.log"); + + if (args.length != 0) { + if (args[0].equals("-f")) { + file = new File(args[1]); + } + } + + try { + FileReader filereader = new FileReader(file); + BufferedReader bufferedReader = new BufferedReader(filereader); + + String line; + Map map = new HashMap(0); + Pattern p = Pattern.compile("\\w+ \\d{0,2} (?:\\d{2}:?){3} (?:anatofuzMBP|anatofuz-15) ([\\w.]+)\\[\\d+\\]"); + + + while ((line = bufferedReader.readLine()) != null) { + Matcher matcher = p.matcher(line); + if (matcher.find()) { + map.merge(matcher.group(1),1,Integer::sum); + } + } + + int sum = 0; + + for (String key :map.keySet()){ + sum += map.get(key); + } + + System.out.println(sum); + + long end = System.currentTimeMillis(); + + System.out.println("0.0" + (end - start)); + + } catch (FileNotFoundException ex){ + System.out.println(ex); + } catch (IOException ex){ + System.out.println(ex); + } + } +} + +``` + +# 計測結果 + +* 結果をブログに載せたら起動時間の比較と突っ込まれる + +``` +perl6(moar) +950 +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/perl6 log_analyze.p6 0.94s user 0.05s system 128% cpu 0.769 total + +perl6(jvm) +./perl6 ~/workspace/cr/Basic/perl6/sandbox/log/log_analyze.p6 17.51s user 0.61s system 439% cpu 4.118 total + + +perl5 +950 +perl log_analyze.pl 0.04s user 0.04s system 86% cpu 0.098 total + +ruby +950 +ruby log_analyze.rb 0.16s user 0.06s system 92% cpu 0.243 total + +java +java -jar java/build/libs/anatofuz-1.0-SNAPSHOT.jar 0.27s user 0.05s system 149% cpu 0.212 total + +time python log_analyze.py +python log_analyze.py 0.07s user 0.05s system 77% cpu 0.153 total +``` + + + +# 内部処理 + +* 内部処理時間のみ計測 +* perl5 + * 0.003434s +* Ruby + * 0.046458s +* Python + * 0.0097 +* Java + * 0.047 +* Perl6(Moar) + * 0.2649 +* Perl6(JVM) + * 0.687 + +``` +perl5 +0.003434 +perl log_analyze.pl 0.04s user 0.04s system 76% cpu 0.105 total + +===== +ruby +0.04645899997558445 +ruby log_analyze.rb 0.15s user 0.05s system 85% cpu 0.239 total +===== + +python log_analyze.py +0.009788036346435547 + +===== + +java +0.047 +java -jar java/build/libs/anatofuz-1.0-SNAPSHOT.jar 0.27s user 0.05s system 151% cpu 0.209 total + +===== +perl6 +0.2649038 +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/perl6 log_analyze.p6 0.86s user 0.08s system 109% cpu 0.856 total + +===== +perl6(jvm) +WARNING: An illegal reflective access operation has occurred +WARNING: Illegal reflective access by org.perl6.nqp.runtime.Ops (file:/Users/anatofuz/workspace/cr/Basic/jvm/nqp/install/share/nqp/runtime/nqp-runtime.jar) to field sun.management.RuntimeImpl.jvm +WARNING: Please consider reporting this to the maintainers of org.perl6.nqp.runtime.Ops +WARNING: Use --illegal-access=warn to enable warnings of further illegal reflective access operations +WARNING: All illegal access operations will be denied in a future release +0.687 +/Users/anatofuz/workspace/cr/Basic/jvm/rakudo/perl6 21.48s user 0.72s system 436% cpu 5.087 total + +``` + + +# 院試 + +* 出願しました +* 過去問やってます + +# Perl2 + +* Perl5のgitリポジトリにtagとして残っていました +* gcc/cc1でbuild出来るようにパッチを書いてます + * gccを参照するように変更 + * ``というヘッダーファイルを削除 + * `sprintf`などの関数の返り値を修正 + * yaccのシンタックスエラーを解消 diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/17/zip.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/17/zip.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,69 @@ +2018-07-10---- +* if文とJIT +* ログアナライザー /var/log/ をエイヤッと見てみる + * この中から特定のパターンを確認する + * デーモンを判定 + * 日付を判定 + * 回数を数えるか + +* ファイルを分割して並列実行 +* golang + +* for文の中で+するなら一旦受け皿を用意しておけば良さそう +* javaのstreamingで分割すると良さそう + +* バッカス-> FP (データ並列を実行する) +* 並列シンタックスをいれるか + +* 並列処理しても + +* 指針-->Javaの代わりのCbCを吐く + +CbCなので最初はGCいれなくても作って良さそう + +* どんな風なCbCを吐くか--> Basic Block単位で生成すると良さそう +Basic blockをcode segment + +if文とかcallまでの間の部分をbasic blockという + +---------- +2018-07-13---- +C +Files=142, Tests=12933, 47 wallclock secs ( 1.18 usr 0.33 sys + 55.57 cusr 3.40 csys = 60.48 CPU) + +tags/2018/04.1の状態ではJVMのmoarはtestで死ぬことがわかった + +nqp ) perl Configure.pl --backends=jvm +rakudo ) perl Configure.pl --backends=jvm --with-nqp=/Users/anatofuz/workspace/cr/Basic/jvm/nqp/install/bin/nqp --prefix=/Users/anatofuz/workspace/cr/Basic/jvm/jvm_install + + +書いた + +perl6 +950 +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/perl6 log_analyze.p6 0.94s user 0.05s system 128% cpu 0.769 total +perl5 +950 +perl log_analyze.pl 0.04s user 0.04s system 86% cpu 0.098 total +ruby +950 +ruby log_analyze.rb 0.16s user 0.06s system 92% cpu 0.243 total + + +驚きの20倍遅い!!!! + +---------- +2018-07-14---- + +---------- +2018-07-15---- +jvm +./perl6 ~/workspace/cr/Basic/perl6/sandbox/log/log_analyze.p6 17.51s user 0.61s system 439% cpu 4.118 total + +moar +/Users/anatofuz/workspace/cr/Basic/build_perl6/bin/perl6 log_analyze.p6 0.72s user 0.07s system 114% cpu 0.689 total + +perl5 +perl log_analyze.pl 0.04s user 0.04s system 77% cpu 0.103 total + +---------- diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/24/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/24/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,9 @@ + +** MoarVMのCbCをswithch文をCに書き換える + +moar VMのcode segmentを順番に呼び出していくコードを書く + +**JITしないMoarVMを見てみる + +CbC +JIT diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/31/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/31/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,7 @@ +* Perl6が動いている特定のコードを早くする +* --> Regular Expression 周り + +* ある特定のパターンを検知してそこだけ早くする +* ファイル分割 + +TODO: masaさんの論文を読む diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/07/31/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/07/31/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,49 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* 院試の勉強していました + * 来週なんで頑張ります +* 3GBのファイルでログアナライザーの計測しました + +# 計測(3GB) + +* Perl5 + * 41.35s +* Ruby + * 574.52s +* Python + * 101.16s +* Java + * 48.85s +* Perl6(Moar) + * 2331.08s +* Perl6(JVM) + * 1665.56s + +# 参考(231K) + +* Perl5 + * 0.04s +* Ruby + * 0.15s +* Python + * 0.06s +* Java + * 0.27s +* Perl6(Moar) + * 0.86s +* Perl6(JVM) + * 21.48s + diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/08/07/memo.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/08/07/memo.txt Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,37 @@ +- Perl6 + - とりあえず言語部分から始めるのが良さそう + +- 正規表現部分はRakudoを呼び出す +- ベンチマークのコードでどんなものを吐き出しているかを調べる +- CbC事態はアセンブラなのでアセンブラ的に使って問題ない + +- ベンチマークに沿ってとりあえず作っていく + +- 正規表現の差が出る--> Linearに終わってない + +- ボーアムーア検索 + - アスタリスクが直前にあると配列があるので厳しい + - Cで実装するとほとんど大丈夫 + - 正規表現に突入すると組み合わせ爆発が発生する可能性 + +- 高速に実現できるパターンマッチング言語の開発? + +- 長い部分を正規表現で探してそこ以外をボーアムーア検索で探す +- 1Mbのマッチングは? 画像ファイルに入れる可能性がありそう… !? + +- 実際に正規表現は非決定的オートマトンに変換されてから処理される +- NFAはバックトラックしながら探すので結構大変そう + - マッチングする行が短ければ文字列の前後に分けて処理をする + - ボトムアップに数字とのパターンを作るという説もありそう + - 行の最長を指定する + +- ボトムアップアプローチ + +(CbCのgrep) +- 文字列を見つけるまでボーアムーアサーチを行い，見つかったら前後にregular expression searchを行う +- 逆方向サーチを実装するという手 + +- CbCは再帰下降が使えない(再起できない)のでDFAに乗せる方針でいけば最適化できそう +- 最終的にCbCで文法解析をするか...!? + +- 文法をCbCでどうやって書くかを開発したい diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/08/07/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/08/07/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,18 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 + +* 院試対策していました + * 木金で院試です diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/09/11/memo.txt diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/09/11/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/09/11/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,50 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* 先週は帰省していました +* 院試合格しました +* ミニマムなCコンパイラの実装していました + * 構文解析は終わりました + +# 懐かしのコーナー +* Perl1.0 +* Perl2.0 +* Perl3.0は動かしました +* Perl4はあと一歩です + +``` +perl.c:53:21: error: expected declaration specifiers or '...' before ',' token + char *index(), *strcpy(), *getenv(); + ^~~~~~ +perl.c:53:21: error: expected declaration specifiers or '...' before ',' token + char *index(), *strcpy(), *getenv(); + ^~~~~~ +In file included from /usr/include/secure/_stdio.h:31:0, + from /Users/anatofuz/workspace/cr/build_gcc/lib/gcc/x86_64-apple-darwin17.5.0/8.0.0/include-fixed/stdio.h:425, + from perl.h:77, + from perl.c:15: +perl.c:53:21: error: expected declaration specifiers or '...' before '__builtin_object_size' + char *index(), *strcpy(), *getenv(); + ^~~~~~ +perl.c:69:19: error: 'environ' undeclared (first use in this function); did you mean 'envix'? + origenviron = environ; + ^~~~~~~ +``` + +# Perl4 + +* エンディアンとbit数を設定する変数が設定されてなかったので設定 +* Makefileに ``などの余計な行があったので削除 +* Perl内部で設定されていた関数名とCの関数が被っていたのでPerlの関数名を修正 diff -r 5f949b153f65 -r 73b27e5c1d79 slides/2018/09/18/slide.md --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/slides/2018/09/18/slide.md Tue Apr 16 18:58:24 2019 +0900 @@ -0,0 +1,25 @@ +title: CbCによるMoarVMの改良 +author: Takahiro Shimizu +profile: +lang: Japanese + + +# 研究目的 +- Perl5の後継言語として開発されているPerl6はMoarVMと呼ばれるVMを搭載している． +- Perl6はMoarVM,JVM,JavaScript上で動くRakudoと呼ばれる実装と，コンパイラ開発者用のサブセットであるNQPが主な実装となっている． +- 現在Perl6及びMoarVMは全体的な速度がPerl5と比較し低下しており，実務として利用できるレベルに達していない． +- さらにPerl6の実装自体巨大なcase-switch文など見通しが悪くなっている． +- この問題を解決するために現在当研究室で開発している継続を中心にしたContinuation based Cを用いて改良を行う +- CbCの設計理念からVMの実装と親和性が高い事も推測できる為，実際にCbCを用いてどのようにVMが実装できるかを検証する + +# 今週の進捗 +* [Roppingi.pm](https://roppongipm.connpass.com/event/96924/)に誘われたので行っていました + * 六本木ヒルズ大きかったです +* Perl1.0からPerl6までを20分で話してきました +* 「初めてのPerl」の訳者の近藤 嘉雪さんからも好評で良かったです +* 週末は[Okinawa.pm](https://okinawapm.connpass.com/event/99127/)です +* `/net/open/Fedora/Fedora-Server-dvd-x86_64-28-1.1.iso`にiso置いておきました +* そういえばKernelのDebug buildどうしましょう + +# 来週の予定 +