File Coverage

blib/lib/Shell/EnvImporter.pm
Criterion Covered Total %
statement 148 170 87.0
branch 32 46 69.5
condition 4 6 66.6
subroutine 29 30 96.6
pod 4 6 66.6
total 217 258 84.1


line stmt bran cond sub pod time code
1             package Shell::EnvImporter;
2              
3 1     1   45713 use strict;
  1         2  
  1         40  
4 1     1   4 use warnings;
  1         1  
  1         30  
5 1     1   4 no warnings 'uninitialized';
  1         6  
  1         72  
6              
7             our @ISA = qw();
8              
9             our $VERSION = '1.06';
10              
11 1     1   753 use Shell::EnvImporter::Shell;
  1         4  
  1         62  
12              
13             use Class::MethodMaker 2.0 [
14 1         13 new => [qw(-init new)],
15             scalar => [qw(
16             debuglevel
17              
18             command
19             file
20             shell
21              
22             auto_run
23             auto_import
24             import_modified
25             import_added
26             import_removed
27             import_filter
28              
29             shellobj
30             result
31             )],
32              
33 1     1   9 ];
  1         25  
34              
35              
36              
37 1     1   10398 use constant DEFAULT_SHELL => 'sh';
  1         3  
  1         91  
38              
39              
40 1         1576 use constant DEFAULTS => (
41             auto_run => 1,
42             auto_import => 1,
43             import_modified => 1,
44             import_added => 1,
45             import_removed => 0,
46              
47             shell => DEFAULT_SHELL,
48 1     1   6 );
  1         2  
49              
50              
51             ##########
52             sub init {
53             ##########
54 15     15 0 132118 my $self = shift;
55 15         105 my %args = @_;
56 15         228 my %defaults = (DEFAULTS);
57              
58             # Set supplied fields with defaults
59 15         81 my @fields = (keys %args, keys %defaults);
60 15         181 my %fields; @fields{@fields} = (1) x @fields;
  15         105  
61 15         65 @fields = keys %fields;
62              
63 15         87 foreach my $field (@fields) {
64 105 50       1471 if ($self->can($field)) {
65 105         4496 my $curval = $self->$field();
66 105 100       1225 my $arg = exists($args{$field}) ? $args{$field} : $defaults{$field};
67 105 50       274 if (ref($curval) =~ /ARRAY/) {
    50          
68 0         0 $self->$field(@$arg);
69             } elsif (ref($curval) =~ /HASH/) {
70 0         0 $self->$field(%$arg);
71             } else {
72 105         4778 $self->$field($arg);
73             }
74             }
75             }
76              
77             # Create a shell object
78 15         177 $self->dprint(1, "Creating shell object\n");
79 15 50       199 my $shellobj = $self->_get_shell() or return;
80              
81             # If file is supplied, command is to source the file.
82 15 100       702 if (defined($self->file)) {
83 3         111 $self->dprint(1, "Setting command to source '", $self->file, "'\n");
84 3         126 $self->command($shellobj->sourcecommand($self->file));
85             }
86              
87             # Run the command if requested.
88 15 100       803 $self->run() if ($self->auto_run);
89              
90             }
91              
92              
93              
94             #########
95             sub run {
96             #########
97 15     15 1 359 my $self = shift;
98 15   66     693 my $command = shift || $self->command;
99              
100 15         174 $self->dprint(1, "Executing command\n");
101              
102 15 50       166 unless (defined($command)) {
103 0         0 $@ = "Can't run without a command";
104 0         0 return undef;
105             };
106              
107 15         635 my $rv = $self->shellobj->run(
108             command => $command,
109             );
110              
111 14         745 $self->result($rv);
112              
113 14 100       2038 if ($self->auto_import) {
114 10 100       675 if ($self->import_filter) {
115 1         25 $self->env_import_filtered();
116             } else {
117 9         134 $self->env_import;
118             }
119             }
120              
121 14         943 return $rv;
122              
123              
124             }
125              
126              
127             ################
128             sub env_import {
129             ################
130 12     12 1 104 my $self = shift;
131 12         23 my @vars;
132              
133 12         82 $self->dprint(1, "Performing policy import\n");
134              
135 12 50       933 unless (defined($self->result)) {
136 0         0 $@ = "Can't import before a successful run";
137 0         0 return undef;
138             }
139              
140 12 50       155 if (ref($_[0])) {
    100          
141 0         0 @vars = @{$_[0]};
  0         0  
142             } elsif (@_) {
143 2         32 @vars = @_;
144             } else {
145 10         908 @vars = $self->result->changed_keys;
146             }
147              
148 12         543 my %import; @import{@vars} = (1) x @vars;
  12         113  
149              
150 12         792 foreach my $var ($self->result->changed_keys) {
151 35 100       2532 next unless ($import{$var});
152 34         1205 my $type = $self->result->changed_index($var)->type;
153 34         11346 my $newval = $self->result->changed_index($var)->value;
154 34         2765 my $fn = "import_${type}";
155 34 100       1631 next unless ($self->$fn());
156              
157 21         403 $self->dprint(2, "Importing $type var $var=$newval\n");
158              
159 21         369 $self->_import_var($var, $newval, $type);
160              
161             }
162              
163 12         1189 return $self->result;
164              
165             }
166              
167              
168             #########################
169             sub env_import_filtered {
170             #########################
171 2     2 1 51 my $self = shift;
172 2   66     35 my $filter = shift || $self->import_filter;
173              
174 2         23 $self->dprint(1, "Performing filtered import\n");
175              
176 2 50       25 unless (ref($filter)) {
177 0         0 $@ = "Can't do filtered import without a filter";
178 0         0 return undef;
179             }
180 2 50       62 unless (defined($self->result)) {
181 0         0 $@ = "Can't import before a successful run";
182 0         0 return undef;
183             }
184              
185 2         74 foreach my $var ($self->result->changed_keys) {
186 6         398 my $type = $self->result->changed_index($var)->type;
187 6         542 my $newval = $self->result->changed_index($var)->value;
188 6 100       393 next unless ($filter->($var, $newval, $type));
189              
190 3         52 $self->dprint(2, "Importing $type var $var=$newval\n");
191              
192 3         40 $self->_import_var($var, $newval, $type);
193              
194             }
195              
196 2         70 return $self->result;
197              
198             }
199              
200              
201              
202              
203             #################
204             sub restore_env {
205             #################
206 0     0 1 0 my $self = shift;
207              
208 0         0 $self->dprint(1, "Restoring environment\n");
209              
210 0 0       0 unless (defined($self->result)) {
211 0         0 $@ = "Can't restore before a successful run";
212 0         0 return undef;
213             }
214              
215             # Delete all environment variables
216 0         0 map(delete($ENV{$_}), keys %ENV);
217              
218             # Restore them from the result backup
219 0         0 @ENV{$self->result->start_env_keys} = $self->result->start_env_values;
220              
221 0         0 return 1;
222              
223             }
224              
225              
226              
227             ############
228             sub dprint {
229             ############
230 86     86 0 254 my $self = shift;
231 86         122 my $level = shift;
232              
233 86         811 my($package, $filename, $line) = caller;
234              
235 86 50       4551 print STDERR "-" x $level, " $package:$line : ", @_
236             if ($self->debuglevel >= $level);
237              
238             }
239              
240              
241              
242              
243             ##############################################################################
244             ########################### Private subroutines #############################
245             ##############################################################################
246              
247              
248              
249             ################
250             sub _get_shell {
251             ################
252 15     15   36 my $self = shift;
253 15         659 my $shellname = $self->shell;
254              
255 15         199 my $shellclass = join("::", ref($self), 'Shell', $shellname);
256              
257 15         67 $self->dprint(2, "Shell class: $shellclass\n");
258              
259 1     1   1443 eval "use $shellclass;";
  1     1   3  
  1     1   18  
  1     1   18  
  1     1   3  
  1     1   41  
  1     1   1665  
  1     1   7  
  1     1   21  
  1     1   19  
  1     1   3  
  1     1   24  
  1     1   21  
  1     1   6  
  1     1   25  
  1         26  
  1         4  
  1         23  
  1         21  
  1         4  
  1         95  
  1         16  
  1         6  
  1         21  
  1         13  
  1         2  
  1         25  
  1         22  
  1         3  
  1         27  
  1         12  
  1         2  
  1         21  
  1         20  
  1         5  
  1         21  
  1         20  
  1         5  
  1         27  
  1         89  
  1         2  
  1         22  
  1         1849  
  1         5  
  1         23  
  15         5073  
260 15 50       109 return undef if ($@);
261              
262 15         26 my $shellobj;
263 15 50       520 unless ($shellobj = $shellclass->new(debuglevel => $self->debuglevel)) {
264 0         0 $@ = "Couldn't create shell object";
265 0         0 return undef;
266             }
267              
268 15         1724 $self->shellobj($shellobj);
269              
270 15         182 return $shellobj;
271              
272             }
273              
274              
275              
276              
277             #################
278             sub _import_var {
279             #################
280 24     24   45 my $self = shift;
281 24         36 my $var = shift;
282 24         40 my $newval = shift;
283 24         27 my $type = shift;
284              
285 24 100       136 if ($type eq 'removed') {
286 4         54 delete($ENV{$var});
287             } else {
288 20         219 $ENV{$var} = $newval;
289             }
290 24         818 $self->result->imported_push($var);
291             }
292              
293              
294              
295              
296              
297              
298             1;
299              
300             __END__