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

File/wise/base/deliv/dev/lib/perl/WISE/Ingest/Seq.pm
Statements Executed697854
Total Time1.35006700000011 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
15825110.503001.01434WISE::Ingest::Seq::PEF::find_bracketing_events
1110.420300.42032WISE::Ingest::Seq::PEF::index_bracketing_events
1110.187710.18771WISE::Ingest::Seq::PEF::track_events
1110.181601.81513WISE::Ingest::Seq::PEF::load_event_ipactbl
15828410.091070.09109WISE::Ingest::Seq::_isopt
1118.5e-51.81537WISE::Ingest::Seq::PEF::new
1114.2e-54.2e-5WISE::Ingest::Seq::PEF::event_tbl
00000WISE::Ingest::Seq::BEGIN
00000WISE::Ingest::Seq::PEF::BEGIN
00000WISE::Ingest::Seq::PEF::_event_ipactbl_meta
00000WISE::Ingest::Seq::PEF::_get_next_rec
00000WISE::Ingest::Seq::PEF::_slurp_hdr
00000WISE::Ingest::Seq::PEF::build_event_table
00000WISE::Ingest::Seq::PEF::dump_event_ipactbl
00000WISE::Ingest::Seq::PEF::err
00000WISE::Ingest::Seq::PEF::event
00000WISE::Ingest::Seq::PEF::event_ipactbl_meta
00000WISE::Ingest::Seq::PEF::event_num
00000WISE::Ingest::Seq::PEF::hdr
00000WISE::Ingest::Seq::PEF::info
00000WISE::Ingest::Seq::PEF::key_event
00000WISE::Ingest::Seq::PEF::naif
00000WISE::Ingest::Seq::PEF::next_event
00000WISE::Ingest::Seq::PEF::next_key_event
00000WISE::Ingest::Seq::PEF::offset_orbit
00000WISE::Ingest::Seq::PEF::recognize_event

LineStmts.Exclusive
Time		Avg.Code
1#! /usr/bin/env perl
2
333.5e-51.2e-5use strict;
# spent 17µs making 1 call to strict::import
435.4e-51.8e-5use warnings;
# spent 48µs making 1 call to warnings::import
5
6package WISE::Ingest::Seq;
7
8use WISE::Env (
9 mod => 'WISE::Ingest::Seq',
# spent 534µs making 1 call to WISE::Env::import
10 cfglib => '<:LIB:>',
11 version => '$Id: Seq.pm 7112 2010-01-30 00:51:55Z tim $ ',
1233.2e-51.1e-5 );
13
1433.3e-51.1e-5use Exporter::Lite;
# spent 42µs making 1 call to Exporter::Lite::import
1530.000144.5e-5use vars qw(@ISA @EXPORT_OK);
# spent 42µs making 1 call to vars::import
1612.0e-62.0e-6@EXPORT_OK = ();
17
18
# spent 91.1ms (91.1+14µs) within WISE::Ingest::Seq::_isopt which was called 15828 times, avg 6µs/call: # 15825 times (91.0ms+0) by WISE::Ingest::Seq::PEF::find_bracketing_events at line 852, avg 6µs/call # once (20µs+4µs) by WISE::Ingest::Seq::PEF::index_bracketing_events at line 872 # once (16µs+7µs) by WISE::Ingest::Seq::PEF::new at line 272 # once (9µs+3µs) by WISE::Ingest::Seq::PEF::load_event_ipactbl at line 908
sub _isopt {
19316560.052201.6e-6 my $r = @_ ? shift : $_;
20 return ref($r)=~/hash/i && ! UNIVERSAL::isa($r,__PACKAGE__);
# spent 14µs making 3 calls to UNIVERSAL::isa, avg 5µs/call
21}
22
23package WISE::Ingest::Seq::PEF;
24
2535.9e-52.0e-5use vars qw(@ISA @EXPORT_OK);
# spent 41µs making 1 call to vars::import
26
2711.2e-51.2e-5my ($err, $warn) = WISE::Env->err_prefix();
# spent 35µs making 1 call to WISE::Env::err_prefix
28
2911.9e-51.9e-5@ISA = qw(WISE::Ingest::Seq);
30
3133.2e-51.1e-5use Clone;
# spent 40µs making 1 call to Exporter::import
32
3332.5e-58.3e-6use WISE;
# spent 592µs making 1 call to WISE::import
3432.5e-58.3e-6use WISE::Ingest::NAIF;
# spent 19µs making 1 call to Exporter::Lite::import
3531.9e-56.3e-6use File::Basename ();
36
3730.006810.00227use Carp 'confess';
# spent 56µs making 1 call to Exporter::import
38
39# Events subject to long term tracking
4013.0e-63.0e-6my %track = (
41 ANNEAL=>{SCAN=>1},
42 );
43
44# Event types; 0=single event (start==stop),
45# 1=start of a bracketted event,
46# 2=stop of a bracketted event,
47# 3=start and stop of a bracketted event (both times in 1 event),
48# 4=split event boundary, start or stop
49# Types 1&2 are assigned during evaluation of type 4 events
5010.000110.00011my @event_specs = (
51 # Primary
52 {
53 name => 'NEP',
54 id => 1,
55 type => 0, # Single, unbracketed event
56 quick_re => 'N_POLE_CROSS',
57 ev_field => 'comment',
58 ev_re => qr'Spacecraft\s+north\s+pole\s+crossing'ix,
59 data_field => 'event',
60 data_re => qr'GEV,N_POLE_CROSS,.*,(\d+\.[05])0*;'ix,
61 data_names => [qw/orbit_num/],
62 },
63 {
64 name => 'SEP',
65 id => 2,
66 type => 0, # Single, unbracketed event
67 quick_re => 'S_POLE_CROSS',
68 ev_field => 'comment',
69 ev_re => qr'Spacecraft\s+south\s+pole\s+crossing'ix,
70 data_field => 'event',
71 data_re => qr'GEV,S_POLE_CROSS,.*,(\d+\.[05])0*;'ix,
72 data_names => [qw/orbit_num/],
73 },
74 {
75 name => 'SCAN_BNDRY',
76 id => 3,
77 type => 4, # Boundary for bracketed event
78 quick_re => 'SLEW_',
79 ev_field => 'event',
80 ev_re => qr'NOTE,SEQ,.*,
81 (
82 (SLEW_START_(SCAN|SURVEY)_TO_\S+) |
83 (SLEW_SETTLE_\S+_TO_(SURVEY|SCAN)) |
84 (SLEW_START_TO_NEAR_PT_STDBY)
85 )'ix,
86 data_field => 'event',
87 data_re => qr'SLEW_(START|SETTLE)_?
88 (TDRS|SURVEY|SCAN)?
89 _TO_
90 (TDRS|SURVEY|SCAN|NEAR_PT_STDBY)'ix,
91 data_names => [qw/turn_state from to/],
92 },
93 {
94 name => 'SAA',
95 id => 4,
96 type => 3, # Start AND stop times in one event
97 quick_re => 'GEV,SAA',
98 ev_field => 'comment',
99 ev_re => qr'South\s+Atlantic\s+Anomaly'ix,
100 data_field => 'event',
101 data_re => qr'GEV,SAA,.*,
102 (2\d\d\d-\d\d\dT\d\d:\d\d:\d\d\.\d*),'ix,
103 data_names => [qw/end_ydt/],
104 },
105 {
106 name => 'MOON',
107 id => 5,
108 type => 3, # Start AND stop times in one event
109 quick_re => 'GEV,MOON',
110 ev_field => 'comment',
111 ev_re => qr'Moon\s+Near\s+Z-Axis'ix,
112 data_field => 'event',
113 data_re => qr'GEV,MOON_ZAXIS,.*,
114 (2\d\d\d-\d\d\dT\d\d:\d\d:\d\d\.\d*),'ix,
115 data_names => [qw/end_ydt/],
116 },
117 {
118 name => 'NODATA_BNDRY',
119 id => 6,
120 type => 4,
121 quick_re => 'CMD,PLBANDALL',
122 ev_field => 'comment',
123 ev_re => qr'(ENABLE|DISABLE)\s+SCIENCE\s+DATA'ix,
124 data_field => 'comment',
125 data_re => qr'(ENABLE|DISABLE)'ix,
126 data_names => [qw/data_state/],
127 },
128 {
129 name => 'ANNEAL',
130 id => 7,
131 type => 5, # Start AND duration times in one event
132 quick_re => 'NOTE,SEQ,ANNEAL',
133 ev_field => 'event',
134 ev_re => qr'ANNEALING\s+HEATER\s+DRIVE\s+.*\sON\s'ix,
135 data_field => 'event',
136 data_re => qr'\sON\s+TIMER\s*=\s*(\d+)\s*;'ix,
137 data_names => [qw/duration/],
138 },
139 # Informatory
140 {
141 name => 'ANODE',
142 id => 11,
143 type => 0,
144 quick_re => 'GEV,NODE_CROSS',
145 ev_field => 'comment',
146 ev_re => qr'Spacecraft\s+ascending\s+node\s+crossing'ix,
147 data_field => 'event',
148 data_re => qr'GEV,NODE_CROSS,.*,(\d+\.[05])0*;'ix,
149 data_names => [qw/orbit_num/],
150 },
151 {
152 name => 'TDRS_BNDRY',
153 id => 12,
154 type => 4,
155 quick_re => 'TDRS',
156 ev_field => 'event',
157 ev_re => qr'NOTE,SEQ,.*,
158 ((SLEW_START_TDRS_TO_(SURVEY|PT_STDBY)) |
159 (SLEW_COMPLETE_(SURVEY|PT_STDBY)_TO_TDRS))'ix,
160 data_field => 'event',
161 data_re => qr'SLEW_(START|COMPLETE)_
162 (TDRS|SURVEY|SCAN|PT_STDBY)_TO_
163 (TDRS|SURVEY|SCAN|PT_STDBY)'ix,
164 data_names => [qw/turn_state from to/],
165 },
166 {
167 name => '12PM',
168 id => 13,
169 type => 0,
170 quick_re => 'GEV,SUN_NOON',
171 ev_field => 'comment',
172 ev_re => qr'GEV,SUN_NOON'ix,
173 data_field => 'event',
174 data_re => qr'GEV,SUN_NOON,.*,(\d+\.[05])0*;'ix,
175 data_names => [qw/orbit_num/],
176 },
177 {
178 name => '6AM',
179 id => 14,
180 type => 0,
181 quick_re => 'GEV,SUN_6AM',
182 ev_field => 'event',
183 ev_re => qr'GEV,SUN_6AM'ix,
184 data_field => 'event',
185 data_re => qr'GEV,SUN_6AM,.*,(\d+\.[05])0*;'ix,
186 data_names => [qw/orbit_num/],
187 },
188 {
189 name => '6PM',
190 id => 15,
191 type => 0,
192 quick_re => 'GEV,SUN_6PM',
193 ev_field => 'event',
194 ev_re => qr'GEV,SUN_6PM'ix,
195 data_field => 'event',
196 data_re => qr'GEV,SUN_6PM,.*,(\d+\.[05])0*;'ix,
197 data_names => [qw/orbit_num/],
198 },
199 {
200 name => '12AM',
201 id => 16,
202 type => 0,
203 quick_re => 'GEV,SUN_MIDNIGHT',
204 ev_field => 'event',
205 ev_re => qr'GEV,SUN_MIDNIGHT'ix,
206 data_field => 'event',
207 data_re => qr'GEV,SUN_MIDNIGHT,.*,(\d+\.[05])0*;'ix,
208 data_names => [qw/orbit_num/],
209 },
210 {
211 name => 'MOM',
212 id => 17,
213 type => 5, # Start AND duration times in one event
214 quick_re => 'NOTE,SEQ,MOM_DUMP',
215 ev_field => 'event',
216 ev_re => qr'MOMENTUM_UNLOAD_DURATION'ix,
217 data_field => 'event',
218 data_re => qr'MOMENTUM_UNLOAD_DURATION\s*=\s*(\d+:\d+:\d+)\s*;'ix,
219 data_names => [qw/duration/],
220 },
221 {
222 name => 'OCCULT',
223 id => 18,
224 type => 3, # Start AND stop times in one event
225 quick_re => 'GEV,OCCULT',
226 ev_field => 'event',
227 ev_re => qr'GEV,OCCULT'ix,
228 data_field => 'event',
229 data_re => qr'GEV,OCCULT,.*,
230 (2\d\d\d-\d\d\dT\d\d:\d\d:\d\d\.\d*),'ix,
231 data_names => [qw/end_ydt/],
232 },
233 {
234 name => 'IMCAL',
235 id => 19,
236 type => 5, # Start AND duration times in one event
237 quick_re => 'NOTE,SEQ,IMAGE_CAL',
238 ev_field => 'event',
239 ev_re => qr'NOTE,SEQ,IMAGE_CAL'ix,
240 data_field => 'event',
241 data_re => qr'CALIBRATION[\s_]+DURATION[\s_]+FOR\s+(\d+:\d+:\d+)\s*;'ix,
242 data_names => [qw/duration/],
243 },
244 {
245 name => 'SBAND_BNDRY',
246 id => 20,
247 type => 4, # Boundary for bracketed event
248 quick_re => 'TCSXPOWER',
249 ev_field => 'event',
250 ev_re => qr'CMD,TCSXPOWER,.*,STATE='ix,
251 data_field => 'event',
252 data_re => qr'CMD,TCSXPOWER,.*,STATE=(\d+);'ix,
253 data_names => [qw/onoff/],
254 },
255 {
256 name => 'SWITCH',
257 id => 21,
258 type => 0, # Start AND duration times in one event
259 quick_re => ',CMKILLSEQ,',
260 ev_field => 'event',
261 ev_re => qr'CMD,CMKILLSEQ,'ix,
262 data_field => 'event',
263 data_re => qr'FNAME=([^;]+);'ix,
264 data_names => [qw/prevpef/],
265 },
266 );
267
26811.5e-51.5e-5my $quick_re = "(".join(")|(", map { $_->{quick_re} } @event_specs).")";
269
270
# spent 1.82s (85µs+1.82) within WISE::Ingest::Seq::PEF::new which was called # once (85µs+1.82s) by main::load_events at line 335 of /wise/base/deliv/dev/bin/wdate
sub new {
271218.3e-54.0e-6 my $class = shift;
272 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 23µs making 1 call to WISE::Ingest::Seq::_isopt
273 my $file = shift;
274 my $fromtbl = $opts->{from_tbl};
275 my $naif = $opts->{naif};
276 my $this = {};
277 $class = ref($class) || $class;
278
279 $this->{file} = $file;
280 $this->{from_tbl} = $fromtbl;
281 $this->{base} = File::Basename::basename($file);
# spent 133µs making 1 call to File::Basename::basename
282 $this->{verbose} = $opts->{verbose};
283 $this->{pef_ydt_start} = $opts->{pef_ydt_start};
284 $this->{pef_t_start} = WISE::Time::Str_time($this->{pef_ydt_start},{z=>1})
285 if $this->{pef_ydt_start};
286 $this->{pef_t_end} = WISE::Time::Str_time($this->{pef_ydt_end}, {z=>1})
287 if $this->{pef_ydt_end};
288 $this->{pef_t_end} = $opts->{pef_ydt_end};
289 $this->{naif} = $naif;
290 $this->{tls} = $opts->{tls} // '/wise/fops/ref/mos/naif/wise.tls';
291 $this->{tsc} = $opts->{tsc} // '/wise/fops/ref/mos/naif/wise.tsc';
292 $this->{debug} = $opts->{debug};
293
29421.3e-56.5e-6 if(! $fromtbl) {
295 # Parse a PEF file
296 my $fh;
297 print "Loading PEF file '$file' ...\n" if $this->{verbose};
298 open($fh, "<", $file)
299 or die "$err: Unable to open '$file'; $!.\n";
300
301 $this->{fh} = \$fh;
302 $this->{hdr} = _slurp_hdr($this,$fh);
303 $this->{next} = {};
304 $this->{event_num} = 0;
305 } else {
306 # Load an event table
307 print "Loading event table file '$file' ...\n" if $this->{verbose};
308 load_event_ipactbl($this,$file,{orbitoff=>$opts->{orbitoff}});
# spent 1.82s making 1 call to WISE::Ingest::Seq::PEF::load_event_ipactbl
309 }
310
311 return bless $this, $class;
312}
313
314sub naif {
315 my $this = shift;
316 my $opts = @_ && _isopt($_[-1]) ? pop : {};
317 my $naif = shift;
318 if(defined $naif) {
319 $this->{naif} = $naif;
320 }
321 return $this->{naif};
322}
323
324sub build_event_table {
325 my $this = shift;
326 my $opts = @_ && _isopt($_[-1]) ? pop : {};
327 my $pretbl = $opts->{pre_tbl}; # The previous event table
328 my @keep = @{ $opts->{keep} || [] }; # Needed events (empty=all known)
329 my @not = @{ $opts->{not} || [] }; # Events to skip
330 my $tls = $opts->{tls} // $this->{tls} // '/wise/fops/ref/mos/naif/wise.tls';
331 my $tsc = $opts->{tsc} // $this->{tsc} // '/wise/fops/ref/mos/naif/wise.tsc';
332 my $tbuf = 10; # Time clearance around commands required for switch to new file
333 my $t2ovlap = 300; # Time to good overlap period from nominal file start time
334 my $scan_max_dur = $opts->{scan_max_dur} // 6000; # Max. scan duration before punting
335 my $good_scan_letters = "abxz";
336 my @tbl; # Output table
337 my %open; # Opened but unclosed events
338 my $scan_letter = 'z'; # Scan started before we get a pole crossing
339 my $orbit; # Running current orbit number
340 my %used_scan_ids; # Track used scan IDs
341 my $fakeorbit = 90000; # In case the file is bad, still want scan IDs
342 my $verbose = $opts->{verbose} // $this->{verbose};
343 my $append = $opts->{append}; # No longer used. Always append the pre-table.
344 my $t_boundary = $opts->{t_boundary}; # Proposed switch time
345 my %keep = map { (lc($_)=>1) } @keep;
346 my %not = map { (lc($_)=>1) } @not;
347 my $naif = $opts->{naif} || $this->{naif};
348 die "$err: Can't specify both keep and not.\n"
349 if %keep && %not;
350
351 my @pretbl;
352
353 if($pretbl) {
354 if(ref $pretbl) {
355 @pretbl = @$pretbl;
356 } else {
357 # File name to open and load
358 print "Loading preceding table '$pretbl' ...\n"
359 if $verbose;
360 my $pre = WISE::IPACTbl->new($pretbl)
361 or die "$err: Can't load pre-table '$pretbl'.\n";
362 @pretbl = $pre->data({hashrow=>1});
363 }
364 }
365
366 my $file_t0 = $this->{hdr}{start_t};
367 my $file_t1 = $this->{hdr}{end_t};
368
369 my ($force_switch,$t_switch,$utc_switch);
370 if($t_boundary) {
371 # Proposed or forced switch time
372 $force_switch = $t_boundary =~ s/^=//;
373 my $tmp = WISE::Time::Str_time($t_boundary,{z=>1})
374 or die "$err: Boundary time '$t_boundary' not parseable.\n";
375 $t_boundary = $tmp;
376 if($force_switch) {
377 $t_switch = $t_boundary;
378 $utc_switch = WISE::Time::Time_str($t_switch,{form=>4});
379 }
380 } else {
381 # Default proposed boundary time
382 $t_boundary = $file_t0+$t2ovlap-$tbuf/2;
383 }
384 my $utc_boundary = WISE::Time::Time_str($t_boundary,{form=>4});
385
386 my $recnum = 0;
387 my ($pre_t1,$pre_ydt1,$pre_rec1,$pre_name1);
388
389 if(@pretbl) {
390 # Rebuild event history from extant table.
391 # Initialize orbit, used scan IDs, and pending (open) events
392 # by searching through the previous event table
393 print "Scanning preceding event table for switch time and open events ...\n"
394 if $verbose;
395 print "Switch around $utc_boundary.\n" if $verbose;
396 my $t_last;
397 my $i = 0;
398 for my $ev (@pretbl) {
399 my ($ydt,$t) = ($ev->{ydt},
400 WISE::Time::Str_time($ev->{ydt},{z=>1}));
401 my $t_next;
402 $t_next = WISE::Time::Str_time($pretbl[$i+1]->{ydt},{z=>1})
403 if $pretbl[$i+1];
404 # We can skip the rest of the overlap if:
405 # - We already have a switch time selected (forced) and we've passed it
406 last if $t_switch && $t >= $t_switch;
407 # ... or ...
408 # - We're past the start of the new file and the 5 min. runup period
409 # (or past the specified time)
410 # - The current and preceding events were 5 secs away from the boundary
411 if($t >= $t_boundary+$tbuf/2) {
412 if(! $t_last || $t_boundary >= $t_last+$tbuf/2) {
413 # Can switch
414 $t_switch = $t_boundary;
415 $utc_switch = WISE::Time::Time_str($t_switch,{form=>4});
416 print "Making switch to new file at $utc_switch (event time $ydt) ...\n"
417 if $verbose;
418 last;
419 } else {
420 # Can't switch here, move boundary forward to next proposed spot
421 $t_boundary = $t + $tbuf/2;
422 }
423 }
424 my ($ydt_end,$t_end);
425 ($ydt_end,$t_end) = ($ev->{end_ydt},
426 WISE::Time::Str_time($ev->{end_ydt},{z=>1}))
427 if $ev->{end_ydt} && ($ev->{type}//-1) == 4;
428 # Save the latest time recorded from the pre-table. It might
429 # be the end time of a split (type 4) event.
430 my $last = $t_end || $t;
431 if(! $pre_t1 || $last > $pre_t1) {
432 $pre_t1 = $last;
433 $pre_ydt1 = $ydt_end || $ydt;
434 $pre_rec1 = $recnum;
435 $pre_name1 = $ev->{name};
436 }
437 if($ev->{scan_id} && $ev->{name} =~ /^SCAN/) {
438 # Note that a particular scan ID has already been
439 # seen, so we can enforce uniqueness and properly
440 # assign subsequent scan IDs correctly by tracking
441 # the last scan letter used.
442 $used_scan_ids{$ev->{scan_id}} = $ev->{ydt};
443 ($scan_letter) = $ev->{scan_id} =~ /([a-z])$/;
444 ++$scan_letter;
445 }
446 if($ev->{name} =~ /^[SN]EP/) {
447 # Pole crossing; reset scan letter until overridden by a scan
448 $scan_letter = 'a';
449 }
450 if(defined $ev->{orbit}) {
451 # Track the orbit so when we start processing the new file
452 # we can pick up where we left off.
453 $orbit = $ev->{orbit};
454 }
455 if($ev->{name} =~ /^(.*)_BNDRY$/ && $ev->{type} == 1) {
456 # If this is a start boundary event, add an entry in %open
457 my $name = $1;
458 $open{$name} = {ydt=>$ev->{start_ydt}, recnum=>$recnum};
459 }
460 if($open{$ev->{name}} && $ev->{type} == 1) {
461 warn "$warn: Unmatched $ev->{name} event at ".
462 "$open{$ev->{name}}{ydt} superceded by ".
463 "closed event at $ev->{ydt}.\n"
464 if $ev->{name} !~ /nodata/i;
465 $open{$ev->{name}} = undef;
466 }
467 push @tbl,$ev;
468 ++$recnum;
469 ++$i;
470 $t_last = $t if ! $t_last || $t != $t_last;
471 }
472 }
473
474 die "$err: Current file completely contained within extant ".
475 "event time range:\n".
476 "$err: Prev range=$this->{hdr}{start_ydt} to $this->{hdr}{end_ydt}\n".
477 "$err: Curr end =$pre_ydt1\n".
478 "$err: File =$this->{file}\n"
479 if @pretbl && $file_t1 <= $pre_t1;
480
481 if($t_switch && @tbl) {
482 # We have a switch time, so now we have to go through the pre-table
483 # and look for bracketed events that start before the switch time but
484 # end after and re-open them
485 my $recnum = 0;
486 for my $ev (@tbl) {
487 my ($ydt0,$ydt1) = ($ev->{start_ydt},$ev->{end_ydt});
488 my ($t0,$t1) = (WISE::Time::Str_time($ydt0,{z=>1}),
489 WISE::Time::Str_time($ydt1,{z=>1}))
490 if $ydt0 && $ydt1;
491 if($ev->{type} == 1 && $ydt0 && $ydt1 &&
492 $t0 < $t_switch && $t1 >= $t_switch) {
493 my $name = $ev->{name};
494 if(! $open{$name} || $ydt0 > $open{$name}{ydt}) {
495 print "Re-opening event $name that ran $ydt0 to $ydt1.\n" if $verbose;
496 warn "$warn: Re-open orphans previous open event at $open{$name}{ydt}.\n"
497 if $open{$name};
498 $ev->{name} .= '_BNDRY';
499 $ev->{end_ydt} = undef;
500 $ev->{duration} = undef;
501 $ev->{end_et} = undef;
502 $open{$name} = {ydt=>$ydt0, recnum=>$recnum};
503 }
504 }
505 ++$recnum;
506 }
507 }
508
509 EVENT: while(my $info = $this->next_key_event($opts)) {
510
511 my $tev = WISE::Time::Str_time($info->{ydt},{z=>1});
512
513 # Skip events that are in the overlap period
514 if($t_switch && @pretbl) {
515 next if $tev <= $t_switch;
516 }
517
518 # Set start/end times based on event type
519 if( $info->{type} == 0) { # Instantaneous event
520 $info->{start_ydt} = undef;
521 $info->{end_ydt} = undef;
522 } elsif ($info->{type} == 1) { # Start of an event pair
523 $info->{start_ydt} = $info->{ydt};
524 $info->{end_ydt} = undef;
525 } elsif ($info->{type} == 2) { # End of an event pair
526 $info->{start_ydt} = undef;
527 $info->{end_ydt} = $info->{ydt};
528 } elsif ($info->{type} == 3) { # Start and end of an event
529 $info->{start_ydt} = $info->{ydt};
530 $info->{end_ydt} = $info->{data}{end_ydt};
531 } elsif ($info->{type} == 4) { # Paired event; two times given
532 $info->{start_ydt} = undef; # Times deduced below
533 $info->{end_ydt} = undef;
534 } elsif ($info->{type} == 5) { # Start and duration of an event given
535 $info->{start_ydt} = $info->{ydt};
536 my $dt = $info->{data}{duration};
537 if($dt =~ /^(\d+):(\d+):(\d+)$/) {
538 my($h,$m,$s) = ($1,$2,$3);
539 $dt = $h*3600+$m*60+$s;
540 }
541 $info->{end_ydt} = WISE::Time::Time_str($tev+$dt,{form=>4});
542 }
543
544 # Event-specific special handling, especially scan start/end pairing
545 if($info->{name} =~ /^[SN]EP/) {
546 # Pole crossing
547 my $orbnum = $info->{data}{orbit_num};
548 # Deal with any possible strange numeric precision issues
549 $orbit = sprintf("%.1f",$orbnum+0.01);
550 # Initialize the scan-letter by half-orbit
551 $scan_letter = 'a';
552 } elsif($info->{name} eq 'SCAN_BNDRY') {
553 # Scan start or stop
554 if($info->{data}{turn_state} =~ /^SETTLE|COMPLETE$/) {
555 # Start of a scan ('STOP' refers to the end of a turn)
556 $info->{start_ydt} = $info->{ydt};
557 # Compute scan ID
558 my $scanid;
559 if(defined $orbit) {
560 $scanid = sprintf("%05d",int(2*$orbit+.01));
561 } else { # Fallback
562 warn "$warn: Orbit number not yet set at scan start at ".
563 "$info->{ydt}.\n";
564 $scanid = sprintf("%05d",$fakeorbit++);
565 $scan_letter = 'p';
566 }
567 $info->{scan_id} = $scanid = $scanid.$scan_letter;
568 warn "$warn: Scan ID $scanid already seen at time ".
569 "$used_scan_ids{$scanid} and again at $info->{ydt}.\n"
570 if $used_scan_ids{$scanid}; # Belt and suspenders
571 warn "$warn: Scan $scanid starting at $info->{ydt} employs ".
572 "a scan letter beyond the pale.\n"
573 if $scan_letter !~ /[$good_scan_letters]/;
574 $used_scan_ids{$scanid} = $info->{ydt};
575 ++$scan_letter; # Alpha increment
576 if($open{SCAN}) {
577 warn "$warn: Unterminated scan at $open{SCAN}{ydt}; ".
578 "replaced at $info->{ydt}.\n";
579 # This scan will be lost
580 }
581 # Indicate we have an open scan.
582 $open{SCAN} = {ydt=>$info->{start_ydt}, recnum=>$recnum};
583 # Post-facto set this as the start of a bracketting pair
584 $info->{type} = 1;
585 } else {
586 # End of a scan
587 # Look for an open scan and fill in that event's stop time
588 $info->{end_ydt} = $info->{ydt};
589 if($open{SCAN}) {
590 my $row = $tbl[$open{SCAN}{recnum}];
591 my $t1 = WISE::Time::Str_time($open{SCAN}{ydt},{z=>1});
592 my $t2 = WISE::Time::Str_time($info->{ydt}, {z=>1});
593 my $scandur = $t2-$t1;
594 if($scan_max_dur > 0 && $scandur > $scan_max_dur) {
595 warn "$warn: Unterminated scan at $open{SCAN}{ydt}; ".
596 "too long ($scandur secs), removed at $info->{ydt}.\n";
597 # This scan will be lost
598 } else {
599 $row->{end_ydt} = $info->{ydt};
600 $row->{name} = 'SCAN'; # Rename for clarity and distinction
601 }
602 $open{SCAN} = undef; # Close scan
603 # Do not add to the table
604 next EVENT;
605 } else {
606 # !!! We won't always want this warning, at least
607 # not without some additional logic, since most
608 # deliveries will have an unterminated scan at the
609 # beginning and end
610 # E.g. we don't want this warning at all if the target
611 # of the turn is pt. stdby
612 if($info->{data}{to} !~ /pt_stdby/i) {
613 warn "$warn: Uninitialized scan at $info->{ydt}.\n";
614 # Post-facto set this as the end of a bracketting pair
615 $info->{type} = 2;
616 }
617 }
618 }
619 } elsif($info->{name} eq 'NODATA_BNDRY') {
620 if($info->{data}{data_state} eq 'DISABLE') {
621 $open{NODATA} = {ydt=>$info->{start_ydt}, recnum=>$recnum};
622 $info->{start_ydt} = $info->{ydt};
623 $info->{type} = 1;
624 } else {
625 $info->{end_ydt} = $info->{ydt};
626 if($open{NODATA}) {
627 my $row = $tbl[$open{NODATA}{recnum}];
628 $row->{end_ydt} = $info->{ydt};
629 $row->{name} = 'NODATA';
630 $open{NODATA} = undef;
631 next EVENT;
632 } else {
633 $info->{type} = 2;
634 }
635 }
636 } elsif($info->{name} eq 'TDRS_BNDRY') {
637 if($info->{data}{turn_state} eq 'COMPLETE') {
638 $open{TDRS} = {ydt=>$info->{start_ydt}, recnum=>$recnum};
639 $info->{start_ydt} = $info->{ydt};
640 $info->{type} = 1;
641 } else {
642 $info->{end_ydt} = $info->{ydt};
643 if($open{TDRS}) {
644 my $row = $tbl[$open{TDRS}{recnum}];
645 $row->{end_ydt} = $info->{ydt};
646 $row->{name} = 'TDRS';
647 $open{TDRS} = undef;
648 next EVENT;
649 } else {
650 $info->{type} = 2;
651 }
652 }
653 } elsif($info->{name} eq 'SBAND_BNDRY') {
654 if($info->{data}{onoff} eq '1') {
655 $open{SBAND} = {ydt=>$info->{start_ydt}, recnum=>$recnum};
656 $info->{start_ydt} = $info->{ydt};
657 $info->{type} = 1;
658 } else {
659 $info->{end_ydt} = $info->{ydt};
660 if($open{SBAND}) {
661 my $row = $tbl[$open{SBAND}{recnum}];
662 $row->{end_ydt} = $info->{ydt};
663 $row->{name} = 'SBAND';
664 $open{SBAND} = undef;
665 next EVENT;
666 } else {
667 $info->{type} = 2;
668 }
669 }
670 } elsif($info->{name} =~ /^(ASCE|DESC)_BNDRY$/) {
671 my $aord = $1;
672 if($info->{data}{start}) {
673 $open{$aord} = {ydt=>$info->{start_ydt}, recnum=>$recnum};
674 $info->{start_ydt} = $info->{ydt};
675 my $scanid = sprintf("%05d",int(2*$orbit+.01));
676 $info->{scan_id} = $scanid.'x';
677 $info->{type} = 1;
678 } else {
679 $info->{end_ydt} = $info->{ydt};
680 if($open{$aord}) {
681 my $row = $tbl[$open{$aord}{recnum}];
682 $row->{end_ydt} = $info->{ydt};
683 $row->{name} = $aord;
684 $open{$aord} = undef;
685 next EVENT;
686 } else {
687 $info->{type} = 2;
688 }
689 }
690 } elsif($info->{name} eq 'ANODE' && defined $orbit) {
691 # Ascending node crossing
692 my $orbnum = $info->{data}{orbit_num};
693 # Deal with any possible strange numeric precision issues
694 $orbnum = sprintf("%.1f",$orbnum+0.01);
695 warn "$warn: Pole/node crossing orbit nums out of sync ".
696 "at $info->{ydt}; pole orbit=$orbit, node orbit=$orbnum.\n"
697 if $orbnum != $orbit;
698 }
699
700 # Add other known info to this event
701 $info->{orbit} = $orbit;
702
703 # Add to table
704 push @tbl, $info;
705 ++$recnum;
706
707 } # EVENT
708
709 if($open{SCAN}) {
710 warn "$warn: Unterminated scan at $open{SCAN}{ydt}.\n";
711 # This scan will probably be found in the next delivery
712 }
713
714 # Drop unwanted events
715 if(%keep || %not) {
716 @tbl = (grep { (%keep && $keep{lc $_->{name}}) ||
717 (%not && ! $not{ lc $_->{name}}) }
718 @tbl);
719 }
720
721 # Add offset to all orbit numbers
722 if($opts->{orbitoff}) {
723 offset_orbit(\@tbl,$opts->{orbitoff});
724 }
725
726 if($tls && $tsc) {
727 # Convert to ephem. time
728
729 if(! $naif) {
730 $naif = WISE::Ingest::NAIF->new({
731 tls => $tls,
732 tsc => $tsc,
733 });
734 }
735
736 for my $info (@tbl) {
737 $info->{et} = $naif->utc2et($info->{ydt});
738 $info->{vtc} = $naif->sce2c_secs($info->{et});
739 $info->{start_et} = $naif->utc2et($info->{start_ydt})
740 if $info->{start_ydt};
741 $info->{end_et} = $naif->utc2et($info->{end_ydt})
742 if $info->{end_ydt};
743 $info->{duration} = sprintf("%.3f",
744 $info->{end_et}-$info->{start_et})
745 if $info->{start_ydt} && $info->{end_ydt};
746 }
747 }
748
749 # Track elapsed time since certain events occured
750 track_events(\@tbl);
751
752 $this->{event_tbl} = \@tbl;
753
754 return wantarray ? @tbl : \@tbl;
755}
756
757sub next_key_event {
758 my $this = shift;
759 my $opts = @_ && _isopt($_[-1]) ? pop : {};
760
761 my ($rc,$virt,$info);
762
763 my $prev = $this->{key_event}; # The previous event, if any
764
765 if($prev) {
766 # Make a fake (virtual) bracketing events out of various
767 # geomteric events which have already been read.
768 $rc = -1;
769 $virt = Clone::clone($prev); # Copy
770 if($virt->{name} eq 'NEP') {
771 # Start a descending scan
772 $virt->{name} = 'DESC_BNDRY';
773 $virt->{id} = 101;
774 $virt->{type} = 4;
775 $virt->{data} = { start => 1 };
776 $info = $virt;
777 } elsif($virt->{name} eq 'DESC_BNDRY' && $virt->{data}{start}) {
778 # End an ascending scan
779 $virt->{name} = 'ASCE_BNDRY';
780 $virt->{id} = 102;
781 $virt->{type} = 4;
782 $virt->{data} = { end => 1 };
783 $info = $virt;
784 } elsif($virt->{name} eq 'SEP') {
785 # Start an ascending scan
786 $virt->{type} = 4;
787 $virt->{id} = 102;
788 $virt->{name} = 'ASCE_BNDRY';
789 $virt->{data} = { start => 1 };
790 $info = $virt;
791 } elsif($virt->{name} eq 'ASCE_BNDRY' && $virt->{data}{start}) {
792 # End a descending scan
793 $virt->{type} = 4;
794 $virt->{id} = 101;
795 $virt->{name} = 'DESC_BNDRY';
796 $virt->{data} = { end => 1 };
797 $info = $virt;
798 }
799 }
800 # No virtual event assigned, so look for a real one
801 if(! $info) {
802 # Search PEF for next key event
803 while($rc = $this->next_event($opts)) {
804 last if $info = $this->recognize_event();
805 }
806 }
807 return $rc if ! $rc;
808 $this->{key_event} = $info;
809 return $info;
810}
811
812sub next_event {
813 my $this = shift;
814 my $opts = @_ && _isopt($_[-1]) ? pop : {};
815
816 $this->{prev} = { %{ $this->{next} } }; # Copy
817 my $next = -1;
818 # Retrieve a new, real event, skipping unwanted records
819 while($next && ! ref $next && $next < 0) {
820 $next = _get_next_rec($this,${$this->{fh}},$opts)
821 }
822 $this->{next} = $next if $next;
823 $this->{eof} = 1 if defined $next && $next == 0;
824 $this->{err} = 1 if ! defined $next;
825 $this->{last} = 1 if ! $next;
826 return $next;
827}
828
829sub recognize_event {
830 my $this = shift;
831 my $opts = @_ && _isopt($_[-1]) ? pop : {};
832 my ($event_name, $event_id, $yd, $type, $spec, %data);
833 return 0 if $this->{next}{rec} !~ m/$quick_re/i;
834 my $ev = $this->{next};
835 # We may have matched something. Find out what.
836 ($spec) = (grep {$ev->{$_->{ev_field}} =~ m/$_->{ev_re}/}
837 @event_specs);
838 return 0 if ! $spec; # Nope, false alarm
839 # Found one. Extract info
840 if($spec->{data_re}) {
841 # Get other data from the field, if any
842 @data{@{$spec->{data_names}}} =
843 $ev->{$spec->{data_field}} =~ m/$spec->{data_re}/;
844 }
845 my %info = (name=>$spec->{name}, id=>$spec->{id}, type=>$spec->{type},
846 ydt=>$ev->{ydt}, file=>$this->{base}, data=>\%data);
847 return wantarray ? %info : \%info;
848}
849
850
# spent 1.01s (503ms+511ms) within WISE::Ingest::Seq::PEF::find_bracketing_events which was called 15825 times, avg 64µs/call: # 15825 times (503ms+511ms) by main::get_event_info at line 438 of /wise/base/deliv/dev/bin/wdate, avg 64µs/call
sub find_bracketing_events {
8512057250.293771.4e-6 my $this = shift;
852 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 91.0ms making 15825 calls to WISE::Ingest::Seq::_isopt, avg 6µs/call
853 my $et = shift;
854 my $binsz= $opts->{binsz} || 1000;
855 my $tbl = $opts->{event_tbl} || $this->{event_tbl};
856 my $ix = $opts->{event_ix} || $this->{event_ix};
857 $ix ||= $this->index_bracketing_events({event_tbl=>$tbl,binsz=>$binsz});
# spent 420ms making 1 call to WISE::Ingest::Seq::PEF::index_bracketing_events
858 my $bin = int($et / $binsz);
859 my $range = $ix->{$bin};
860 return [] if ! $range || ! @$range;
861 my @subset;
862 for my $try (@$range) {
8631163030.206861.8e-6 if($et >= $try->{start_et} && $et <= $try->{end_et}) {
864 push @subset, $try;
865 }
866 }
867 return \@subset;
868}
869
870
# spent 420ms (420+24µs) within WISE::Ingest::Seq::PEF::index_bracketing_events which was called # once (420ms+24µs) by WISE::Ingest::Seq::PEF::find_bracketing_events at line 857
sub index_bracketing_events {
87182.5e-53.1e-6 my $this = shift;
872 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 24µs making 1 call to WISE::Ingest::Seq::_isopt
873 my $tbl = $opts->{event_tbl} || $this->{event_tbl};
874 my $binsz= $opts->{binsz} || 1000;
875 my $ix;
876 for my $row (@$tbl) {
8771130990.216531.9e-6 next if ! $row->{start_et} || ! $row->{end_et};
878 my $bin0 = int($row->{start_et}/$binsz);
879 my $bin1 = int($row->{end_et} /$binsz) + 1;
880 for my $bin ($bin0..$bin1) {
881863740.203742.4e-6 push @{$ix->{$bin}}, $row;
882 }
883 }
884 $this->{event_ix} = $ix;
885 return $ix;
886}
887
888sub dump_event_ipactbl {
889 my $this = shift;
890 my $opts = @_ && _isopt($_[-1]) ? pop : {};
891 my $file = shift || '-';
892 require WISE::IPACTbl;
893 my $ev = $opts->{tbl} || $this->{event_tbl};
894 my $tbl = WISE::IPACTbl->new($file,'w',
895 {
896 meta => _event_ipactbl_meta($this),
897 data => $ev,
898 fast => 1,
899 })
900 or die "$err: Unable to init IPAC table file '$file'.\n";
901 $tbl->data($ev)
902 or die "$err: Unable to write IPAC table file '$file'.\n";
903 return 1;
904}
905
906
# spent 1.82s (182ms+1.63) within WISE::Ingest::Seq::PEF::load_event_ipactbl which was called # once (182ms+1.63s) by WISE::Ingest::Seq::PEF::new at line 308
sub load_event_ipactbl {
907100.181660.01817 my $this = shift;
908 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 12µs making 1 call to WISE::Ingest::Seq::_isopt
909 my $file = shift || $opts->{file};
910 require WISE::IPACTbl;
911 my $tbl = WISE::IPACTbl->new($file,{fast=>1})
# spent 577ms making 1 call to WISE::IPACTbl::new
912 or die "$err: Unable to init events from IPAC table file '$file'.\n";
913 my $rows = $tbl->data({hashrow=>1})
# spent 869ms making 1 call to WISE::IPACTbl::data
914 or die "$err: Unable to read IPAC event table file '$file'.\n";
915 $this->{event_tbl} = $rows;
916 # Add offset to all orbit numbers
917 if($opts->{orbitoff}) {
918 offset_orbit($rows,$opts->{orbitoff});
919 }
920 # Track elapsed time since certain events occured
921 track_events($rows);
# spent 188ms making 1 call to WISE::Ingest::Seq::PEF::track_events
922 return $rows;
923}
924
925
# spent 42µs within WISE::Ingest::Seq::PEF::event_tbl which was called # once (42µs+0) by main::load_events at line 342 of /wise/base/deliv/dev/bin/wdate
sub event_tbl {
92639.0e-63.0e-6 my $this = shift;
927 my $opts = @_ && _isopt($_[-1]) ? pop : {};
928 return $this->{event_tbl};
929}
930
931sub offset_orbit {
932 my $rows = shift;
933 my $off = shift;
934 return if ! $rows || ! @$rows || ! $off;
935 warn "$warn: Applying offset of $off to orbit numbers.\n";
936 for my $info (@$rows) {
937 if(defined $info->{orbit}) {
938 $info->{orbit} += $off;
939 if($info->{scan_id}) {
940 $info->{scan_id} = sprintf("%05d%1s",
941 $info->{orbit}*2,
942 substr($info->{scan_id},-1,1));
943 }
944 }
945 }
946 return 1;
947}
948
949
# spent 188ms within WISE::Ingest::Seq::PEF::track_events which was called # once (188ms+0) by WISE::Ingest::Seq::PEF::load_event_ipactbl at line 921
sub track_events {
95032.2e-57.3e-6 my $tbl = shift;
951
95241.8e-54.5e-6 if(%track) { # Are we tracking anything?
953 my %lasttrack; # Saved events we want to track
954 my %lastwant; # Saved events that want to track something
955 # Compose hash to find what events want to know about tracked events
956 my %wants = map { ($_ => 1) } map { (keys %$_) } values %track;
957 for my $info (@$tbl) { # Step through full event table
9581198500.133581.1e-6 my $name = $info->{name};
9595600.000801.4e-6 if($track{$name}) {
960 # Have we already seen an event that's tracking this one?
961 for my $want (keys %lastwant) { # Who wants something
9628400.002633.1e-6 if($track{$name}{$want}) { # Yup, we want this event
963 my $last = $lastwant{$want};
964 if($last->{start_et} && $last->{end_et} &&
965 $info->{et} >= $last->{start_et} &&
966 $info->{et} <= $last->{end_et}
967 ) {
968 push @{$last->{tracked}{$name}},
969 {ev => $info,
970 et => $info->{et},
971 dt => $last->{et} - $info->{et}
972 };
973 #print "--- 1: Added $name at $info->{ydt} to ".
974 # "$last->{name} at $last->{ydt}; ",
975 # "Now ".@{$last->{tracked}{$name}}." deep. ".
976 # "Dt=",$last->{et} - $info->{et},"\n";
977 }
978 }
979 }
980 $lasttrack{$name} = $info; # Save last event info for events we're tracking
981 }
98295460.012431.3e-6 if($wants{$name}) {
983 # Event $name wants to track something. Look and see if we've seen one
984 for my $tracked (keys %track) { # Step through events to be tracked
985138090.038202.8e-6 next if ! $track{$tracked}{$name}; # Doesn't want this ($name) event
986 next if ! $lasttrack{$tracked}; # Haven't seen one of these yet
987 # We've seen an event that $name wants to track
988 push @{$info->{tracked}{$tracked}},
989 {ev => $info,
990 et => $lasttrack{$tracked}{et},
991 dt => $info->{et} - $lasttrack{$tracked}{et}
992 };
993 #print "--- 2: Added $tracked at $lasttrack{$tracked}{ydt} ".
994 # "to $name at $info->{ydt}; ",
995 # "Now ".@{$info->{tracked}{$tracked}}." deep. ".
996 # "Dt=",$info->{et} - $lasttrack{$tracked}{et},"\n";
997 }
998 $lastwant{$name} = $info;
999 }
1000 }
1001 }
1002
1003 return 1;
1004}
1005
1006sub hdr {
1007 my $this = shift;
1008 my $opts = @_ && _isopt($_[-1]) ? pop : {};
1009 return $this->{hdr};
1010}
1011
1012sub info {
1013 my $this = shift;
1014 my $opts = @_ && _isopt($_[-1]) ? pop : {};
1015 return $this->{next};
1016}
1017
1018sub event {
1019 my $this = shift;
1020 my $opts = @_ && _isopt($_[-1]) ? pop : {};
1021 return $this->{next}{event};
1022}
1023
1024sub event_num {
1025 my $this = shift;
1026 my $opts = @_ && _isopt($_[-1]) ? pop : {};
1027 return $this->{event_num};
1028}
1029
1030sub key_event {
1031 my $this = shift;
1032 my $opts = @_ && _isopt($_[-1]) ? pop : {};
1033
1034 return $this->{key_event};
1035}
1036
1037sub err {
1038 my $this = shift;
1039 my $opts = @_ && _isopt($_[-1]) ? pop : {};
1040 return $this->{err};
1041}
1042
1043sub event_ipactbl_meta {
1044 my $this = shift;
1045
1046 return _event_ipactbl_meta();
1047}
1048
1049# Parts of a sample PEF header:
1050
1051#SPACECRAFT_NAME = WISE;
1052#APPLICABLE_START_TIME = 2010-010T23:54:59.000;
1053#APPLICABLE_STOP_TIME = 2010-016T12:04:59.000;
1054#PRODUCT_CREATION_TIME = 2009-245T21:03:10;
1055#SEQ_ID = WIS_WSEQ_1003_1A;
1056#*OPERATOR Toni Feldman
1057#*SEQGEN V28.2 Thu Mar 10 11:42:07 PST 2005
1058#*CONTEXT Wed Aug 26 18:31:22 2009 /home/MPSSS/sol9/dev/adapt/WISE.cvf
1059#*SC_MODEL Wed Aug 26 19:45:57 2009 /home/MPSSS/sol9/dev/adapt/WISE_CMD_DEF.smf
1060#*SC_MODEL Fri Jul 24 18:11:33 2009 /home/MPSSS/sol9/dev/adapt/WISE_OEF.smf
1061#*SC_MODEL Fri Jul 24 18:11:33 2009 /home/MPSSS/sol9/dev/adapt/WISE_EVENTS.smf
1062#*CATALOG Wed Sep 2 21:02:24 2009 /home/MPSSS/sol9/dev/adapt/WISE_BLKS.satf
1063#*CATALOG Fri Jul 24 18:11:33 2009 /home/MPSSS/sol9/dev/adapt/WISE_PROCEDURES.satf
1064#*CLOCK Fri Jul 24 18:11:33 2009 /home/MPSSS/sol9/dev/adapt/WISE.sclk
1065#*SEQUENCE Wed Sep 2 21:03:10 2009 /home/MPST/seq_dirs/WISE/WIS_WSEQ_1003_1A/WIS_WSEQ_1003_1A.sasf
1066
1067# Parse the above header
1068sub _slurp_hdr {
1069 my $this = shift;
1070 my $fh = shift;
1071 my $hdrtxt = $_;
1072 my $line;
1073 while(defined ($line = <$fh>) && $line !~ /\$\$EOH/) {
1074 $hdrtxt .= $line;
1075 }
1076 die "$err: Unable to read header from '$this->{file}'; $!."
1077 if ! defined $line;
1078 die "$err: No header found in '$this->{file}'."
1079 if ! $hdrtxt;
1080 # Check prerequisites
1081 my @bad;
1082 for my $pat ('CONTEXT .* \.cvf',
1083 'SC_MODEL .* DEF \.smf',
1084 'SC_MODEL .* OEF \.smf',
1085 'SC_MODEL .* EVENTS \.smf',
1086 'CATALOG .* BLKS \.satf',
1087 'CATALOG .* PROCEDURES \.satf',
1088 'CLOCK .* \.sclk',
1089 'SEQUENCE .* \.sasf',
1090 ) {
1091 push @bad, $pat if $hdrtxt !~ m|\n\s*\*$pat\s*\n|x;
1092 }
1093 warn "$warn: Missing file prerequisite(s) in PEF '$this->{file}'.\n",
1094 "$warn: Missing pattern='".join("'\n$warn: Missing pattern='",@bad),"'\n"
1095 if @bad;
1096 # Capture header values
1097 my %hdr;
1098 @hdr{qw/sc_name start_ydt end_ydt create_ydt seq_id operator seqgen_vsn/} =
1099 $hdrtxt =~
1100 /
1101 ^ SPACECRAFT_NAME \s* = \s* (\S.*?) \s* ; \s* $ .*
1102 ^ APPLICABLE_START_TIME \s* = \s* (\S.*?) \s* ; \s* $ .*
1103 ^ APPLICABLE_STOP _TIME \s* = \s* (\S.*?) \s* ; \s* $ .*
1104 ^ PRODUCT_CREATION_TIME \s* = \s* (\S.*?) \s* ; \s* $ .*
1105 ^ SEQ_ID \s* = \s* (\S.*?) \s* ; \s* $ .*
1106 ^ \*OPERATOR \s+ (\S.*?) \s* $ .*
1107 ^ \*SEQGEN \s+ (\S.*?) \s* $ .*
1108 /smx;
1109 # Plenty o' date conversions
1110 $hdr{create_t} = WISE::Time::Str_time($hdr{create_ydt},{z=>1});
1111 $hdr{start_t} = WISE::Time::Str_time($hdr{start_ydt},{z=>1});
1112 $hdr{end_t} = WISE::Time::Str_time($hdr{end_ydt},{z=>1});
1113 $hdr{create_gmt_full} = WISE::Time::Time_str($hdr{create_t});
1114 $hdr{start_gmt_full} = WISE::Time::Time_str($hdr{start_t});
1115 $hdr{end_gmt_full} = WISE::Time::Time_str($hdr{end_t});
1116 $hdr{create_gmt_ansi} = WISE::Time::Time_str($hdr{create_t},{ansi=>1});
1117 $hdr{start_gmt_ansi} = WISE::Time::Time_str($hdr{start_t}, {ansi=>1});
1118 $hdr{end_gmt_ansi} = WISE::Time::Time_str($hdr{end_t}, {ansi=>1});
1119 return \%hdr;
1120}
1121
1122sub _get_next_rec {
1123 my $this = shift;
1124 my $fh = shift;
1125 my $opts = shift || {};
1126 my $ydt0 = $opts->{event_ydt_start} || $opts->{pef_ydt_start};
1127 my $ydt1 = $opts->{event_ydt_end} || $opts->{pef_ydt_end};
1128 local $/ = "\n";
1129 my $rec = $this->{readahead} || <$fh>;
1130 confess "$err: Error reading '$this->{file}' at record $.; $!.\n"
1131 if ! defined $rec;
1132 #warn("$err: Error reading '$this->{file}' at record $.; $!.\n"),
1133 #return
1134 # if ! defined $rec;
1135 return 0 if $rec =~ /^\$\$EOF/;
1136 my $ahead;
1137 while(defined ($ahead = <$fh>) && $ahead =~ /^\s/) {
1138 $rec .= $ahead;
1139 }
1140 $rec =~ s/[\s\n]+/ /g;
1141 $this->{readahead} = $ahead;
1142 my ($tcode,$ydt,$event) = $rec =~ /^(\d+:\d+)\s+(\S+)\s+(\S.*)\s*$/;
1143 warn("$err: Unexpected format at record $.;".
1144 "\n THIS='$rec'\n".
1145 "\n PREV='$this->{prev}{rec}'\n"),
1146 return
1147 if ! $tcode || ! $ydt || ! $event;
1148 return -1
1149 if $ydt0 && $tcode lt $ydt0;
1150 return 0
1151 if $ydt1 && $tcode gt $ydt1;
1152 my $comment = "";
1153 $event =~ s/\s*<<\s*(.*?)\s*>>\s*//
1154 and $comment = $1;
1155 $event =~ s/^[:;]+\s*//;
1156 ++$this->{event_num};
1157 my %info = (event_num => $this->{event_num}, rec => $rec,
1158 tcode=>$tcode, ydt=>$ydt, event=>$event, comment=>$comment,
1159 file=>$this->{base});
1160 return wantarray ? %info : \%info;
1161}
1162
1163sub _event_ipactbl_meta {
1164 my $this = shift;
1165
1166 return {
1167 names => [qw/name ydt start_ydt end_ydt duration scan_id orbit et vtc start_et end_et type file/],
1168 types => [qw/c c c c r c r r r r r i c /],
1169 blanks=> [qw/- - null null null null null null null null null null null/],
1170 lens => [qw/10 23 23 23 12 6 11 11 11 11 11 6 32 /],
1171 };
1172}
1173
117412.0e-62.0e-6*_isopt = \&WISE::Ingest::Seq::_isopt;
1175
117617.2e-57.2e-51;

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