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__ |