← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:27 2010

File/wise/base/static/lib/perl5/site_perl/5.10.0/WISE/Env.pm
Statements Executed461
Total Time0.011458 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1111110.009520.43451WISE::Env::import
6110.000430.00043WISE::Env::_export
00000WISE::Env::err_prefix

LineStmts.Exclusive
Time		Avg.Code
1#! /usr/bin/env perl
2
3package WISE::Env;
4
532.8e-59.3e-6use strict;
# spent 10µs making 1 call to strict::import
633.3e-51.1e-5use warnings;
# spent 18µs making 1 call to warnings::import
7
830.000610.00020use vars qw(@ISA $VERSION $AUTOLOAD $Banner);
# spent 65µs making 1 call to vars::import
9
1011.0e-61.0e-6$VERSION = 0.10;
1111.2e-51.2e-5@ISA = ();
12
1311.0e-61.0e-6our ($hostname,
14 $opsdir, $opslib, $staticlib, $staticsite, $importlib, $iam, $err, $warn,
15 $curgid, $logfh, $staticdir, $version, %pvals, %steps, %bands, @bands,
16 $curgrp, $uid, $basedir, $delivdir, $cfg, $cfgdir, $cfglib, $pars,
17 $logfile);
18
19BEGIN {
20144.3e-53.1e-6 umask(2); # Kluge!!!!
21 $basedir = ($ENV{WISE_BASE} ||"/wise/base");
22 $delivdir = ($ENV{WISE_DELIVBASE} ||"$basedir/deliv");
23 $cfg = $ENV{WISE_CONFIG} ||"";
24 if($cfg) {
25 if($cfg =~ /,/) {
26 # Multiple, stacked configs, e.g. 'tim/dev,dev,ops'
27 my @cfg = grep {defined $_} split(/,+/,$cfg);
28 $cfgdir= [map {"$delivdir/$_"} @cfg];
29 $cfglib= [map {"$_/lib/perl"} @$cfgdir];
30 } else {
31 $cfgdir= "$delivdir/$cfg";
32 $cfglib= "$cfgdir/lib/perl";
33 }
34 } else {
35 $cfgdir= $cfglib = "";
36 }
37 $opsdir = "$delivdir/ops";
38 $opslib = "$opsdir/lib/perl";
39 $staticdir = $ENV{WISE_GENBASE} ||"$basedir/static";
40 $staticsite= "$staticdir/lib/perl5/site_perl";
41 $staticlib = $staticsite; # "$staticdir/lib/perl";
42 $importlib = ($ENV{WISE_IMPBASE} ||"$basedir/import").
43 "/lib/perl5/site_perl";
4410.001860.00186}
45
46# SVN revision ID
4711.0e-61.0e-6my $env_version = '$Id: Env.pm 5815 2009-09-26 20:51:23Z tim $ ';
48
4911.2e-51.2e-5my ($xbase) = $0=~m|([^/]+)$|;
50
51
# spent 435ms (9.52+425) within WISE::Env::import which was called 11 times, avg 39.5ms/call: # once (2.78ms+431ms) at line 46 of /wise/base/deliv/dev/bin/getfix # once (307µs+348µs) at line 6 of /wise/base/deliv/dev/lib/perl/x86_64-linux-thread-multi/WISE/CHealPix.pm # once (242µs+305µs) by main::BEGIN at line 6 of /wise/base/deliv/dev/lib/perl/WISE/FITSIO/Utils.pm # once (254µs+-254000ns) at line 8 of /wise/base/deliv/dev/lib/perl/WISE/Wrap.pm # once (4.61ms+-4606000ns) at line 8 of /wise/base/deliv/dev/lib/perl/WISE/UtilsLight.pm # once (310µs+-310000ns) at line 36 of /wise/base/deliv/dev/lib/perl/WISE/Params.pm # once (199µs+-199000ns) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/IOUtils.pm # once (251µs+-251000ns) at line 7 of /wise/base/deliv/dev/lib/perl/WISE/FITSIO.pm # once (200µs+-200000ns) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/BandUtils.pm # once (179µs+-179000ns) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/Utils.pm # once (193µs+-193000ns) at line 3 of /wise/base/deliv/dev/lib/perl/WISE/Time.pm
sub import {
523330.006782.0e-5 my $pkg = shift;
53 my %opts = @_;
54 my $env_err = "*** $xbase/".__PACKAGE__;
55 my $env_warn = "=== $xbase/".__PACKAGE__;
56 $opts{lc $_} = $opts{$_} for keys %opts;
57 my $caller_pkg = (caller())[0];
58 if($opts{cfglib} && $opts{cfglib} !~ /^<:/) {
59 $cfglib = $opts{cfglib};
60 }
6110.000500.00050 eval "use lib ('$staticlib','$staticsite','$importlib');";
# spent 3.21ms making 11 calls to lib::import, avg 292µs/call
62 if($cfglib) { # && $^C) {
63 my @cfglib = ref($cfglib) ? @$cfglib : $cfglib;
6410.000230.00023 eval "use lib qw|@cfglib|;";
# spent 1.37ms making 11 calls to lib::import, avg 125µs/call
65 } else {
66 # Fallback
67 eval "use lib '$opslib';";
68 }
69
70 if(! grep(m|/WISE.pm$|,keys %INC) &&
71 ($opts{use_wise} || $opts{usewise})) {
7210.000830.00083 eval "package $caller_pkg; use WISE;\n";
# spent 363ms making 1 call to WISE::import
73 die $@ if $@;
74 }
75 my ($steps,$bands);
76 if($opts{import}) {
77 my @import;
78 if(ref $opts{import}) {
79 @import = @{ $opts{import} };
80 } else {
81 @import = split(" ",$opts{import});
82 }
83 my @pkgs = map {s/^://; $_;} grep {/^:/} @import;
84 @import = grep {! /^:/} @import;
85 if(grep {$_ eq '$hostname'} @import) {
86 chomp(($hostname) = `/bin/hostname -s 2>/dev/null`);
87 $hostname ||= 'UNKNOWN';
88 }
89 if(grep {$_ eq '$curgrp'} @import) {
90 $curgrp = (getgrgid($curgid))[0] || '?';
91 }
92 if(grep {$_ eq '$uid'} @import) {
93 $uid = getpwuid($<) || '?';
94 }
95 if(grep {$_ eq '$curgid'} @import) {
96 $curgid = (split " ","$)")[0] || -1;
97 }
98 if(grep {$_ eq '%steps'} @import) {
99 $steps = \%steps;
100 }
101 if(grep($_ eq '%bands', @import) ||
102 grep($_ eq '@bands', @import)) {
103 $bands = 1;
104 }
105 if(@import) {
# spent 433µs making 6 calls to WISE::Env::_export, avg 72µs/call
106 _export($caller_pkg, $pkg, @import);
107 }
108 if(@pkgs) {
109 my $use = "package $caller_pkg;\n".
110 join("\n",map {"use $_;"} @pkgs)."\n";
111 eval $use;
112 die "$env_err: $@" if $@;
113 }
114 }
115 die "$env_err: Params, log, or banner requested, but 'iam' not supplied.\n"
116 if ($opts{params}||$opts{log}||$opts{banner}) && ! $opts{iam};
117 if(defined $opts{iam} && ! $^C) {
118 require Cwd;
119 warn "$env_warn: Exported variables being redefined; iam was '$iam'.\n"
120 if $iam;
121 $version = $opts{version};
122 $iam = $opts{iam};
123 $err = "*** $iam";
124 $warn = "=== $iam";
125 if($opts{params}) {
126 require WISE::Pars;
127 $pars = WISE::Pars->new($opts{params},
128 {
129 iam => $opts{iam},
130 %{ $opts{param_opts} ||
# spent 65.9ms making 1 call to WISE::Pars::new
131 $opts{paramopts} ||
132 {}
133 },
134 }
135 );
136 }
137 $pars ||= $opts{pars};
138 %pvals = $pars->vals() if $pars;
# spent 231µs making 1 call to WISE::Pars::vals
139 if($opts{cd}) {
140 my $cdpar = $opts{cd_param} || 'run_dir';
141 die "$env_err: Chdir requested, but no parameters specified."
142 if ! $pars;
143 die "$env_err: Chdir requested, but no $cdpar ".
144 "parameter found."
145 if ! $pars->has($cdpar);
146 my $dir = $pars->get($cdpar);
147 if(defined $dir) {
148 # Invalidate environment pwd since Cwd::chdir will recompute
149 # it, which is a good thing, because if we do
150 # 'Cwd::chdir "/a/b/symlink/.."' PWD will track incorrectly.
151 $ENV{PWD} = undef;
152 Cwd::chdir($dir)
153 or die "$env_err: Cannot chdir to '$dir'; $!.\n";
154 }
155
156 } else {
157 # Just to be safe, let's set our ENV PWD to help be sure we're
158 # keeping it all straight
159 $ENV{PWD} = Cwd::getcwd();
# spent 13µs making 1 call to Cwd::getcwd
160 }
161 if($opts{log}) {
162 require WISE::UtilsLight;
163 my $logpar = $opts{log_param} || 'log_file';
164 my $outdpar = $opts{outdir_param} || 'out_dir';
165 die "$env_err: Logging requested, but no parameters specified."
166 if ! $pars;
167 die "$env_err: Logging requested, but no $logpar ".
168 "parameter found."
169 if ! $pars->has($logpar);
170 my $outdir = $pars->get($outdpar,{missingok=>1});
171 $outdir = defined $outdir && -d $outdir ? $outdir : undef;
172 ($logfh,$logfile) =
173 WISE::UtilsLight::openlog(
174 $iam,
175 {name => $pars->get($logpar),
176 logdir => $outdir,
177 verbose => $pars->get('verbose',{missingok=>1}),
178 duperr =>
179 $ENV{WISE_LOG_NODUP}||$ENV{WISE_LOG_NODUPOUT}
180 ? 0 : 1,
181 errtag => "%DATIME% )-",
182 dupout =>
183 $ENV{WISE_LOG_NODUP}||$ENV{WISE_LOG_NODUPERR}
184 ? 0 : 1,
185 outtag => "%DATIME% (-",
186 %{ $opts{log_opts} ||
187 $opts{logopts} ||
188 {}
189 },
190 });
191 }
192 if($opts{banner}) {
193 require WISE::UtilsLight;
194 WISE::UtilsLight::banner($iam,$opts{version},
195 {defs=>$pars,
196 %{ $opts{banner_opts} ||
197 $opts{banneropts} ||
198 {}
199 },
200 })
201 if ! $pars || ! $pars->has('test') || ! $pars->get('test');
202 }
203 if($steps) {
204 die "$env_err: Steps, but no parameters specified."
205 if ! $pars;
206 die "$env_err: Steps requested, but no 'steps' parameter found."
207 if ! $pars->has('steps');
208 my @steps = # Preserve order
209 WISE::Params::steps_resolve($pars->get('steps'),
210 $pars->get('step_macros'));
211 %steps = @steps; # exportable form
212 my @running = (grep {$steps{$_}}
213 map {$steps[$_]}
214 grep {!($_%2)} 0..$#steps);
215 print "Running step(s) ".
216 (@running ? join(", ",@running) : "NONE").
217 ".\n"
218 if $opts{banner} || $pars->get('verbose');
219 }
220 if($bands) {
221 die "$env_err: Bands, but no parameters specified."
222 if ! $pars;
223 die "$env_err: Bands requested, but no 'bands' parameter found."
224 if ! $pars->has('bands');
225 require WISE::BandUtils;
226 @bands = (sort {$a<=>$b}
227 map
228 { WISE::BandUtils::bandnum($_)
229 or die "$env_err: Cannot decode band spec '$_'.\n"
230 }
231 @{ref $pars->get('bands')
232 ? $pars->get('bands')
233 : $pars->get('bands')
234 ? [$pars->get('bands')]
235 : []
236 }
237 );
238 %bands = (1=>0, 2=>0, 3=>0, 4=>0);
239 @bands{@bands} = (1) x @bands;
240 print "Running band(s) ".
241 (@bands ? join(", ",@bands) : "NONE").
242 ".\n"
243 if $opts{banner} || $pars->get('verbose',{missingok=>1});
244 }
245 }
246 return 1;
247}
248
249sub err_prefix { # Pseudo "class method"
250 my $pkg = shift;
251 my $iam = shift;
252 my $opts = shift || {};
253 my $caller_pkg = (caller())[0];
254 $caller_pkg = "" if $caller_pkg eq 'main';
255 my $err = "*** $xbase/$caller_pkg";
256 my $warn = "=== $xbase/$caller_pkg";
257 return wantarray ? ($err, $warn) : $err;
258}
259
260# Stolen from Schwern's Exporter::lite, which was in turn stolen from
261# Exporter::Heavy
262
# spent 433µs within WISE::Env::_export which was called 6 times, avg 72µs/call: # 6 times (433µs+0) by WISE::Env::import at line 105, avg 72µs/call
sub _export {
263920.000313.4e-6 my($caller, $exporter, @imports) = @_;
264
265 # Stole this from Exporter::Heavy. I'm sure it can be written better
266 # but I'm lazy at the moment.
26730.000196.3e-5 no strict;
# spent 11µs making 1 call to strict::unimport
268 foreach my $sym (@imports) {
269 # shortcut for the common case of no type character
270 (*{$caller.'::'.$sym} = \&{$exporter.'::'.$sym}, next)
271 unless $sym =~ s/^(\W)//;
272
273 my $type = $1;
274 my $caller_sym = $caller.'::'.$sym;
275 my $export_sym = $exporter.'::'.$sym;
276 *{$caller_sym} =
277 $type eq '&' ? \&{$export_sym} :
278 $type eq '$' ? \${$export_sym} :
279 $type eq '@' ? \@{$export_sym} :
280 $type eq '%' ? \%{$export_sym} :
281 $type eq '*' ? *{$export_sym} :
282 do { die("*** $0/Env: Can't export symbol: $type$sym.\n") };
283 }
284}
285
286
28711.1e-51.1e-51;

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.