← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/framedepth
  Run on Fri May 28 15:23:26 2010
Reported on Fri May 28 15:26:28 2010

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

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

LineStmts.Exclusive
Time		Avg.Code
1#! /usr/bin/env perl
2
3package WISE::Env;
4
533.2e-51.1e-5use strict;
# spent 10µs making 1 call to strict::import
633.5e-51.2e-5use warnings;
# spent 23µs making 1 call to warnings::import
7
830.000650.00022use vars qw(@ISA $VERSION $AUTOLOAD $Banner);
# spent 74µs making 1 call to vars::import
9
1011.0e-61.0e-6$VERSION = 0.10;
1116.0e-66.0e-6@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 {
2017.0e-67.0e-6 umask(2); # Kluge!!!!
2112.0e-62.0e-6 $basedir = ($ENV{WISE_BASE} ||"/wise/base");
2211.0e-61.0e-6 $delivdir = ($ENV{WISE_DELIVBASE} ||"$basedir/deliv");
2311.0e-61.0e-6 $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";
3215.0e-65.0e-6 $cfglib= "$cfgdir/lib/perl";
33 }
34 } else {
35 $cfgdir= $cfglib = "";
36 }
3711.0e-61.0e-6 $opsdir = "$delivdir/ops";
3811.0e-61.0e-6 $opslib = "$opsdir/lib/perl";
3911.0e-61.0e-6 $staticdir = $ENV{WISE_GENBASE} ||"$basedir/static";
4011.0e-61.0e-6 $staticsite= "$staticdir/lib/perl5/site_perl";
4111.0e-61.0e-6 $staticlib = $staticsite; # "$staticdir/lib/perl";
4212.0e-62.0e-6 $importlib = ($ENV{WISE_IMPBASE} ||"$basedir/import").
43 "/lib/perl5/site_perl";
4410.001880.00188}
45
46# SVN revision ID
4711.0e-61.0e-6my $env_version = '$Id: Env.pm 5815 2009-09-26 20:51:23Z tim $ ';
48
4912.2e-52.2e-5my ($xbase) = $0=~m|([^/]+)$|;
50
51
# spent 132ms (96.8+35.7) within WISE::Env::import which was called 12 times, avg 11.0ms/call: # once (90.3ms+37.9ms) at line 7 of /wise/base/deliv/dev/bin/framedepth # once (265µs+360µs) at line 8 of /wise/base/deliv/dev/lib/perl/WISE/Wrap.pm # once (260µs+335µs) at line 7 of /wise/base/deliv/dev/lib/perl/WISE/FITSIO.pm # once (223µs+365µs) at line 6 of /wise/base/deliv/dev/lib/perl/x86_64-linux-thread-multi/WISE/CHealPix.pm # once (199µs+342µs) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/FITSIO/Utils.pm # once (180µs+316µs) at line 3 of /wise/base/deliv/dev/lib/perl/WISE/Time.pm # once (177µs+307µs) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/Utils.pm # once (191µs+293µs) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/IOUtils.pm # once (153µs+315µs) at line 8 of /wise/base/deliv/dev/lib/perl/WISE/PgAitoff.pm # once (4.33ms+-4331000ns) at line 8 of /wise/base/deliv/dev/lib/perl/WISE/UtilsLight.pm # once (325µs+-325000ns) at line 36 of /wise/base/deliv/dev/lib/perl/WISE/Params.pm # once (183µs+-183000ns) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/BandUtils.pm
sub import {
52121.7e-51.4e-6 my $pkg = shift;
53124.8e-54.0e-6 my %opts = @_;
54123.3e-52.8e-6 my $env_err = "*** $xbase/".__PACKAGE__;
55123.1e-52.6e-6 my $env_warn = "=== $xbase/".__PACKAGE__;
56249.2e-53.8e-6 $opts{lc $_} = $opts{$_} for keys %opts;
57122.9e-52.4e-6 my $caller_pkg = (caller())[0];
58123.8e-53.2e-6 if($opts{cfglib} && $opts{cfglib} !~ /^<:/) {
59102.4e-52.4e-6 $cfglib = $opts{cfglib};
60 }
61120.001078.9e-5 eval "use lib ('$staticlib','$staticsite','$importlib');";
# spent 3.23ms making 12 calls to lib::import, avg 269µs/call
62122.3e-51.9e-6 if($cfglib) { # && $^C) {
63122.6e-52.2e-6 my @cfglib = ref($cfglib) ? @$cfglib : $cfglib;
64120.000615.0e-5 eval "use lib qw|@cfglib|;";
# spent 1.26ms making 12 calls to lib::import, avg 105µs/call
65 } else {
66 # Fallback
67 eval "use lib '$opslib';";
68 }
69
70120.000383.1e-5 if(! grep(m|/WISE.pm$|,keys %INC) &&
71 ($opts{use_wise} || $opts{usewise})) {
72 eval "package $caller_pkg; use WISE;\n";
73 die $@ if $@;
74 }
75121.0e-58.3e-7 my ($steps,$bands);
76121.3e-51.1e-6 if($opts{import}) {
7763.0e-65.0e-7 my @import;
7864.3e-57.2e-6 if(ref $opts{import}) {
79 @import = @{ $opts{import} };
80 } else {
81 @import = split(" ",$opts{import});
82 }
83206.0e-53.0e-6 my @pkgs = map {s/^://; $_;} grep {/^:/} @import;
84203.7e-51.8e-6 @import = grep {! /^:/} @import;
8561.2e-52.0e-6 if(grep {$_ eq '$hostname'} @import) {
8610.004060.00406 chomp(($hostname) = `/bin/hostname -s 2>/dev/null`);
8711.2e-51.2e-5 $hostname ||= 'UNKNOWN';
88 }
8962.9e-54.8e-6 if(grep {$_ eq '$curgrp'} @import) {
90 $curgrp = (getgrgid($curgid))[0] || '?';
91 }
9267.0e-61.2e-6 if(grep {$_ eq '$uid'} @import) {
93 $uid = getpwuid($<) || '?';
94 }
9561.8e-53.0e-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.0e-51.7e-6 if(grep($_ eq '%bands', @import) ||
102 grep($_ eq '@bands', @import)) {
103 $bands = 1;
104 }
10566.3e-51.0e-5 if(@import) {
# spent 322µs making 6 calls to WISE::Env::_export, avg 54µs/call
106 _export($caller_pkg, $pkg, @import);
107 }
10868.0e-61.3e-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 }
115121.7e-51.4e-6 die "$env_err: Params, log, or banner requested, but 'iam' not supplied.\n"
116 if ($opts{params}||$opts{log}||$opts{banner}) && ! $opts{iam};
117121.1e-59.2e-7 if(defined $opts{iam} && ! $^C) {
11810.000200.00020 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}) {
12610.000800.00080 require WISE::Pars;
127 $pars = WISE::Pars->new($opts{params},
128 {
129 iam => $opts{iam},
13011.7e-51.7e-5 %{ $opts{param_opts} ||
# spent 18.5ms making 1 call to WISE::Pars::new
131 $opts{paramopts} ||
132 {}
133 },
134 }
135 );
136 }
13711.0e-61.0e-6 $pars ||= $opts{pars};
13811.8e-51.8e-5 %pvals = $pars->vals() if $pars;
# spent 79µ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.2e-52.2e-5 $ENV{PWD} = Cwd::getcwd();
# spent 13µs making 1 call to Cwd::getcwd
160 }
16111.0e-61.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 }
246124.9e-54.1e-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 322µs within WISE::Env::_export which was called 6 times, avg 54µs/call: # 6 times (322µs+0) by WISE::Env::import at line 105, avg 54µs/call
sub _export {
26366.1e-51.0e-5 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.000175.7e-5 no strict;
# spent 10µs making 1 call to strict::unimport
26862.5e-54.2e-6 foreach my $sym (@imports) {
269 # shortcut for the common case of no type character
270144.3e-53.1e-6 (*{$caller.'::'.$sym} = \&{$exporter.'::'.$sym}, next)
271 unless $sym =~ s/^(\W)//;
272
273142.9e-52.1e-6 my $type = $1;
274141.8e-51.3e-6 my $caller_sym = $caller.'::'.$sym;
275141.3e-59.3e-7 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} :
282149.1e-56.5e-6 do { die("*** $0/Env: Can't export symbol: $type$sym.\n") };
283 }
284}
285
286
28711.8e-51.8e-51;

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