removed unrequired explicit 'list' data levels
[scpubgit/System-Introspector.git] / lib / System / Introspector / Util.pm
index 5943490..530f9f9 100644 (file)
@@ -3,6 +3,10 @@ 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 );
+use Capture::Tiny qw( capture_stderr );
 
 our @EXPORT_OK = qw(
     handle_from_command
@@ -15,13 +19,13 @@ our @EXPORT_OK = qw(
 );
 
 do {
-    package System::Introspection::_Exception;
+    package System::Introspector::_Exception;
     use Moo;
     has message => (is => 'ro');
 };
 
-sub fail { die System::Introspection::_Exception->new(message => shift) }
-sub is_report_exception { ref(shift) eq 'System::Introspection::_Exception' }
+sub fail { die System::Introspector::_Exception->new(message => shift) }
+sub is_report_exception { ref(shift) eq 'System::Introspector::_Exception' }
 
 sub files_from_dir {
     my ($dir) = @_;
@@ -40,7 +44,7 @@ sub transform_exceptions (&) {
     my ($code) = @_;
     my $result = eval { $code->() };
     if (my $error = $@) {
-        return { error => $error->message }
+        return { __error__ => $error->message }
             if is_report_exception $error;
         die $@;
     }
@@ -71,8 +75,33 @@ 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;
+        my @lines;
+        my ($err) = capture_stderr {
+          $child_pid = open2($out, File::Spec->devnull, $command);
+          @lines = <$out>;
+          close $out;
+          waitpid $child_pid, 0;
+        };
+        my $content = join '', @lines;
+        my $status = $? >> 8;
+        $err = "Unknown error"
+            unless defined $err;
+        fail "Command error ($command): $err\n"
+            if $status;
+        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;
 }