X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FApp%2FFatPacker.pm;h=b643d3a2bd362d546efdfd5f6bb9376e5f8be6f8;hb=75b0b05695b1845872338484e059725050e79d8f;hp=a6a01e33a0f71c641ee06370362f6427dc169aec;hpb=276a30c97c5932b6bdc4b0246102caec559d9ab8;p=p5sagit%2FApp-FatPacker.git diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm index a6a01e3..b643d3a 100644 --- a/lib/App/FatPacker.pm +++ b/lib/App/FatPacker.pm @@ -13,16 +13,16 @@ use File::Copy qw(copy); use File::Path qw(mkpath rmtree); use B qw(perlstring); -our $VERSION = '0.009006'; # 0.9.6 +our $VERSION = '0.009008'; # 0.9.8 $VERSION = eval $VERSION; sub call_parser { my $self = shift; - my ( $args, $options ) = @_; + my ($args, $options) = @_; local *ARGV = [ @{$args} ]; - $self->{'option_parser'}->getoptions( @{$options} ); + $self->{option_parser}->getoptions(@$options); return [ @ARGV ]; } @@ -69,15 +69,16 @@ sub script_command_help { sub script_command_trace { my ($self, $args) = @_; - $args = $self->call_parser( $args => [ + $args = $self->call_parser($args => [ 'to=s' => \my $file, 'to-stderr' => \my $to_stderr, 'use=s' => \my @additional_use - ] ); + ]); die "Can't use to and to-stderr on same call" if $file && $to_stderr; $file ||= 'fatpacker.trace'; + if (!$to_stderr and -e $file) { unlink $file or die "Couldn't remove old trace file: $!"; } @@ -90,25 +91,35 @@ sub script_command_trace { }; $self->trace( - use => \@additional_use, - args => $args, + use => \@additional_use, + args => $args, output => $arg, ); } sub trace { my ($self, %opts) = @_; - my $use = defined $opts{'use'} ? $opts{'use'} : []; - my $args = defined $opts{'args'} ? $opts{'args'} : []; - my $output = $opts{'output'}; - if(@$use) { - $output .= "," . join ",", @$use; - } + my $capture; + + my $output = $opts{output} || do { + $capture++; '>&STDOUT' + }; + + my $trace_opts = join ',', $output||'>&STDOUT', @{$opts{use}||[]}; - { - local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$output; - system $^X, @$args; + local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$trace_opts; + + my @args = @{$opts{args}||[]}; + + if ($output) { + # user specified output target, JFDI + system $^X, @args; + return; + } else { + # no output target specified, slurp + open my $out_fh, '-|', $^X, @args; + return do { local $/; <$out_fh> }; } } @@ -122,7 +133,9 @@ sub script_command_packlists_for { sub packlists_containing { my ($self, $targets) = @_; my @targets = @$targets; - require $_ for @targets; + foreach my $t (@targets) { + require $t; + } my @search = grep -d $_, map catdir($_, 'auto'), @INC; my %pack_rev; my $cwd = cwd;