X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FApp%2FFatPacker.pm;h=c225ac7167058df0dcb8baf7f1610694bf6feb34;hb=b079df6c417e2e015eb7f9625b514a2d9edacc3f;hp=cdbb400fd69c64ecf0b0c6dd9e58badd56504093;hpb=abd7cf010a3586c6c2d136525b528eecc5d48f2f;p=p5sagit%2FApp-FatPacker.git

diff --git a/lib/App/FatPacker.pm b/lib/App/FatPacker.pm
index cdbb400..c225ac7 100644
--- a/lib/App/FatPacker.pm
+++ b/lib/App/FatPacker.pm
@@ -4,6 +4,7 @@ use strict;
 use warnings FATAL => 'all';
 use 5.008001;
 use Getopt::Long;
+use Capture::Tiny ();
 use Cwd qw(cwd);
 use File::Find qw(find);
 use File::Spec::Functions qw(
@@ -83,26 +84,54 @@ sub script_command_trace {
   }
   my $arg = do {
     if ($to_stderr) {
-      "=>&STDERR"
+      "=&STDERR"
     } elsif ($file) {
-      "=>>${file}"
+      ">>${file}"
     }
   };
 
-  if(@additional_use) {
-    $arg .= "," . join ",", @additional_use;
-  }
-
-  $self->trace($arg, $args);
+  $self->trace(
+    use => \@additional_use,
+    args => $args,
+    output => $arg,
+  );
 }
 
 sub trace {
-  my ($self, $arg, $args) = @_;
+  my ($self, %opts) = @_;
+  my $use = defined $opts{'use'} ? $opts{'use'} : [];
+  my $args = defined $opts{'args'} ? $opts{'args'} : [];
+  my $output = $opts{'output'};
+  my $capture;
+
+  # if the user doesn't provide output, they want to actually
+  # capture the output and receive it back
+  if (!$output) {
+    # throw to STDOUT to differ from STDERR
+    $output .= '>&STDOUT';
+
+    # raise capture flag
+    $capture++;
+  }
 
-  {
-    local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace'.$arg;
-    system $^X, @$args;
+  if(@$use) {
+    $output .= "," . join ",", @$use;
   }
+
+  my $trace_sub = sub {
+     local $ENV{PERL5OPT} = '-MApp::FatPacker::Trace='.$output;
+     system $^X, @$args;
+  };
+
+  if ($capture) {
+    # capture both STDOUT and STDERR so we could throw away STDERR
+    # STDOUT will contain the trace
+    # STDERR will contain the "syntax OK" statement
+    my ($stdout, $stderr) = Capture::Tiny::capture {$trace_sub->()};
+    return $stdout;
+  } else {
+    $trace_sub->();
+   }
 }
 
 sub script_command_packlists_for {