lib/System/Introspector/Util.pm

   1 use strictures 1;
   2
   3 package System::Introspector::Util;
   4 use Exporter 'import';
   5 use IPC::Run qw( run );
   6 use IPC::Open2;
   7 use File::Spec;
   8 use Scalar::Util qw( blessed );
   9 use Capture::Tiny qw( capture_stderr );
  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     use Moo;
  25     has message => (is => 'ro');
  26 };
  27
  28 sub fail { die System::Introspector::_Exception->new(message => shift) }
  29 sub is_report_exception { ref(shift) eq 'System::Introspector::_Exception' }
  30
  31 sub files_from_dir {
  32     my ($dir) = @_;
  33     my $dh;
  34     opendir $dh, $dir
  35         or fail "Unable to read directory $dir: $!";
  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
  44 sub transform_exceptions (&) {
  45     my ($code) = @_;
  46     my $result = eval { $code->() };
  47     if (my $error = $@) {
  48         return { __error__ => $error->message }
  49             if is_report_exception $error;
  50         die $@;
  51     }
  52     return $result;
  53 }
  54
  55 sub output_from_command {
  56     my ($command, $in) = @_;
  57     $in = ''
  58         unless defined $in;
  59     my ($out, $err) = ('', '');
  60     my $ok = eval { run($command, \$in, \$out, \$err) or die $err};
  61     $err = $@ unless $ok;
  62     return $out, $err, $ok
  63         if wantarray;
  64     $command = join ' ', @$command
  65         if ref $command;
  66     fail "Error running command ($command): $err"
  67         unless $ok;
  68     return $out;
  69 }
  70
  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
  78 sub handle_from_command {
  79     my ($command) = @_;
  80     my $pipe;
  81     local $@;
  82     my $ok = eval {
  83         my $out;
  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         };
  92         my $content = join '', @lines;
  93         my $status = $? >> 8;
  94         $err = "Unknown error"
  95             unless defined $err;
  96         fail "Command error ($command): $err\n"
  97             if $status;
  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     }
 107     return $pipe;
 108 }
 109
 110 sub handle_from_file {
 111     my ($file) = @_;
 112     open my $fh, '<', $file
 113         or fail "Unable to read $file: $!";
 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
 125 1;
 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