← 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:47 2010

File/wise/base/static/lib/perl5/site_perl/5.10.0/WISE/Env.pm
Statements Executed458
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 {
2016.0e-66.0e-6 umask(2); # Kluge!!!!
2112.0e-62.0e-6 $basedir = ($ENV{WISE_BASE} ||"/wise/base");
2212.0e-62.0e-6 $delivdir = ($ENV{WISE_DELIVBASE} ||"$basedir/deliv");
23100 $cfg = $ENV{WISE_CONFIG} ||"";
2411.0e-61.0e-6 if($cfg) {
2511.0e-61.0e-6 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 {
3111.0e-61.0e-6 $cfgdir= "$delivdir/$cfg";
3212.0e-62.0e-6 $cfglib= "$cfgdir/lib/perl";
33 }
34 } else {
35 $cfgdir= $cfglib = "";
36 }
3711.3e-51.3e-5 $opsdir = "$delivdir/ops";
3811.0e-61.0e-6 $opslib = "$opsdir/lib/perl";
3912.0e-62.0e-6 $staticdir = $ENV{WISE_GENBASE} ||"$basedir/static";
4011.0e-61.0e-6 $staticsite= "$staticdir/lib/perl5/site_perl";
41100 $staticlib = $staticsite; # "$staticdir/lib/perl";
4211.1e-51.1e-5 $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 {
52112.5e-52.3e-6 my $pkg = shift;
53115.5e-55.0e-6 my %opts = @_;
54113.7e-53.4e-6 my $env_err = "*** $xbase/".__PACKAGE__;
55112.9e-52.6e-6 my $env_warn = "=== $xbase/".__PACKAGE__;
56220.000115.0e-6 $opts{lc $_} = $opts{$_} for keys %opts;
57112.8e-52.5e-6 my $caller_pkg = (caller())[0];
58117.0e-56.4e-6 if($opts{cfglib} && $opts{cfglib} !~ /^<:/) {
59101.7e-51.7e-6 $cfglib = $opts{cfglib};
60 }
61110.000999.0e-5 eval "use lib ('$staticlib','$staticsite','$importlib');";
# spent 3.21ms making 11 calls to lib::import, avg 292µs/call
62112.3e-52.1e-6 if($cfglib) { # && $^C) {
63112.3e-52.1e-6 my @cfglib = ref($cfglib) ? @$cfglib : $cfglib;
64110.000575.2e-5 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
70110.000474.3e-5 if(! grep(m|/WISE.pm$|,keys %INC) &&
71 ($opts{use_wise} || $opts{usewise})) {
7210.000870.00087 eval "package $caller_pkg; use WISE;\n";
# spent 363ms making 1 call to WISE::import
7311.0e-61.0e-6 die $@ if $@;
74 }
75114.0e-53.6e-6 my ($steps,$bands);
76111.6e-51.5e-6 if($opts{import}) {
7764.0e-66.7e-7 my @import;
7866.3e-51.0e-5 if(ref $opts{import}) {
79 @import = @{ $opts{import} };
80 } else {
81 @import = split(" ",$opts{import});
82 }
83224.0e-51.8e-6 my @pkgs = map {s/^://; $_;} grep {/^:/} @import;
84224.4e-52.0e-6 @import = grep {! /^:/} @import;
8561.1e-51.8e-6 if(grep {$_ eq '$hostname'} @import) {
8610.004350.00435 chomp(($hostname) = `/bin/hostname -s 2>/dev/null`);
8713.0e-63.0e-6 $hostname ||= 'UNKNOWN';
88 }
8961.8e-53.0e-6 if(grep {$_ eq '$curgrp'} @import) {
90 $curgrp = (getgrgid($curgid))[0] || '?';
91 }
9269.0e-61.5e-6 if(grep {$_ eq '$uid'} @import) {
93 $uid = getpwuid($<) || '?';
94 }
9561.9e-53.2e-6 if(grep {$_ eq '$curgid'} @import) {
96 $curgid = (split " ","$)")[0] || -1;
97 }
9869.0e-61.5e-6 if(grep {$_ eq '%steps'} @import) {
99 $steps = \%steps;
100 }
10161.2e-52.0e-6 if(grep($_ eq '%bands', @import) ||
102 grep($_ eq '@bands', @import)) {
103 $bands = 1;
104 }
10560.000152.5e-5 if(@import) {
# spent 433µs making 6 calls to WISE::Env::_export, avg 72µs/call
106 _export($caller_pkg, $pkg, @import);
107 }
10861.1e-51.8e-6 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 }
115111.8e-51.6e-6 die "$env_err: Params, log, or banner requested, but 'iam' not supplied.\n"
116 if ($opts{params}||$opts{log}||$opts{banner}) && ! $opts{iam};
117111.2e-51.1e-6 if(defined $opts{iam} && ! $^C) {
11811.0e-61.0e-6 require Cwd;
11911.0e-61.0e-6 warn "$env_warn: Exported variables being redefined; iam was '$iam'.\n"
120 if $iam;
12111.0e-61.0e-6 $version = $opts{version};
12211.0e-61.0e-6 $iam = $opts{iam};
12311.0e-61.0e-6 $err = "*** $iam";
12411.0e-61.0e-6 $warn = "=== $iam";
12512.0e-62.0e-6 if($opts{params}) {
12611.0e-61.0e-6 require WISE::Pars;
127 $pars = WISE::Pars->new($opts{params},
128 {
129 iam => $opts{iam},
13011.7e-51.7e-5 %{ $opts{param_opts} ||
# spent 65.9ms making 1 call to WISE::Pars::new
131 $opts{paramopts} ||
132 {}
133 },
134 }
135 );
136 }
137100 $pars ||= $opts{pars};
13816.9e-56.9e-5 %pvals = $pars->vals() if $pars;
# spent 231µs making 1 call to WISE::Pars::vals
13912.0e-62.0e-6 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
15912.0e-52.0e-5 $ENV{PWD} = Cwd::getcwd();
# spent 13µs making 1 call to Cwd::getcwd
160 }
16112.0e-62.0e-6 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 }
19211.0e-61.0e-6 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 }
20311.0e-61.0e-6 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 }
22011.0e-61.0e-6 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 }
246116.6e-56.0e-6 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 {
26363.7e-56.2e-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
26862.6e-54.3e-6 foreach my $sym (@imports) {
269 # shortcut for the common case of no type character
270165.5e-53.4e-6 (*{$caller.'::'.$sym} = \&{$exporter.'::'.$sym}, next)
271 unless $sym =~ s/^(\W)//;
272
273163.7e-52.3e-6 my $type = $1;
274162.0e-51.3e-6 my $caller_sym = $caller.'::'.$sym;
275161.7e-51.1e-6 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} :
282160.000127.6e-6 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.