File Coverage

blib/lib/HPC/Runner/Command/archive.pm
Criterion Covered Total %
statement 33 89 37.0
branch 0 8 0.0
condition n/a
subroutine 11 15 73.3
pod 0 4 0.0
total 44 116 37.9


line stmt bran cond sub pod time code
1             package HPC::Runner::Command::archive;
2              
3 1     1   3714 use MooseX::App::Command;
  1         4  
  1         18  
4              
5             with 'HPC::Runner::Command::Logger::Loggers';
6              
7 1     1   19368 use File::Spec;
  1         4  
  1         39  
8 1     1   11 use Path::Tiny;
  1         3  
  1         96  
9 1     1   14 use Cwd;
  1         4  
  1         89  
10 1     1   10 use DateTime;
  1         4  
  1         40  
11 1     1   11 use Archive::Tar;
  1         4  
  1         85  
12 1     1   12 use File::Path qw(make_path remove_tree);
  1         5  
  1         83  
13 1     1   11 use File::Find::Rule;
  1         4  
  1         17  
14 1     1   118 use IO::Dir;
  1         4  
  1         125  
15 1     1   11 use IPC::Cmd qw[can_run run];
  1         2  
  1         90  
16              
17 1     1   11 use MooseX::Types::Path::Tiny qw/Path Paths AbsPath AbsFile/;
  1         3  
  1         21  
18              
19             command_short_description 'Create an archive of results.';
20             command_long_description 'Create an archive of results. '
21             . 'Default is to add all files in your current working directory.'
22             . 'Include or exclude with --include_paths and --exclude_paths. '
23             . 'This requires tar to be installed';
24              
25             =head2 Command Line Options
26              
27             =cut
28              
29             option 'include_paths' => (
30             is => 'rw',
31             isa => Paths,
32             required => 0,
33             coerce => 1,
34             documentation => 'Include files or directories',
35             cmd_aliases => ['ip'],
36             predicate => 'has_include_paths',
37             clearer => 'clear_include_paths',
38             );
39              
40             option 'exclude_paths' => (
41             is => 'rw',
42             isa => Paths,
43             required => 0,
44             coerce => 1,
45             predicate => 'has_exclude_paths',
46             documentation => 'Files or directories to exclude',
47             cmd_aliases => ['ep'],
48             clearer => 'clear_exclude_paths',
49             );
50              
51             option 'archive' => (
52             is => 'rw',
53             isa => Path,
54             coerce => 1,
55             required => 0,
56             default => sub {
57             my $self = shift;
58             my $dt = DateTime->now( time_zone => 'local' );
59             $dt = "$dt";
60             $dt =~ s/:/-/g;
61              
62             my $tar_path = File::Spec->catdir( 'archive-' . $dt . '.tar.gz' );
63              
64             return path($tar_path);
65             },
66             );
67              
68             sub execute {
69 0     0 0   my $self = shift;
70              
71 0           my $files = $self->list_dirs;
72 0           $files = $self->check_dirs_exist($files);
73              
74 0           $self->create_archive($files);
75             }
76              
77             sub create_archive {
78 0     0 0   my $self = shift;
79 0           my $files = shift;
80              
81 0           make_path( $self->archive->parent );
82              
83 0           my $buffer;
84             my $cmd =
85 0           "tar -zcvf " . $self->archive->stringify . " " . join( ' ', @{$files} );
  0            
86 0           $self->screen_log->info( 'Cmd is: ' . $cmd );
87 0 0         if (
88             scalar run(
89             command => $cmd,
90             verbose => 0,
91             buffer => \$buffer,
92             timeout => 20
93             )
94             )
95             {
96 0           $self->screen_log->info(
97             'Archive ' . $self->archive->stringify . ' created successfully' );
98             }
99             else {
100 0           $self->screen_log->info( 'Archive could not be created! ' . $buffer );
101             }
102              
103 0           my $tar = Archive::Tar->new;
104 0           $tar->read( $self->archive );
105              
106 0           return $tar;
107             }
108              
109             sub check_dirs_exist {
110 0     0 0   my $self = shift;
111 0           my $files = shift;
112              
113 0           my @exists = ();
114              
115 0           foreach my $file ( @{$files} ) {
  0            
116 0 0         if ( $file->exists ) {
117 0           push( @exists, $file );
118             }
119             else {
120 0           $self->screen_log->warn(
121             'Path ' . $file->stringify . ' does not exist. Excluding.' );
122             }
123             }
124              
125 0 0         if ( !scalar @exists ) {
126 0           $self->screen_log->fatal('There are no paths to archive. Exiting.');
127 0           exit 1;
128             }
129              
130 0           return \@exists;
131             }
132              
133             sub list_dirs {
134 0     0 0   my $self = shift;
135              
136 0           my @dirs =
137             File::Find::Rule->extras( { follow => 1 } )->maxdepth(1)->directory()
138             ->in(getcwd);
139              
140 0           my @files =
141             File::Find::Rule->extras( { follow => 1 } )->maxdepth(1)->file()
142             ->in(getcwd);
143              
144             # my @files = glob( File::Spec->catdir( getcwd(), "*" ) );
145 0           my $cwd_files = {};
146              
147 0           map { $cwd_files->{$_} = 1 } @files;
  0            
148 0           map { $cwd_files->{$_} = 1 } @dirs;
  0            
149              
150 0 0         if ( $self->has_include_paths ) {
151 0           map { my $str = $_->absolute->stringify; $cwd_files->{$str} = 1 }
  0            
152 0           @{ $self->include_paths };
  0            
153             }
154 0           push( @{ $self->exclude_paths }, path('.git') );
  0            
155 0           push( @{ $self->exclude_paths }, path(getcwd()) );
  0            
156 0           map { my $str = $_->absolute->stringify; delete $cwd_files->{$str} }
  0            
157 0           @{ $self->exclude_paths };
  0            
158              
159 0           my @keys = keys %{$cwd_files};
  0            
160 0           @keys = sort(@keys);
161 0           my @rel_files = map { path($_)->relative } @keys;
  0            
162              
163 0           return \@rel_files;
164             }
165              
166             1;