← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/wdate
  Run on Fri Jun 4 15:13:22 2010
Reported on Fri Jun 4 15:14:31 2010

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

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1616160.017934.85051WISE::Env::import
5110.000340.00034WISE::Env::_export
6660.000200.00020WISE::Env::err_prefix

LineStmts.Exclusive
Time		Avg.Code
1#! /usr/bin/env perl
2
3package WISE::Env;
4
532.7e-59.0e-6use strict;
# spent 9µs making 1 call to strict::import
632.8e-59.3e-6use warnings;
# spent 35µs making 1 call to warnings::import
7
830.005120.00171use vars qw(@ISA $VERSION $AUTOLOAD $Banner);
# spent 64µ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 {
2019.0e-69.0e-6 umask(2); # Kluge!!!!
2113.0e-63.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} ||"";
2412.0e-62.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 {
3112.0e-62.0e-6 $cfgdir= "$delivdir/$cfg";
3211.0e-61.0e-6 $cfglib= "$cfgdir/lib/perl";
33 }
34 } else {
35 $cfgdir= $cfglib = "";
36 }
37100 $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";
4213.0e-63.0e-6 $importlib = ($ENV{WISE_IMPBASE} ||"$basedir/import").
43 "/lib/perl5/site_perl";
4410.001870.00187}
45
46# SVN revision ID
4711.0e-61.0e-6my $env_version = '$Id: Env.pm 5815 2009-09-26 20:51:23Z tim $ ';
48
4916.0e-56.0e-5my ($xbase) = $0=~m|([^/]+)$|;
50
51
# spent 4.85s (17.9ms+4.83) within WISE::Env::import which was called 16 times, avg 303ms/call: # once (10.6ms+4.83s) at line 9 of /wise/base/deliv/dev/bin/wdate # once (269µs+930µs) at line 8 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/Decom.pm # once (294µs+650µs) at line 11 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/HK.pm # once (338µs+545µs) at line 9 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/NAIF.pm # once (210µs+324µs) at line 9 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/Seq.pm # once (207µs+320µs) at line 11 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/SurveyPlan.pm # once (161µs+327µs) at line 11 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/GroundTrack.pm # once (157µs+285µs) at line 7 of /wise/base/deliv/dev/lib/perl/x86_64-linux-thread-multi/WISE/Ingest/Rice.pm # once (248µs+-248000ns) at line 8 of /wise/base/deliv/dev/lib/perl/WISE/Wrap.pm # once (326µs+-326000ns) at line 36 of /wise/base/deliv/dev/lib/perl/WISE/Params.pm # once (175µs+-175000ns) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/IOUtils.pm # once (176µs+-176000ns) at line 3 of /wise/base/deliv/dev/lib/perl/WISE/Time.pm # once (258µs+-258000ns) at line 7 of /wise/base/deliv/dev/lib/perl/WISE/FITSIO.pm # once (196µs+-196000ns) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/BandUtils.pm # once (4.13ms+-4126000ns) at line 8 of /wise/base/deliv/dev/lib/perl/WISE/UtilsLight.pm # once (209µs+-209000ns) at line 6 of /wise/base/deliv/dev/lib/perl/WISE/Utils.pm
sub import {
52162.1e-51.3e-6 my $pkg = shift;
53169.6e-56.0e-6 my %opts = @_;
54163.8e-52.4e-6 my $env_err = "*** $xbase/".__PACKAGE__;
55162.6e-51.6e-6 my $env_warn = "=== $xbase/".__PACKAGE__;
56320.000165.0e-6 $opts{lc $_} = $opts{$_} for keys %opts;
57165.1e-53.2e-6 my $caller_pkg = (caller())[0];
58169.4e-55.9e-6 if($opts{cfglib} && $opts{cfglib} !~ /^<:/) {
5992.2e-52.4e-6 $cfglib = $opts{cfglib};
60 }
61160.004060.00025 eval "use lib ('$staticlib','$staticsite','$importlib');";
# spent 5.27ms making 16 calls to lib::import, avg 329µs/call
62162.9e-51.8e-6 if($cfglib) { # && $^C) {
63163.1e-51.9e-6 my @cfglib = ref($cfglib) ? @$cfglib : $cfglib;
64160.001046.5e-5 eval "use lib qw|@cfglib|;";
# spent 2.44ms making 16 calls to lib::import, avg 152µs/call
65 } else {
66 # Fallback
67 eval "use lib '$opslib';";
68 }
69
70160.000764.7e-5 if(! grep(m|/WISE.pm$|,keys %INC) &&
71 ($opts{use_wise} || $opts{usewise})) {
7220.003160.00158 eval "package $caller_pkg; use WISE;\n";
# spent 464ms making 2 calls to WISE::import, avg 232ms/call
7322.0e-61.0e-6 die $@ if $@;
74 }
75161.3e-58.1e-7 my ($steps,$bands);
76161.6e-51.0e-6 if($opts{import}) {
7753.0e-66.0e-7 my @import;
7853.0e-56.0e-6 if(ref $opts{import}) {
79 @import = @{ $opts{import} };
80 } else {
81 @import = split(" ",$opts{import});
82 }
83183.3e-51.8e-6 my @pkgs = map {s/^://; $_;} grep {/^:/} @import;
84183.9e-52.2e-6 @import = grep {! /^:/} @import;
8559.0e-61.8e-6 if(grep {$_ eq '$hostname'} @import) {
8610.003870.00387 chomp(($hostname) = `/bin/hostname -s 2>/dev/null`);
8712.0e-62.0e-6 $hostname ||= 'UNKNOWN';
88 }
8951.8e-53.6e-6 if(grep {$_ eq '$curgrp'} @import) {
90 $curgrp = (getgrgid($curgid))[0] || '?';
91 }
9257.0e-61.4e-6 if(grep {$_ eq '$uid'} @import) {
93 $uid = getpwuid($<) || '?';
94 }
9557.0e-61.4e-6 if(grep {$_ eq '$curgid'} @import) {
96 $curgid = (split " ","$)")[0] || -1;
97 }
9858.0e-61.6e-6 if(grep {$_ eq '%steps'} @import) {
99 $steps = \%steps;
100 }
10152.2e-54.4e-6 if(grep($_ eq '%bands', @import) ||
102 grep($_ eq '@bands', @import)) {
103 $bands = 1;
104 }
10557.0e-51.4e-5 if(@import) {
# spent 341µs making 5 calls to WISE::Env::_export, avg 68µs/call
106 _export($caller_pkg, $pkg, @import);
107 }
10858.0e-61.6e-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 }
115162.4e-51.5e-6 die "$env_err: Params, log, or banner requested, but 'iam' not supplied.\n"
116 if ($opts{params}||$opts{log}||$opts{banner}) && ! $opts{iam};
117162.6e-51.6e-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};
122100 $iam = $opts{iam};
12311.0e-61.0e-6 $err = "*** $iam";
12411.0e-61.0e-6 $warn = "=== $iam";
12513.0e-63.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.6e-51.6e-5 %{ $opts{param_opts} ||
# spent 4.37s making 1 call to WISE::Pars::new
131 $opts{paramopts} ||
132 {}
133 },
134 }
135 );
136 }
13711.0e-61.0e-6 $pars ||= $opts{pars};
13813.8e-53.8e-5 %pvals = $pars->vals() if $pars;
# spent 80µs making 1 call to WISE::Pars::vals
13911.0e-61.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 15µ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 }
19212.0e-62.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 }
203100 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 }
246167.8e-54.9e-6 return 1;
247}
248
249
# spent 198µs within WISE::Env::err_prefix which was called 6 times, avg 33µs/call: # once (59µs+0) at line 25 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/GroundTrack.pm # once (35µs+0) at line 27 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/Seq.pm # once (34µs+0) at line 25 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/HK.pm # once (27µs+0) at line 21 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/Decom.pm # once (25µs+0) at line 27 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/NAIF.pm # once (18µs+0) at line 25 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/SurveyPlan.pm
sub err_prefix { # Pseudo "class method"
25069.0e-61.5e-6 my $pkg = shift;
25165.0e-68.3e-7 my $iam = shift;
25261.1e-51.8e-6 my $opts = shift || {};
25361.9e-53.2e-6 my $caller_pkg = (caller())[0];
25467.0e-61.2e-6 $caller_pkg = "" if $caller_pkg eq 'main';
25561.3e-52.2e-6 my $err = "*** $xbase/$caller_pkg";
25661.8e-53.0e-6 my $warn = "=== $xbase/$caller_pkg";
25763.4e-55.7e-6 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 341µs within WISE::Env::_export which was called 5 times, avg 68µs/call: # 5 times (341µs+0) by WISE::Env::import at line 105, avg 68µs/call
sub _export {
26353.8e-57.6e-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.000175.7e-5 no strict;
# spent 10µs making 1 call to strict::unimport
26853.3e-56.6e-6 foreach my $sym (@imports) {
269 # shortcut for the common case of no type character
270134.7e-53.6e-6 (*{$caller.'::'.$sym} = \&{$exporter.'::'.$sym}, next)
271 unless $sym =~ s/^(\W)//;
272
273133.4e-52.6e-6 my $type = $1;
274131.7e-51.3e-6 my $caller_sym = $caller.'::'.$sym;
275131.2e-59.2e-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} :
282130.000118.3e-6 do { die("*** $0/Env: Can't export symbol: $type$sym.\n") };
283 }
284}
285
286
28719.0e-69.0e-61;

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