File Coverage

blib/lib/HPC/Runner/Command/Logger/JSON/Archive.pm
Criterion Covered Total %
statement 45 91 49.4
branch 0 10 0.0
condition n/a
subroutine 15 22 68.1
pod 0 4 0.0
total 60 127 47.2


line stmt bran cond sub pod time code
1             package HPC::Runner::Command::Logger::JSON::Archive;
2              
3 1     1   8 use Moose;
  1         3  
  1         9  
4 1     1   10090 use MooseX::NonMoose;
  1         1429  
  1         6  
5              
6 1     1   82289 use File::Spec;
  1         3  
  1         33  
7 1     1   8 use File::Slurp;
  1         3  
  1         98  
8 1     1   8 use Try::Tiny;
  1         4  
  1         76  
9 1     1   10 use Path::Tiny;
  1         4  
  1         66  
10 1     1   8 use Data::Dumper;
  1         4  
  1         73  
11 1     1   9 use Capture::Tiny ':all';
  1         4  
  1         221  
12 1     1   10 use File::Temp qw/ tempfile tempdir /;
  1         3  
  1         81  
13 1     1   8 use File::Path qw(make_path remove_tree);
  1         3  
  1         70  
14 1     1   10 use Cwd;
  1         4  
  1         83  
15 1     1   8 use File::Temp qw(tempdir);
  1         13  
  1         63  
16 1     1   9 use Log::Log4perl qw(:easy);
  1         4  
  1         13  
17 1     1   2266 use IPC::Run qw(run);
  1         31517  
  1         1090  
18              
19             extends 'Archive::Tar::Wrapper';
20              
21             sub contains_file {
22 0     0 0   my $self = shift;
23 0           my $file = shift;
24              
25 0           my $found = 0;
26 0           $self->list_reset();
27              
28 0           while ( my $entry = $self->list_next() ) {
29 0           my ( $tar_path, $phys_path ) = @$entry;
30 0 0         if ( $tar_path eq $file ) {
31 0           $found = 1;
32 0           last;
33             }
34             }
35              
36 0           $self->list_reset();
37 0           return $found;
38             }
39              
40             sub add_data {
41 0     0 0   my $self = shift;
42 0           my $file = shift;
43 0           my $data = shift;
44 0           my $append = shift;
45              
46 0 0         $append = 0 if !$append;
47              
48 0 0         return unless $file;
49 0 0         $data = '' unless $data;
50              
51 0           my $cwd = getcwd();
52 0           my $tmpdir = tempdir( CLEANUP => 0 );
53 0           chdir $tmpdir;
54              
55 0           my $rel_path = File::Spec->abs2rel($file);
56 0           path($rel_path)->touchpath;
57 0           path($rel_path)->touch;
58              
59             try {
60 0     0     write_file( $rel_path, { append => $append }, $data );
61             }
62             catch {
63 0     0     warn "We were not able to write data to file $file $_\n";
64 0           };
65              
66 0           $self->add( $rel_path, $rel_path );
67              
68 0           chdir $cwd;
69 0           remove_tree($tmpdir);
70             }
71              
72             sub replace_content {
73 0     0 0   my $self = shift;
74 0           my $file = shift;
75 0           my $data = shift;
76              
77 0           $self->add_data( $file, $data, 0 );
78             }
79              
80             sub get_content {
81 0     0 0   my $self = shift;
82 0           my $file = shift;
83              
84 0           $self->list_reset();
85 0           my $data = '{}';
86              
87 0           while ( my $entry = $self->list_next() ) {
88 0           my ( $tar_path, $phys_path ) = @$entry;
89 0 0         if ( $tar_path eq $file ) {
90             try {
91 0     0     $data = read_file( $entry->[1] );
92 0           };
93 0           last;
94             }
95             }
96 0           $self->list_reset();
97 0           return $data;
98             }
99              
100             ############################################################
101             # Read and write are very nearly the same as the original. The only major
102             # difference was to get rid of the DEBUG statement about Running
103             ############################################################
104              
105             around 'read' => sub {
106             my $orig = shift;
107             my $self = shift;
108             my $tarfile = shift;
109             my @files = @_;
110              
111             my $cwd = getcwd();
112              
113             $tarfile = File::Spec->rel2abs($tarfile);
114             chdir $self->{tardir}
115             or LOGDIE "Cannot chdir to $self->{tardir}";
116              
117             my $compr_opt = "";
118             $compr_opt = $self->is_compressed($tarfile);
119              
120             my $cmd = [
121             $self->{tar},
122             "${compr_opt}x$self->{tar_read_options}",
123             @{ $self->{tar_gnu_read_options} },
124             "-f", $tarfile, @files
125             ];
126              
127             my $rc = run( $cmd, \my ( $in, $out, $err ) );
128              
129             if ( !$rc ) {
130             ERROR "@$cmd failed: $err";
131             chdir $cwd or LOGDIE "Cannot chdir to $cwd";
132             return undef;
133             }
134              
135             WARN $err if $err;
136              
137             chdir $cwd or LOGDIE "Cannot chdir to $cwd";
138              
139             return 1;
140             };
141              
142             around 'write' => sub {
143             my ( $orig, $self, $tarfile, $compress ) = @_;
144              
145             my $cwd = getcwd();
146             chdir $self->{tardir} or LOGDIE "Can't chdir to $self->{tardir} ($!)";
147              
148             $tarfile = File::Spec->rel2abs($tarfile);
149              
150             my $compr_opt = "";
151             $compr_opt = "z" if $compress;
152              
153             opendir DIR, "." or LOGDIE "Cannot open $self->{tardir}";
154             my @top_entries = grep { $_ !~ /^\.\.?$/ } readdir DIR;
155             closedir DIR;
156              
157             my $cmd = [
158             $self->{tar}, "${compr_opt}cf$self->{tar_write_options}",
159             $tarfile, @{ $self->{tar_gnu_write_options} }
160             ];
161              
162             if ( @top_entries > $self->{max_cmd_line_args} ) {
163             my $filelist_file = File::Spec->catdir( $self->{tmpdir}, "file-list" );
164             write_file( $filelist_file, { append => 0 }, '' )
165             or LOGDIE "Cannot open $filelist_file ($!)";
166              
167             for (@top_entries) {
168             write_file( $filelist_file, { append => 1 }, $_ );
169             }
170             push @$cmd, "-T", $filelist_file;
171             }
172             else {
173             push @$cmd, @top_entries;
174             }
175              
176             my $rc = run( $cmd, \my ( $in, $out, $err ) );
177              
178             if ( !$rc ) {
179             ERROR "@$cmd failed: $err";
180             chdir $cwd or LOGDIE "Cannot chdir to $cwd";
181             return undef;
182             }
183              
184             WARN $err if $err;
185              
186             chdir $cwd or LOGDIE "Cannot chdir to $cwd";
187              
188             return 1;
189             };
190              
191 1     1   12 no Moose;
  1         2  
  1         8  
192             __PACKAGE__->meta->make_immutable;
193              
194             1;