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

File/wise/base/deliv/dev/lib/perl/WISE/Time.pm
Statements Executed3106696
Total Time4.06821799995033 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
27738212.084812.08481WISE::Time::Time_str
13869110.654262.09461WISE::Time::Str_time
13869110.429541.44036WISE::Time::dayno_secs
13869110.319520.58162WISE::Time::date_jday
27738210.230010.23001WISE::Time::hms_frac
27738210.170700.17070WISE::Time::correct_tz
27738210.156070.15607WISE::Time::jday_secs
13869110.134520.13452WISE::Time::cannonicalyr
00000WISE::Time::BEGIN
00000WISE::Time::Make_abs_time
00000WISE::Time::OO::AUTOLOAD
00000WISE::Time::OO::BEGIN
00000WISE::Time::OO::new
00000WISE::Time::Str_tbase
00000WISE::Time::frac_hms
00000WISE::Time::jday_dow
00000WISE::Time::mjd_secs
00000WISE::Time::mysecs
00000WISE::Time::mytime
00000WISE::Time::pb5buf_time
00000WISE::Time::secs_jday
00000WISE::Time::secs_mjd
00000WISE::Time::sunday_yywww
00000WISE::Time::thisyr

LineStmts.Exclusive
Time		Avg.Code
134.2e-51.4e-5use strict;
# spent 10µs making 1 call to strict::import
2
336.9e-52.3e-5use WISE::Env (cfglib=>'/wise/base/deliv/dev/lib/perl');
# spent 460µs making 1 call to WISE::Env::import, max recursion depth 1
4
5
6package WISE::Time;
7
832.8e-59.3e-6use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
# spent 67µs making 1 call to vars::import
9
1030.000940.00031use Exporter;
# spent 41µs making 1 call to Exporter::import
1111.0e-61.0e-6$VERSION = 1.00;
1219.0e-69.0e-6@ISA = qw(Exporter);
13
1413.0e-63.0e-6@EXPORT = qw(mytime mysecs Time_str Str_time Make_abs_time Str_tbase
15 sunday_yywww pb5buf_time);
1612.0e-62.0e-6@EXPORT_OK = qw(date_jday jday_date secs_jday jday_secs jday_dow);
17
1830.000890.00030use Time::Local;
# spent 45µs making 1 call to Exporter::import
1930.000860.00029use Time::Timezone;
# spent 58µs making 1 call to Exporter::import
2030.000227.2e-5use POSIX qw(strftime);
# spent 2.27ms making 1 call to POSIX::import
2130.004700.00157use Carp qw/:DEFAULT confess cluck/;
# spent 2.69ms making 1 call to Exporter::import
22
2311.0e-61.0e-6my $version = '$Id: Time.pm 6848 2010-01-04 20:11:50Z tim $ ';
24
25100my ($debug,$unixbasejd,$mjdbase,$pb5base);
26
2711.0e-61.0e-6$debug = 0;
2811.0e-61.0e-6$unixbasejd = 2440587.5; # 1970-01-01-00-00-00
29100$mjdbase = 2400000.5; # date_jday(1900, 1, 1) - 0.5;
30
31# For backward compatability
32sub mytime { &Time_str }
33sub mysecs { &Str_time }
34
35# Convert UNIX time (sec.s since Jan 1 1970) to a variety of formats
36
# spent 2.08s within WISE::Time::Time_str which was called 27738 times, avg 75µs/call: # 13869 times (1.19s+0) at line 819 of /wise/base/deliv/dev/bin/getfix, avg 86µs/call # 13869 times (897ms+0) at line 825 of /wise/base/deliv/dev/bin/getfix, avg 65µs/call
sub Time_str {
3721913022.011869.2e-7 my $t = shift||time();
38 my $mode = shift||0;
39 my $gmt = shift;
40 my $dp = shift;
41 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
42 # I may not actually use these. Stolen from ctime.pl.
43 my(@DoW) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
44# my(@MoY) = ('Jan','Feb','Mar','Apr','May','Jun',
45# 'Jul','Aug','Sep','Oct','Nov','Dec');
46 my($ds) = "";
47 my($mo,$yd);
48 my $sep = '/';
49 my $tsep = ':';
50 my $sep2 = '_';
51 my $dsep = '_';
52 my $nojul = 0;
53 my $nodow = 0;
54 my $notime = 0;
55 my $compact = 0;
56 my $dayno = 0;
57 my $mjd = 0;
58 my $jd = 0;
59 my $noz = 0;
60 my $tz;
61 my ($frac,$opts,$strfmt);
62
63 #if($t < 100000000) {
64 # # Too small to be seconds. Must be a Julian day.
65 # confess "$0/time_str: Unusable Julian day $t" if $t < $unixbasejd;
66 # $t = jday_secs($t);
67 # # (!!! This means we can't get dates for the first couple of weeks
68 # # of January, 1970.)
69 #}
70
71 if(defined $mode && ! ref($mode) && $mode !~ /^\s*\d+\s*$/) {
72 local $_ = $mode;
73 $mode = 0;
74 $mode |= 1 if /a/; # alternate separators
75 $mode |= 2 if /-d/; # no day of year or weekday displayed
76 $mode |= 4 if /c/; # Compact display
77 $mode |= 8 if /-w/; # no day of week displayed
78 $mode |= 16 if /-t/; # no time displayed
79 $mode |= 32 if /n/; # use day number format
80 ($mode |= 64,$mjd=1) if /[jm]/; # use mjd format
81 $dp = $1 if /\.=?(\d+)/; # set no. of dp's
82 $gmt = 0 if /l/; # Use local time
83 $gmt = 1 if /z/; # use GMT
84 $noz = 1 if /-Z/; # don't add 'Z'
85 $mode |= 128 if /A/; # ANSI time format
86 $noz = 1 if /A/ && !/z/; # "
87 $gmt = 1 if /A/; # "
88 } elsif(ref($mode)) {
89 $opts = { %$mode };
90 if($opts->{form}) {
91 if($opts->{form} == 1) {
92 @{$opts}{qw/compact gmt alt dp/} = (1,1,1,$opts->{dp}||0);
93 } elsif ($opts->{form} == 2) {
94 @{$opts}{qw/notime nodow noday gmt alt noz/} = (1,1,1,1,1,1);
95 } elsif ($opts->{form} == 3) {
96 @{$opts}{qw/nodow noday gmt/} = (1,1,1);
97 } elsif ($opts->{form} == 4) {
98 @{$opts}{qw/daynum gmt noz alt timesep dp/} = (1,1,1,1,":",
99 $opts->{dp}//3);
100 } elsif ($opts->{form} == 5) {
101 @{$opts}{qw/daynum noday gmt noz alt datetimesep timesep dp/}
102 = (0,1,1,1,0," ",":",$opts->{dp}//0);
103 } elsif ($opts->{form} == 6) {
104 @{$opts}{qw/daynum noday gmt noz alt datesep datetimesep timesep dp/}
105 = (0,1,1,1,0,"-",$opts->{datetimesep}//" ",":",$opts->{dp}//3);
106 }
107 }
108 $mode = 0;
109 $mode |= 1 if $opts->{altsep} || $opts->{alt};
110 $mode |= 2 if $opts->{noday};
111 $mode |= 4 if $opts->{compact};
112 $mode |= 8 if $opts->{nodow};
113 $mode |= 16 if $opts->{notime};
114 $mode |= 32 if $opts->{daynum} || $opts->{dayno};
115 ($mode |= 64,$mjd=1) if $opts->{mjd};
116 $dp = $opts->{dp} || 0;
117 $gmt = 1 if $opts->{gmt} || $opts->{z} ||
118 $opts->{ansii} || $opts->{ansi};
119 $gmt = 0 if $opts->{local};
120 $noz = 1 if $opts->{noz};
121 $mode |= 128 if $opts->{ansii} || $opts->{ansi};
122 $debug = $opts->{debug};
123 $jd = $opts->{jd};
124 $strfmt = $opts->{strftime};
125 }
126
127 if(! defined $gmt) { $gmt = 1; } # Make GMT the default
128
129 print "t=$t\n" if $debug;
130 print "localt=".strftime('%a_%Y/%m/%d(%j)_%H:%M:%S',localtime($t))."\n"
131 if $debug;
132
133 if($jd) {
134 $dp ||= 1;
135 return sprintf("%.${dp}f",secs_jday($t));
136 }
137
138 if($mjd) {
139 $dp ||= 1;
140 return sprintf("%.${dp}f",secs_mjd($t));
141 }
142
143 if($strfmt) {
144 return strftime($strfmt,$t);
145 }
146
147 print "$sec,$min,$hour,$mday,$mon,$year,$wday,$yday\n" if $debug;
148
149 if($dp) {
150 $t = sprintf("%.${dp}f",$t);
151 ($t,$frac) = split(/\./,$t);
152 $frac = ".$frac";
153 $t = int($t);
154 } else {
155 $t = int($t + 0.5);
156 $frac = "";
157 }
158
159 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
160 = $gmt ? gmtime($dp?$t:int($t+0.5)) : localtime($dp?$t:int($t+0.5));
161 $tz = $gmt && ! $noz ? "Z" : "";
162
163 if($mode != 0) {
164 if($mode&1) { $sep = '-'; $tsep = '-'; $sep2 = 'T'; $dsep = ':'; }
165 if($mode&2) { $nojul = 1; }
166 if($mode&4) { $compact = 1; $nojul = 1; }
167 if($mode&8) { $nodow = 1; }
168 if($mode&16) { $notime = 1; }
169 if($mode&32) { $dayno = 1; }
170 if($mode&64) { $mjd = 1; }
171 if($mode&128) {
172 $sep = '-'; $tsep = ':'; $sep2 = 'T'; $nodow = 1; $nojul = 1;
173 }
174 }
175
176 $sep = $opts->{datesep} if $opts->{datesep};
177 $sep2= $opts->{datetimesep} if $opts->{datetimesep};
178 $tsep= $opts->{timesep} if $opts->{timesep};
179
180 $mo = $mon+1;
181 $yd = $yday+1;
182 $year += 1900;
183
184 if($dayno) {
185 if($compact) { $sep = $tsep = $sep2 = ""; }
186 sprintf("%02d$sep%03d".
187 ($notime ? "" : "$sep2%02d$tsep%02d$tsep%02d$frac").
188 "%s",
189 ($compact?$year%100:$year),$yd,
190 ($notime ? () : ($hour,$min,$sec)),
191 $tz);
192 } elsif(! $nojul) {
193 sprintf(($nodow ? "" : "%3s$dsep").
194 "%4d$sep%02d$sep%02d(%03d)".
195 ($notime ? "" : "$sep2%02d$tsep%02d$tsep%02d$frac").
196 "%s",
197 ($nodow ? () : $DoW[$wday]),
198 $year,$mo,$mday,$yd,
199 ($notime ? () : ($hour,$min,$sec)),
200 $tz);
201 } else {
202 if(! $compact) {
203 sprintf("%4d$sep%02d$sep%02d".
204 ($notime ? "" : "$sep2%02d$tsep%02d$tsep%02d$frac").
205 "%s",
206 $year,$mo,$mday,
207 ($notime ? () : ($hour,$min,$sec)),
208 $tz);
209 } else {
210 sprintf("%02d%02d%02d".
211 ($notime ? "" : "$sep2%02d%02d%02d$frac").
212 "%s",
213 $year%100,$mo,$mday,
214 ($notime ? () : ($hour,$min,$sec)),
215 $tz);
216 }
217 }
218
219}
220
221# Convert a variety of date/time formats to UNIX time.
222# Heuristics are used to determine what format the time is in. A means of
223# explicitly specifying the format is needed.
224
# spent 2.09s (654ms+1.44) within WISE::Time::Str_time which was called 13869 times, avg 151µs/call: # 13869 times (654ms+1.44s) at line 819 of /wise/base/deliv/dev/bin/getfix, avg 151µs/call
sub Str_time {
2252496420.664812.7e-6 my $t = shift;
226 my $opts = shift;
227 my $fmt = "";
228 my ($msg,$alwaysz,$quiet,$isecs,$frac,$jd);
229
230 $quiet = $opts->{quiet};
231 $debug = $opts->{debug};
232 $alwaysz = $opts->{z}; # Assume the input is always in GMT
233 $jd = $opts->{jd}; # Output in Julian days instead of seconds
234 # Explicit format check (rather than pattern match) ...
235 # ... in options
236 $fmt = $opts->{format} || $opts->{form} || $opts->{fmt};
237 # ... or attached to the time spec.
238 $t =~ s/\s*[=_]\s*([a-yA-Y]*)\s*$// and ($fmt ||= $1||"");
239 $fmt = lc $fmt;
240
241 $msg = ! $quiet || $debug;
242
243 warn("*** $0/STR_TIME: Time undefined.\n"), return
244 if $msg && ! defined $t;
245
246 if((! $fmt || $fmt =~ /^ymdhms|dt|dat|datime|ymdt|dhms$/i) &&
247 $t =~ m{^\s*
248 (?:(?:Mon|Tue|Wed|Thu|Fri|Sat|Sun)[-_])? # Ignore DOW_
249 (\d\d(?:\d\d)?)(?:[-_/:y]\s*)? # year 1
250 (\d\d)(?:[-_/:m]\s*)? # mo 2
251 (\d\d)d? # mday 3
252 (?:\(\d\d\d\))? # Ignore (DOY)
253 (?:[-_Tt,;:\s])? # Date/time separator
254 (\d\d)(?:[-_/:h]\s*)? # hour 4
255 (\d\d)(?:[-_/:m]\s*)? # minute 5
256 (\d\d(?:\.\d*)?)s? # sec. 6
257 (z)? # Zulu or local 7
258 \s*$ }ix
259 ) {
260 # Date/time format
261 my $yr = $1;
262 print "YMDHMS $t=$1 $2 $3 $4 $5 $6\n" if $debug;
263 $yr = cannonicalyr($yr);
264 $isecs = int($6);
265 $frac = $6 - $isecs;
266 $t = ($7||$alwaysz ? timegm($isecs,$5,$4,$3,$2-1,$yr)
267 : timelocal($isecs,$5,$4,$3,$2-1,$yr))
268 + $frac;
269 } elsif((! $fmt || $fmt =~ /^hms|t|time$/i) &&
270 $t =~ m{^\s*
271 (\d\d?)[:h]\s* # hour 1
272 (\d\d?)[:m]\s* # minute 2
273 (\d\d?(?:\.\d*)?)s? # sec. 3
274 \s*$ }ix
275 ) {
276 # A time only; return sec.s into day.
277 print "HMS $t=$1 $2 $3\n" if $debug;
278 $t = 86400.*hms_frac($1,$2,$3);
279 } elsif((! $fmt || $fmt =~ /^(ymd|date|da)c(ompact)?$/i) &&
280 $t =~ m{^\s*(?:(?:
281 (\d\d)[-/:y]?\s* # year 1
282 (\d\d)[-/:m]?\s* # mo 2
283 (\d\d)d? # mday 3
284 ) |
285 (?:
286 (\d\d\d\d)[-/:y]?\s* # year 4
287 (\d\d)[-/:m]?\s* # mo 5
288 (\d\d)d? # mday 6
289 ))
290 (z)? # Zulu or local 7
291 \s*$ }ix
292 ) {
293 # A date only (no separators)
294 my $yr = defined $1 ? $1 : $4;
295 print "Y-M-D $t=$1 $2 $3 $4 $5 $6\n" if $debug;
296 $yr = cannonicalyr($yr);
297 $t = ($7||$alwaysz ? timegm(0,0,0,$3||$6,($2||$5)-1,$yr) :
298 timelocal(0,0,0,$3||$6,($2||$5)-1,$yr));
299 } elsif((! $fmt || $fmt =~ /^ymd|date|da$/i) &&
300 $t =~ m{^\s*
301 (\d\d(?:\d\d)?)[-/:y]\s* # year 1
302 (\d\d?)[-/:m]\s* # mo 2
303 (\d\d?)d? # mday 3
304 (z)? # Zulu or local 4
305 \s*$ }ix
306 ) {
307 # A date only (with separators)
308 my $yr = $1;
309 print "YMD $t=$1 $2 $3 $4\n" if $debug;
310 $yr = cannonicalyr($yr);
311 $t = $4||$alwaysz ? timegm(0,0,0,$3,$2-1,$yr) :
312 timelocal(0,0,0,$3,$2-1,$yr);
313 } elsif((! $fmt || $fmt =~ /^yy?ddd|dayno|ddd|dn|ydn$/i) &&
314 $t =~ m{^\s*((?:(?:19)?[7-9]\d)|(?:(?:20)?[0-3]\d))?
315 (?:[-_/:,;]\s*)? # year 1
316 ([0-3]\d\d(?:\.\d*)?) # dayno 2
317 \s*$ }ix
318 ) {
319 # Optional year + day of year + optional fractional day
320 print "YD.F $t=$1 $2 $3\n" if $debug;
321 $t = dayno_secs($2,$1); # Always assumed to be zulu time
322 } elsif((! $fmt || $fmt =~ /^ydt|dnt|ydnt|dddhms|dddt$/i) &&
323 $t =~ m{^\s*((?:(?:19)?[7-9]\d)|(?:(?:20)?[0-3]\d))? # year 1
324 (?:[-_/:,;]\s*)?
325 ([0-3]\d\d)(?:[-_/:,;d]\s*)? # dayno 2
326 (?:[-_/:,;Tt]\s*)?
327 (\d\d)(?:[-_/:,;h]\s*)? # hour 3
328 (\d\d)(?:[-_/:,;m]\s*)? # minute 4
329 (\d\d(?:\.\d*)?) # sec. 5
330 (z)? # Zulu or local 6
331 \s*$ }ix
332 ) {
333 # Optional year + day of year + HMS
334 print "YDHMS $t=$1 $2 $3 $4 $5 $6\n" if $debug;
335 $t = dayno_secs($2,$1,$3,$4,$5,! ($6||$alwaysz));
# spent 1.44s making 13869 calls to WISE::Time::dayno_secs, avg 104µs/call
336 } elsif((! $fmt || $fmt =~ /^mjd$/i) &&
337 $t =~ m{^\s*(\d{5}(?:\.\d*)?)\s*$ }ix
338 ) {
339 # Modified Julian date + optional fractional day
340 print "MJD $t=$1\n" if $debug;
341 $t = mjd_secs($1); # Always assumed to be zulu time
342 } elsif((! $fmt || $fmt =~ /^julianday|jday|jd$/i) &&
343 $t =~ m{^\s*(\d{7}(?:\.\d*)?)\s*$ }x
344 ) {
345 # Julian day
346 print "Julian day $t\n" if $debug;
347 $t = jday_secs($1); # Always assumed to be zulu time
348 } elsif((! $fmt || $fmt =~ /^unix-?time|secs|unix$/i) &&
349 $t =~ m{^\s*0*([12]?\d{9}(?:\.\d*)?)\s*$ }x
350 ) {
351 # UNIX time
352 print "UNIX time $t\n" if $debug;
353 $t = $1; # Always assumed to be zulu time
354 } elsif($fmt && $fmt =~ /^gps$/i && # Demand units
355 $t =~ m{^\s*0*([12]?\d{9}(?:\.\d*)?)\s*$ }x
356 ) {
357 # Spacecraft/GPS time
358 print "GPS time $t\n" if $debug;
359 $t = $1 + Str_tbase("GPS"); # Always assumed to be zulu time
360 } else {
361 cluck "*** $0/STR_TIME: '$t'/'$fmt' not a valid format.\n"
362 if $msg;
363 return;
364 }
365
366 cluck("*** $0/STR_TIME: '$t'/'$fmt' could not produce a valid time.\n"),
367 return
368 if $msg && (! defined $t || $t eq "");
369
370 return $jd ? secs_jday($t) : $t;
371}
372
373# Take a user input time range in one of the formats below and make it
374# an absolute time wrt given start and end times.
375# - Absolute times may be in any format recognized by Str_time. Tbase will
376# be added if the time refers to a date before 2000-01-01.
377# - Times are ALWAYS IN GMT
378# - Convert to absolute time (sec.s since 1-1-1970) as follows:
379# 0,... = same as '+0,...'
380# t1 = from absolute time t1 to tlast or 1e30
381# t1,t2 = from absolute time t1 to absolute time t2
382# t1,+t2 = from absolute time t1 to t1+t2
383# t1,0 or +0 = same as 't1,+0.99999999'
384# +t1 = t1 + tbase+toff to tlast or 1e30
385# +t1,t2 = t1 + tbase+toff to t2 + tbase+toff
386# +t1,+t2 = t1 + tbase+toff to t1+t2 + tbase+toff
387# +t1,0 or +0 = same as 't1,+0.99999999'
388# - After making absolute:
389# If t1<toff, t1 = toff
390# If t2>tlast, t2 = tlast
391sub Make_abs_time {
392 my $times = shift;
393 my $tbase = shift || 0;
394 my $toff = shift || 0;
395 my $tlast = shift || 0;
396 my @times = @$times;
397 my ($opts);
398 my ($rel0,$rel1,$peg0,$peg1) = (0,0,0,0);
399 my $y2k = Str_tbase("2000");
400
401 if(ref $tbase) {
402 $opts = $tbase;
403 $tbase = $opts->{tbase} || 0;
404 $toff = $opts->{toff} || $opts->{tfirst} || $opts->{tstart} || 0;
405 $tlast = $opts->{tlast} || $opts->{tend} || 0;
406 }
407
408 my $t0 = $toff;
409 my $t1 = $tlast;
410
411 if(! defined $times[0] ||
412 ($times[0]=~/^[-+.\d]+$/ && $times[0]>=0 && $times[0]<40000000)) {
413 # Really meant to be relative since no absolute time will be < 40000000
414 $times[0] = "+".$times[0] if $times[0] && $times[0] !~ /^\s*\+/;
415 $times[0] ||= "+0";
416 }
417 if(defined $times[1] && $times[1] eq "0") { $times[1] = "+0.99999999"; }
418 if($times[0]=~/^\s*[-+]/) {
419 # t0 is relative time
420 $times[0] += $t0 if $times[0]=~/\+/; # Make absolute
421 $times[0] += $t1 if $times[0]=~/\-/;
422 $rel0 = 1;
423 # Resolve t1
424 if($times[1]) {
425 if($times[1]!~/^[-+.\d]+$/ || abs($times[1])>40000000) {
426 # t1 is absolute
427 #print "/$times[0]/$times[1]/\n";
428 $times[1] = Str_time($times[1],{z=>1});
429 $times[1] += $tbase if $times[1] < $y2k;
430 } else {
431 # t1 is relative
432 if($times[1]=~/^\s*\+/) { $times[1] += $times[0]; $rel1 = 1; }
433 elsif($times[1]=~/^\s*\-/){ $times[1] = $t1 + $times[1]; }
434 else { $times[1] += $t0; }
435 }
436 }
437 } else {
438 # t0 is absolute time
439 $times[0] = Str_time($times[0],{z=>1}); # Convert from multiple formats
440 $times[0] += $tbase if $times[0] < $y2k;
441 # Resolve t1
442 if($times[1]) {
443 if($times[1]=~/^[-+.\d]+$/ && $times[1]>=0 && $times[1]<40000000) {
444 $times[1] = "+".$times[1] if $times[1] & $times[1] !~ /^\s*\+/;
445 }
446 if($times[1]=~/^\s*\+/) { $times[1] += $times[0]; $rel1 = 1; }
447 elsif($times[1]=~/^\s*\-/){ $times[1] = $t1 + $times[1]; }
448 else {
449 $times[1] = Str_time($times[1],{z=>1});
450 $times[1] += $tbase if $times[1] < $y2k;
451 }
452 }
453 }
454
455 if($times[0] < $t0) { $times[0] = $t0; $peg0 = 1; }
456 if($tlast && (!$times[1] || $times[1] > $t1)){ $times[1] = $t1; $peg1 = 1; }
457
458 if($times[1] && $times[1] < $times[0]) {
459 # The specification was invalid, so return an impossible
460 # time range
461 @times = (0,0);
462 }
463
464 return wantarray ? @times
465 : {times=>\@times,rel=>[$rel0,$rel1],peg=>[$peg0,$peg1]};
466}
467
468# Return the no. sec.s between various epochs and 1-1-1970Z (*NIX time).
469sub Str_tbase {
470 my $tbase = shift;
471 $tbase = lc $tbase;
472 my $opts = shift;
473 if(! defined $tbase || $tbase eq "1970" || $tbase eq "unix")
474 { $tbase = 0; } # *NIX
475 elsif(lc($tbase) eq "gps") { $tbase = 315532800+432000; }# GPS
476 elsif($tbase eq "1980") { $tbase = 315532800; } # PC?
477 elsif($tbase eq "2000") { $tbase = 946684800; }
478 elsif($tbase eq "1900") { $tbase = -2208988800; }
479 elsif($tbase eq "j2000") { $tbase = 946756735.816; } # 2000-1-1.5 TDB
480 elsif($tbase eq "plan") { $tbase = -50716800.000; } # May 24, 1968
481 else {
482 die "*** $0/STR_TBASE: Don't know time base '$tbase'.\n";
483 }
484 return $tbase;
485}
486
487# These routines are mostly for internal use, though some may be exported and
488# all could be useful to the user.
489
490sub mjd_secs {
491 my $mjd = shift;
492 my $jd = $mjd + $mjdbase;
493 my $t;
494
495 $t = jday_secs($jd, 0, 0, 0);
496
497 # print "$mjd $base $frac $t\n";
498
499 return $t;
500}
501
502sub secs_mjd {
503 my $secs = shift;
504 my $mjd = secs_jday($secs) - $mjdbase;
505
506 # print "$secs $base $jd $frac\n";
507
508 return $mjd;
509}
510
511
# spent 1.44s (430ms+1.01) within WISE::Time::dayno_secs which was called 13869 times, avg 104µs/call: # 13869 times (430ms+1.01s) by WISE::Time::Str_time at line 335, avg 104µs/call
sub dayno_secs {
5121941660.563682.9e-6 my ($dayno,$yr,$hr,$min,$secs,$loc) = (shift,shift,
513 shift,shift,shift,shift);
514 my ($base,$frac,$t,$c);
515
516 if(defined $hr) {
517 $dayno = int($dayno);
518 $frac = hms_frac($hr,$min,$secs);
# spent 142ms making 13869 calls to WISE::Time::hms_frac, avg 10µs/call
519 } else {
520 $dayno =~ s/^(\d*)(\.\d*)?$/$1/;
521 $frac = $2||0;
522 }
523 if(! defined $yr) {
524 if(length($dayno) == 7) { $yr = substr($dayno,0,4);
525 $dayno = substr($dayno,4,3); }
526 if(length($dayno) == 5) { $yr = substr($dayno,0,2);
527 $dayno = substr($dayno,2,3); }
528 } else {
529 $dayno = substr($dayno,-3);
530 }
531
532 $yr = cannonicalyr($yr);
# spent 135ms making 13869 calls to WISE::Time::cannonicalyr, avg 10µs/call
533 $base = date_jday($yr, 1, 1);
# spent 582ms making 13869 calls to WISE::Time::date_jday, avg 42µs/call
534
535 $t = jday_secs($dayno+$base-1+$frac);
# spent 71.1ms making 13869 calls to WISE::Time::jday_secs, avg 5µs/call
536
537 $c = correct_tz($t,$loc); # !=0 when $loc is true
# spent 81.4ms making 13869 calls to WISE::Time::correct_tz, avg 6µs/call
538 $t -= $c; # !=0 when $loc is true
539
540 print "dayno_secs: $yr $dayno $frac $base $unixbasejd $t $c\n" if $debug;
541
542 return $t;
543}
544
545
# spent 582ms (320+262) within WISE::Time::date_jday which was called 13869 times, avg 42µs/call: # 13869 times (320ms+262ms) by WISE::Time::dayno_secs at line 533, avg 42µs/call
sub date_jday {
5461802970.392802.2e-6 my ($yr, $mo, $da, $hr, $min, $secs, $loc) =
547 (shift, shift, shift, shift||0, shift||0, shift||0, shift);
548 my ($jd,$frac);
549
550 $frac = hms_frac($hr, $min, $secs);
# spent 87.8ms making 13869 calls to WISE::Time::hms_frac, avg 6µs/call
551 #print "$yr, $mo, $da, $hr, $min, $secs, $frac\n";
552 if($mo <= 2) { --$yr; $mo += 12; }
553 $jd = int(365.25*$yr) + int(30.6001*($mo+1)) + $da + 1720994.5;
554 $jd += $frac;
555 if($jd > 2299170.5) { # Gregorian
556 my $a = int($yr/100);
557 $jd += 2 - $a + int($a/4);
558 }
559
560 $jd -= correct_tz(jday_secs($jd),$loc)/86400.;
# spent 89.3ms making 13869 calls to WISE::Time::correct_tz, avg 6µs/call # spent 85.0ms making 13869 calls to WISE::Time::jday_secs, avg 6µs/call
561
562 return $jd;
563}
564
565
# spent 171ms within WISE::Time::correct_tz which was called 27738 times, avg 6µs/call: # 13869 times (89.3ms+0) by WISE::Time::date_jday at line 560, avg 6µs/call # 13869 times (81.4ms+0) by WISE::Time::dayno_secs at line 537, avg 6µs/call
sub correct_tz {
566832140.101421.2e-6 my ($t,$loc) = (shift,shift);
567 my $cor = 0;
568
569 if(! $loc) { return 0; }
570
571 # from Time::Timezone
572 $cor = tz_local_offset($t);
573
574 print "correct_tz: cor = $cor\n" if $debug;
575
576 return $cor;
577}
578
579
# spent 156ms within WISE::Time::jday_secs which was called 27738 times, avg 6µs/call: # 13869 times (85.0ms+0) by WISE::Time::date_jday at line 560, avg 6µs/call # 13869 times (71.1ms+0) by WISE::Time::dayno_secs at line 535, avg 5µs/call
sub jday_secs {
580554760.081071.5e-6 my $jd = shift;
581 #print join(",",map{defined($_)?$_:"<undef>"} ($jd,$unixbasejd)),"\n";
582 return ($jd-$unixbasejd)*86400;
583}
584
585sub secs_jday
586{
587 my $t = shift;
588 #print "$t/$unixbasejd\n";
589 return $unixbasejd + $t/86400.;
590}
591
592sub jday_dow {
593 return ($_[0]+1.5)%7;
594}
595
596
# spent 230ms within WISE::Time::hms_frac which was called 27738 times, avg 8µs/call: # 13869 times (142ms+0) by WISE::Time::dayno_secs at line 518, avg 10µs/call # 13869 times (87.8ms+0) by WISE::Time::date_jday at line 550, avg 6µs/call
sub hms_frac {
597554760.156822.8e-6 my ($hr, $min, $secs) = (shift||0, shift||0, shift||0);
598 return $hr/24 + $min/(60.*24)+ $secs/(3600*24);
599}
600
601sub frac_hms {
602 my $dayno = shift;
603 my $frac = $dayno - int($dayno);
604 my $secs = $frac*86400;
605 my $h = $secs/3600.;
606 my $m = ($secs - int($h)*3600)/60.;
607 my $s = $secs - int($h)*3600 - int($m)*60.;
608 return (int($h), int($m), $s);
609}
610
611sub thisyr {
612 my $loc = shift;
613 return (! $loc ? gmtime(time) : localtime(time))[5] + 1900;
614}
615
616
# spent 135ms within WISE::Time::cannonicalyr which was called 13869 times, avg 10µs/call: # 13869 times (135ms+0) by WISE::Time::dayno_secs at line 532, avg 10µs/call
sub cannonicalyr {
617970830.087689.0e-7 my ($yr,$loc) = (shift, shift);
618
619 if(! defined $yr) { $yr = thisyr($loc); }
620
621 print "cannonicalyr: in yr = $yr\n" if $debug;
622
623 if($yr < 38) { $yr += 100; } # 2 digit yr to a UNIX-type year
624 if($yr < 1970) { $yr += 1900; } # UNIX-type yr to a full 4 digit year
625
626 print " out yr = $yr\n" if $debug;
627
628 return $yr;
629}
630
631# Compute the year and day of year of the most recent Sunday.
632sub sunday_yywww {
633 my $datime = shift;
634 my $sep = shift || "";
635 my $jd = Str_time($datime,{z=>1,jd=>1}); # Julian day
636 my $dow = jday_dow($jd); # Day of week; Sunday = 0, Monday = 1, etc.
637 my $sunjd= int($jd-$dow-.5)+.5; # Correct to 0 hours of previous Sunday
638 my $t = jday_secs($sunjd); # Get back to seconds
639 if($t < 0) {
640 warn "*** $0/SUNDAY: Date/time $datime produces a pre-1970 Sunday. ".
641 "(t=$t,jd=$jd,sunjd=$sunjd,dow=$dow)";
642 return;
643 }
644 my ($yr,$dayno) = (gmtime($t))[5,7]; # Get date info for this jd
645 $yr = ($yr+1900)%100; # Get the year in 2 digits
646 ++$dayno; # Make the day 1-based not 0-based.
647
648 return wantarray ? ($yr,$dayno) : sprintf("%02d$sep%03d",$yr,$dayno);
649}
650
651sub pb5buf_time {
652 my $buf = shift; # Buf is an (at least) 8 byte binary buffer.
653 my $PB5TOGPS_DAYS = 5756;
654
655 return if length $buf < 8;
656
657 my ($w1,$w2) = unpack("NN",substr($buf,0,8));
658 $w1 &= 0x7fffffff; # Strip flag bit
659 my $tjd = ($w1>>17) & 0x3fff; # Days since epoch
660 my $sec = $w1 & 0x1ffff; # Seconds since start of day
661 my $ms = ($w2>>22) & 0x3ff; # Milli-secs
662 my $us = ($w2>>12) & 0x3ff; # Micro-secs
663 # Convert to S/C (GPS) seconds
664 my $t = ($tjd + $PB5TOGPS_DAYS)*86400. + $sec + $ms/1000. + $us/1000000.;
665 # Convert to UNIX seconds
666 $t += Str_tbase("gps");
667
668 return $t;
669}
670
671#######################
672
673package WISE::Time::OO;
674
67530.000196.2e-5use vars qw/$AUTOLOAD/;
# spent 41µs making 1 call to vars::import
676
677sub new {
678 my $this = shift;
679 my $class = ref($this) || $this;
680 return bless {},$class;
681}
682
683# Auto-gen methods
684sub AUTOLOAD {
685 my $self = shift;
686 my $err = "*** $0/".__PACKAGE__."/AUTOLOAD";
687 my $this = ref($self)
688 or die "$err: '$self' is not an object.\n";
689 return if ($AUTOLOAD =~ /::DESTROY$/);
690 # Separate package qualifier from desired sub name
691 my ($pkg,$sub) = $AUTOLOAD =~ m/(.*:)(.*)/;
692 #print "'$AUTOLOAD'/'$pkg'/'$sub'/@_\n";
693 # Strip off OO trailer
694 $pkg =~ s/::OO//;
695 # Get sub ref (do not store in namespace)
696 my $subref;
697 {
69830.000113.7e-5 no strict qw{refs};
# spent 23µs making 1 call to strict::unimport
699 $subref = eval "\\&$pkg$sub";
700 die "$err: Can't eval '$subref'.\n$@" if $@;
701 }
702 # Call
703 goto &$subref;
704}
705
70611.1e-51.1e-51;
707

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