root/trunk/omnipitr/lib/OmniPITR/Tools.pm

Revision 87, 1.8 kB (checked in by depesz, 4 years ago)

omnipitr-archive is working

Line 
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;
Note: See TracBrowser for help on using the browser.