File Coverage

blib/lib/Footprintless/Mixins.pm
Criterion Covered Total %
statement 61 98 62.2
branch 10 38 26.3
condition 5 12 41.6
subroutine 18 26 69.2
pod n/a
total 94 174 54.0


line stmt bran cond sub pod time code
1 11     11   61 use strict;
  11         20  
  11         271  
2 11     11   48 use warnings;
  11         32  
  11         437  
3              
4             package Footprintless::Mixins;
5             $Footprintless::Mixins::VERSION = '1.29';
6             # ABSTRACT: A utility package for mixins for standard object
7             # PODNAME: Footprintless::Mixins
8              
9 11     11   81 use Carp;
  11         21  
  11         554  
10 11     11   56 use Exporter qw(import);
  11         16  
  11         347  
11 11         549 use File::Path qw(
12             make_path
13 11     11   55 );
  11         19  
14 11         599 use Footprintless::Command qw(
15             cp_command
16 11     11   1772 );
  11         33  
17 11         640 use Footprintless::Util qw(
18             clean
19             dumper
20             extract
21             invalid_entity
22             rebase
23             temp_dir
24 11     11   59 );
  11         27  
25 11     11   59 use Log::Any;
  11         17  
  11         63  
26              
27             our @EXPORT_OK = qw(
28             _clean
29             _command_options
30             _deployment
31             _download
32             _entity
33             _extract_resource
34             _is_local
35             _local_template
36             _overlay
37             _push_resource_to_destination
38             _push_to_destination
39             _resource
40             _run
41             _run_or_die
42             _service
43             _sub_coordinate
44             _sub_entity
45             _verify_required_entities
46             );
47              
48             my $logger = Log::Any->get_logger();
49              
50             sub _clean {
51 11     11   31 my ( $self, %options ) = @_;
52 11         42 my $clean = _sub_entity( $self, 'clean' );
53 11 50       35 if ($clean) {
54             clean(
55             $clean,
56             command_runner => $self->{factory}->command_runner(),
57             command_options => _command_options($self),
58             rebase => $options{rebase}
59 11         46 );
60             }
61             }
62              
63             sub _command_options {
64 23     23   58 my ( $self, $sub_coordinate ) = @_;
65             my $entity =
66             $sub_coordinate
67             ? _sub_entity( $self, $sub_coordinate )
68 23 50       84 : _entity( $self, $self->{coordinate} );
69 23         144 return $self->{factory}->command_options(%$entity);
70             }
71              
72             sub _deployment {
73 0     0   0 my ( $self, $sub_coordinate, $name ) = @_;
74 0 0       0 my $deployment = $name ? $self->{$name} : undef;
75 0 0       0 unless ($deployment) {
76 0         0 $deployment = $self->{factory}->deployment( _sub_coordinate( $self, $sub_coordinate ) );
77 0 0       0 $self->{$name} = $deployment if ($name);
78             }
79 0         0 return $deployment;
80             }
81              
82             sub _download {
83 17     17   168 my ( $self, $resource, $to ) = @_;
84             my @options =
85             $to
86             && ref($resource)
87             && $resource->{as}
88 17 100 66     178 ? ( to => File::Spec->catfile( $to, $resource->{as} ) )
89             : ( to => $to );
90              
91 17         79 my $path = $self->{factory}->resource_manager()->download( $resource, @options );
92 17 50       265 die( "$path did not exist after _download of " . dumper($resource) ) unless ( -e $path );
93 17         104 $logger->debugf( 'Successfully downloaded resource %s to %s', $resource, $path );
94 17         299 return $path;
95              
96             # return $self->{factory}->resource_manager()->download($resource, @options);
97             }
98              
99             sub _entity {
100 230     230   426 my ( $self, $coordinate, $required ) = @_;
101 230         759 my $entity = $self->{factory}->entities()->get_entity($coordinate);
102 230 50 66     6300 invalid_entity( $coordinate, "does not exist" )
103             if ( $required && !$entity );
104 230         730 return $entity;
105             }
106              
107             sub _extract_resource {
108 5     5   18 my ( $self, $resource, $to_dir ) = @_;
109 5         31 extract( _download( $self, $resource ), to => $to_dir );
110             }
111              
112             sub _is_local {
113 16     16   71 my ( $self, $hostname_sub_coordinate ) = @_;
114             return $self->{factory}->localhost()
115 16         133 ->is_alias( _sub_entity( $self, $hostname_sub_coordinate ) );
116             }
117              
118             sub _local_template {
119 17     17   161 my ( $self, $local_work, %options ) = @_;
120             my $destination_dir = $options{destination_dir}
121 17   33     366 || _sub_entity( $self, 'to_dir', 1 );
122              
123 17         45 my ( $is_local, $to_dir );
124 17 100       61 if ( $options{rebase} ) {
125 1         14 $to_dir = rebase( $destination_dir, $options{rebase} );
126 1         5 $is_local = 1;
127             }
128             else {
129 16         70 $is_local = _is_local( $self, 'hostname' );
130 16 50       83 $to_dir = $is_local ? $destination_dir : temp_dir();
131             }
132              
133 17         94 &$local_work($to_dir);
134              
135 17 50       13133 _push_to_destination( $self, $to_dir, $destination_dir ) unless ($is_local);
136             }
137              
138             sub _overlay {
139 0     0   0 my ( $self, $sub_coordinate, $name ) = @_;
140 0 0       0 my $overlay = $name ? $self->{$name} : undef;
141 0 0       0 unless ($overlay) {
142 0         0 $overlay = $self->{factory}->overlay( _sub_coordinate( $self, $sub_coordinate ) );
143 0 0       0 $self->{$name} = $overlay if ($name);
144             }
145 0         0 return $overlay;
146             }
147              
148             sub _push_resource_to_destination {
149 0     0   0 my ( $self, $resource, $destination_dir, %options ) = @_;
150              
151 0         0 my $temp_dir = temp_dir();
152 0 0       0 if ( $options{extract} ) {
153 0         0 _extract_resource( $self, $resource, $temp_dir );
154             }
155             else {
156 0         0 _download( $self, $resource, $temp_dir );
157             }
158              
159 0         0 _push_to_destination( $self, $temp_dir, $destination_dir, %options );
160             }
161              
162             sub _push_to_destination {
163 0     0   0 my ( $self, $source_dir, $destination_dir, %options ) = @_;
164              
165 0         0 my %copy_options = ();
166 0         0 my %runner_options = ();
167              
168 0 0       0 if ( $options{status} ) {
169 0         0 $copy_options{status} = $options{status};
170 0         0 $runner_options{err_handle} = \*STDERR;
171             }
172              
173             _run_or_die(
174             $self,
175             cp_command(
176             $source_dir, $destination_dir,
177 0   0     0 $options{command_options} || _command_options($self), %copy_options
178             ),
179             \%runner_options
180             );
181             }
182              
183             sub _resource {
184 0     0   0 my ( $self, $resource ) = @_;
185 0         0 return $self->{factory}->resource_manager()->resource($resource);
186             }
187              
188             sub _run {
189 0     0   0 my ( $self, $command, @runner_options ) = @_;
190 0         0 return $self->{factory}->command_runner()->run( $command, @runner_options );
191             }
192              
193             sub _run_or_die {
194 24     24   46 my ( $self, $command, @runner_options ) = @_;
195 24         72 return $self->{factory}->command_runner()->run_or_die( $command, @runner_options );
196             }
197              
198             sub _service {
199 0     0   0 my ( $self, $sub_coordinate, $name ) = @_;
200 0 0       0 my $service = $name ? $self->{$name} : undef;
201 0 0       0 unless ($service) {
202 0         0 $service = $self->{factory}->service( _sub_coordinate( $self, $sub_coordinate ) );
203 0 0       0 $self->{$name} = $service if ($name);
204             }
205 0         0 return $service;
206             }
207              
208             sub _sub_coordinate {
209 135     135   286 my ( $self, $sub_coordinate ) = @_;
210 135         513 return "$self->{coordinate}.$sub_coordinate";
211             }
212              
213             sub _sub_entity {
214 135     135   466 my ( $self, $sub_coordinate, $required ) = @_;
215 135         503 return _entity( $self, _sub_coordinate( $self, $sub_coordinate ), $required );
216             }
217              
218             sub _verify_required_entities {
219 0     0     my ( $self, @sub_coordinates ) = @_;
220 0           _sub_entity( $self, $_, 1 ) foreach @sub_coordinates;
221             }
222              
223             1;
224              
225             __END__