File Coverage

blib/lib/System/Introspector/Util.pm
Criterion Covered Total %
statement 84 89 94.3
branch 21 32 65.6
condition 0 3 0.0
subroutine 19 19 100.0
pod 0 9 0.0
total 124 152 81.5


line stmt bran cond sub pod time code
1 16     16   95 use strictures 1;
  16         102  
  16         409  
2              
3             package System::Introspector::Util;
4 16     16   1329 use Exporter 'import';
  16         33  
  16         630  
5 16     16   27259 use IPC::Run qw( run );
  16         1107604  
  16         1103  
6 16     16   15759 use IPC::Open2;
  16         72233  
  16         961  
7 16     16   134 use File::Spec;
  16         33  
  16         244  
8 16     16   426 use Scalar::Util qw( blessed );
  16         36  
  16         1482  
9 16     16   17788 use Capture::Tiny qw( capture_stderr );
  16         464284  
  16         2206  
10              
11             our @EXPORT_OK = qw(
12             handle_from_command
13             handle_from_file
14             output_from_command
15             output_from_file
16             lines_from_command
17             files_from_dir
18             transform_exceptions
19             fail
20             );
21              
22             do {
23             package System::Introspector::_Exception;
24 16     16   321 use Moo;
  16         32  
  16         148  
25             has message => (is => 'ro');
26             };
27              
28 1     1 0 25 sub fail { die System::Introspector::_Exception->new(message => shift) }
29 1     1 0 18 sub is_report_exception { ref(shift) eq 'System::Introspector::_Exception' }
30              
31             sub files_from_dir {
32 4     4 0 16 my ($dir) = @_;
33 4         8 my $dh;
34 4 50       217 opendir $dh, $dir
35             or fail "Unable to read directory $dir: $!";
36 4         14 my @files;
37 4         157 while (defined( my $item = readdir $dh )) {
38 12 100       350 next if -d "$dir/$item";
39 4         33 push @files, $item;
40             }
41 4         97 return @files;
42             }
43              
44             sub transform_exceptions (&) {
45 46     46 0 121 my ($code) = @_;
46 46         154 my $result = eval { $code->() };
  46         164  
47 46 100       1843 if (my $error = $@) {
48 1 50       6 return { __error__ => $error->message }
49             if is_report_exception $error;
50 0         0 die $@;
51             }
52 45         695 return $result;
53             }
54              
55             sub output_from_command {
56 16     16 0 36 my ($command, $in) = @_;
57 16 50       103 $in = ''
58             unless defined $in;
59 16         77 my ($out, $err) = ('', '');
60 16 50       25 my $ok = eval { run($command, \$in, \$out, \$err) or die $err};
  16         349  
61 16 100       316270 $err = $@ unless $ok;
62 16 100       188 return $out, $err, $ok
63             if wantarray;
64 14 50       132 $command = join ' ', @$command
65             if ref $command;
66 14 100       139 fail "Error running command ($command): $err"
67             unless $ok;
68 13         294 return $out;
69             }
70              
71             sub lines_from_command {
72 4     4 0 8 my ($command) = @_;
73 4         22 my $output = output_from_command $command;
74 3         22 chomp $output;
75 3         65 return split m{\n}, $output;
76             }
77              
78             sub handle_from_command {
79 8     8 0 63 my ($command) = @_;
80 8         12 my $pipe;
81 8         13 local $@;
82 8         16 my $ok = eval {
83 8         15 my $out;
84             my $child_pid;
85 0         0 my @lines;
86             my ($err) = capture_stderr {
87 8     8   229331 $child_pid = open2($out, File::Spec->devnull, $command);
88 8         8122950 @lines = <$out>;
89 8         273 close $out;
90 8         476 waitpid $child_pid, 0;
91 8         389 };
92 8         9485 my $content = join '', @lines;
93 8         50 my $status = $? >> 8;
94 8 50       80 $err = "Unknown error"
95             unless defined $err;
96 8 50       195 fail "Command error ($command): $err\n"
97             if $status;
98 8     2   285 open $pipe, '<', \$content;
  2         38  
  2         7  
  2         53  
99 8         3910 1;
100             };
101 8 50       56 unless ($ok) {
102 0         0 my $err = $@;
103 0 0 0     0 die $err
104             if blessed($err) and $err->isa('System::Introspector::_Exception');
105 0         0 fail "Error from command '$command': $err";
106             }
107 8         279 return $pipe;
108             }
109              
110             sub handle_from_file {
111 17     17 0 36 my ($file) = @_;
112 17 50       1086 open my $fh, '<', $file
113             or fail "Unable to read $file: $!";
114 17         64 return $fh;
115             }
116              
117             sub output_from_file {
118 13     13 0 36 my ($file) = @_;
119 13         49 my $fh = handle_from_file $file;
120             return <$fh>
121 13 100       189 if wantarray;
122 8         18 return do { local $/; <$fh> };
  8         37  
  8         572  
123             }
124              
125             1;
126              
127             __END__