line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Env::Modify; |
2
|
7
|
|
|
7
|
|
125188
|
use strict; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
206
|
|
3
|
7
|
|
|
7
|
|
30
|
use warnings; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
219
|
|
4
|
7
|
|
|
7
|
|
31
|
use base 'Exporter'; |
|
7
|
|
|
|
|
11
|
|
|
7
|
|
|
|
|
740
|
|
5
|
7
|
|
|
7
|
|
4013
|
use Shell::GetEnv '0.09'; |
|
7
|
|
|
|
|
200800
|
|
|
7
|
|
|
|
|
263
|
|
6
|
|
|
|
|
|
|
#use String::ShellQuote; # nah, just borrow from String::ShellQuote |
7
|
7
|
|
|
7
|
|
4109
|
use File::Spec::Functions 'catfile'; |
|
7
|
|
|
|
|
4625
|
|
|
7
|
|
|
|
|
482
|
|
8
|
7
|
|
|
7
|
|
39
|
use File::Temp; |
|
7
|
|
|
|
|
18
|
|
|
7
|
|
|
|
|
3126
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
*DEBUG = *DEVNULL; open DEVNULL,'>/dev/null'; |
11
|
|
|
|
|
|
|
our $DEBUG && (*DEBUG = *STDERR); |
12
|
|
|
|
|
|
|
our $SHELL = 'sh'; |
13
|
|
|
|
|
|
|
our $CHDIR = 0; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
16
|
|
|
|
|
|
|
our @EXPORT_OK = qw(system readpipe qx backticks source |
17
|
|
|
|
|
|
|
readpipe_list qx_list backticks_list); |
18
|
|
|
|
|
|
|
my @readpipe_exp = qw(readpipe readpipe_list qx_list backticks_list); |
19
|
|
|
|
|
|
|
our %EXPORT_TAGS = ('system' => ['system'], |
20
|
|
|
|
|
|
|
'readpipe' => [@readpipe_exp], |
21
|
|
|
|
|
|
|
'qx' => ['qx','backticks', @readpipe_exp], |
22
|
|
|
|
|
|
|
'backticks' => ['qx','backticks', @readpipe_exp], |
23
|
|
|
|
|
|
|
'all' => ['system', 'qx','backticks', 'source', @readpipe_exp], |
24
|
|
|
|
|
|
|
'chdir' => [], |
25
|
|
|
|
|
|
|
'sh' => [], 'bash' => [], 'csh' => [], 'dash' => [], |
26
|
|
|
|
|
|
|
'ksh' => [], 'tcsh' => [], 'zsh' => [] ); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# default attributes that go to all Shell::GetEnv constructors |
30
|
|
|
|
|
|
|
our %CMDOPT = ( |
31
|
|
|
|
|
|
|
startup => 0, |
32
|
|
|
|
|
|
|
login => 0, |
33
|
|
|
|
|
|
|
interactive => 0, |
34
|
|
|
|
|
|
|
verbose => 0, |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
our %ENVSOPT = ( |
38
|
|
|
|
|
|
|
ZapDeleted => 1 |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
our $TEMPDIR = File::Temp::tempdir( CLEANUP => 1 ); |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my $calls = 0; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# RT115330 describes a bug with overloaded readpipe function. |
46
|
|
|
|
|
|
|
# It was fixed in Perl v5.20.0 |
47
|
|
|
|
|
|
|
our $_RT115330 = $] < 5.020000; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub import { |
50
|
|
|
|
|
|
|
# Handle the CORE::GLOBAL::readpipe bug (RT#115330) differently depending |
51
|
|
|
|
|
|
|
# on whether the caller primarily uses qx(), `backticks`, or readpipe. |
52
|
|
|
|
|
|
|
# The bug was fixed in Perl v5.20.0 |
53
|
7
|
|
|
7
|
|
84
|
my %tags = map {; $_ => 1 } grep /^:/, @_; |
|
6
|
|
|
|
|
22
|
|
54
|
7
|
|
|
|
|
11
|
my $cgreadpipe = 0; |
55
|
7
|
100
|
66
|
|
|
70
|
if ($tags{":qx"} || $tags{":backticks"} || $tags{":all"}) { |
|
|
100
|
66
|
|
|
|
|
56
|
|
|
|
|
|
|
*CORE::GLOBAL::readpipe = sub { |
57
|
6
|
|
|
6
|
|
4956
|
local $_RT115330 = $] < 5.020000; |
58
|
6
|
|
|
|
|
27
|
return _readpipe_mod_env(@_); |
59
|
2
|
|
|
|
|
14
|
}; |
60
|
2
|
|
|
|
|
3
|
$cgreadpipe = 1; |
61
|
|
|
|
|
|
|
} elsif ($tags{":readpipe"}) { |
62
|
|
|
|
|
|
|
# CORE::GLOBAL::readpipe will not be respected for Perl
|
63
|
|
|
|
|
|
|
*CORE::GLOBAL::readpipe = sub { |
64
|
7
|
|
|
7
|
|
5318
|
local $_RT115330 = 0; |
65
|
7
|
|
|
|
|
36
|
return _readpipe_mod_env(@_); |
66
|
1
|
|
|
|
|
4
|
}; |
67
|
1
|
|
|
|
|
2
|
$cgreadpipe = 1; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
7
|
100
|
66
|
|
|
33
|
if ($tags{":system"} || $tags{":all"}) { |
71
|
7
|
|
|
7
|
|
37
|
no warnings 'once'; |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
968
|
|
72
|
2
|
|
|
|
|
7
|
*CORE::GLOBAL::system = \&Env::Modify::system; |
73
|
|
|
|
|
|
|
} |
74
|
7
|
100
|
|
|
|
20
|
if ($tags{":chdir"}) { |
75
|
1
|
|
|
|
|
2
|
$CHDIR = 1; |
76
|
|
|
|
|
|
|
} |
77
|
7
|
|
|
|
|
12
|
for my $shell ('zsh','tcsh','ksh','dash','csh','bash','sh') { |
78
|
49
|
50
|
|
|
|
94
|
if ($tags{":$shell"}) { |
79
|
0
|
|
|
|
|
0
|
$SHELL = $shell; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
} |
82
|
7
|
100
|
|
|
|
17
|
if ($cgreadpipe) { |
83
|
3
|
|
|
|
|
480
|
__PACKAGE__->export_to_level(1, __PACKAGE__, @_[1..$#_]); |
84
|
3
|
|
|
|
|
6
|
my $callpkg = caller; |
85
|
7
|
|
|
7
|
|
32
|
no strict 'refs'; |
|
7
|
|
|
|
|
7
|
|
|
7
|
|
|
|
|
223
|
|
86
|
7
|
|
|
7
|
|
27
|
no warnings 'redefine'; |
|
7
|
|
|
|
|
9
|
|
|
7
|
|
|
|
|
5599
|
|
87
|
3
|
|
|
|
|
5
|
*{$callpkg . "::readpipe"} = \&CORE::GLOBAL::readpipe; |
|
3
|
|
|
|
|
6186
|
|
88
|
|
|
|
|
|
|
} else { |
89
|
4
|
|
|
|
|
384
|
goto &Exporter::import; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
4
|
|
|
4
|
1
|
2780
|
sub backticks {goto &readpipe } |
94
|
3
|
|
|
3
|
1
|
1981
|
sub qx { goto &readpipe } |
95
|
0
|
|
|
0
|
1
|
0
|
sub backticks_list { goto &readpipe_list } |
96
|
0
|
|
|
0
|
1
|
0
|
sub qx_list { goto &readpipe_list } |
97
|
|
|
|
|
|
|
sub readpipe { |
98
|
7
|
|
|
7
|
1
|
25
|
local $_RT115330 = 0; |
99
|
7
|
|
|
|
|
62
|
return _readpipe_mod_env(@_); |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub readpipe_list { |
103
|
1
|
|
|
1
|
1
|
10
|
local $_RT115330 = 0; |
104
|
1
|
50
|
|
|
|
13
|
my $cmd = @_ > 1 ? _sh_quote(@_) : $_[0]; |
105
|
1
|
|
|
|
|
7
|
return _readpipe_mod_env($cmd); |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub system { |
109
|
35
|
|
|
35
|
1
|
63609
|
my @cmd = @_; |
110
|
35
|
100
|
|
|
|
240
|
my $cmd = @cmd > 1 ? _sh_quote(@cmd) : $cmd[0]; |
111
|
35
|
|
|
|
|
123
|
$calls++; |
112
|
35
|
|
|
|
|
235
|
my $stub = "$calls.$$"; |
113
|
35
|
|
|
|
|
360
|
my $stdout = catfile( $TEMPDIR, $stub . "-stdout"); |
114
|
35
|
|
|
|
|
198
|
my $stderr = catfile( $TEMPDIR, $stub . "-stderr"); |
115
|
35
|
|
|
|
|
570
|
my $getenv = Shell::GetEnv->new( $SHELL, $cmd, |
116
|
|
|
|
|
|
|
{ %CMDOPT, echo => 0, |
117
|
|
|
|
|
|
|
stdout => $stdout, stderr => $stderr } ); |
118
|
26
|
|
|
|
|
789752
|
$getenv->import_envs( %ENVSOPT ); |
119
|
|
|
|
|
|
|
|
120
|
26
|
100
|
|
|
|
5951
|
if (-s $stderr) { |
121
|
6
|
|
|
|
|
120
|
open my $err, '>&2'; # or warn "print to unopened filehandle?" |
122
|
6
|
|
|
|
|
137
|
open my $fh, '<', $stderr; |
123
|
6
|
|
|
|
|
16
|
print {$err} <$fh>; |
|
6
|
|
|
|
|
152
|
|
124
|
6
|
|
|
|
|
42
|
close $fh; |
125
|
6
|
|
|
|
|
517
|
close $err; |
126
|
|
|
|
|
|
|
} |
127
|
26
|
100
|
|
|
|
382
|
if (-s $stdout) { |
128
|
4
|
|
|
|
|
63
|
open my $out, '>&1'; # or warn "print to unopened filehandle?" |
129
|
4
|
|
|
|
|
87
|
open my $fh, '<', $stdout; |
130
|
4
|
|
|
|
|
11
|
print {$out} <$fh>; |
|
4
|
|
|
|
|
82
|
|
131
|
4
|
|
|
|
|
25
|
close $fh; |
132
|
4
|
|
|
|
|
695
|
close $out; |
133
|
|
|
|
|
|
|
} |
134
|
26
|
|
|
|
|
2526
|
unlink $stdout, $stderr; |
135
|
26
|
|
|
|
|
163
|
my $status = _status($getenv->status); |
136
|
26
|
100
|
|
|
|
156
|
$CHDIR && chdir $ENV{PWD}; |
137
|
26
|
|
|
|
|
823
|
return $? = $status; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub source { |
141
|
3
|
|
|
3
|
1
|
3500
|
my ($file,@args) = @_; |
142
|
3
|
50
|
|
|
|
22
|
if ($SHELL eq 'tcsh') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
143
|
0
|
|
|
|
|
0
|
$file = _sh_quote($file,@args); |
144
|
0
|
|
|
|
|
0
|
return Env::Modify::system( "source $file" ); |
145
|
|
|
|
|
|
|
} elsif ($SHELL eq 'csh') { |
146
|
0
|
|
|
|
|
0
|
$file = _sh_quote($file,@args); |
147
|
0
|
|
|
|
|
0
|
return Env::Modify::system("source $file"); |
148
|
|
|
|
|
|
|
} elsif ($SHELL eq 'ksh') { |
149
|
|
|
|
|
|
|
# . $file is supposed to work, but it doesn't |
150
|
0
|
|
|
|
|
0
|
$file = _sh_quote($file,@args); |
151
|
0
|
|
|
|
|
0
|
return Env::Modify::system("eval \$(cat $file)"); |
152
|
|
|
|
|
|
|
} else { |
153
|
3
|
|
|
|
|
17
|
return Env::Modify::system( ". " . _sh_quote($file,@args) ); |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub _readpipe_mod_env { |
158
|
21
|
|
|
21
|
|
55
|
my ($cmd) = @_; |
159
|
|
|
|
|
|
|
|
160
|
21
|
50
|
|
|
|
79
|
if ($_RT115330) { |
161
|
0
|
0
|
|
|
|
0
|
if ($cmd !~ /"/) { |
162
|
0
|
|
|
|
|
0
|
$cmd = eval qq["$cmd"]; |
163
|
|
|
|
|
|
|
} else { |
164
|
0
|
|
|
|
|
0
|
for my $delim ('#',',', qw(! ' ; " @ $ % ^ & * - = + |
165
|
|
|
|
|
|
|
: . / ? ~ ` 00)) { |
166
|
0
|
0
|
|
|
|
0
|
if ($cmd eq '00') { |
|
|
0
|
|
|
|
|
|
167
|
0
|
|
|
|
|
0
|
warn __PACKAGE__,"::_readpipe_mod_env: ", |
168
|
|
|
|
|
|
|
"reinterpolation of $cmd neglected"; |
169
|
|
|
|
|
|
|
} elsif ($cmd !~ /\Q$delim/) { |
170
|
0
|
|
|
|
|
0
|
$cmd = eval qq[qq$delim$cmd$delim]; |
171
|
0
|
|
|
|
|
0
|
last; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
} |
176
|
21
|
|
|
|
|
50
|
$calls++; |
177
|
21
|
|
|
|
|
102
|
my $stub = "$calls.$$"; |
178
|
21
|
|
|
|
|
248
|
my $stdout = catfile( $TEMPDIR, $stub . "-stdout"); |
179
|
21
|
|
|
|
|
170
|
my $stderr = catfile( $TEMPDIR, $stub . "-stderr"); |
180
|
21
|
|
|
|
|
395
|
my $getenv = Shell::GetEnv->new( $SHELL, $cmd, |
181
|
|
|
|
|
|
|
{ %CMDOPT, echo => 0, |
182
|
|
|
|
|
|
|
stdout => $stdout, stderr => $stderr } ); |
183
|
21
|
|
|
|
|
626941
|
$getenv->import_envs( %ENVSOPT ); |
184
|
21
|
|
|
|
|
4719
|
my @out; |
185
|
|
|
|
|
|
|
{ |
186
|
21
|
50
|
|
|
|
74
|
local $/ = wantarray ? $/ : undef; |
|
21
|
|
|
|
|
202
|
|
187
|
7
|
|
|
7
|
|
87
|
no warnings 'io'; # in case open $fh touches fd 1 or 2 |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
4238
|
|
188
|
21
|
|
|
|
|
825
|
open my $fh, '<', $stdout; |
189
|
21
|
|
|
|
|
893
|
@out = <$fh>; |
190
|
21
|
|
|
|
|
152
|
close $fh; |
191
|
21
|
100
|
|
|
|
408
|
if (-s $stderr) { |
192
|
9
|
|
|
|
|
149
|
open my $err, '>&=2'; # or warn "print to unopened filehandle?" |
193
|
9
|
|
|
|
|
230
|
open my $fh, '<', $stderr; |
194
|
9
|
|
|
|
|
224
|
my @err = <$fh>; |
195
|
9
|
|
|
|
|
94
|
print {$err} @err; |
|
9
|
|
|
|
|
116
|
|
196
|
9
|
|
|
|
|
599
|
close $err; |
197
|
9
|
|
|
|
|
122
|
close $fh; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
} |
200
|
21
|
|
|
|
|
2883
|
unlink $stdout, $stderr; |
201
|
21
|
100
|
|
|
|
150
|
$CHDIR && chdir $ENV{PWD}; |
202
|
21
|
|
|
|
|
155
|
$? = _status($getenv->status); |
203
|
21
|
50
|
|
|
|
830
|
return wantarray ? @out : $out[0]; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
sub _status { |
207
|
47
|
|
|
47
|
|
470
|
my $ge_status = shift; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# http://tldp.org/LDP/abs/html/exitcodes.html |
210
|
|
|
|
|
|
|
# treat exit code 128+n as command terminated by signal ? |
211
|
|
|
|
|
|
|
# may not be portable to non-POSIX OS or other shells |
212
|
47
|
|
|
|
|
90
|
my $status = $ge_status; |
213
|
47
|
100
|
|
|
|
245
|
if ($status > 128) { |
214
|
1
|
|
|
|
|
5
|
$status = $status - 128; |
215
|
|
|
|
|
|
|
} else { |
216
|
46
|
|
|
|
|
153
|
$status = $status << 8; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub _sh_quote { # borrowed heavily from String::ShellQuote 1.04 |
221
|
12
|
|
|
12
|
|
4576
|
my @in = @_; |
222
|
12
|
50
|
|
|
|
56
|
return '' unless @in; |
223
|
12
|
|
|
|
|
41
|
my ($ret, $saw_non_equal, @err) = ('', 0); |
224
|
12
|
|
|
|
|
40
|
foreach (@in) { |
225
|
37
|
50
|
33
|
|
|
204
|
if (!defined $_ or $_ eq '') { |
226
|
0
|
|
|
|
|
0
|
$_ = "''"; |
227
|
0
|
|
|
|
|
0
|
next; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
s/\x00//g && |
230
|
37
|
50
|
|
|
|
114
|
push @err, "No way to quote string containing null (\\000) bytes"; |
231
|
37
|
|
|
|
|
49
|
my $escape = 0; |
232
|
37
|
50
|
|
|
|
236
|
if (/=/) { |
233
|
0
|
0
|
|
|
|
0
|
$escape = 1 if !$saw_non_equal; |
234
|
|
|
|
|
|
|
} else { |
235
|
37
|
|
|
|
|
37
|
$saw_non_equal = 1; |
236
|
|
|
|
|
|
|
} |
237
|
37
|
100
|
|
|
|
129
|
$escape = 1 if m|[^\w!%+,\-./:=@^]|; |
238
|
37
|
100
|
33
|
|
|
174
|
if ($escape || (!$saw_non_equal && /=/)) { |
|
|
|
66
|
|
|
|
|
239
|
12
|
|
|
|
|
30
|
s/'/'\\''/g; # ' -> '\'' |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# make multiple ' in a row look simpler |
242
|
|
|
|
|
|
|
# '\'''\'''\'' -> '"'''"' |
243
|
12
|
|
|
|
|
25
|
s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'}|ge; |
|
0
|
|
|
|
|
0
|
|
244
|
12
|
|
|
|
|
35
|
$_ = "'$_'"; |
245
|
12
|
|
|
|
|
18
|
s/^''//; |
246
|
12
|
|
|
|
|
24
|
s/''$//; |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
} continue { |
249
|
37
|
|
|
|
|
100
|
$ret .= "$_ "; |
250
|
|
|
|
|
|
|
} |
251
|
12
|
|
|
|
|
34
|
chop $ret; |
252
|
12
|
50
|
|
|
|
46
|
if (@err) { |
253
|
0
|
|
|
|
|
0
|
warn __PACKAGE__ . "::sh_quote: @err"; |
254
|
|
|
|
|
|
|
} |
255
|
12
|
|
|
|
|
70
|
return $ret; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
1; |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=head1 NAME |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Env::Modify - affect Perl %ENV from subshell |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head1 VERSION |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
0.01 |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head1 SYNOPSIS |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
use Env::Modify 'system', ':readpipe'; |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
$ENV{FOO}="bar"; |
273
|
|
|
|
|
|
|
system('echo $FOO'); # "bar" |
274
|
|
|
|
|
|
|
system('FOO=baz'); |
275
|
|
|
|
|
|
|
print $ENV{FOO}; # "baz" |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# on Perl <=v5.8.8, say "Env::Modify::readpipe" instead |
278
|
|
|
|
|
|
|
$out = qx(BAR=123; export BAR; echo hello); |
279
|
|
|
|
|
|
|
print $ENV{BAR}; # "123" |
280
|
|
|
|
|
|
|
print $out; # "hello"; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
### |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
use Env::Modify 'source', ':bash', ':chdir'; |
285
|
|
|
|
|
|
|
open ENV, '>my_env.sh'; |
286
|
|
|
|
|
|
|
print ENV "export MEANING_OF_LIFE=42\n"; |
287
|
|
|
|
|
|
|
print ENV "cd \$HOME\n"; |
288
|
|
|
|
|
|
|
print ENV "cd .cpan\n"; |
289
|
|
|
|
|
|
|
close ENV; |
290
|
|
|
|
|
|
|
my $status = source("my_env.sh"); |
291
|
|
|
|
|
|
|
print $ENV{MEANING_OF_LIFE}; # "42" |
292
|
|
|
|
|
|
|
print "Current dir: ",Cwd::getcwd(),"\n"; # "/home/mob/.cpan" |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
=head1 DESCRIPTION |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
New Perl programmers are often confused about how the C call |
298
|
|
|
|
|
|
|
interacts with the environment, and they wonder why this code: |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
system('export foo=bar'); |
301
|
|
|
|
|
|
|
system('echo $foo'); |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
behaves differently from |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
system('export foo=bar; echo $foo'); |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
or why when they run this code |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
system("chdir \$HOME/scripts"); |
310
|
|
|
|
|
|
|
system("source my.env"); |
311
|
|
|
|
|
|
|
system("./my_script.sh"); |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
all the environment variables that they carefully set in C |
314
|
|
|
|
|
|
|
are ignored by C<./my_script.sh>. |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
The reason these codes do not meet the new user's expectations |
317
|
|
|
|
|
|
|
is that subshells, such as those launched by C, receive |
318
|
|
|
|
|
|
|
their own copy of the operating system environment and can only |
319
|
|
|
|
|
|
|
make changes to that local environment. |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
This module seeks to overcome that limitation, allowing |
322
|
|
|
|
|
|
|
C calls (and C/C/backticks) calls |
323
|
|
|
|
|
|
|
to affect the local environment. It uses the clever mechanism |
324
|
|
|
|
|
|
|
in Diab Jerius's L module to copy |
325
|
|
|
|
|
|
|
the environment of the subshell back to the calling environment. |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
=head1 FUNCTIONS |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=head2 system |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=head2 EXIT_CODE = system LIST |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Acts like the builtin L command, |
334
|
|
|
|
|
|
|
but any changes made to the subshell environment are preserved |
335
|
|
|
|
|
|
|
and copied to the calling environment. |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
Like the builtin call, the return value is the exit status of |
338
|
|
|
|
|
|
|
the command as returned by the L call. |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
When you import the C command into your calling |
341
|
|
|
|
|
|
|
package (with C |
342
|
|
|
|
|
|
|
C installs the C |
343
|
|
|
|
|
|
|
function to the C namespace (see |
344
|
|
|
|
|
|
|
L), making it |
345
|
|
|
|
|
|
|
available anywhere that your program makes a call to C. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=head2 readpipe |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=head2 readpipe(EXPR) |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=head2 Env::Modify::qx(EXPR), &qx(EXPR) |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=head2 backticks(EXPR) |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
Executes a system command and returns the standard output of |
356
|
|
|
|
|
|
|
the command. In scalar context, the output comes back as a single |
357
|
|
|
|
|
|
|
(potentially multi-line) string. In list context, returns a list |
358
|
|
|
|
|
|
|
of lines (however lines are defined with L or |
359
|
|
|
|
|
|
|
L). |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Unlike the builtin C command, any changes made by the |
362
|
|
|
|
|
|
|
system command to the subshell environment are preserved and |
363
|
|
|
|
|
|
|
copied back to the calling environment. |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
When any of the functions C, C, or C |
366
|
|
|
|
|
|
|
or any of the tags C<:readpipe>, C<:qx>, C<:backticks>, or |
367
|
|
|
|
|
|
|
C<:all> are imported into the calling namespace, |
368
|
|
|
|
|
|
|
this module installs the C function to |
369
|
|
|
|
|
|
|
the C namespace. As described in |
370
|
|
|
|
|
|
|
L, an override |
371
|
|
|
|
|
|
|
for the C function also overrides the operators |
372
|
|
|
|
|
|
|
C<``> and C. Note that C was not supported |
373
|
|
|
|
|
|
|
as an overridable function for the C package |
374
|
|
|
|
|
|
|
until Perl v5.8.9. If your version of perl is older than that, |
375
|
|
|
|
|
|
|
you will need to use function names and not C or |
376
|
|
|
|
|
|
|
backticks notation to get this module to modify your |
377
|
|
|
|
|
|
|
environment. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
See the L<"RT115330"> section for another important caveat |
380
|
|
|
|
|
|
|
about the C set of functions, and how to structure |
381
|
|
|
|
|
|
|
your C |
382
|
|
|
|
|
|
|
this module. |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=head2 readpipe_list LIST |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=head2 backticks_list LIST |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head2 qx_list LIST |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
Convenience functions to accommodate external commands with |
391
|
|
|
|
|
|
|
shell metacharacters. Like the L<"readpipe"> function, |
392
|
|
|
|
|
|
|
but may take a list of arguments the way that Perl's |
393
|
|
|
|
|
|
|
C function does. Compare: |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
$output = readpipe("ls -l \"My Documents\" Videos*"); |
396
|
|
|
|
|
|
|
$output = readpipe_list("ls","-l","My Documents","Videos*"); |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
(See also: |
399
|
|
|
|
|
|
|
L.) |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head2 source FILE LIST |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
Like the shell built-in command of the same name (also called |
404
|
|
|
|
|
|
|
C<.> in some shells), executes the shell |
405
|
|
|
|
|
|
|
commands in a file and incorporates any modifications to the |
406
|
|
|
|
|
|
|
subshell's environment into the calling environment. |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
That is, if C contains |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
FOO=123 |
411
|
|
|
|
|
|
|
NUM_HOME_FILES=$(ls $HOME | wc -l) |
412
|
|
|
|
|
|
|
export FOO NUM_HOME_FILES |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
then you could run |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
use Env::Modify 'source'; |
417
|
|
|
|
|
|
|
source("my_env.sh"); |
418
|
|
|
|
|
|
|
print "FOO is $ENV{FOO}\n"; # expect: "123" |
419
|
|
|
|
|
|
|
print "There are $ENV{NUM_HOME_FILES} in the home dir\n"; |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=head1 RT115330 |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
L<"perlbug RT#115330"|https://rt.perl.org/Ticket/Display.html?id=115330> |
424
|
|
|
|
|
|
|
described an issue with Perl code that sets the C<*CORE::GLOBAL::readpipe> |
425
|
|
|
|
|
|
|
function, like this module does. |
426
|
|
|
|
|
|
|
This bug was fixed in Perl v5.20.0 |
427
|
|
|
|
|
|
|
and if you are not using an older version of Perl than that, you |
428
|
|
|
|
|
|
|
are not affected by this bug and you may stop reading. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
The short version is that the arguments received by the |
431
|
|
|
|
|
|
|
C function are correct when you |
432
|
|
|
|
|
|
|
use the keyword C to call the function, and they |
433
|
|
|
|
|
|
|
need to be interpolated an extra time when you use backticks |
434
|
|
|
|
|
|
|
or the C construction. |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
The form of the C |
437
|
|
|
|
|
|
|
that you I invoke the C command. If your |
438
|
|
|
|
|
|
|
code literally calls the C function, then you |
439
|
|
|
|
|
|
|
should load this module with |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
use Env::Modify ':readpipe'; |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
If your code usually uses the C construct or backticks |
444
|
|
|
|
|
|
|
to invoke C, then you should load the module with |
445
|
|
|
|
|
|
|
either |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
use Env::Modify ':qx'; |
448
|
|
|
|
|
|
|
use Env::Modify ':backticks'; |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
(these two calls are equivalent). This will have the effect |
451
|
|
|
|
|
|
|
of interpolating the input one last time before the input |
452
|
|
|
|
|
|
|
is passed to the shell. |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
If your code uses both C and C/backticks, |
455
|
|
|
|
|
|
|
you can always workaround this bug using fully-qualified function |
456
|
|
|
|
|
|
|
names like C, |
457
|
|
|
|
|
|
|
C, or |
458
|
|
|
|
|
|
|
C. All of these function calls |
459
|
|
|
|
|
|
|
will receive correctly interpolated input. |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=head1 MODULE VARIABLES |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
=head2 $SHELL |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
The shell that the L module will use to run |
466
|
|
|
|
|
|
|
an external command. This must be a value supported by |
467
|
|
|
|
|
|
|
L, namely one of C, C, C, |
468
|
|
|
|
|
|
|
C, C, C, or C. |
469
|
|
|
|
|
|
|
Defaults to C. |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
The value of C<$SHELL> can also be set by specifing a tag |
472
|
|
|
|
|
|
|
with the shell name when this module is imported. For |
473
|
|
|
|
|
|
|
example, to specify C as the shell for this module |
474
|
|
|
|
|
|
|
to use, load this module like |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
use Env::Modify ':bash'; |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=head2 $CHDIR |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
If C<$Env::Modify::CHDIR> is set to a true value, then any |
481
|
|
|
|
|
|
|
change of the current working directory in a subshell will |
482
|
|
|
|
|
|
|
also affect the working directory in the calling (Perl) |
483
|
|
|
|
|
|
|
environment. That is, you can say |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
chdir "/some/path"; |
486
|
|
|
|
|
|
|
$f = -f "bar"; # -f /some/path/bar |
487
|
|
|
|
|
|
|
system("cd foo"); |
488
|
|
|
|
|
|
|
$g = -f "bar"; # -f /some/path/foo/bar |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
You can also enable this feature at import time with the |
491
|
|
|
|
|
|
|
C<:chdir> tag. |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=head2 %CMDOPT |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
A set of options that are passed to the L |
496
|
|
|
|
|
|
|
constructor. See the C method in L. |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
# don't load startup files (.profile, .bashrc, etc.) |
499
|
|
|
|
|
|
|
# when system() runs below |
500
|
|
|
|
|
|
|
local $Env::Modify::CMDOPT{startup} = 0; |
501
|
|
|
|
|
|
|
Env::Modify::system("FOO=bar; export FOO"); |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
=head2 %ENVSOPT |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
A set of options that are passed to the C |
507
|
|
|
|
|
|
|
method of L. See the C method |
508
|
|
|
|
|
|
|
in L. |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# don't remove entries from Perl environment |
511
|
|
|
|
|
|
|
local $Env::Modify::ENVSOPT{ZapDeleted} = 0; |
512
|
|
|
|
|
|
|
source("./script_that_erases_PATH_var.sh"); |
513
|
|
|
|
|
|
|
print "PATH is still $ENV{PATH}"; # not erased |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
=head1 EXPORT |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
This module has four functions that can be exported into the |
518
|
|
|
|
|
|
|
calling namespace: C, C, C, and C. |
519
|
|
|
|
|
|
|
As C is a Perl language construction and not just a keyword, |
520
|
|
|
|
|
|
|
if you import the C function you would either have to use |
521
|
|
|
|
|
|
|
a fully qualified function name or a sigil to use it: |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
package My::Pkg; |
524
|
|
|
|
|
|
|
use Env::Modify 'qx'; |
525
|
|
|
|
|
|
|
... |
526
|
|
|
|
|
|
|
$out1 = qx($cmd1); # calls Perl built-in, not Env::Modify::qx ! |
527
|
|
|
|
|
|
|
$out2 = &qx($cmd2); # calls Env::Modify::qx |
528
|
|
|
|
|
|
|
$out3 = My::Pkg::qx($cmd3); # calls Env::Modify::qx |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
The tag C<:system> exports the C function into the calling |
531
|
|
|
|
|
|
|
namespace and also sets the C function, so that |
532
|
|
|
|
|
|
|
all C calls in any package in any part of your script will |
533
|
|
|
|
|
|
|
use the C function. |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
The tags C<:readpipe>, C<:qx>, or C<:backticks> export the |
536
|
|
|
|
|
|
|
C, C, and C functions into the calling |
537
|
|
|
|
|
|
|
namespace, and also set the C function, |
538
|
|
|
|
|
|
|
so that all C calls, C constructions, or |
539
|
|
|
|
|
|
|
backticks expressions in any package and in any part of your script |
540
|
|
|
|
|
|
|
will use the C function. If you are |
541
|
|
|
|
|
|
|
vulnerable to L<"RT115330"> (see above), then you should use |
542
|
|
|
|
|
|
|
C<:readpipe> if your script generally uses C to |
543
|
|
|
|
|
|
|
capture output from external programs and use C<:qx> or C<:backticks> |
544
|
|
|
|
|
|
|
if your script generally uses C or backticks. |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
The C<:all> tag behaves like C<:system> + C<:backticks>. |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
You may also specify the C<:chdir> tag to enable the "chdir" |
549
|
|
|
|
|
|
|
feature (see C<$CHDIR> under L<"MODULE VARIABLES">), or a tag |
550
|
|
|
|
|
|
|
with the name of a shell like C<:sh>, C<:bash>, etc. |
551
|
|
|
|
|
|
|
to specify the default shell for this module to run external |
552
|
|
|
|
|
|
|
commands (see C<$SHELL> under L<"MODULE VARIABLES">). |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=head1 LIMITATIONS |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
=over 4 |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
=item Portability |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
C can only work on systems where L |
561
|
|
|
|
|
|
|
will work, namely systems where POSIX-y type shells are |
562
|
|
|
|
|
|
|
installed. |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
=item Buffering |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
With a regular C or C/C/backticks call, |
567
|
|
|
|
|
|
|
lines from the standard error stream of the external command |
568
|
|
|
|
|
|
|
(and from the standard output stream in the case of C) |
569
|
|
|
|
|
|
|
are written to the terminal as the external program produces |
570
|
|
|
|
|
|
|
them. Because of the nature of how this module recovers and |
571
|
|
|
|
|
|
|
transfers the environment of the subshell, C |
572
|
|
|
|
|
|
|
functions will hold onto external program output, and not |
573
|
|
|
|
|
|
|
publish it to your Perl script's terminal until the command |
574
|
|
|
|
|
|
|
has completed. This may cause |
575
|
|
|
|
|
|
|
L, |
576
|
|
|
|
|
|
|
and for that, the author of this module apologizes. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
=item Interlaced standard output and standard error |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
In a regular C call that writes to both standard |
581
|
|
|
|
|
|
|
output and standard error, lines from the output stream |
582
|
|
|
|
|
|
|
and error stream will often be interleaved on your terminal. |
583
|
|
|
|
|
|
|
Because of the nature of how this module recovers and |
584
|
|
|
|
|
|
|
transfers the environment of the subshell, C |
585
|
|
|
|
|
|
|
calls will not interleave error and output this way. All |
586
|
|
|
|
|
|
|
of the standard error output, if any, will be written to |
587
|
|
|
|
|
|
|
the terminal (file descriptor 2, which is usually but not |
588
|
|
|
|
|
|
|
necessarily STDERR), followed by all standard output being |
589
|
|
|
|
|
|
|
written to the terminal (file descriptor 1). |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
=back |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
L provides the mechanism for copying a subshell's |
596
|
|
|
|
|
|
|
environment back into the calling environment. |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
=head1 SUPPORT |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
perldoc Env::Modify |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
You can also look for information at: |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
=over 4 |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
L |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
L |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
=item * CPAN Ratings |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
L |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
=item * Search CPAN |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
L |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
=back |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
=head1 AUTHOR |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
Marty O'Brien, C<< >> |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
Copyright (c) 2016, Marty O'Brien |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
635
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.8 or, |
636
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
=cut |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
# TODO: open2, open3 that modifies environment |
643
|
|
|
|
|
|
|
# test on openbsd, Cygwin, other systems |