Commit | Line | Data |
f79a227c |
1 | use strictures 1; |
2 | |
3 | package System::Introspector::Util; |
4 | use Exporter 'import'; |
db5ba31f |
5 | use IPC::Run qw( run ); |
9c3e454c |
6 | use IPC::Open2; |
7 | use File::Spec; |
8 | use Scalar::Util qw( blessed ); |
23b83532 |
9 | use Capture::Tiny qw( capture_stderr ); |
f79a227c |
10 | |
11 | our @EXPORT_OK = qw( |
12 | handle_from_command |
db5ba31f |
13 | handle_from_file |
db5ba31f |
14 | output_from_command |
15 | output_from_file |
91c60940 |
16 | lines_from_command |
17 | files_from_dir |
f79a227c |
18 | transform_exceptions |
949dba9c |
19 | fail |
f79a227c |
20 | ); |
21 | |
c23ab973 |
22 | do { |
65e569ee |
23 | package System::Introspector::_Exception; |
c23ab973 |
24 | use Moo; |
25 | has message => (is => 'ro'); |
26 | }; |
27 | |
65e569ee |
28 | sub fail { die System::Introspector::_Exception->new(message => shift) } |
29 | sub is_report_exception { ref(shift) eq 'System::Introspector::_Exception' } |
c23ab973 |
30 | |
db5ba31f |
31 | sub files_from_dir { |
32 | my ($dir) = @_; |
33 | my $dh; |
34 | opendir $dh, $dir |
c23ab973 |
35 | or fail "Unable to read directory $dir: $!"; |
db5ba31f |
36 | my @files; |
37 | while (defined( my $item = readdir $dh )) { |
38 | next if -d "$dir/$item"; |
39 | push @files, $item; |
40 | } |
41 | return @files; |
42 | } |
43 | |
f79a227c |
44 | sub transform_exceptions (&) { |
45 | my ($code) = @_; |
f79a227c |
46 | my $result = eval { $code->() }; |
c23ab973 |
47 | if (my $error = $@) { |
8b69d66e |
48 | return { __error__ => $error->message } |
c23ab973 |
49 | if is_report_exception $error; |
50 | die $@; |
51 | } |
f79a227c |
52 | return $result; |
53 | } |
54 | |
db5ba31f |
55 | sub output_from_command { |
56 | my ($command, $in) = @_; |
57 | $in = '' |
58 | unless defined $in; |
59 | my ($out, $err) = ('', ''); |
ff4d9e13 |
60 | my $ok = eval { run($command, \$in, \$out, \$err) or die $err}; |
61 | $err = $@ unless $ok; |
db5ba31f |
62 | return $out, $err, $ok |
63 | if wantarray; |
64 | $command = join ' ', @$command |
65 | if ref $command; |
c23ab973 |
66 | fail "Error running command ($command): $err" |
db5ba31f |
67 | unless $ok; |
68 | return $out; |
69 | } |
70 | |
91c60940 |
71 | sub lines_from_command { |
72 | my ($command) = @_; |
73 | my $output = output_from_command $command; |
74 | chomp $output; |
75 | return split m{\n}, $output; |
76 | } |
77 | |
f79a227c |
78 | sub handle_from_command { |
79 | my ($command) = @_; |
9c3e454c |
80 | my $pipe; |
81 | local $@; |
82 | my $ok = eval { |
83 | my $out; |
23b83532 |
84 | my $child_pid; |
85 | my @lines; |
86 | my ($err) = capture_stderr { |
87 | $child_pid = open2($out, File::Spec->devnull, $command); |
88 | @lines = <$out>; |
89 | close $out; |
90 | waitpid $child_pid, 0; |
91 | }; |
9c3e454c |
92 | my $content = join '', @lines; |
93 | my $status = $? >> 8; |
23b83532 |
94 | $err = "Unknown error" |
95 | unless defined $err; |
96 | fail "Command error ($command): $err\n" |
97 | if $status; |
9c3e454c |
98 | open $pipe, '<', \$content; |
99 | 1; |
100 | }; |
101 | unless ($ok) { |
102 | my $err = $@; |
103 | die $err |
104 | if blessed($err) and $err->isa('System::Introspector::_Exception'); |
105 | fail "Error from command '$command': $err"; |
106 | } |
f79a227c |
107 | return $pipe; |
108 | } |
109 | |
db5ba31f |
110 | sub handle_from_file { |
111 | my ($file) = @_; |
112 | open my $fh, '<', $file |
c23ab973 |
113 | or fail "Unable to read $file: $!"; |
db5ba31f |
114 | return $fh; |
115 | } |
116 | |
117 | sub output_from_file { |
118 | my ($file) = @_; |
119 | my $fh = handle_from_file $file; |
120 | return <$fh> |
121 | if wantarray; |
122 | return do { local $/; <$fh> }; |
123 | } |
124 | |
f79a227c |
125 | 1; |
f24afb0e |
126 | |
127 | __END__ |
128 | |
129 | =head1 NAME |
130 | |
131 | System::Introspector::Util - Utility functions |
132 | |
133 | =head1 DESCRIPTION |
134 | |
135 | Contains utility functions for L<System::Introspector>. |
136 | |
137 | =head1 SEE ALSO |
138 | |
139 | =over |
140 | |
141 | =item L<System::Introspector> |
142 | |
143 | =back |
144 | |
145 | =head1 COPYRIGHT |
146 | |
147 | Copyright (c) 2012 the L<System::Introspector> |
148 | L<AUTHOR|System::Introspector/AUTHOR>, |
149 | L<CONTRIBUTORS|System::Introspector/CONTRIBUTORS> and |
150 | L<SPONSORS|System::Introspector/SPONSORS>. |
151 | |
152 | =head1 LICENSE |
153 | |
154 | This library is free software and may be distributed under the same terms |
155 | as perl itself. |
156 | |
157 | =cut |