File Coverage

blib/lib/Footprintless/Mixins.pm
Criterion Covered Total %
statement 58 95 61.0
branch 9 36 25.0
condition 5 12 41.6
subroutine 18 26 69.2
pod n/a
total 90 169 53.2


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