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

File/wise/base/deliv/dev/lib/perl/WISE/Pars.pm
Statements Executed178
Total Time0.006262 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1110.000350.00035WISE::ParamDefs::_ignore
1110.000230.00023WISE::Pars::vals
1110.000210.00065WISE::ParamDefs::basic
1119.0e-59.0e-5WISE::ParamDefs::_only
1115.0e-50.06592WISE::Pars::new
4312.9e-52.9e-5WISE::Pars::_isopt
2112.9e-59.6e-5WISE::Pars::get
1111.9e-55.6e-5WISE::Pars::origval
1111.3e-51.9e-5WISE::Pars::has
00000WISE::ParamDefs::from
00000WISE::Pars::BEGIN
00000WISE::Pars::addval
00000WISE::Pars::argv
00000WISE::Pars::argv_spec
00000WISE::Pars::check_pragmas
00000WISE::Pars::clone
00000WISE::Pars::cmdline
00000WISE::Pars::cmds_from_specs
00000WISE::Pars::condition
00000WISE::Pars::defaultstr
00000WISE::Pars::expand_tags
00000WISE::Pars::from
00000WISE::Pars::given
00000WISE::Pars::has_tag
00000WISE::Pars::help
00000WISE::Pars::iam
00000WISE::Pars::passon
00000WISE::Pars::passon_abbrev
00000WISE::Pars::renew
00000WISE::Pars::set
00000WISE::Pars::show
00000WISE::Pars::spawn
00000WISE::Pars::target_defs
00000WISE::Pars::valstr

LineStmts.Exclusive
Time		Avg.Code
1#! /use/bin/env perl
2
333.2e-51.1e-5use strict;
# spent 11µs making 1 call to strict::import
434.0e-51.3e-5use warnings;
# spent 30µs making 1 call to warnings::import
5
6#use lib qw(/wise/base/deliv/dev/lib/perl);
7
8#
9#
10# ====================================================================
11# Object oriented interface for the main functionality in WISE::Params.
12#
13
14package WISE::Pars;
15
16#use threads::shared qw(share is_shared);
17
1830.000950.00032use WISE::Params;
# spent 34µs making 1 call to Exporter::Lite::import
19
2033.2e-51.1e-5use File::Basename;
# spent 95µs making 1 call to Exporter::import
2130.004160.00139use Clone;
# spent 32µs making 1 call to Exporter::import
22
23# Separate package so there will be no exports.
24
25
# spent 65.9ms (50µs+65.9) within WISE::Pars::new which was called # once (50µs+65.9ms) by WISE::Env::import at line 130 of /wise/base/static/lib/perl5/site_perl/5.10.0/WISE/Env.pm
sub new {
26118.6e-57.8e-6 my $class = shift;
27 my $pardefs = shift;
28 my $opts = shift || {};
29 my $this = $opts->{ctxt} || $opts->{defs} ||
30 (ref $class ? $class : undef);
31 my $vals = $opts->{vals} ||
32 ($this && $this->{vals} ? $this->{vals} : undef);
33
34 $class = ref($class) || $class;
35
36 if(! $this) { $this = {}; }
37 if(! $vals) { $vals = {}; }
38
39 WISE::Params::Params($pardefs,
# spent 65.8ms making 1 call to WISE::Params::Params
40 {strict=>1, %$opts,
41 defs=>$this, vals=>$vals});
42
43 $this->{_meta}{opts} = Clone::clone($opts); # Deep copy
# spent 37µs making 1 call to Clone::clone
44
45 return bless $this,$class;
46}
47
48# $p->show prints to stdout
49# $p->show(\*FH) prints to the FH file handle
50# $p->show(0) doesn't print (just returns the text in a scalar).
51sub show {
52 my $this = shift;
53 my $opts = @_ && _isopt($_[-1]) ? pop : {};
54 my $to = shift;
55 my %to;
56
57 if($to) { %to = (to=>$to); }
58
59 return WISE::Params::Param_print({%$opts, %to, defs=>$this});
60}
61
62sub help {
63 my $this = shift;
64 my $opts = @_ && _isopt($_[-1]) ? pop : {};
65 my $help = shift;
66
67 return WISE::Params::Param_help($help,{%$opts, defs=>$this});
68}
69
70sub given {
71 my $this = shift;
72 my $opts = @_ && _isopt($_[-1]) ? pop : {};
73 my $alias= shift;
74
75 return WISE::Params::Param_specified($alias, {%$opts, defs=>$this});
76}
77
78# Weird manipulations here to make this as intuitive as possible and
79# still hook up to the weird way I did things in Param_passon.
80sub passon_abbrev {
81 my $this = shift;
82 my $opts = @_ && _isopt($_[-1]) ? pop : {};
83 my $for = shift;
84 return WISE::Spawn::passon_abbrev($for);
85}
86
87# Weird manipulations here to make this as intuitive as possible and
88# still hook up to the weird way I did things in Param_passon.
89sub passon {
90 my $this = shift;
91 my $opts = @_ && _isopt($_[-1]) ? pop : {};
92 my $for = shift;
93 my %for;
94
95 if($for) { %for = (for=>$for); }
96
97 return WISE::Spawn::param_passon({%$opts, %for, defs=>$this});
98}
99
100
# spent 19µs (13+6) within WISE::Pars::has which was called # once (13µs+6µs) by WISE::Pars::origval at line 208
sub has {
10141.2e-53.0e-6 my $this = shift;
102 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 6µs making 1 call to WISE::Pars::_isopt
103 my $alias = shift;
104 return $this->{_meta}{aliases}{$alias};
105}
106
107
# spent 96µs (29+67) within WISE::Pars::get which was called 2 times, avg 48µs/call: # 2 times (29µs+67µs) at line 305 of /wise/base/deliv/dev/bin/getfix, avg 48µs/call
sub get {
10863.8e-56.3e-6 my $this = shift;
109 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 16µs making 2 calls to WISE::Pars::_isopt, avg 8µs/call
110 return WISE::Params::Param_get(@_,{%$opts, defs=>$this});
# spent 51µs making 2 calls to WISE::Params::Param_get, avg 25µs/call
111}
112
113sub set {
114 my $this = shift;
115 my $opts = @_ && _isopt($_[-1]) ? pop : {};
116 return WISE::Params::Param_reassign(@_,{%$opts, defs=>$this});
117}
118
119sub addval {
120 my $this = shift;
121 my $opts = @_ && _isopt($_[-1]) ? pop : {};
122 my $full = shift;
123 my $val = shift;
124
125 return WISE::Params::Param_addval($full,$val,{%$opts, defs=>$this});
126}
127
128
# spent 231µs within WISE::Pars::vals which was called # once (231µs+0) by WISE::Env::import at line 138 of /wise/base/static/lib/perl5/site_perl/5.10.0/WISE/Env.pm
sub vals {
12930.000227.5e-5 my $this = shift;
130 my %vals = (
131 map { ($_ => $this->{_meta}{vals}{$_}) }
132 @{$this->{_meta}{parnames}}
133 );
134 return wantarray ? %vals : \%vals;
135}
136
137# Need to preserve sanctitiy of deault for sanity's sake.
138# Remove this routine.
139#sub default {
140# my $this = shift;
141# my $opts = @_ && _isopt($_[-1]) ? pop : {};
142# return WISE::Params::Param_default(@_,{%$opts, defs=>$this});
143#}
144
145sub condition {
146 my $this = shift;
147 my $opts = @_ && _isopt($_[-1]) ? pop : {};
148 my %conditions = @_;
149
150 while( my($k,$v) = each %conditions) {
151 $this->{_meta}{conditions}{$k} = $v;
152 }
153
154 return 1;
155}
156
157sub renew {
158 my $this = shift;
159 my $opts = @_ && _isopt($_[-1]) ? pop : {};
160 my $keeprefs = $opts->{keeprefs};
161 my $keepvals = $opts->{keepvals};
162 my $argv = $opts->{argv} // ($keepvals ? undef : $this->{_meta}{argv});
163
164 # Capture the old defaults or make current values the new defaults
165 my %defaults = (map { ($_ => $this->defaultstr($_)) }
166 grep { $this->{$_}{isdefault} }
167 @{$this->{_meta}{parnames}} );
168 my %vals;
169 if($keepvals) {
170 %vals = (map { ($_ => $this->valstr($_)) }
171 grep { $this->{$_}{specified} }
172 @{$this->{_meta}{parnames}} );
173 }
174 my @def = @{ $this->{_meta}{def} };
175
176 if(! $keeprefs) {
177 # Exclude any target variable references
178 ref($_) and $_ = "" for @def;
179 }
180
181 # Recreate the data structure from the ground up the way we did before,
182 # starting from the same input, but excluding the old result refs.
183 my $new = WISE::Pars->new(\@def,
184 {argv =>$argv||undef,
185 defaults=>{
186 %defaults,
187 %{$opts->{defaults} || {}},
188 },
189 inits =>\%vals,
190 %$opts});
191
192 if($keepvals && ! $argv) {
193 # Add in pass-on info since it can't come from argv
194 $new->{_meta}{pass_on} = [];
195 @{$new->{_meta}{pass_on}} = @{$this->{_meta}{pass_on} || []};
196 $new->{_meta}{pass_on_abs} = [];
197 @{$new->{_meta}{pass_on_abs}} = @{$this->{_meta}{pass_on_abs} || []};
198 }
199
200 return $new;
201}
202
203
# spent 56µs (19+37) within WISE::Pars::origval which was called # once (19µs+37µs) at line 332 of /wise/base/deliv/dev/bin/getfix
sub origval {
20442.4e-56.0e-6 my $this = shift;
205 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 7µs making 1 call to WISE::Pars::_isopt
206 my $param= shift;
207
208 return WISE::Params::origval($this,$this->has($param));
# spent 19µs making 1 call to WISE::Pars::has # spent 11µs making 1 call to WISE::Params::origval
209}
210
211sub valstr {
212 my $this = shift;
213 my $opts = @_ && _isopt($_[-1]) ? pop : {};
214 my $param= shift;
215 my $full = $this->has($param);
216 my $def = $this->{$full}{isdefault};
217 return WISE::Params::valstr($this,$full,$def);
218}
219
220sub defaultstr {
221 my $this = shift;
222 my $opts = @_ && _isopt($_[-1]) ? pop : {};
223 my $param= shift;
224 return $this->{$this->has($param)}{defaultstr};
225}
226
227sub cmdline {
228 my $this = shift;
229 my $opts = @_ && _isopt($_[-1]) ? pop : {};
230 my $targ = @_ ? shift : $this->{_meta}{iam};
231 my $targdefs = $opts->{targdefs};
232 my @cmd;
233
234 ($targdefs) = $this->target_defs($targ,$opts) if ! $targdefs;
235
236 my %newopts = %$opts;
237 delete $newopts{targdefs};
238
239 return WISE::Spawn::Param_spawn($targ,
240 {merge => 1, # Overridable
241 passon => 1,
242 %newopts, # Overrides
243 targdefs=> $targdefs, # Not overridable
244 defs => $this,
245 norun => 1,
246 });
247
248}
249
250sub spawn {
251 my $this = shift;
252 my $opts = @_ && _isopt($_[-1]) ? pop : {};
253 my $targ = @_ ? shift : $this->{_meta}{iam};
254 my $err = "*** $0/SPAWN";
255
256 die "$err: Spawn method illegally called with norun option; ".
257 "use cmdline instead.\n"
258 if $opts->{norun};
259
260 my ($targdefs) = $this->target_defs($targ,$opts);
261
262 my $verbose = $opts->{verbose} // $this->{verbose}{val};
263 my $test = $opts->{test} // $this->{test}{val};
264 my $debug = $this->{debug}{val} || $this->{_meta}{debug} ||
265 $opts->{debug};
266
267 my $cluster = exists $opts->{cluster}
268 ? $opts->{cluster}
269 : $this->{cluster}{val};
270
271 my $status = WISE::Spawn::spawncmd($targ,
272 {
273 %$opts,
274 defs => $this,
275 targdefs=> $targdefs,
276 cluster => $cluster,
277 verbose => $verbose,
278 test => $test,
279 debug => $debug,
280 });
281
282 return $status;
283}
284
285# Remaining argv elements
286sub argv {
287 my $this = shift;
288 my @argv = @{$this->{_meta}{argv}};
289 return wantarray ? @argv : \@argv;
290}
291
292# ARGV as sepcified at start of processing
293sub argv_spec {
294 my $this = shift;
295 my @argv = @{$this->{_meta}{argv_orig}};
296 return wantarray ? @argv : \@argv;
297}
298
299sub from { my $this = shift; my $param = shift; $this->{$param}{from}; }
300
301sub iam { my $this = shift; $this->{_meta}{iam}; }
302
303sub expand_tags {
304 my $this = shift;
305 my $opts = @_ && _isopt($_[-1]) ? pop : {};
306 WISE::Params::expand_tags($this,$opts);
307 return $this;
308}
309
310sub check_pragmas {
311 my $this = shift;
312 my $opts = @_ && _isopt($_[-1]) ? pop : {};
313 WISE::Params::check_pragmas($this,$opts);
314 return $this;
315}
316
317# This imitates part of Params::expand_tags.
318# !!! Should refactor so there's no repeated code.
319sub has_tag {
320 my $this = shift;
321 my $opts = @_ && _isopt($_[-1]) ? pop : {};
322 my $alias = shift;
323 my $origval= $this->get($alias);
324 my ($tag) = $origval =~ /%([^%]+)%/;
325 # undef = no syntactic tag-like thing present
326 return if ! $tag;
327 $tag = ($this->{_meta}{tag_aliases} &&
328 $this->{_meta}{tag_aliases}{lc $tag})
329 // $tag;
330 # Expand to full param name
331 my $tmptag = $this->{_meta}{aliases}{lc $tag};
332 # 0 = not a known param., but a tag-like thing was there
333 return wantarray ? (0, $tag) : 0
334 if ! $tmptag && ! defined $WISE::Params::tag_predefs{lc $tag};
335 $tag = $tmptag if $tmptag;
336 # Get the param. value
337 my $val = (defined $this->{$tag} &&
338 defined $this->{$tag}{val}
339 ? $this->{$tag}{val} # Param value
340 : $WISE::Params::tag_predefs{$tag} # Pre-defined value
341 );
342 # "" = no value available for substitution
343 return wantarray ? ("",$tag, $val) : "" if ! defined $val;
344 # 0 = not substitutable (must be a scalar, for now)
345 return wantarray ? (0, $tag, $val) : 0 if ref $val;
346 # 1 = substitutable tag
347 return wantarray ? (1, $tag, $val) : 1;
348}
349
350sub clone {
351 my $this = shift;
352 require Clone;
353 my $that = Clone::clone($this);
354 return $that;
355}
356
357sub target_defs {
358 my $this = shift;
359 my $opts = @_ && _isopt($_[-1]) ? pop : {};
360 my $targ = @_ ? shift : ref($this) ? $this->{_meta}{iam} : undef;
361 my $err = "*** $0/TARGDEFS";
362 my ($targdefs,$targbase);
363 my $iambase = ref($this) ? lc basename($this->{_meta}{iam}) : undef;
364
365 die "$err: No target defined.\n"
366 if ! defined $targ;
367
368 my %newopts = %$opts;
369
370 if(ref($targ)) {
371 # Command already constructed, just pass through spawn on way
372 # to either condorjob or param_spawn
373
374 $targbase = lc basename($targ->[0]);
375
376 } else {
377 # Spawn from the command name
378
379 $targbase = lc basename($targ);
380
381 if(! defined $iambase || $targbase ne $iambase) {
382 # Get target parameter definition
383 my $model = WISE::Params::paramsfrommodel($targ, { arrayref=>1 } )
384 or die "$err: Unable to get param model from '$targ'.\n";
385 $targdefs = WISE::Pars->new($model,
386 {
387 iam=>$targbase,
388 parseonly => 1,
389 %newopts,
390 }
391 );
392 #use WISE::Dumper;
393 #print Dumper $targdefs;
394 } else {
395 $targdefs = $this->clone();
396 }
397 }
398
399 return wantarray ? ($targdefs,$targbase) : $targdefs;
400}
401
402sub cmds_from_specs {
403 my $this = shift;
404 my $opts = @_ && _isopt($_[-1]) ? pop : {};
405 my $targ = @_ ? shift : $opts->{targ} ||
406 (ref($this) ? $this->{_meta}{iam} : undef);
407 my $specs= shift || $opts->{specs};
408 my $err = "*** $0/GETCMD";
409 my $check= $opts->{check};
410 my $job = $opts->{job}; # Set up wise::condor job structure
411 my $jobdir_par = $opts->{jobdir_param} || 'run_dir';
412 my $args = $opts->{argsonly} || $job; # Command args only
413 my @specs= @$specs;
414
415 my %newopts = (%$opts);
416 my @not = @{$newopts{not} || []};
417 my %add = %{$newopts{add} || {}};
418 delete @newopts{qw/specs add not check argsonly/};
419
420 die "$err: No target provided.\n" if ! $targ;
421 die "$err: No specs provided.\n" if ! @specs;
422
423 my $targdefs = $this->target_defs($targ,\%newopts);
424
425 my $defs_copy = $this->renew({keepvals=>1,notags=>$opts->{notags}});
426
427 my @cmds;
428 for my $spec (@specs) {
429
430 # Make a new parameter instance so we can update any tags
431 my $defs_new = $defs_copy->clone();
432
433 # $spec can either be just a specification hash ref, or have
434 # sub members prefixed by dashes
435 my $params = grep(/^-/, keys %$spec) ? $spec->{-spec} : $spec;
436
437 # Override specified param values
438 if($params) {
439 $defs_new->set(%$params,{public=>1});
440 $defs_new->expand_tags() if ! $opts->{notags};
441 }
442
443 $check->($specs,$defs_new,$targdefs) if $check;
444
445 my @cmd = $defs_new->cmdline($targ,
446 {
447 targdefs => $targdefs,
448 not => [
449 @not,
450 @{$spec->{-not} || []},
451 ],
452 add => {
453 %add,
454 %{$spec->{-add} || {}},
455 },
456 %newopts,
457 }
458 );
459
460 shift @cmd if $args; # Don't want executable name, just the args
461
462 my $ref;
463 if($job) {
464 $ref = {directory => $defs_new->get($jobdir_par), args => \@cmd};
465 } else {
466 $ref = \@cmd;
467 }
468
469 push @cmds, $ref;
470
471 }
472
473 return wantarray ? @cmds : \@cmds;
474}
475
476
# spent 29µs within WISE::Pars::_isopt which was called 4 times, avg 7µs/call: # 2 times (16µs+0) by WISE::Pars::get at line 109, avg 8µs/call # once (7µs+0) by WISE::Pars::origval at line 205 # once (6µs+0) by WISE::Pars::has at line 102
sub _isopt {
47781.4e-51.7e-6 my $r = @_ ? shift : $_;
478 return ref($r)=~/hash/i && ! UNIVERSAL::isa($r,__PACKAGE__);
479}
480
481package WISE::ParamDefs;
482
483
# spent 651µs (214+437) within WISE::ParamDefs::basic which was called # once (214µs+437µs) at line 1 of (eval 39)[/wise/base/deliv/dev/lib/perl/WISE/Params.pm:319] at line 319 of /wise/base/deliv/dev/lib/perl/WISE/Params.pm
sub basic {
48460.000233.9e-5 my $this = shift;
485 my $opts = shift || {};
486 my @defs = (
487 "in_base,inbase,inb: str",
488 " # Input file(s) base name",
489 "band,bnd: int (1 to 4)",
490 " # Band number",
491 "out_base,outbase,outb: str = %in_base%",
492 " # Output file(s) base name",
493 "in_dir,indir,ind: file (in) = .",
494 " # Input directory",
495 "out_dir,outdir,outd: file = .",
496 " # Output directory",
497 "in_type,intype,int: str",
498 " # Input file type",
499 "in_var,invar,inv: str",
500 " # Input file variety",
501 "out_type,outtype,outt: str",
502 " # Ouput file type",
503 "out_var,outvar,outv: str",
504 " # Ouput file variety",
505 "qa_dir,qad: file = %out_dir%/%qa_sub_dir%",
506 " # Directory for QA output",
507 "qa_sub_dir,qasubdir,qasubd,qasub: file quiet = qa",
508 " # Directory for QA output",
509 "local_cal_dir,lcald: file = %out_dir%/%local_cal_sub_dir%",
510 " # Directory for local cal output",
511 "local_cal_sub_dir,lcalsubdir,lcalsubd,lcalsub: file quiet = cal",
512 " # Directory for QA output",
513 "work_dir,workd: file = %out_dir%/work",
514 " # Directory for volatile output",
515 "frame_dir,framed: file = %in_dir%",
516 " # Directory for frame input/output",
517 "cal_dir,caldir,cald: file quiet = ".
518 "%data_root%/%cal_sub_dir%",
519 " # Top-level calibration directory",
520 "cal_sub_dir,calsubdir,calsubd,calsub: file quiet = cal",
521 " # Top-level calibration directory",
522 "cal_base,calbase,calb: str = wise",
523 " # Base name of calibration files",
524 "ref_dir,refdir,refd: file quiet = ".
525 "%data_root%/%ref_sub_dir%",
526 " # Top-level reference data directory",
527 "ref_sub_dir,refsubdir,refsubd,refsub: file quiet = ref",
528 " # Top-level reference directory",
529 "ref_base,refbase,refb: str = wise",
530 " # Base name of most reference files",
531 "ifr_cal_dir,ifrcaldir,ifrcal: file quiet = ".
532 "%cal_dir%/%ifr_subdir%",
533 " # Internal (instrumental) frame calibration directory",
534 "ifr_subdir,ifrsubdir: str = ifr",
535 " # Subdir within cal directory with instrumental cal",
536 "cal_meta_base,calmetabase: str quiet = %cal_base%",
537 "cal_meta_var,calmetavar: str quiet = \"\"",
538 "cal_meta_file,calmeta: file (in) ".
539 "= %ifr_cal_dir%/%cal_meta_base%-meta-%cal_meta_var%.tbl",
540 "psf_dir, psfdir, psfd: file quiet = ".
541 "%cal_dir%/%psf_subdir%",
542 " # PSF file root used for both mdet static and wphot grid PSFs",
543 "psf_subdir,psfsubdir: str = psf",
544 " # Sub-dir containing static PSF file, used when -autopsf NOT set",
545 "apcorr_dir, apcorrdir, apcorrd: file quiet = ".
546 "%cal_dir%/%apcorr_subdir%",
547 " # PSF file root used for both mdet static and wphot grid PSFs",
548 "apcorr_subdir,apcorrsubdir: str = apcorr",
549 " # Sub-dir containing static PSF file, used when -autopsf NOT set",
550 "photom_dir, photomdir, photomd: file quiet = ".
551 "%cal_dir%/%photom_subdir%",
552 " # Photometric calibration directory for zero point history",
553 "photom_subdir,photomsubdir: str = photom",
554 " # Sub-dir containing zero point history database",
555 "prod_dir,proddir,prod: file quiet = scans",
556 " # Data product subdirectory under data_root",
557 "pipe_dir,pipedir,piped: file quiet = %data_root%/%prod_dir%",
558 " # Top-level pipeline data directory",
559 "l0_sub_dir,l0subdir,l0subd: str quiet = l0",
560 "# Level-0 archive subdir name",
561 "l0_dir,l0dir,l0d: file quiet = %data_root%/%l0_sub_dir%",
562 "# Level-0 archive dir",
563 "ql_sub_dir,qlsubdir,qlsubd: str quiet = ql",
564 "# Quicklook archive subdir name",
565 "ql_dir,qldir,qld: file quiet = %data_root%/%ql_sub_dir%",
566 "# Quicklook archive dir",
567 "local_dir,localdir,locald: file quiet = ".
568 "%local_root%/%prod_dir%",
569 " # Top-level pipeline local data directory",
570 "data_root,dataroot: file quiet = %\@dataroot%",
571 " # Root of persistent pipeline output data",
572 "frame_index_driver,fixdriver: str quiet = dbi:SQLite",
573 " # Frame Index DBI driver spec",
574 "frame_index_base,fixbase: str quiet = %ref_base%",
575 " # Frame Index file basename",
576 "frame_index_subdir,fixsubdir,fixsubd: str = fix",
577 " # Frame Index subdir name",
578 "frame_index_dir,fixdir,fixd: file = ".
579 "%ref_dir%/%frame_index_subdir%",
580 " # Frame Index directory",
581 "frame_index_file,fixfile: file = ".
582 "%frame_index_dir%/%frame_index_base%-fix.db",
583 " # Frame index file name",
584 "frame_index,frameindex,fix: file = ".
585 "%frame_index_driver%:%frame_index_file%",
586 " # Frame Index database name, including DBI standard ".
587 "driver specification",
588 "local_root,localroot: file quiet = %\@local%/%data_root%",
589 " # Root of volatile pipeline output data",
590 "uniform_local_root,unilocalroot: file quiet ".
591 "= %\@unilocal%/%data_root%",
592 " # Global root of volatile pipeline output data",
593 "run_dir,target_dir,target,chdir,cd: file(in) private",
594 " # Directory to chdir to prior to processing; ".
595 "requires defining params through Env.pm",
596 "compress_mode,compress,gzip: int (0..1) = 1",
597 " # Compression mode (mainly for some FITS out files); ".
598 "0=no, 1=yes",
599 "pixel_sigfigs,sigfigs: int = 4",
600 " # If non-zero, reduce pixel precision of some FITS files",
601 "verbose,v: switch",
602 " # Increase verbosity of informatory output",
603 "log_file,logfile,log: str",
604 " # Write (or inherit) standard log file",
605 " # '1' => do the usual thing.",
606 " # '+' prefix means append.",
607 " # '=' prefix means overwrite (the default).",
608 " # Otherwise assume a literal file name.",
609 "test: switch",
610 " # Do not actually run but display what would be run",
611 "debug,dbg: str private = 0",
612 " # Add targetted debug output",
613 );
614 @defs = _ignore($opts->{ignore},@defs);
# spent 347µs making 1 call to WISE::ParamDefs::_ignore
615 @defs = _only($opts->{only},@defs);
# spent 90µs making 1 call to WISE::ParamDefs::_only
616 return (wantarray
617 ? @defs
618 : \@defs
619 );
620}
621
622sub from {
623 my $this = shift;
624 my $exec = shift;
625 my $opts = shift || {};
626 my @defs = WISE::Params::paramsfrommodel($exec,{%$opts});
627 @defs = _ignore($opts->{ignore},@defs);
628 return (wantarray
629 ? @defs
630 : \@defs
631 );
632}
633
634
# spent 347µs within WISE::ParamDefs::_ignore which was called # once (347µs+0) by WISE::ParamDefs::basic at line 614
sub _ignore {
63560.000183.0e-5 my $ignore = shift;
636 my @defs = @_;
637 return @defs if ! $ignore || ! @defs;
638 $ignore = [ $ignore] if ! ref $ignore;
639 my $ignore_re = join "|",@$ignore;
6401110.000161.4e-6 return grep { ! /(^|[\s,])($ignore_re)($|[,\s:])/ } @defs;
641}
642
643
# spent 90µs within WISE::ParamDefs::_only which was called # once (90µs+0) by WISE::ParamDefs::basic at line 615
sub _only {
64437.7e-52.6e-5 my $only = shift;
645 my @defs = @_;
646 return @defs if ! $only || ! @defs;
647 $only = [ $only] if ! ref $only;
648 my $only_re = join "|",@$only;
649 return grep { /(^|[\s,])($only_re)($|[,\s:])/ } @defs;
650}
651
652
65313.0e-63.0e-61;

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