1 |
package OmniPITR::Tools; |
---|
2 |
use strict; |
---|
3 |
use warnings; |
---|
4 |
use English qw( -no_match_vars ); |
---|
5 |
use Carp; |
---|
6 |
use Digest::MD5; |
---|
7 |
use File::Temp qw( tempfile ); |
---|
8 |
use base qw( Exporter ); |
---|
9 |
|
---|
10 |
our @EXPORT_OK = qw( file_md5sum run_command ext_for_compression ); |
---|
11 |
our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK ); |
---|
12 |
|
---|
13 |
sub ext_for_compression { |
---|
14 |
my $compression = lc shift; |
---|
15 |
return '.gz' if $compression eq 'gzip'; |
---|
16 |
return '.bz2' if $compression eq 'bzip2'; |
---|
17 |
return '.lzma' if $compression eq 'lzma'; |
---|
18 |
croak 'Unknown compression type: ' . $compression; |
---|
19 |
} |
---|
20 |
|
---|
21 |
sub file_md5sum { |
---|
22 |
my $filename = shift; |
---|
23 |
|
---|
24 |
my $ctx = Digest::MD5->new; |
---|
25 |
|
---|
26 |
open my $fh, '<', $filename or croak( sprintf( 'Cannot open file for md5summing %s : %s', $filename, $OS_ERROR ) ); |
---|
27 |
$ctx->addfile( $fh ); |
---|
28 |
my $md5 = $ctx->hexdigest(); |
---|
29 |
close $fh; |
---|
30 |
|
---|
31 |
return $md5; |
---|
32 |
} |
---|
33 |
|
---|
34 |
sub run_command { |
---|
35 |
my ( $temp_dir, @cmd ) = @_; |
---|
36 |
|
---|
37 |
my $real_command = join( ' ', map { quotemeta } @cmd ); |
---|
38 |
|
---|
39 |
my ( $stdout_fh, $stdout_filename ) = tempfile( 'stdout.XXXXXX', 'DIR' => $temp_dir ); |
---|
40 |
my ( $stderr_fh, $stderr_filename ) = tempfile( 'stderr.XXXXXX', 'DIR' => $temp_dir ); |
---|
41 |
|
---|
42 |
$real_command .= sprintf ' 2>%s >%s', quotemeta $stderr_filename, quotemeta $stdout_filename; |
---|
43 |
|
---|
44 |
my $reply = {}; |
---|
45 |
$reply->{ 'status' } = system $real_command; |
---|
46 |
local $/ = undef; |
---|
47 |
$reply->{ 'stdout' } = <$stdout_fh>; |
---|
48 |
$reply->{ 'stderr' } = <$stderr_fh>; |
---|
49 |
|
---|
50 |
close $stdout_fh; |
---|
51 |
close $stderr_fh; |
---|
52 |
|
---|
53 |
unlink( $stdout_filename, $stderr_filename ); |
---|
54 |
|
---|
55 |
if ( $CHILD_ERROR == -1 ) { |
---|
56 |
$reply->{ 'error_code' } = $OS_ERROR; |
---|
57 |
} |
---|
58 |
elsif ( $CHILD_ERROR & 127 ) { |
---|
59 |
$reply->{ 'error_code' } = sprintf "child died with signal %d, %s coredump\n", ( $CHILD_ERROR & 127 ), ( $CHILD_ERROR & 128 ) ? 'with' : 'without'; |
---|
60 |
} |
---|
61 |
else { |
---|
62 |
$reply->{ 'error_code' } = $CHILD_ERROR >> 8; |
---|
63 |
} |
---|
64 |
|
---|
65 |
return $reply; |
---|
66 |
} |
---|
67 |
|
---|
68 |
1; |
---|