From: Robert 'phaylon' Sedlacek <r.sedlacek@shadowcat.co.uk>
Date: Thu, 10 May 2012 18:31:16 +0000 (+0000)
Subject: use reusable I/O utils, more solid error handling
X-Git-Tag: v0.001_001~82
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ff85404797ecd49c582258166349bb8315bc8f69;p=scpubgit%2FSystem-Introspector.git

use reusable I/O utils, more solid error handling
---

diff --git a/lib/System/Introspector/LibDirs/Perl.pm b/lib/System/Introspector/LibDirs/Perl.pm
index ed70e32..5bc01c4 100644
--- a/lib/System/Introspector/LibDirs/Perl.pm
+++ b/lib/System/Introspector/LibDirs/Perl.pm
@@ -3,6 +3,11 @@ use Moo;
 use Module::Metadata;
 use Digest::SHA;
 
+use System::Introspector::Util qw(
+    handle_from_command
+    transform_exceptions
+);
+
 has root => (
     is      => 'ro',
     default => sub { '/' },
@@ -10,13 +15,17 @@ has root => (
 
 sub gather {
     my ($self) = @_;
-    my $pipe = $self->_open_locate_libdirs_pipe;
-    my %libdir;
-    while (defined( my $line = <$pipe> )) {
-        chomp $line;
-        $libdir{ $line } = $self->_gather_libdir_info($line);
-    }
-    return \%libdir;
+    return transform_exceptions {
+        my $pipe = $self->_open_locate_libdirs_pipe;
+        my %libdir;
+        while (defined( my $line = <$pipe> )) {
+            chomp $line;
+            $libdir{ $line } = transform_exceptions {
+                return { modules => $self->_gather_libdir_info($line) };
+            };
+        }
+        return { libdirs_perl => \%libdir };
+    };
 }
 
 sub _gather_libdir_info {
@@ -41,12 +50,8 @@ sub _gather_libdir_info {
 
 sub _open_locate_pm_pipe {
     my ($self, $libdir) = @_;
-    my $command = sprintf
-        q{find %s -name '*.pm'},
-        $libdir;
-    open my $pipe, '-|', $command
-        or die "Unable to open pipe to '$command': $!\n";
-    return $pipe;
+    return handle_from_command
+        sprintf q{find %s -name '*.pm'}, $libdir;
 }
 
 sub _open_locate_libdirs_pipe {
@@ -54,12 +59,8 @@ sub _open_locate_libdirs_pipe {
     my $root = $self->root;
     $root .= '/'
         unless $root =~ m{/$};
-    my $command = sprintf
-        q{locate --regex '^%s.*lib/perl5$'},
-        $root;
-    open my $pipe, '-|', $command
-        or die "Unable to open pipe to '$command': $!\n";
-    return $pipe;
+    return handle_from_command sprintf
+        q{locate --regex '^%s.*lib/perl5$'}, $root;
 }
 
 1;
diff --git a/t/libdirs-perl.t b/t/libdirs-perl.t
index 799a7da..be60cdb 100644
--- a/t/libdirs-perl.t
+++ b/t/libdirs-perl.t
@@ -18,17 +18,23 @@ my $probe = System::Introspector::LibDirs::Perl->new(
 );
 my $data = $probe->gather;
 
-my $sha = delete $data->{"$dir/lib/perl5"}{Foo}[0]{sha256_hex};
+my $sha = delete $data
+    ->{libdirs_perl}{"$dir/lib/perl5"}{modules}{Foo}[0]{sha256_hex};
 ok $sha, 'contains SHA fingerprint';
 
-my $size = delete $data->{"$dir/lib/perl5"}{Foo}[0]{size};
+my $size = delete $data
+    ->{libdirs_perl}{"$dir/lib/perl5"}{modules}{Foo}[0]{size};
 ok $size, 'contains file size';
 
 is_deeply $data, {
-    "$dir/lib/perl5" => {
-        Foo => [
-            { file => "$dir/lib/perl5/Foo.pm", version => 0.001 },
-        ],
+    libdirs_perl => {
+        "$dir/lib/perl5" => {
+            modules => {
+                Foo => [
+                    { file => "$dir/lib/perl5/Foo.pm", version => 0.001 },
+                ],
+            },
+        },
     },
 }, 'package found';