| File | /wise/base/deliv/dev/lib/perl/WISE/Time.pm | Statements Executed | 4352134 | Total Time | 4.91793900000144 seconds |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine | |
|---|---|---|---|---|---|---|
| 63300 | 4 | 1 | 4.25612 | 4.48430 | WISE::Time:: | Time_str |
| 15830 | 4 | 2 | 0.67053 | 0.67108 | WISE::Time:: | Str_time |
| 15825 | 1 | 1 | 0.12929 | 0.22818 | WISE::Time:: | secs_mjd |
| 15825 | 1 | 1 | 0.09889 | 0.09889 | WISE::Time:: | secs_jday |
| 2 | 1 | 1 | 7.7e-5 | 0.00012 | WISE::Time:: | date_jday |
| 2 | 1 | 1 | 7.4e-5 | 0.00027 | WISE::Time:: | dayno_secs |
| 5 | 2 | 1 | 7.3e-5 | 7.3e-5 | WISE::Time:: | cannonicalyr |
| 4 | 2 | 1 | 4.3e-5 | 4.3e-5 | WISE::Time:: | hms_frac |
| 4 | 2 | 1 | 2.8e-5 | 2.8e-5 | WISE::Time:: | jday_secs |
| 4 | 2 | 1 | 2.8e-5 | 2.8e-5 | WISE::Time:: | correct_tz |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | BEGIN |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | Make_abs_time |
| 0 | 0 | 0 | 0 | 0 | WISE::Time::OO:: | AUTOLOAD |
| 0 | 0 | 0 | 0 | 0 | WISE::Time::OO:: | BEGIN |
| 0 | 0 | 0 | 0 | 0 | WISE::Time::OO:: | new |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | Str_tbase |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | frac_hms |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | jday_dow |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | mjd_secs |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | mysecs |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | mytime |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | pb5buf_time |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | sunday_yywww |
| 0 | 0 | 0 | 0 | 0 | WISE::Time:: | thisyr |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | 3 | 3.3e-5 | 1.1e-5 | use strict; # spent 9µs making 1 call to strict::import |
| 2 | ||||
| 3 | 3 | 8.4e-5 | 2.8e-5 | use WISE::Env (cfglib=>'/wise/base/deliv/dev/lib/perl'); # spent 469µs making 1 call to WISE::Env::import, max recursion depth 1 |
| 4 | ||||
| 5 | ||||
| 6 | package WISE::Time; | |||
| 7 | ||||
| 8 | 3 | 2.7e-5 | 9.0e-6 | use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); # spent 75µs making 1 call to vars::import |
| 9 | ||||
| 10 | 3 | 0.00214 | 0.00071 | use Exporter; # spent 50µs making 1 call to Exporter::import |
| 11 | 1 | 1.0e-6 | 1.0e-6 | $VERSION = 1.00; |
| 12 | 1 | 8.0e-6 | 8.0e-6 | @ISA = qw(Exporter); |
| 13 | ||||
| 14 | 1 | 3.0e-6 | 3.0e-6 | @EXPORT = qw(mytime mysecs Time_str Str_time Make_abs_time Str_tbase |
| 15 | sunday_yywww pb5buf_time); | |||
| 16 | 1 | 2.0e-6 | 2.0e-6 | @EXPORT_OK = qw(date_jday jday_date secs_jday jday_secs jday_dow); |
| 17 | ||||
| 18 | 3 | 0.00127 | 0.00042 | use Time::Local; # spent 53µs making 1 call to Exporter::import |
| 19 | 3 | 0.00098 | 0.00033 | use Time::Timezone; # spent 74µs making 1 call to Exporter::import |
| 20 | 3 | 0.00137 | 0.00046 | use POSIX qw(strftime); # spent 3.17ms making 1 call to POSIX::import |
| 21 | 3 | 0.00449 | 0.00150 | use Carp qw/:DEFAULT confess cluck/; # spent 3.15ms making 1 call to Exporter::import |
| 22 | ||||
| 23 | 1 | 1.0e-6 | 1.0e-6 | my $version = '$Id: Time.pm 6848 2010-01-04 20:11:50Z tim $ '; |
| 24 | ||||
| 25 | 1 | 1.0e-6 | 1.0e-6 | my ($debug,$unixbasejd,$mjdbase,$pb5base); |
| 26 | ||||
| 27 | 1 | 1.0e-6 | 1.0e-6 | $debug = 0; |
| 28 | 1 | 0 | 0 | $unixbasejd = 2440587.5; # 1970-01-01-00-00-00 |
| 29 | 1 | 0 | 0 | $mjdbase = 2400000.5; # date_jday(1900, 1, 1) - 0.5; |
| 30 | ||||
| 31 | # For backward compatability | |||
| 32 | sub mytime { &Time_str } | |||
| 33 | sub mysecs { &Str_time } | |||
| 34 | ||||
| 35 | # Convert UNIX time (sec.s since Jan 1 1970) to a variety of formats | |||
| 36 | # spent 4.48s (4.26+228ms) within WISE::Time::Time_str which was called 63300 times, avg 71µs/call:
# 15825 times (1.26s+0) at line 201 of /wise/base/deliv/dev/bin/wdate, avg 80µs/call
# 15825 times (1.22s+0) at line 196 of /wise/base/deliv/dev/bin/wdate, avg 77µs/call
# 15825 times (1.05s+0) at line 197 of /wise/base/deliv/dev/bin/wdate, avg 66µs/call
# 15825 times (731ms+228ms) at line 200 of /wise/base/deliv/dev/bin/wdate, avg 61µs/call | |||
| 37 | 63300 | 0.05949 | 9.4e-7 | my $t = shift||time(); |
| 38 | 63300 | 0.04537 | 7.2e-7 | my $mode = shift||0; |
| 39 | 63300 | 0.03679 | 5.8e-7 | my $gmt = shift; |
| 40 | 63300 | 0.03320 | 5.2e-7 | my $dp = shift; |
| 41 | 63300 | 0.05270 | 8.3e-7 | my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst); |
| 42 | # I may not actually use these. Stolen from ctime.pl. | |||
| 43 | 63300 | 0.14301 | 2.3e-6 | 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 | 63300 | 0.04255 | 6.7e-7 | my($ds) = ""; |
| 47 | 63300 | 0.03280 | 5.2e-7 | my($mo,$yd); |
| 48 | 63300 | 0.03897 | 6.2e-7 | my $sep = '/'; |
| 49 | 63300 | 0.03247 | 5.1e-7 | my $tsep = ':'; |
| 50 | 63300 | 0.03192 | 5.0e-7 | my $sep2 = '_'; |
| 51 | 63300 | 0.03181 | 5.0e-7 | my $dsep = '_'; |
| 52 | 63300 | 0.03162 | 5.0e-7 | my $nojul = 0; |
| 53 | 63300 | 0.03040 | 4.8e-7 | my $nodow = 0; |
| 54 | 63300 | 0.03022 | 4.8e-7 | my $notime = 0; |
| 55 | 63300 | 0.02998 | 4.7e-7 | my $compact = 0; |
| 56 | 63300 | 0.02940 | 4.6e-7 | my $dayno = 0; |
| 57 | 63300 | 0.02940 | 4.6e-7 | my $mjd = 0; |
| 58 | 63300 | 0.02942 | 4.6e-7 | my $jd = 0; |
| 59 | 63300 | 0.02911 | 4.6e-7 | my $noz = 0; |
| 60 | 63300 | 0.02972 | 4.7e-7 | my $tz; |
| 61 | 63300 | 0.03494 | 5.5e-7 | 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 | 63300 | 0.11307 | 1.8e-6 | 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 | 63300 | 0.21175 | 3.3e-6 | $opts = { %$mode }; |
| 90 | 63300 | 0.06587 | 1.0e-6 | if($opts->{form}) { |
| 91 | 15825 | 0.08028 | 5.1e-6 | 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 | 63300 | 0.03947 | 6.2e-7 | $mode = 0; |
| 109 | 63300 | 0.05638 | 8.9e-7 | $mode |= 1 if $opts->{altsep} || $opts->{alt}; |
| 110 | 63300 | 0.03671 | 5.8e-7 | $mode |= 2 if $opts->{noday}; |
| 111 | 63300 | 0.03975 | 6.3e-7 | $mode |= 4 if $opts->{compact}; |
| 112 | 63300 | 0.03594 | 5.7e-7 | $mode |= 8 if $opts->{nodow}; |
| 113 | 63300 | 0.03791 | 6.0e-7 | $mode |= 16 if $opts->{notime}; |
| 114 | 63300 | 0.04699 | 7.4e-7 | $mode |= 32 if $opts->{daynum} || $opts->{dayno}; |
| 115 | 63300 | 0.04400 | 7.0e-7 | ($mode |= 64,$mjd=1) if $opts->{mjd}; |
| 116 | 63300 | 0.04412 | 7.0e-7 | $dp = $opts->{dp} || 0; |
| 117 | 63300 | 0.05990 | 9.5e-7 | $gmt = 1 if $opts->{gmt} || $opts->{z} || |
| 118 | $opts->{ansii} || $opts->{ansi}; | |||
| 119 | 63300 | 0.03883 | 6.1e-7 | $gmt = 0 if $opts->{local}; |
| 120 | 63300 | 0.03752 | 5.9e-7 | $noz = 1 if $opts->{noz}; |
| 121 | 63300 | 0.04572 | 7.2e-7 | $mode |= 128 if $opts->{ansii} || $opts->{ansi}; |
| 122 | 63300 | 0.04051 | 6.4e-7 | $debug = $opts->{debug}; |
| 123 | 63300 | 0.03567 | 5.6e-7 | $jd = $opts->{jd}; |
| 124 | 63300 | 0.04836 | 7.6e-7 | $strfmt = $opts->{strftime}; |
| 125 | } | |||
| 126 | ||||
| 127 | 63300 | 0.03806 | 6.0e-7 | if(! defined $gmt) { $gmt = 1; } # Make GMT the default |
| 128 | ||||
| 129 | 63300 | 0.02987 | 4.7e-7 | print "t=$t\n" if $debug; |
| 130 | 63300 | 0.02775 | 4.4e-7 | print "localt=".strftime('%a_%Y/%m/%d(%j)_%H:%M:%S',localtime($t))."\n" |
| 131 | if $debug; | |||
| 132 | ||||
| 133 | 63300 | 0.02702 | 4.3e-7 | if($jd) { |
| 134 | $dp ||= 1; | |||
| 135 | return sprintf("%.${dp}f",secs_jday($t)); | |||
| 136 | } | |||
| 137 | ||||
| 138 | 63300 | 0.03052 | 4.8e-7 | if($mjd) { |
| 139 | 15825 | 0.00811 | 5.1e-7 | $dp ||= 1; |
| 140 | 15825 | 0.21391 | 1.4e-5 | return sprintf("%.${dp}f",secs_mjd($t)); # spent 228ms making 15825 calls to WISE::Time::secs_mjd, avg 14µs/call |
| 141 | } | |||
| 142 | ||||
| 143 | 47475 | 0.02046 | 4.3e-7 | if($strfmt) { |
| 144 | return strftime($strfmt,$t); | |||
| 145 | } | |||
| 146 | ||||
| 147 | 47475 | 0.02048 | 4.3e-7 | print "$sec,$min,$hour,$mday,$mon,$year,$wday,$yday\n" if $debug; |
| 148 | ||||
| 149 | 47475 | 0.04909 | 1.0e-6 | if($dp) { |
| 150 | 47475 | 0.31811 | 6.7e-6 | $t = sprintf("%.${dp}f",$t); |
| 151 | 47475 | 0.14843 | 3.1e-6 | ($t,$frac) = split(/\./,$t); |
| 152 | 47475 | 0.04310 | 9.1e-7 | $frac = ".$frac"; |
| 153 | 47475 | 0.04769 | 1.0e-6 | $t = int($t); |
| 154 | } else { | |||
| 155 | $t = int($t + 0.5); | |||
| 156 | $frac = ""; | |||
| 157 | } | |||
| 158 | ||||
| 159 | 47475 | 0.23434 | 4.9e-6 | ($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 | 47475 | 0.03897 | 8.2e-7 | $tz = $gmt && ! $noz ? "Z" : ""; |
| 162 | ||||
| 163 | 47475 | 0.03770 | 7.9e-7 | if($mode != 0) { |
| 164 | 79125 | 0.05223 | 6.6e-7 | if($mode&1) { $sep = '-'; $tsep = '-'; $sep2 = 'T'; $dsep = ':'; } |
| 165 | 15825 | 0.00847 | 5.4e-7 | if($mode&2) { $nojul = 1; } |
| 166 | 15825 | 0.00760 | 4.8e-7 | if($mode&4) { $compact = 1; $nojul = 1; } |
| 167 | 15825 | 0.00813 | 5.1e-7 | if($mode&8) { $nodow = 1; } |
| 168 | 15825 | 0.00780 | 4.9e-7 | if($mode&16) { $notime = 1; } |
| 169 | 15825 | 0.00983 | 6.2e-7 | if($mode&32) { $dayno = 1; } |
| 170 | 15825 | 0.00802 | 5.1e-7 | if($mode&64) { $mjd = 1; } |
| 171 | 15825 | 0.00832 | 5.3e-7 | if($mode&128) { |
| 172 | $sep = '-'; $tsep = ':'; $sep2 = 'T'; $nodow = 1; $nojul = 1; | |||
| 173 | } | |||
| 174 | } | |||
| 175 | ||||
| 176 | 47475 | 0.03917 | 8.3e-7 | $sep = $opts->{datesep} if $opts->{datesep}; |
| 177 | 47475 | 0.02949 | 6.2e-7 | $sep2= $opts->{datetimesep} if $opts->{datetimesep}; |
| 178 | 47475 | 0.03592 | 7.6e-7 | $tsep= $opts->{timesep} if $opts->{timesep}; |
| 179 | ||||
| 180 | 47475 | 0.02981 | 6.3e-7 | $mo = $mon+1; |
| 181 | 47475 | 0.02381 | 5.0e-7 | $yd = $yday+1; |
| 182 | 47475 | 0.02427 | 5.1e-7 | $year += 1900; |
| 183 | ||||
| 184 | 47475 | 0.36777 | 7.7e-6 | if($dayno) { |
| 185 | 15825 | 0.00846 | 5.3e-7 | if($compact) { $sep = $tsep = $sep2 = ""; } |
| 186 | 15825 | 0.06438 | 4.1e-6 | 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 671ms (671+544µs) within WISE::Time::Str_time which was called 15830 times, avg 42µs/call:
# 15827 times (670ms+272µs) by main::dat_to_secs at line 422 of /wise/base/deliv/dev/bin/wdate, avg 42µs/call
# once (162µs+145µs) at line 36 of /wise/base/deliv/dev/lib/perl/WISE/Ingest/Decom.pm
# once (77µs+95µs) at line 157 of /wise/base/deliv/dev/bin/wdate
# once (40µs+32µs) at line 159 of /wise/base/deliv/dev/bin/wdate | |||
| 225 | 15830 | 0.01380 | 8.7e-7 | my $t = shift; |
| 226 | 15830 | 0.00948 | 6.0e-7 | my $opts = shift; |
| 227 | 15830 | 0.00971 | 6.1e-7 | my $fmt = ""; |
| 228 | 15830 | 0.01166 | 7.4e-7 | my ($msg,$alwaysz,$quiet,$isecs,$frac,$jd); |
| 229 | ||||
| 230 | 15830 | 0.01317 | 8.3e-7 | $quiet = $opts->{quiet}; |
| 231 | 15830 | 0.01227 | 7.7e-7 | $debug = $opts->{debug}; |
| 232 | 15830 | 0.01165 | 7.4e-7 | $alwaysz = $opts->{z}; # Assume the input is always in GMT |
| 233 | 15830 | 0.00972 | 6.1e-7 | $jd = $opts->{jd}; # Output in Julian days instead of seconds |
| 234 | # Explicit format check (rather than pattern match) ... | |||
| 235 | # ... in options | |||
| 236 | 15830 | 0.01660 | 1.0e-6 | $fmt = $opts->{format} || $opts->{form} || $opts->{fmt}; |
| 237 | # ... or attached to the time spec. | |||
| 238 | 15830 | 0.02714 | 1.7e-6 | $t =~ s/\s*[=_]\s*([a-yA-Y]*)\s*$// and ($fmt ||= $1||""); |
| 239 | 15830 | 0.01096 | 6.9e-7 | $fmt = lc $fmt; |
| 240 | ||||
| 241 | 15830 | 0.01070 | 6.8e-7 | $msg = ! $quiet || $debug; |
| 242 | ||||
| 243 | 15830 | 0.01060 | 6.7e-7 | warn("*** $0/STR_TIME: Time undefined.\n"), return |
| 244 | if $msg && ! defined $t; | |||
| 245 | ||||
| 246 | 15830 | 0.35819 | 2.3e-5 | 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 | 3 | 4.5e-5 | 1.5e-5 | my $yr = $1; |
| 262 | 3 | 3.0e-6 | 1.0e-6 | print "YMDHMS $t=$1 $2 $3 $4 $5 $6\n" if $debug; |
| 263 | 3 | 3.1e-5 | 1.0e-5 | $yr = cannonicalyr($yr); # spent 51µs making 3 calls to WISE::Time::cannonicalyr, avg 17µs/call |
| 264 | 3 | 1.2e-5 | 4.0e-6 | $isecs = int($6); |
| 265 | 3 | 5.0e-6 | 1.7e-6 | $frac = $6 - $isecs; |
| 266 | 3 | 3.9e-5 | 1.3e-5 | $t = ($7||$alwaysz ? timegm($isecs,$5,$4,$3,$2-1,$yr) # spent 221µs making 3 calls to Time::Local::timegm, avg 74µs/call |
| 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 | 2 | 1.0e-6 | 5.0e-7 | print "YDHMS $t=$1 $2 $3 $4 $5 $6\n" if $debug; |
| 335 | 2 | 2.8e-5 | 1.4e-5 | $t = dayno_secs($2,$1,$3,$4,$5,! ($6||$alwaysz)); # spent 272µs making 2 calls to WISE::Time::dayno_secs, avg 136µ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 | 15825 | 0.00903 | 5.7e-7 | print "UNIX time $t\n" if $debug; |
| 353 | 15825 | 0.03067 | 1.9e-6 | $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 | 15830 | 0.01471 | 9.3e-7 | cluck("*** $0/STR_TIME: '$t'/'$fmt' could not produce a valid time.\n"), |
| 367 | return | |||
| 368 | if $msg && (! defined $t || $t eq ""); | |||
| 369 | ||||
| 370 | 15830 | 0.04332 | 2.7e-6 | 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 | |||
| 391 | sub 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). | |||
| 469 | sub 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 | ||||
| 490 | sub 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 | ||||
| 502 | # spent 228ms (129+98.9) within WISE::Time::secs_mjd which was called 15825 times, avg 14µs/call:
# 15825 times (129ms+98.9ms) by WISE::Time::Time_str at line 140, avg 14µs/call | |||
| 503 | 15825 | 0.01439 | 9.1e-7 | my $secs = shift; |
| 504 | 15825 | 0.07024 | 4.4e-6 | my $mjd = secs_jday($secs) - $mjdbase; # spent 98.9ms making 15825 calls to WISE::Time::secs_jday, avg 6µs/call |
| 505 | ||||
| 506 | # print "$secs $base $jd $frac\n"; | |||
| 507 | ||||
| 508 | 15825 | 0.02138 | 1.4e-6 | return $mjd; |
| 509 | } | |||
| 510 | ||||
| 511 | # spent 272µs (74+198) within WISE::Time::dayno_secs which was called 2 times, avg 136µs/call:
# 2 times (74µs+198µs) by WISE::Time::Str_time at line 335, avg 136µs/call | |||
| 512 | 2 | 1.9e-5 | 9.5e-6 | my ($dayno,$yr,$hr,$min,$secs,$loc) = (shift,shift, |
| 513 | shift,shift,shift,shift); | |||
| 514 | 2 | 1.0e-6 | 5.0e-7 | my ($base,$frac,$t,$c); |
| 515 | ||||
| 516 | 2 | 2.0e-6 | 1.0e-6 | if(defined $hr) { |
| 517 | 2 | 4.0e-6 | 2.0e-6 | $dayno = int($dayno); |
| 518 | 2 | 1.3e-5 | 6.5e-6 | $frac = hms_frac($hr,$min,$secs); # spent 27µs making 2 calls to WISE::Time::hms_frac, avg 14µs/call |
| 519 | } else { | |||
| 520 | $dayno =~ s/^(\d*)(\.\d*)?$/$1/; | |||
| 521 | $frac = $2||0; | |||
| 522 | } | |||
| 523 | 2 | 2.0e-6 | 1.0e-6 | 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 | 2 | 4.0e-6 | 2.0e-6 | $dayno = substr($dayno,-3); |
| 530 | } | |||
| 531 | ||||
| 532 | 2 | 1.2e-5 | 6.0e-6 | $yr = cannonicalyr($yr); # spent 22µs making 2 calls to WISE::Time::cannonicalyr, avg 11µs/call |
| 533 | 2 | 1.5e-5 | 7.5e-6 | $base = date_jday($yr, 1, 1); # spent 124µs making 2 calls to WISE::Time::date_jday, avg 62µs/call |
| 534 | ||||
| 535 | 2 | 1.3e-5 | 6.5e-6 | $t = jday_secs($dayno+$base-1+$frac); # spent 12µs making 2 calls to WISE::Time::jday_secs, avg 6µs/call |
| 536 | ||||
| 537 | 2 | 8.0e-6 | 4.0e-6 | $c = correct_tz($t,$loc); # !=0 when $loc is true # spent 13µs making 2 calls to WISE::Time::correct_tz, avg 6µs/call |
| 538 | 2 | 2.0e-6 | 1.0e-6 | $t -= $c; # !=0 when $loc is true |
| 539 | ||||
| 540 | 2 | 1.0e-6 | 5.0e-7 | print "dayno_secs: $yr $dayno $frac $base $unixbasejd $t $c\n" if $debug; |
| 541 | ||||
| 542 | 2 | 2.0e-6 | 1.0e-6 | return $t; |
| 543 | } | |||
| 544 | ||||
| 545 | # spent 124µs (77+47) within WISE::Time::date_jday which was called 2 times, avg 62µs/call:
# 2 times (77µs+47µs) by WISE::Time::dayno_secs at line 533, avg 62µs/call | |||
| 546 | 2 | 9.0e-6 | 4.5e-6 | my ($yr, $mo, $da, $hr, $min, $secs, $loc) = |
| 547 | (shift, shift, shift, shift||0, shift||0, shift||0, shift); | |||
| 548 | 2 | 1.0e-6 | 5.0e-7 | my ($jd,$frac); |
| 549 | ||||
| 550 | 2 | 9.0e-6 | 4.5e-6 | $frac = hms_frac($hr, $min, $secs); # spent 16µs making 2 calls to WISE::Time::hms_frac, avg 8µs/call |
| 551 | #print "$yr, $mo, $da, $hr, $min, $secs, $frac\n"; | |||
| 552 | 6 | 1.5e-5 | 2.5e-6 | if($mo <= 2) { --$yr; $mo += 12; } |
| 553 | 2 | 5.0e-6 | 2.5e-6 | $jd = int(365.25*$yr) + int(30.6001*($mo+1)) + $da + 1720994.5; |
| 554 | 2 | 1.6e-5 | 8.0e-6 | $jd += $frac; |
| 555 | 2 | 2.0e-6 | 1.0e-6 | if($jd > 2299170.5) { # Gregorian |
| 556 | 2 | 2.0e-6 | 1.0e-6 | my $a = int($yr/100); |
| 557 | 2 | 4.0e-6 | 2.0e-6 | $jd += 2 - $a + int($a/4); |
| 558 | } | |||
| 559 | ||||
| 560 | 2 | 2.5e-5 | 1.3e-5 | $jd -= correct_tz(jday_secs($jd),$loc)/86400.; # spent 16µs making 2 calls to WISE::Time::jday_secs, avg 8µs/call
# spent 15µs making 2 calls to WISE::Time::correct_tz, avg 8µs/call |
| 561 | ||||
| 562 | 2 | 3.0e-6 | 1.5e-6 | return $jd; |
| 563 | } | |||
| 564 | ||||
| 565 | sub correct_tz { | |||
| 566 | 4 | 7.0e-6 | 1.7e-6 | my ($t,$loc) = (shift,shift); |
| 567 | 4 | 3.0e-6 | 7.5e-7 | my $cor = 0; |
| 568 | ||||
| 569 | 4 | 5.0e-6 | 1.2e-6 | 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 | sub jday_secs { | |||
| 580 | 4 | 3.0e-6 | 7.5e-7 | my $jd = shift; |
| 581 | #print join(",",map{defined($_)?$_:"<undef>"} ($jd,$unixbasejd)),"\n"; | |||
| 582 | 4 | 8.0e-6 | 2.0e-6 | return ($jd-$unixbasejd)*86400; |
| 583 | } | |||
| 584 | ||||
| 585 | sub secs_jday | |||
| 586 | # spent 98.9ms within WISE::Time::secs_jday which was called 15825 times, avg 6µs/call:
# 15825 times (98.9ms+0) by WISE::Time::secs_mjd at line 504, avg 6µs/call | |||
| 587 | 15825 | 0.01199 | 7.6e-7 | my $t = shift; |
| 588 | #print "$t/$unixbasejd\n"; | |||
| 589 | 15825 | 0.05436 | 3.4e-6 | return $unixbasejd + $t/86400.; |
| 590 | } | |||
| 591 | ||||
| 592 | sub jday_dow { | |||
| 593 | return ($_[0]+1.5)%7; | |||
| 594 | } | |||
| 595 | ||||
| 596 | sub hms_frac { | |||
| 597 | 4 | 9.0e-6 | 2.2e-6 | my ($hr, $min, $secs) = (shift||0, shift||0, shift||0); |
| 598 | 4 | 1.8e-5 | 4.5e-6 | return $hr/24 + $min/(60.*24)+ $secs/(3600*24); |
| 599 | } | |||
| 600 | ||||
| 601 | sub 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 | ||||
| 611 | sub thisyr { | |||
| 612 | my $loc = shift; | |||
| 613 | return (! $loc ? gmtime(time) : localtime(time))[5] + 1900; | |||
| 614 | } | |||
| 615 | ||||
| 616 | sub cannonicalyr { | |||
| 617 | 5 | 1.0e-5 | 2.0e-6 | my ($yr,$loc) = (shift, shift); |
| 618 | ||||
| 619 | 5 | 5.0e-6 | 1.0e-6 | if(! defined $yr) { $yr = thisyr($loc); } |
| 620 | ||||
| 621 | 5 | 4.0e-6 | 8.0e-7 | print "cannonicalyr: in yr = $yr\n" if $debug; |
| 622 | ||||
| 623 | 5 | 8.0e-6 | 1.6e-6 | if($yr < 38) { $yr += 100; } # 2 digit yr to a UNIX-type year |
| 624 | 5 | 4.0e-6 | 8.0e-7 | if($yr < 1970) { $yr += 1900; } # UNIX-type yr to a full 4 digit year |
| 625 | ||||
| 626 | 5 | 2.0e-6 | 4.0e-7 | print " out yr = $yr\n" if $debug; |
| 627 | ||||
| 628 | 5 | 1.0e-5 | 2.0e-6 | return $yr; |
| 629 | } | |||
| 630 | ||||
| 631 | # Compute the year and day of year of the most recent Sunday. | |||
| 632 | sub 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 | ||||
| 651 | sub 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 | ||||
| 673 | package WISE::Time::OO; | |||
| 674 | ||||
| 675 | 3 | 0.00018 | 5.9e-5 | use vars qw/$AUTOLOAD/; # spent 36µs making 1 call to vars::import |
| 676 | ||||
| 677 | sub new { | |||
| 678 | my $this = shift; | |||
| 679 | my $class = ref($this) || $this; | |||
| 680 | return bless {},$class; | |||
| 681 | } | |||
| 682 | ||||
| 683 | # Auto-gen methods | |||
| 684 | sub 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 | { | |||
| 698 | 3 | 9.2e-5 | 3.1e-5 | no strict qw{refs}; # spent 31µ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 | ||||
| 706 | 1 | 1.2e-5 | 1.2e-5 | 1; |
| 707 |