From: Robert 'phaylon' Sedlacek <r.sedlacek@shadowcat.co.uk>
Date: Wed, 13 Jun 2012 20:21:50 +0000 (+0000)
Subject: more explicit ipc to work around child-exec issues
X-Git-Tag: v0.001_001~50
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9c3e454c89f701b573ced38188039aba920a8aef;p=scpubgit%2FSystem-Introspector.git

more explicit ipc to work around child-exec issues
---

diff --git a/lib/System/Introspector/Probe/FileHandles.pm b/lib/System/Introspector/Probe/FileHandles.pm
index 8c26e07..9b72367 100644
--- a/lib/System/Introspector/Probe/FileHandles.pm
+++ b/lib/System/Introspector/Probe/FileHandles.pm
@@ -6,6 +6,8 @@ use System::Introspector::Util qw(
     transform_exceptions
 );
 
+has lsof_command => (is => 'ro', default => sub { 'lsof' });
+
 sub gather {
     my ($self) = @_;
     return transform_exceptions {
@@ -25,7 +27,8 @@ sub gather {
 
 sub _open_lsof_pipe {
     my ($self) = @_;
-    return handle_from_command 'lsof -F0';
+    my $lsof = $self->lsof_command;
+    return handle_from_command "$lsof -F0";
 }
 
 1;
diff --git a/lib/System/Introspector/Util.pm b/lib/System/Introspector/Util.pm
index d699799..98d2429 100644
--- a/lib/System/Introspector/Util.pm
+++ b/lib/System/Introspector/Util.pm
@@ -3,6 +3,9 @@ use strictures 1;
 package System::Introspector::Util;
 use Exporter 'import';
 use IPC::Run qw( run );
+use IPC::Open2;
+use File::Spec;
+use Scalar::Util qw( blessed );
 
 our @EXPORT_OK = qw(
     handle_from_command
@@ -71,8 +74,24 @@ sub lines_from_command {
 
 sub handle_from_command {
     my ($command) = @_;
-    open my $pipe, '-|', $command
-        or fail "Unable to read from command '$command': $!";
+    my $pipe;
+    local $@;
+    my $ok = eval {
+        my $out;
+        my $child_pid = open2($out, File::Spec->devnull, $command);
+        my @lines = <$out>;
+        waitpid $child_pid, 0;
+        my $content = join '', @lines;
+        my $status = $? >> 8;
+        open $pipe, '<', \$content;
+        1;
+    };
+    unless ($ok) {
+        my $err = $@;
+        die $err
+            if blessed($err) and $err->isa('System::Introspector::_Exception');
+        fail "Error from command '$command': $err";
+    }
     return $pipe;
 }
 
diff --git a/t/filehandles.t b/t/filehandles.t
index f740318..a9562ea 100644
--- a/t/filehandles.t
+++ b/t/filehandles.t
@@ -12,4 +12,13 @@ my $handles = $data->{handles};
 ok($handles, 'received filehandle data');
 ok(not(grep { not keys %$_ } @$handles), 'keys in all entries');
 
+do {
+    my $fail_probe = System::Introspector::Probe::FileHandles->new(
+        lsof_command => 'lsoffakethisonedoesntexistatleastihopenot',
+    );
+    my $fail_data;
+    $fail_data = $fail_probe->gather;
+    ok $fail_data, 'received data';
+};
+
 done_testing;