File Coverage

blib/lib/Footprintless/Util.pm
Criterion Covered Total %
statement 96 113 84.9
branch 30 46 65.2
condition 5 17 29.4
subroutine 19 21 90.4
pod 15 15 100.0
total 165 212 77.8


line stmt bran cond sub pod time code
1 18     18   138498 use strict;
  18         45  
  18         451  
2 18     18   81 use warnings;
  18         35  
  18         691  
3              
4             package Footprintless::Util;
5             $Footprintless::Util::VERSION = '1.29';
6             # ABSTRACT: A utility method package for common functionality in Footprintless
7             # PODNAME: Footprintless::Util
8              
9 18     18   92 use Carp;
  18         31  
  18         1016  
10 18     18   224 use Exporter qw(import);
  18         33  
  18         555  
11 18     18   1660 use Log::Any;
  18         48343  
  18         103  
12              
13             our @EXPORT_OK = qw(
14             agent
15             clean
16             default_command_runner
17             dynamic_module_new
18             dumper
19             exit_due_to
20             extract
21             factory
22             invalid_entity
23             rebase
24             slurp
25             spurt
26             temp_dir
27             temp_file
28             terse_dumper
29             );
30              
31             my $logger = Log::Any->get_logger();
32             my $extract_impl;
33              
34             sub agent {
35 11     11 1 25 my (%options) = @_;
36              
37 11         1678 require LWP::UserAgent;
38 11         99289 my $agent = LWP::UserAgent->new();
39 11         9776 $agent->env_proxy();
40              
41 11 50       36647 $agent->timeout( $options{timeout} ) if ( defined( $options{timeout} ) );
42 11 50       50 $agent->cookie_jar( $options{cookie_jar} ) if ( defined( $options{cookie_jar} ) );
43              
44 11         67 return $agent;
45             }
46              
47             sub clean {
48 14     14 1 91 my ( $paths, %options ) = @_;
49              
50 14 50 33     164 if ( $paths && ref($paths) eq 'ARRAY' && scalar(@$paths) ) {
      50        
51 14         71 $logger->debugf( "cleaning %s", $paths );
52             my $command_runner = $options{command_runner}
53 14   33     296 || default_command_runner();
54              
55             my @all_paths =
56             $options{rebase}
57 14 50       61 ? map { rebase( $_, $options{rebase} ) } @$paths
  0         0  
58             : @$paths;
59 14 100       36 my @dir_paths = map { ( $_ =~ /\/\s*$/ ) ? $_ : () } @all_paths;
  18         204  
60              
61 14         566 require Footprintless::Command;
62 14         31 eval {
63             $command_runner->run_or_die(
64             Footprintless::Command::batch_command(
65             Footprintless::Command::rm_command(@all_paths),
66             ( @dir_paths
67             ? Footprintless::Command::mkdir_command(@dir_paths)
68             : ()
69             ),
70             $options{command_options}
71             )
72 14 50       76 );
73             };
74 14 50       1563 if ($@) {
75 0         0 $logger->errorf( 'clean failed: %s', $@ );
76 0         0 croak($@);
77             }
78             }
79             }
80              
81             sub default_command_runner {
82 13     13 1 7540 require Footprintless::CommandRunner::IPCRun;
83 13         233 return Footprintless::CommandRunner::IPCRun->new(@_);
84             }
85              
86             sub dumper {
87 1     1 1 632 require Data::Dumper;
88 1         6534 return Data::Dumper->new( \@_ )->Indent(1)->Sortkeys(1)->Dump();
89             }
90              
91             sub dynamic_module_new {
92 40     40 1 139 my ( $module, @args ) = @_;
93 40         105 my $module_path = $module;
94 40         206 $module_path =~ s/::/\//g;
95 40         6992 require "$module_path.pm"; ## no critic
96 28         2597 return $module->new(@args);
97             }
98              
99             sub exit_due_to {
100 0     0 1 0 my ( $dollar_at, $verbose ) = @_;
101 0 0 0     0 if ( ref($dollar_at)
102             && $dollar_at->isa('Footprintless::CommandRunner::ExecutionException') )
103             {
104 0         0 $dollar_at->exit($verbose);
105             }
106             else {
107 0         0 print( STDERR "$dollar_at\n" );
108 0         0 exit 255;
109             }
110             }
111              
112             sub extract {
113 5     5 1 36 my ( $archive, %options ) = @_;
114              
115 5 50       51 my @to = $options{to} ? ( to => $options{to} ) : ();
116 5         41 my @type_option = ();
117 5 50       26 if ( $options{type} ) {
    100          
118 0         0 push( @type_option, type => $options{type} );
119             }
120             elsif ( $archive =~ /\.war|\.jar|\.ear|\.twbx$/ ) {
121              
122             # other known zip type extensions
123 1         20 push( @type_option, type => 'zip' );
124             }
125              
126 5   33     95 return _new_extract( archive => $archive, @type_option )->extract(@to)
127             || croak("unable to extract $archive: $!");
128             }
129              
130             sub factory {
131 49     49 1 99364 my ( $entities, @options ) = @_;
132              
133 49 100       221 if ( ref($entities) eq 'HASH' ) {
134 30         687 require Config::Entities;
135 30         28125 $entities = Config::Entities->new( { entity => $entities } );
136             }
137              
138 49         6790 my $factory;
139 49         203 my $factory_module = $entities->get_entity('footprintless.factory');
140 49 100       881 if ( $entities->get_entity('footprintless.factory') ) {
141 5         80 $factory = dynamic_module_new( $factory_module, $entities, @options );
142             }
143             else {
144 44         5575 require Footprintless::Factory;
145 44         329 $factory = Footprintless::Factory->new( $entities, @options );
146             }
147              
148 49         482 return $factory;
149             }
150              
151             sub invalid_entity {
152 2     2 1 4 my ( $coordinate, $message ) = @_;
153              
154 2         10 require Footprintless::InvalidEntityException;
155 2   33     12 die(Footprintless::InvalidEntityException->new(
156             $coordinate, $message || "$coordinate required"
157             )
158             );
159             }
160              
161             sub _new_extract {
162 5     5   28 my (@args) = @_;
163              
164 5 100       23 unless ($extract_impl) {
165 2         4 eval {
166 2         247 require Archive::Extract::Libarchive;
167 0         0 $extract_impl = 'Archive::Extract::Libarchive';
168             };
169             }
170 5 100       29 unless ($extract_impl) {
171 2         5 eval {
172 2         218 require Archive::Extract;
173 0         0 $extract_impl = 'Archive::Extract';
174             };
175             }
176 5 100       19 unless ($extract_impl) {
177 2         1289 require Footprintless::Extract;
178 2         7 $extract_impl = 'Footprintless::Extract';
179             }
180              
181 5         49 return $extract_impl->new(@args);
182             }
183              
184             sub rebase {
185 1     1 1 6 my ( $path, $rebase ) = @_;
186              
187 1         3 my $rebased;
188 1 50       35 if ( $path =~ /^$rebase->{from}(.*)$/ ) {
189 1         10 $rebased = "$rebase->{to}$1";
190             }
191             else {
192 0         0 croak("invalid rebase $path from $rebase->{from} to $rebase->{to}");
193             }
194              
195 1         11 return $rebased;
196             }
197              
198             sub slurp {
199 92     92 1 86090 my ($file) = @_;
200              
201             # http://www.perl.com/pub/2003/11/21/slurp.html
202             return $file
203 92         568 ? do { local ( @ARGV, $/ ) = $file; <> }
  92         6077  
204 92 50       277 : do { local $/; };
  0         0  
  0         0  
205             }
206              
207             sub spurt {
208 23     23 1 86490 my ( $content, $file, %options ) = @_;
209 23 50       128 my $write_mode = $options{append} ? '>>' : '>';
210 23 50       1463 open( my $handle, $write_mode, $file )
211             || croak("unable to open [$file]: $!");
212 23         324 print( $handle $content );
213 23         1062 close($handle);
214             }
215              
216             sub temp_dir {
217 7     7 1 16360 require File::Temp;
218 7         14154 my $temp = File::Temp->newdir( 'fpl_XXXXXXXX', TMPDIR => 1 );
219 7 50       4261 if ( !chmod( 0700, $temp ) ) {
220 0         0 croak("unable to create secure temp file");
221             }
222 7         207 return $temp;
223             }
224              
225             sub temp_file {
226 8     8 1 43 my (%options) = @_;
227 8         752 require File::Temp;
228             my $temp = File::Temp->new(
229             'fpl_XXXXXXXX',
230             TMPDIR => 1,
231 8 100       38292 ( $options{suffix} ? ( SUFFIX => $options{suffix} ) : () )
232             );
233 8 50       4174 if ( !chmod( 0600, $temp ) ) {
234 0         0 croak("unable to create secure temp file");
235             }
236 8         45 return $temp;
237             }
238              
239             sub terse_dumper {
240 0     0 1   Data::Dumper->new( \@_ )->Indent(1)->Sortkeys(1)->Terse(1)->Dump();
241             }
242              
243             1;
244              
245             __END__