| Filename | /usr/lib/perl/5.18/Time/Piece.pm |
| Statements | Executed 83 statements in 6.81ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 2.26ms | 3.78ms | Time::Piece::BEGIN@7 |
| 1 | 1 | 1 | 211µs | 215µs | Time::Piece::BEGIN@422 |
| 1 | 1 | 1 | 55µs | 150µs | Time::Piece::BEGIN@121 |
| 1 | 1 | 1 | 46µs | 196µs | Time::Piece::BEGIN@8 |
| 1 | 1 | 1 | 36µs | 86µs | Time::Piece::BEGIN@9 |
| 1 | 1 | 1 | 35µs | 95µs | Time::Piece::BEGIN@3 |
| 1 | 1 | 1 | 29µs | 29µs | Time::Piece::bootstrap (xsub) |
| 1 | 1 | 1 | 26µs | 75µs | Time::Piece::BEGIN@122 |
| 1 | 1 | 1 | 25µs | 33µs | Time::Piece::export |
| 1 | 1 | 1 | 23µs | 162µs | Time::Piece::BEGIN@34 |
| 1 | 1 | 1 | 22µs | 48µs | Time::Piece::BEGIN@42 |
| 1 | 1 | 1 | 16µs | 45µs | Time::Piece::BEGIN@37 |
| 1 | 1 | 1 | 15µs | 48µs | Time::Piece::import |
| 1 | 1 | 1 | 15µs | 60µs | Time::Piece::BEGIN@510 |
| 1 | 1 | 1 | 12µs | 46µs | Time::Piece::BEGIN@35 |
| 1 | 1 | 1 | 12µs | 41µs | Time::Piece::BEGIN@36 |
| 1 | 1 | 1 | 10µs | 31µs | Time::Piece::BEGIN@533 |
| 1 | 1 | 1 | 10µs | 38µs | Time::Piece::BEGIN@38 |
| 1 | 1 | 1 | 10µs | 28µs | Time::Piece::BEGIN@575 |
| 1 | 1 | 1 | 9µs | 41µs | Time::Piece::BEGIN@44 |
| 1 | 1 | 1 | 9µs | 35µs | Time::Piece::BEGIN@41 |
| 1 | 1 | 1 | 8µs | 36µs | Time::Piece::BEGIN@39 |
| 1 | 1 | 1 | 8µs | 34µs | Time::Piece::BEGIN@40 |
| 1 | 1 | 1 | 8µs | 34µs | Time::Piece::BEGIN@43 |
| 1 | 1 | 1 | 4µs | 4µs | Time::Piece::__ANON__[:114] |
| 1 | 1 | 1 | 4µs | 4µs | Time::Piece::__ANON__[:113] |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::__ANON__[:293] |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::_is_leap_year |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::_jd |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::_mktime |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::_mon |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::_wday |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::_year |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::add |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::add_months |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::add_years |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::cdate |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::compare |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::date_separator |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::datetime |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::day_list |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::dmy |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::epoch |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::fullday |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::fullmonth |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::get_epochs |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::gmtime |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::hms |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::hour |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::is_leap_year |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::isdst |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::julian_day |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::localtime |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::mday |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::mdy |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::min |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::mjd |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::mon |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::mon_list |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::month |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::month_last_day |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::new |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::parse |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::sec |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::str_compare |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::strftime |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::strptime |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::subtract |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::time_separator |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::tzoffset |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::wday |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::wdayname |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::week |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::yday |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::year |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::ymd |
| 0 | 0 | 0 | 0s | 0s | Time::Piece::yy |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package Time::Piece; | ||||
| 2 | |||||
| 3 | 2 | 89µs | 2 | 155µs | # spent 95µs (35+60) within Time::Piece::BEGIN@3 which was called:
# once (35µs+60µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 3 # spent 95µs making 1 call to Time::Piece::BEGIN@3
# spent 60µs making 1 call to strict::import |
| 4 | |||||
| 5 | 1 | 1µs | require Exporter; | ||
| 6 | 1 | 500ns | require DynaLoader; | ||
| 7 | 2 | 725µs | 2 | 4.00ms | # spent 3.78ms (2.26+1.51) within Time::Piece::BEGIN@7 which was called:
# once (2.26ms+1.51ms) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 7 # spent 3.78ms making 1 call to Time::Piece::BEGIN@7
# spent 222µs making 1 call to Exporter::import |
| 8 | 2 | 76µs | 2 | 345µs | # spent 196µs (46+149) within Time::Piece::BEGIN@8 which was called:
# once (46µs+149µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 8 # spent 196µs making 1 call to Time::Piece::BEGIN@8
# spent 149µs making 1 call to Exporter::import |
| 9 | 2 | 346µs | 2 | 135µs | # spent 86µs (36+50) within Time::Piece::BEGIN@9 which was called:
# once (36µs+50µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 9 # spent 86µs making 1 call to Time::Piece::BEGIN@9
# spent 50µs making 1 call to Exporter::import |
| 10 | |||||
| 11 | 1 | 12µs | our @ISA = qw(Exporter DynaLoader); | ||
| 12 | |||||
| 13 | 1 | 1µs | our @EXPORT = qw( | ||
| 14 | localtime | ||||
| 15 | gmtime | ||||
| 16 | ); | ||||
| 17 | |||||
| 18 | 1 | 2µs | our %EXPORT_TAGS = ( | ||
| 19 | ':override' => 'internal', | ||||
| 20 | ); | ||||
| 21 | |||||
| 22 | 1 | 300ns | our $VERSION = '1.20_01'; | ||
| 23 | |||||
| 24 | 1 | 9µs | 1 | 260µs | bootstrap Time::Piece $VERSION; # spent 260µs making 1 call to DynaLoader::bootstrap |
| 25 | |||||
| 26 | 1 | 500ns | my $DATE_SEP = '-'; | ||
| 27 | 1 | 800ns | my $TIME_SEP = ':'; | ||
| 28 | 1 | 2µs | my @MON_LIST = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); | ||
| 29 | 1 | 2µs | my @FULLMON_LIST = qw(January February March April May June July | ||
| 30 | August September October November December); | ||||
| 31 | 1 | 1µs | my @DAY_LIST = qw(Sun Mon Tue Wed Thu Fri Sat); | ||
| 32 | 1 | 2µs | my @FULLDAY_LIST = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); | ||
| 33 | |||||
| 34 | 2 | 54µs | 2 | 301µs | # spent 162µs (23+139) within Time::Piece::BEGIN@34 which was called:
# once (23µs+139µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 34 # spent 162µs making 1 call to Time::Piece::BEGIN@34
# spent 139µs making 1 call to constant::import |
| 35 | 2 | 37µs | 2 | 80µs | # spent 46µs (12+34) within Time::Piece::BEGIN@35 which was called:
# once (12µs+34µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 35 # spent 46µs making 1 call to Time::Piece::BEGIN@35
# spent 34µs making 1 call to constant::import |
| 36 | 2 | 30µs | 2 | 70µs | # spent 41µs (12+29) within Time::Piece::BEGIN@36 which was called:
# once (12µs+29µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 36 # spent 41µs making 1 call to Time::Piece::BEGIN@36
# spent 29µs making 1 call to constant::import |
| 37 | 2 | 34µs | 2 | 75µs | # spent 45µs (16+30) within Time::Piece::BEGIN@37 which was called:
# once (16µs+30µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 37 # spent 45µs making 1 call to Time::Piece::BEGIN@37
# spent 30µs making 1 call to constant::import |
| 38 | 2 | 28µs | 2 | 66µs | # spent 38µs (10+28) within Time::Piece::BEGIN@38 which was called:
# once (10µs+28µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 38 # spent 38µs making 1 call to Time::Piece::BEGIN@38
# spent 28µs making 1 call to constant::import |
| 39 | 2 | 29µs | 2 | 64µs | # spent 36µs (8+28) within Time::Piece::BEGIN@39 which was called:
# once (8µs+28µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 39 # spent 36µs making 1 call to Time::Piece::BEGIN@39
# spent 28µs making 1 call to constant::import |
| 40 | 2 | 33µs | 2 | 60µs | # spent 34µs (8+26) within Time::Piece::BEGIN@40 which was called:
# once (8µs+26µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 40 # spent 34µs making 1 call to Time::Piece::BEGIN@40
# spent 26µs making 1 call to constant::import |
| 41 | 2 | 33µs | 2 | 62µs | # spent 35µs (9+26) within Time::Piece::BEGIN@41 which was called:
# once (9µs+26µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 41 # spent 35µs making 1 call to Time::Piece::BEGIN@41
# spent 26µs making 1 call to constant::import |
| 42 | 2 | 26µs | 2 | 75µs | # spent 48µs (22+27) within Time::Piece::BEGIN@42 which was called:
# once (22µs+27µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 42 # spent 48µs making 1 call to Time::Piece::BEGIN@42
# spent 27µs making 1 call to constant::import |
| 43 | 2 | 35µs | 2 | 61µs | # spent 34µs (8+27) within Time::Piece::BEGIN@43 which was called:
# once (8µs+27µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 43 # spent 34µs making 1 call to Time::Piece::BEGIN@43
# spent 27µs making 1 call to constant::import |
| 44 | 2 | 1.05ms | 2 | 73µs | # spent 41µs (9+32) within Time::Piece::BEGIN@44 which was called:
# once (9µs+32µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 44 # spent 41µs making 1 call to Time::Piece::BEGIN@44
# spent 32µs making 1 call to constant::import |
| 45 | |||||
| 46 | sub localtime { | ||||
| 47 | unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; | ||||
| 48 | my $class = shift; | ||||
| 49 | my $time = shift; | ||||
| 50 | $time = time if (!defined $time); | ||||
| 51 | $class->_mktime($time, 1); | ||||
| 52 | } | ||||
| 53 | |||||
| 54 | sub gmtime { | ||||
| 55 | unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') }; | ||||
| 56 | my $class = shift; | ||||
| 57 | my $time = shift; | ||||
| 58 | $time = time if (!defined $time); | ||||
| 59 | $class->_mktime($time, 0); | ||||
| 60 | } | ||||
| 61 | |||||
| 62 | sub new { | ||||
| 63 | my $class = shift; | ||||
| 64 | my ($time) = @_; | ||||
| 65 | |||||
| 66 | my $self; | ||||
| 67 | |||||
| 68 | if (defined($time)) { | ||||
| 69 | $self = $class->localtime($time); | ||||
| 70 | } | ||||
| 71 | elsif (ref($class) && $class->isa(__PACKAGE__)) { | ||||
| 72 | $self = $class->_mktime($class->epoch, $class->[c_islocal]); | ||||
| 73 | } | ||||
| 74 | else { | ||||
| 75 | $self = $class->localtime(); | ||||
| 76 | } | ||||
| 77 | |||||
| 78 | return bless $self, ref($class) || $class; | ||||
| 79 | } | ||||
| 80 | |||||
| 81 | sub parse { | ||||
| 82 | my $proto = shift; | ||||
| 83 | my $class = ref($proto) || $proto; | ||||
| 84 | my @components; | ||||
| 85 | if (@_ > 1) { | ||||
| 86 | @components = @_; | ||||
| 87 | } | ||||
| 88 | else { | ||||
| 89 | @components = shift =~ /(\d+)$DATE_SEP(\d+)$DATE_SEP(\d+)(?:(?:T|\s+)(\d+)$TIME_SEP(\d+)(?:$TIME_SEP(\d+)))/; | ||||
| 90 | @components = reverse(@components[0..5]); | ||||
| 91 | } | ||||
| 92 | return $class->new(_strftime("%s", @components)); | ||||
| 93 | } | ||||
| 94 | |||||
| 95 | sub _mktime { | ||||
| 96 | my ($class, $time, $islocal) = @_; | ||||
| 97 | $class = eval { (ref $class) && (ref $class)->isa('Time::Piece') } | ||||
| 98 | ? ref $class | ||||
| 99 | : $class; | ||||
| 100 | if (ref($time)) { | ||||
| 101 | $time->[c_epoch] = undef; | ||||
| 102 | return wantarray ? @$time : bless [@$time[0..9], $islocal], $class; | ||||
| 103 | } | ||||
| 104 | _tzset(); | ||||
| 105 | my @time = $islocal ? | ||||
| 106 | CORE::localtime($time) | ||||
| 107 | : | ||||
| 108 | CORE::gmtime($time); | ||||
| 109 | wantarray ? @time : bless [@time, $time, $islocal], $class; | ||||
| 110 | } | ||||
| 111 | |||||
| 112 | my %_special_exports = ( | ||||
| 113 | 2 | 6µs | # spent 4µs within Time::Piece::__ANON__[/usr/lib/perl/5.18/Time/Piece.pm:113] which was called:
# once (4µs+0s) by Time::Piece::export at line 123 | ||
| 114 | 2 | 7µs | # spent 4µs within Time::Piece::__ANON__[/usr/lib/perl/5.18/Time/Piece.pm:114] which was called:
# once (4µs+0s) by Time::Piece::export at line 123 | ||
| 115 | 1 | 8µs | ); | ||
| 116 | |||||
| 117 | # spent 33µs (25+8) within Time::Piece::export which was called:
# once (25µs+8µs) by Time::Piece::import at line 139 | ||||
| 118 | 1 | 1µs | my ($class, $to, @methods) = @_; | ||
| 119 | 1 | 5µs | for my $method (@methods) { | ||
| 120 | 2 | 2µs | if (exists $_special_exports{$method}) { | ||
| 121 | 2 | 130µs | 2 | 244µs | # spent 150µs (55+95) within Time::Piece::BEGIN@121 which was called:
# once (55µs+95µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 121 # spent 150µs making 1 call to Time::Piece::BEGIN@121
# spent 95µs making 1 call to strict::unimport |
| 122 | 2 | 2.37ms | 2 | 124µs | # spent 75µs (26+49) within Time::Piece::BEGIN@122 which was called:
# once (26µs+49µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 122 # spent 75µs making 1 call to Time::Piece::BEGIN@122
# spent 49µs making 1 call to warnings::unimport |
| 123 | 2 | 13µs | 2 | 8µs | *{$to . "::$method"} = $_special_exports{$method}->($class); # spent 4µs making 1 call to Time::Piece::__ANON__[Time/Piece.pm:114]
# spent 4µs making 1 call to Time::Piece::__ANON__[Time/Piece.pm:113] |
| 124 | } else { | ||||
| 125 | $class->SUPER::export($to, $method); | ||||
| 126 | } | ||||
| 127 | } | ||||
| 128 | } | ||||
| 129 | |||||
| 130 | # spent 48µs (15+33) within Time::Piece::import which was called:
# once (15µs+33µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 13 of HTTP/Headers/ActionPack/Util.pm | ||||
| 131 | # replace CORE::GLOBAL localtime and gmtime if required | ||||
| 132 | 1 | 500ns | my $class = shift; | ||
| 133 | 1 | 300ns | my %params; | ||
| 134 | 1 | 4µs | map($params{$_}++,@_,@EXPORT); | ||
| 135 | 1 | 6µs | if (delete $params{':override'}) { | ||
| 136 | $class->export('CORE::GLOBAL', keys %params); | ||||
| 137 | } | ||||
| 138 | else { | ||||
| 139 | 1 | 4µs | 1 | 33µs | $class->export((caller)[0], keys %params); # spent 33µs making 1 call to Time::Piece::export |
| 140 | } | ||||
| 141 | } | ||||
| 142 | |||||
| 143 | ## Methods ## | ||||
| 144 | |||||
| 145 | sub sec { | ||||
| 146 | my $time = shift; | ||||
| 147 | $time->[c_sec]; | ||||
| 148 | } | ||||
| 149 | |||||
| 150 | 1 | 1µs | *second = \&sec; | ||
| 151 | |||||
| 152 | sub min { | ||||
| 153 | my $time = shift; | ||||
| 154 | $time->[c_min]; | ||||
| 155 | } | ||||
| 156 | |||||
| 157 | 1 | 600ns | *minute = \&min; | ||
| 158 | |||||
| 159 | sub hour { | ||||
| 160 | my $time = shift; | ||||
| 161 | $time->[c_hour]; | ||||
| 162 | } | ||||
| 163 | |||||
| 164 | sub mday { | ||||
| 165 | my $time = shift; | ||||
| 166 | $time->[c_mday]; | ||||
| 167 | } | ||||
| 168 | |||||
| 169 | 1 | 500ns | *day_of_month = \&mday; | ||
| 170 | |||||
| 171 | sub mon { | ||||
| 172 | my $time = shift; | ||||
| 173 | $time->[c_mon] + 1; | ||||
| 174 | } | ||||
| 175 | |||||
| 176 | sub _mon { | ||||
| 177 | my $time = shift; | ||||
| 178 | $time->[c_mon]; | ||||
| 179 | } | ||||
| 180 | |||||
| 181 | sub month { | ||||
| 182 | my $time = shift; | ||||
| 183 | if (@_) { | ||||
| 184 | return $_[$time->[c_mon]]; | ||||
| 185 | } | ||||
| 186 | elsif (@MON_LIST) { | ||||
| 187 | return $MON_LIST[$time->[c_mon]]; | ||||
| 188 | } | ||||
| 189 | else { | ||||
| 190 | return $time->strftime('%b'); | ||||
| 191 | } | ||||
| 192 | } | ||||
| 193 | |||||
| 194 | 1 | 700ns | *monname = \&month; | ||
| 195 | |||||
| 196 | sub fullmonth { | ||||
| 197 | my $time = shift; | ||||
| 198 | if (@_) { | ||||
| 199 | return $_[$time->[c_mon]]; | ||||
| 200 | } | ||||
| 201 | elsif (@FULLMON_LIST) { | ||||
| 202 | return $FULLMON_LIST[$time->[c_mon]]; | ||||
| 203 | } | ||||
| 204 | else { | ||||
| 205 | return $time->strftime('%B'); | ||||
| 206 | } | ||||
| 207 | } | ||||
| 208 | |||||
| 209 | sub year { | ||||
| 210 | my $time = shift; | ||||
| 211 | $time->[c_year] + 1900; | ||||
| 212 | } | ||||
| 213 | |||||
| 214 | sub _year { | ||||
| 215 | my $time = shift; | ||||
| 216 | $time->[c_year]; | ||||
| 217 | } | ||||
| 218 | |||||
| 219 | sub yy { | ||||
| 220 | my $time = shift; | ||||
| 221 | my $res = $time->[c_year] % 100; | ||||
| 222 | return $res > 9 ? $res : "0$res"; | ||||
| 223 | } | ||||
| 224 | |||||
| 225 | sub wday { | ||||
| 226 | my $time = shift; | ||||
| 227 | $time->[c_wday] + 1; | ||||
| 228 | } | ||||
| 229 | |||||
| 230 | sub _wday { | ||||
| 231 | my $time = shift; | ||||
| 232 | $time->[c_wday]; | ||||
| 233 | } | ||||
| 234 | |||||
| 235 | 1 | 400ns | *day_of_week = \&_wday; | ||
| 236 | |||||
| 237 | sub wdayname { | ||||
| 238 | my $time = shift; | ||||
| 239 | if (@_) { | ||||
| 240 | return $_[$time->[c_wday]]; | ||||
| 241 | } | ||||
| 242 | elsif (@DAY_LIST) { | ||||
| 243 | return $DAY_LIST[$time->[c_wday]]; | ||||
| 244 | } | ||||
| 245 | else { | ||||
| 246 | return $time->strftime('%a'); | ||||
| 247 | } | ||||
| 248 | } | ||||
| 249 | |||||
| 250 | 1 | 400ns | *day = \&wdayname; | ||
| 251 | |||||
| 252 | sub fullday { | ||||
| 253 | my $time = shift; | ||||
| 254 | if (@_) { | ||||
| 255 | return $_[$time->[c_wday]]; | ||||
| 256 | } | ||||
| 257 | elsif (@FULLDAY_LIST) { | ||||
| 258 | return $FULLDAY_LIST[$time->[c_wday]]; | ||||
| 259 | } | ||||
| 260 | else { | ||||
| 261 | return $time->strftime('%A'); | ||||
| 262 | } | ||||
| 263 | } | ||||
| 264 | |||||
| 265 | sub yday { | ||||
| 266 | my $time = shift; | ||||
| 267 | $time->[c_yday]; | ||||
| 268 | } | ||||
| 269 | |||||
| 270 | 1 | 300ns | *day_of_year = \&yday; | ||
| 271 | |||||
| 272 | sub isdst { | ||||
| 273 | my $time = shift; | ||||
| 274 | $time->[c_isdst]; | ||||
| 275 | } | ||||
| 276 | |||||
| 277 | 1 | 400ns | *daylight_savings = \&isdst; | ||
| 278 | |||||
| 279 | # Thanks to Tony Olekshy <olekshy@cs.ualberta.ca> for this algorithm | ||||
| 280 | sub tzoffset { | ||||
| 281 | my $time = shift; | ||||
| 282 | |||||
| 283 | return Time::Seconds->new(0) unless $time->[c_islocal]; | ||||
| 284 | |||||
| 285 | my $epoch = $time->epoch; | ||||
| 286 | |||||
| 287 | my $j = sub { | ||||
| 288 | |||||
| 289 | my ($s,$n,$h,$d,$m,$y) = @_; $m += 1; $y += 1900; | ||||
| 290 | |||||
| 291 | $time->_jd($y, $m, $d, $h, $n, $s); | ||||
| 292 | |||||
| 293 | }; | ||||
| 294 | |||||
| 295 | # Compute floating offset in hours. | ||||
| 296 | # | ||||
| 297 | # Note use of crt methods so the tz is properly set... | ||||
| 298 | # See: http://perlmonks.org/?node_id=820347 | ||||
| 299 | my $delta = 24 * ($j->(_crt_localtime($epoch)) - $j->(_crt_gmtime($epoch))); | ||||
| 300 | |||||
| 301 | # Return value in seconds rounded to nearest minute. | ||||
| 302 | return Time::Seconds->new( int($delta * 60 + ($delta >= 0 ? 0.5 : -0.5)) * 60 ); | ||||
| 303 | } | ||||
| 304 | |||||
| 305 | sub epoch { | ||||
| 306 | my $time = shift; | ||||
| 307 | if (defined($time->[c_epoch])) { | ||||
| 308 | return $time->[c_epoch]; | ||||
| 309 | } | ||||
| 310 | else { | ||||
| 311 | my $epoch = $time->[c_islocal] ? | ||||
| 312 | timelocal(@{$time}[c_sec .. c_mon], $time->[c_year]+1900) | ||||
| 313 | : | ||||
| 314 | timegm(@{$time}[c_sec .. c_mon], $time->[c_year]+1900); | ||||
| 315 | $time->[c_epoch] = $epoch; | ||||
| 316 | return $epoch; | ||||
| 317 | } | ||||
| 318 | } | ||||
| 319 | |||||
| 320 | sub hms { | ||||
| 321 | my $time = shift; | ||||
| 322 | my $sep = @_ ? shift(@_) : $TIME_SEP; | ||||
| 323 | sprintf("%02d$sep%02d$sep%02d", $time->[c_hour], $time->[c_min], $time->[c_sec]); | ||||
| 324 | } | ||||
| 325 | |||||
| 326 | 1 | 400ns | *time = \&hms; | ||
| 327 | |||||
| 328 | sub ymd { | ||||
| 329 | my $time = shift; | ||||
| 330 | my $sep = @_ ? shift(@_) : $DATE_SEP; | ||||
| 331 | sprintf("%d$sep%02d$sep%02d", $time->year, $time->mon, $time->[c_mday]); | ||||
| 332 | } | ||||
| 333 | |||||
| 334 | 1 | 300ns | *date = \&ymd; | ||
| 335 | |||||
| 336 | sub mdy { | ||||
| 337 | my $time = shift; | ||||
| 338 | my $sep = @_ ? shift(@_) : $DATE_SEP; | ||||
| 339 | sprintf("%02d$sep%02d$sep%d", $time->mon, $time->[c_mday], $time->year); | ||||
| 340 | } | ||||
| 341 | |||||
| 342 | sub dmy { | ||||
| 343 | my $time = shift; | ||||
| 344 | my $sep = @_ ? shift(@_) : $DATE_SEP; | ||||
| 345 | sprintf("%02d$sep%02d$sep%d", $time->[c_mday], $time->mon, $time->year); | ||||
| 346 | } | ||||
| 347 | |||||
| 348 | sub datetime { | ||||
| 349 | my $time = shift; | ||||
| 350 | my %seps = (date => $DATE_SEP, T => 'T', time => $TIME_SEP, @_); | ||||
| 351 | return join($seps{T}, $time->date($seps{date}), $time->time($seps{time})); | ||||
| 352 | } | ||||
| 353 | |||||
| - - | |||||
| 356 | # Julian Day is always calculated for UT regardless | ||||
| 357 | # of local time | ||||
| 358 | sub julian_day { | ||||
| 359 | my $time = shift; | ||||
| 360 | # Correct for localtime | ||||
| 361 | $time = $time->gmtime( $time->epoch ) if $time->[c_islocal]; | ||||
| 362 | |||||
| 363 | # Calculate the Julian day itself | ||||
| 364 | my $jd = $time->_jd( $time->year, $time->mon, $time->mday, | ||||
| 365 | $time->hour, $time->min, $time->sec); | ||||
| 366 | |||||
| 367 | return $jd; | ||||
| 368 | } | ||||
| 369 | |||||
| 370 | # MJD is defined as JD - 2400000.5 days | ||||
| 371 | sub mjd { | ||||
| 372 | return shift->julian_day - 2_400_000.5; | ||||
| 373 | } | ||||
| 374 | |||||
| 375 | # Internal calculation of Julian date. Needed here so that | ||||
| 376 | # both tzoffset and mjd/jd methods can share the code | ||||
| 377 | # Algorithm from Hatcher 1984 (QJRAS 25, 53-55), and | ||||
| 378 | # Hughes et al, 1989, MNRAS, 238, 15 | ||||
| 379 | # See: http://adsabs.harvard.edu/cgi-bin/nph-bib_query?bibcode=1989MNRAS.238.1529H&db_key=AST | ||||
| 380 | # for more details | ||||
| 381 | |||||
| 382 | sub _jd { | ||||
| 383 | my $self = shift; | ||||
| 384 | my ($y, $m, $d, $h, $n, $s) = @_; | ||||
| 385 | |||||
| 386 | # Adjust input parameters according to the month | ||||
| 387 | $y = ( $m > 2 ? $y : $y - 1); | ||||
| 388 | $m = ( $m > 2 ? $m - 3 : $m + 9); | ||||
| 389 | |||||
| 390 | # Calculate the Julian Date (assuming Julian calendar) | ||||
| 391 | my $J = int( 365.25 *( $y + 4712) ) | ||||
| 392 | + int( (30.6 * $m) + 0.5) | ||||
| 393 | + 59 | ||||
| 394 | + $d | ||||
| 395 | - 0.5; | ||||
| 396 | |||||
| 397 | # Calculate the Gregorian Correction (since we have Gregorian dates) | ||||
| 398 | my $G = 38 - int( 0.75 * int(49+($y/100))); | ||||
| 399 | |||||
| 400 | # Calculate the actual Julian Date | ||||
| 401 | my $JD = $J + $G; | ||||
| 402 | |||||
| 403 | # Modify to include hours/mins/secs in floating portion. | ||||
| 404 | return $JD + ($h + ($n + $s / 60) / 60) / 24; | ||||
| 405 | } | ||||
| 406 | |||||
| 407 | sub week { | ||||
| 408 | my $self = shift; | ||||
| 409 | |||||
| 410 | my $J = $self->julian_day; | ||||
| 411 | # Julian day is independent of time zone so add on tzoffset | ||||
| 412 | # if we are using local time here since we want the week day | ||||
| 413 | # to reflect the local time rather than UTC | ||||
| 414 | $J += ($self->tzoffset/(24*3600)) if $self->[c_islocal]; | ||||
| 415 | |||||
| 416 | # Now that we have the Julian day including fractions | ||||
| 417 | # convert it to an integer Julian Day Number using nearest | ||||
| 418 | # int (since the day changes at midday we oconvert all Julian | ||||
| 419 | # dates to following midnight). | ||||
| 420 | $J = int($J+0.5); | ||||
| 421 | |||||
| 422 | 2 | 838µs | 2 | 218µs | # spent 215µs (211+4) within Time::Piece::BEGIN@422 which was called:
# once (211µs+4µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 422 # spent 215µs making 1 call to Time::Piece::BEGIN@422
# spent 4µs making 1 call to integer::import |
| 423 | my $d4 = ((($J + 31741 - ($J % 7)) % 146097) % 36524) % 1461; | ||||
| 424 | my $L = $d4 / 1460; | ||||
| 425 | my $d1 = (($d4 - $L) % 365) + $L; | ||||
| 426 | return $d1 / 7 + 1; | ||||
| 427 | } | ||||
| 428 | |||||
| 429 | sub _is_leap_year { | ||||
| 430 | my $year = shift; | ||||
| 431 | return (($year %4 == 0) && !($year % 100 == 0)) || ($year % 400 == 0) | ||||
| 432 | ? 1 : 0; | ||||
| 433 | } | ||||
| 434 | |||||
| 435 | sub is_leap_year { | ||||
| 436 | my $time = shift; | ||||
| 437 | my $year = $time->year; | ||||
| 438 | return _is_leap_year($year); | ||||
| 439 | } | ||||
| 440 | |||||
| 441 | 1 | 2µs | my @MON_LAST = qw(31 28 31 30 31 30 31 31 30 31 30 31); | ||
| 442 | |||||
| 443 | sub month_last_day { | ||||
| 444 | my $time = shift; | ||||
| 445 | my $year = $time->year; | ||||
| 446 | my $_mon = $time->_mon; | ||||
| 447 | return $MON_LAST[$_mon] + ($_mon == 1 ? _is_leap_year($year) : 0); | ||||
| 448 | } | ||||
| 449 | |||||
| 450 | sub strftime { | ||||
| 451 | my $time = shift; | ||||
| 452 | my $tzname = $time->[c_islocal] ? '%Z' : 'UTC'; | ||||
| 453 | my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S $tzname"; | ||||
| 454 | if (!defined $time->[c_wday]) { | ||||
| 455 | if ($time->[c_islocal]) { | ||||
| 456 | return _strftime($format, CORE::localtime($time->epoch)); | ||||
| 457 | } | ||||
| 458 | else { | ||||
| 459 | return _strftime($format, CORE::gmtime($time->epoch)); | ||||
| 460 | } | ||||
| 461 | } | ||||
| 462 | return _strftime($format, (@$time)[c_sec..c_isdst]); | ||||
| 463 | } | ||||
| 464 | |||||
| 465 | sub strptime { | ||||
| 466 | my $time = shift; | ||||
| 467 | my $string = shift; | ||||
| 468 | my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z"; | ||||
| 469 | my @vals = _strptime($string, $format); | ||||
| 470 | # warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals))); | ||||
| 471 | return scalar $time->_mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0)); | ||||
| 472 | } | ||||
| 473 | |||||
| 474 | sub day_list { | ||||
| 475 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method | ||||
| 476 | my @old = @DAY_LIST; | ||||
| 477 | if (@_) { | ||||
| 478 | @DAY_LIST = @_; | ||||
| 479 | } | ||||
| 480 | return @old; | ||||
| 481 | } | ||||
| 482 | |||||
| 483 | sub mon_list { | ||||
| 484 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); # strip first if called as a method | ||||
| 485 | my @old = @MON_LIST; | ||||
| 486 | if (@_) { | ||||
| 487 | @MON_LIST = @_; | ||||
| 488 | } | ||||
| 489 | return @old; | ||||
| 490 | } | ||||
| 491 | |||||
| 492 | sub time_separator { | ||||
| 493 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); | ||||
| 494 | my $old = $TIME_SEP; | ||||
| 495 | if (@_) { | ||||
| 496 | $TIME_SEP = $_[0]; | ||||
| 497 | } | ||||
| 498 | return $old; | ||||
| 499 | } | ||||
| 500 | |||||
| 501 | sub date_separator { | ||||
| 502 | shift if ref($_[0]) && $_[0]->isa(__PACKAGE__); | ||||
| 503 | my $old = $DATE_SEP; | ||||
| 504 | if (@_) { | ||||
| 505 | $DATE_SEP = $_[0]; | ||||
| 506 | } | ||||
| 507 | return $old; | ||||
| 508 | } | ||||
| 509 | |||||
| 510 | 1 | 9µs | 1 | 45µs | # spent 60µs (15+45) within Time::Piece::BEGIN@510 which was called:
# once (15µs+45µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 512 # spent 45µs making 1 call to overload::import |
| 511 | 'cmp' => \&str_compare, | ||||
| 512 | 1 | 150µs | 1 | 60µs | 'fallback' => undef; # spent 60µs making 1 call to Time::Piece::BEGIN@510 |
| 513 | |||||
| 514 | sub cdate { | ||||
| 515 | my $time = shift; | ||||
| 516 | if ($time->[c_islocal]) { | ||||
| 517 | return scalar(CORE::localtime($time->epoch)); | ||||
| 518 | } | ||||
| 519 | else { | ||||
| 520 | return scalar(CORE::gmtime($time->epoch)); | ||||
| 521 | } | ||||
| 522 | } | ||||
| 523 | |||||
| 524 | sub str_compare { | ||||
| 525 | my ($lhs, $rhs, $reverse) = @_; | ||||
| 526 | if (UNIVERSAL::isa($rhs, 'Time::Piece')) { | ||||
| 527 | $rhs = "$rhs"; | ||||
| 528 | } | ||||
| 529 | return $reverse ? $rhs cmp $lhs->cdate : $lhs->cdate cmp $rhs; | ||||
| 530 | } | ||||
| 531 | |||||
| 532 | use overload | ||||
| 533 | 1 | 6µs | 1 | 21µs | # spent 31µs (10+21) within Time::Piece::BEGIN@533 which was called:
# once (10µs+21µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 534 # spent 21µs making 1 call to overload::import |
| 534 | 1 | 216µs | 1 | 31µs | '+' => \&add; # spent 31µs making 1 call to Time::Piece::BEGIN@533 |
| 535 | |||||
| 536 | sub subtract { | ||||
| 537 | my $time = shift; | ||||
| 538 | my $rhs = shift; | ||||
| 539 | if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { | ||||
| 540 | $rhs = $rhs->seconds; | ||||
| 541 | } | ||||
| 542 | |||||
| 543 | if (shift) | ||||
| 544 | { | ||||
| 545 | # SWAPED is set (so someone tried an expression like NOTDATE - DATE). | ||||
| 546 | # Imitate Perl's standard behavior and return the result as if the | ||||
| 547 | # string $time resolves to was subtracted from NOTDATE. This way, | ||||
| 548 | # classes which override this one and which have a stringify function | ||||
| 549 | # that resolves to something that looks more like a number don't need | ||||
| 550 | # to override this function. | ||||
| 551 | return $rhs - "$time"; | ||||
| 552 | } | ||||
| 553 | |||||
| 554 | if (UNIVERSAL::isa($rhs, 'Time::Piece')) { | ||||
| 555 | return Time::Seconds->new($time->epoch - $rhs->epoch); | ||||
| 556 | } | ||||
| 557 | else { | ||||
| 558 | # rhs is seconds. | ||||
| 559 | return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]); | ||||
| 560 | } | ||||
| 561 | } | ||||
| 562 | |||||
| 563 | sub add { | ||||
| 564 | my $time = shift; | ||||
| 565 | my $rhs = shift; | ||||
| 566 | if (UNIVERSAL::isa($rhs, 'Time::Seconds')) { | ||||
| 567 | $rhs = $rhs->seconds; | ||||
| 568 | } | ||||
| 569 | croak "Invalid rhs of addition: $rhs" if ref($rhs); | ||||
| 570 | |||||
| 571 | return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]); | ||||
| 572 | } | ||||
| 573 | |||||
| 574 | use overload | ||||
| 575 | 2 | 348µs | 2 | 46µs | # spent 28µs (10+18) within Time::Piece::BEGIN@575 which was called:
# once (10µs+18µs) by HTTP::Headers::ActionPack::Util::BEGIN@13 at line 575 # spent 28µs making 1 call to Time::Piece::BEGIN@575
# spent 18µs making 1 call to overload::import |
| 576 | |||||
| 577 | sub get_epochs { | ||||
| 578 | my ($lhs, $rhs, $reverse) = @_; | ||||
| 579 | if (!UNIVERSAL::isa($rhs, 'Time::Piece')) { | ||||
| 580 | $rhs = $lhs->new($rhs); | ||||
| 581 | } | ||||
| 582 | if ($reverse) { | ||||
| 583 | return $rhs->epoch, $lhs->epoch; | ||||
| 584 | } | ||||
| 585 | return $lhs->epoch, $rhs->epoch; | ||||
| 586 | } | ||||
| 587 | |||||
| 588 | sub compare { | ||||
| 589 | my ($lhs, $rhs) = get_epochs(@_); | ||||
| 590 | return $lhs <=> $rhs; | ||||
| 591 | } | ||||
| 592 | |||||
| 593 | sub add_months { | ||||
| 594 | my ($time, $num_months) = @_; | ||||
| 595 | |||||
| 596 | croak("add_months requires a number of months") unless defined($num_months); | ||||
| 597 | |||||
| 598 | my $final_month = $time->_mon + $num_months; | ||||
| 599 | my $num_years = 0; | ||||
| 600 | if ($final_month > 11 || $final_month < 0) { | ||||
| 601 | # these two ops required because we have no POSIX::floor and don't | ||||
| 602 | # want to load POSIX.pm | ||||
| 603 | if ($final_month < 0 && $final_month % 12 == 0) { | ||||
| 604 | $num_years = int($final_month / 12) + 1; | ||||
| 605 | } | ||||
| 606 | else { | ||||
| 607 | $num_years = int($final_month / 12); | ||||
| 608 | } | ||||
| 609 | $num_years-- if ($final_month < 0); | ||||
| 610 | |||||
| 611 | $final_month = $final_month % 12; | ||||
| 612 | } | ||||
| 613 | |||||
| 614 | my @vals = _mini_mktime($time->sec, $time->min, $time->hour, | ||||
| 615 | $time->mday, $final_month, $time->year - 1900 + $num_years); | ||||
| 616 | # warn(sprintf("got %d vals: %d-%d-%d %d:%d:%d [%d]\n", scalar(@vals), reverse(@vals), $time->[c_islocal])); | ||||
| 617 | return scalar $time->_mktime(\@vals, $time->[c_islocal]); | ||||
| 618 | } | ||||
| 619 | |||||
| 620 | sub add_years { | ||||
| 621 | my ($time, $years) = @_; | ||||
| 622 | $time->add_months($years * 12); | ||||
| 623 | } | ||||
| 624 | |||||
| 625 | 1 | 18µs | 1; | ||
| 626 | __END__ | ||||
# spent 29µs within Time::Piece::bootstrap which was called:
# once (29µs+0s) by DynaLoader::bootstrap at line 207 of DynaLoader.pm |