← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:12 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/5.18.2/Env.pm
StatementsExecuted 279 statements in 7.21ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1115.81ms6.93msEnv::::import Env::import
1111.24ms1.40msEnv::Array::::BEGIN@123 Env::Array::BEGIN@123
15631198µs198µsEnv::::CORE:match Env::CORE:match (opcode)
521171µs71µsEnv::::TIESCALAR Env::TIESCALAR
11124µs37µsEnv::Array::::BEGIN@122 Env::Array::BEGIN@122
1118µs8µsEnv::Array::VMS::::BEGIN@227Env::Array::VMS::BEGIN@227
0000s0sEnv::Array::::CLEAR Env::Array::CLEAR
0000s0sEnv::Array::::DELETE Env::Array::DELETE
0000s0sEnv::Array::::EXISTS Env::Array::EXISTS
0000s0sEnv::Array::::FETCH Env::Array::FETCH
0000s0sEnv::Array::::FETCHSIZE Env::Array::FETCHSIZE
0000s0sEnv::Array::::POP Env::Array::POP
0000s0sEnv::Array::::PUSH Env::Array::PUSH
0000s0sEnv::Array::::SHIFT Env::Array::SHIFT
0000s0sEnv::Array::::SPLICE Env::Array::SPLICE
0000s0sEnv::Array::::STORE Env::Array::STORE
0000s0sEnv::Array::::STORESIZE Env::Array::STORESIZE
0000s0sEnv::Array::::TIEARRAY Env::Array::TIEARRAY
0000s0sEnv::Array::::UNSHIFT Env::Array::UNSHIFT
0000s0sEnv::Array::VMS::::DELETEEnv::Array::VMS::DELETE
0000s0sEnv::Array::VMS::::EXISTSEnv::Array::VMS::EXISTS
0000s0sEnv::Array::VMS::::FETCHEnv::Array::VMS::FETCH
0000s0sEnv::Array::VMS::::FETCHSIZEEnv::Array::VMS::FETCHSIZE
0000s0sEnv::Array::VMS::::TIEARRAYEnv::Array::VMS::TIEARRAY
0000s0sEnv::::FETCH Env::FETCH
0000s0sEnv::::STORE Env::STORE
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Env;
2
31900nsour $VERSION = '1.04';
4
5=head1 NAME
6
7Env - perl module that imports environment variables as scalars or arrays
8
9=head1 SYNOPSIS
10
11 use Env;
12 use Env qw(PATH HOME TERM);
13 use Env qw($SHELL @LD_LIBRARY_PATH);
14
15=head1 DESCRIPTION
16
17Perl maintains environment variables in a special hash named C<%ENV>. For
18when this access method is inconvenient, the Perl module C<Env> allows
19environment variables to be treated as scalar or array variables.
20
21The C<Env::import()> function ties environment variables with suitable
22names to global Perl variables with the same names. By default it
23ties all existing environment variables (C<keys %ENV>) to scalars. If
24the C<import> function receives arguments, it takes them to be a list of
25variables to tie; it's okay if they don't yet exist. The scalar type
26prefix '$' is inferred for any element of this list not prefixed by '$'
27or '@'. Arrays are implemented in terms of C<split> and C<join>, using
28C<$Config::Config{path_sep}> as the delimiter.
29
30After an environment variable is tied, merely use it like a normal variable.
31You may access its value
32
33 @path = split(/:/, $PATH);
34 print join("\n", @LD_LIBRARY_PATH), "\n";
35
36or modify it
37
38 $PATH .= ":.";
39 push @LD_LIBRARY_PATH, $dir;
40
41however you'd like. Bear in mind, however, that each access to a tied array
42variable requires splitting the environment variable's string anew.
43
44The code:
45
46 use Env qw(@PATH);
47 push @PATH, '.';
48
49is equivalent to:
50
51 use Env qw(PATH);
52 $PATH .= ":.";
53
54except that if C<$ENV{PATH}> started out empty, the second approach leaves
55it with the (odd) value "C<:.>", but the first approach leaves it with "C<.>".
56
57To remove a tied environment variable from
58the environment, assign it the undefined value
59
60 undef $PATH;
61 undef @LD_LIBRARY_PATH;
62
63=head1 LIMITATIONS
64
65On VMS systems, arrays tied to environment variables are read-only. Attempting
66to change anything will cause a warning.
67
68=head1 AUTHOR
69
70Chip Salzenberg E<lt>F<chip@fin.uucp>E<gt>
71and
72Gregor N. Purdy E<lt>F<gregor@focusresearch.com>E<gt>
73
74=cut
75
76
# spent 6.93ms (5.81+1.11) within Env::import which was called: # once (5.81ms+1.11ms) by Lingua::EN::Inflect::BEGIN@5 at line 5 of Lingua/EN/Inflect.pm
sub import {
7713µs my ($callpack) = caller(0);
781600ns my $pack = shift;
791153µs5246µs my @vars = grep /^[\$\@]?[A-Za-z_]\w*$/, (@_ ? @_ : keys(%ENV));
# spent 46µs making 52 calls to Env::CORE:match, avg 881ns/call
801500ns return unless @vars;
81
8253199µs5230µs @vars = map { m/^[\$\@]/ ? $_ : '$'.$_ } @vars;
# spent 30µs making 52 calls to Env::CORE:match, avg 571ns/call
83
84188µs eval "package $callpack; use vars qw(" . join(' ', @vars) . ")";
# spent 29µs executing statements in string eval
# includes 17µs spent executing 1 call to 1 sub defined therein.
851200ns die $@ if $@;
86116µs foreach (@vars) {
87525.23ms52122µs my ($type, $name) = m/^([\$\@])(.*)$/;
# spent 122µs making 52 calls to Env::CORE:match, avg 2µs/call
885235µs if ($type eq '$') {
8952177µs5271µs tie ${"${callpack}::$name"}, Env, $name;
# spent 71µs making 52 calls to Env::TIESCALAR, avg 1µs/call
90 } else {
91 if ($^O eq 'VMS') {
92 tie @{"${callpack}::$name"}, Env::Array::VMS, $name;
93 } else {
94 tie @{"${callpack}::$name"}, Env::Array, $name;
95 }
96 }
97 }
98}
99
100
# spent 71µs within Env::TIESCALAR which was called 52 times, avg 1µs/call: # 52 times (71µs+0s) by Env::import at line 89, avg 1µs/call
sub TIESCALAR {
10152118µs bless \($_[1]);
102}
103
104sub FETCH {
105 my ($self) = @_;
106 $ENV{$$self};
107}
108
109sub STORE {
110 my ($self, $value) = @_;
111 if (defined($value)) {
112 $ENV{$$self} = $value;
113 } else {
114 delete $ENV{$$self};
115 }
116}
117
118######################################################################
119
120package Env::Array;
121
122230µs251µs
# spent 37µs (24+14) within Env::Array::BEGIN@122 which was called: # once (24µs+14µs) by Lingua::EN::Inflect::BEGIN@5 at line 122
use Config;
# spent 37µs making 1 call to Env::Array::BEGIN@122 # spent 14µs making 1 call to Config::import
1232916µs11.40ms
# spent 1.40ms (1.24+167µs) within Env::Array::BEGIN@123 which was called: # once (1.24ms+167µs) by Lingua::EN::Inflect::BEGIN@5 at line 123
use Tie::Array;
# spent 1.40ms making 1 call to Env::Array::BEGIN@123
124
12517µs@ISA = qw(Tie::Array);
126
127110µs16µsmy $sep = $Config::Config{path_sep};
# spent 6µs making 1 call to Config::FETCH
128
129sub TIEARRAY {
130 bless \($_[1]);
131}
132
133sub FETCHSIZE {
134 my ($self) = @_;
135 return 1 + scalar(() = $ENV{$$self} =~ /\Q$sep\E/g);
136}
137
138sub STORESIZE {
139 my ($self, $size) = @_;
140 my @temp = split($sep, $ENV{$$self});
141 $#temp = $size - 1;
142 $ENV{$$self} = join($sep, @temp);
143}
144
145sub CLEAR {
146 my ($self) = @_;
147 $ENV{$$self} = '';
148}
149
150sub FETCH {
151 my ($self, $index) = @_;
152 return (split($sep, $ENV{$$self}))[$index];
153}
154
155sub STORE {
156 my ($self, $index, $value) = @_;
157 my @temp = split($sep, $ENV{$$self});
158 $temp[$index] = $value;
159 $ENV{$$self} = join($sep, @temp);
160 return $value;
161}
162
163sub EXISTS {
164 my ($self, $index) = @_;
165 return $index < $self->FETCHSIZE;
166}
167
168sub DELETE {
169 my ($self, $index) = @_;
170 my @temp = split($sep, $ENV{$$self});
171 my $value = splice(@temp, $index, 1, ());
172 $ENV{$$self} = join($sep, @temp);
173 return $value;
174}
175
176sub PUSH {
177 my $self = shift;
178 my @temp = split($sep, $ENV{$$self});
179 push @temp, @_;
180 $ENV{$$self} = join($sep, @temp);
181 return scalar(@temp);
182}
183
184sub POP {
185 my ($self) = @_;
186 my @temp = split($sep, $ENV{$$self});
187 my $result = pop @temp;
188 $ENV{$$self} = join($sep, @temp);
189 return $result;
190}
191
192sub UNSHIFT {
193 my $self = shift;
194 my @temp = split($sep, $ENV{$$self});
195 my $result = unshift @temp, @_;
196 $ENV{$$self} = join($sep, @temp);
197 return $result;
198}
199
200sub SHIFT {
201 my ($self) = @_;
202 my @temp = split($sep, $ENV{$$self});
203 my $result = shift @temp;
204 $ENV{$$self} = join($sep, @temp);
205 return $result;
206}
207
208sub SPLICE {
209 my $self = shift;
210 my $offset = shift;
211 my $length = shift;
212 my @temp = split($sep, $ENV{$$self});
213 if (wantarray) {
214 my @result = splice @temp, $offset, $length, @_;
215 $ENV{$$self} = join($sep, @temp);
216 return @result;
217 } else {
218 my $result = scalar splice @temp, $offset, $length, @_;
219 $ENV{$$self} = join($sep, @temp);
220 return $result;
221 }
222}
223
224######################################################################
225
226package Env::Array::VMS;
2272214µs18µs
# spent 8µs within Env::Array::VMS::BEGIN@227 which was called: # once (8µs+0s) by Lingua::EN::Inflect::BEGIN@5 at line 227
use Tie::Array;
# spent 8µs making 1 call to Env::Array::VMS::BEGIN@227
228
22915µs@ISA = qw(Tie::Array);
230
231sub TIEARRAY {
232 bless \($_[1]);
233}
234
235sub FETCHSIZE {
236 my ($self) = @_;
237 my $i = 0;
238 while ($i < 127 and defined $ENV{$$self . ';' . $i}) { $i++; };
239 return $i;
240}
241
242sub FETCH {
243 my ($self, $index) = @_;
244 return $ENV{$$self . ';' . $index};
245}
246
247sub EXISTS {
248 my ($self, $index) = @_;
249 return $index < $self->FETCHSIZE;
250}
251
252sub DELETE { }
253
25416µs1;
 
# spent 198µs within Env::CORE:match which was called 156 times, avg 1µs/call: # 52 times (122µs+0s) by Env::import at line 87, avg 2µs/call # 52 times (46µs+0s) by Env::import at line 79, avg 881ns/call # 52 times (30µs+0s) by Env::import at line 82, avg 571ns/call
sub Env::CORE:match; # opcode
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.