Filename | /usr/local/lib/perl/5.14.2/DateTime.pm |
Statements | Executed 440 statements in 28.7ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 6.47ms | 36.7ms | BEGIN@46 | DateTime::
1 | 1 | 1 | 3.80ms | 19.2ms | BEGIN@43 | DateTime::
1 | 1 | 1 | 3.59ms | 93.4ms | BEGIN@45 | DateTime::
1 | 1 | 1 | 1.32ms | 14.9ms | BEGIN@49 | DateTime::
1 | 1 | 1 | 272µs | 279µs | BEGIN@718 | DateTime::
4 | 1 | 1 | 137µs | 168µs | _calc_local_components | DateTime::
59 | 3 | 1 | 116µs | 116µs | CORE:qr (opcode) | DateTime::
4 | 4 | 2 | 108µs | 362µs | _calc_local_rd | DateTime::
3 | 3 | 2 | 93µs | 126µs | _calc_utc_rd | DateTime::
1 | 1 | 1 | 88µs | 344µs | _new | DateTime::
1 | 1 | 1 | 62µs | 999µs | from_epoch | DateTime::
2 | 2 | 1 | 61µs | 193µs | _handle_offset_modifier | DateTime::
1 | 1 | 1 | 59µs | 438µs | set_time_zone | DateTime::
1 | 1 | 1 | 54µs | 54µs | CORE:regcomp (opcode) | DateTime::
1 | 1 | 1 | 40µs | 40µs | BEGIN@6 | DateTime::
1 | 1 | 1 | 28µs | 34µs | BEGIN@1871 | DateTime::
1 | 1 | 1 | 27µs | 162µs | BEGIN@47 | DateTime::
1 | 1 | 1 | 26µs | 81µs | BEGIN@77 | DateTime::
4 | 2 | 1 | 26µs | 26µs | _normalize_tai_seconds (xsub) | DateTime::
3 | 3 | 2 | 25µs | 257µs | offset | DateTime::
1 | 1 | 1 | 20µs | 88µs | BEGIN@50 | DateTime::
2 | 2 | 1 | 18µs | 52µs | DefaultLocale | DateTime::
1 | 1 | 1 | 17µs | 192µs | BEGIN@58 | DateTime::
1 | 1 | 1 | 17µs | 100µs | BEGIN@42 | DateTime::
1 | 1 | 1 | 16µs | 23µs | BEGIN@8 | DateTime::
1 | 1 | 1 | 15µs | 19µs | _set_locale | DateTime::
1 | 1 | 1 | 15µs | 81µs | BEGIN@75 | DateTime::
1 | 1 | 1 | 15µs | 26µs | BEGIN@9 | DateTime::
1 | 1 | 1 | 14µs | 80µs | BEGIN@73 | DateTime::
1 | 1 | 1 | 13µs | 71µs | BEGIN@76 | DateTime::
1 | 1 | 1 | 13µs | 13µs | BEGIN@85 | DateTime::
1 | 1 | 1 | 12µs | 68µs | BEGIN@81 | DateTime::
1 | 1 | 1 | 12µs | 12µs | BEGIN@44 | DateTime::
1 | 1 | 1 | 12µs | 70µs | BEGIN@79 | DateTime::
3 | 1 | 1 | 12µs | 12µs | utc_rd_as_seconds | DateTime::
1 | 1 | 1 | 9µs | 1.01ms | now | DateTime::
1 | 1 | 1 | 9µs | 11µs | _offset_for_local_datetime | DateTime::
1 | 1 | 1 | 9µs | 9µs | _normalize_nanoseconds | DateTime::
2 | 1 | 1 | 9µs | 9µs | _rd2ymd (xsub) | DateTime::
1 | 1 | 1 | 6µs | 6µs | _ymd2rd (xsub) | DateTime::
1 | 1 | 1 | 6µs | 6µs | CORE:match (opcode) | DateTime::
2 | 1 | 1 | 4µs | 4µs | _seconds_as_components (xsub) | DateTime::
1 | 1 | 1 | 4µs | 4µs | second | DateTime::
1 | 1 | 1 | 3µs | 3µs | _day_length (xsub) | DateTime::
1 | 1 | 1 | 3µs | 3µs | _time_as_seconds (xsub) | DateTime::
0 | 0 | 0 | 0s | 0s | STORABLE_freeze | DateTime::
0 | 0 | 0 | 0s | 0s | STORABLE_thaw | DateTime::
0 | 0 | 0 | 0s | 0s | time_zone | DateTime::_Thawed::
0 | 0 | 0 | 0s | 0s | utc_rd_values | DateTime::_Thawed::
0 | 0 | 0 | 0s | 0s | __ANON__[:1001] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1002] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1003] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1004] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1005] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1006] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1007] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1008] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1009] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1010] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1011] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1012] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1013] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1014] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1015] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1016] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1018] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1019] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1020] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1021] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1022] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1023] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1024] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1025] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1026] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1030] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1031] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1035] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1039] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1042] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1045] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1046] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1047] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1048] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1049] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1050] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1099] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1104] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1112] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1113] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1114] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1116] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1121] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1126] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1130] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1132] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1135] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1139] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1143] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1146] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1150] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1151] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1154] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1158] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1160] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1163] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1167] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1173] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1178] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1183] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1186] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1190] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1192] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1197] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1198] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1200] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1202] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1209] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:120] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1212] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1215] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1226] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1228] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1230] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1231] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1235] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1237] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1238] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1239] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1240] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1241] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:128] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:136] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:144] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:152] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:160] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:167] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:183] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:2014] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:2017] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:634] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:995] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:996] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:997] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:998] | DateTime::
0 | 0 | 0 | 0s | 0s | _add_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _adjust_for_positive_difference | DateTime::
0 | 0 | 0 | 0s | 0s | _calc_utc_components | DateTime::
0 | 0 | 0 | 0s | 0s | _cldr_pattern | DateTime::
0 | 0 | 0 | 0s | 0s | _compare | DateTime::
0 | 0 | 0 | 0s | 0s | _compare_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _era_index | DateTime::
0 | 0 | 0 | 0s | 0s | _format_nanosecs | DateTime::
0 | 0 | 0 | 0s | 0s | _month_length | DateTime::
0 | 0 | 0 | 0s | 0s | _new_from_self | DateTime::
0 | 0 | 0 | 0s | 0s | _normalize_seconds | DateTime::
0 | 0 | 0 | 0s | 0s | _space_padded_string | DateTime::
0 | 0 | 0 | 0s | 0s | _string_compare_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _string_equals_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _string_not_equals_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _stringify | DateTime::
0 | 0 | 0 | 0s | 0s | _subtract_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _utc_hms | DateTime::
0 | 0 | 0 | 0s | 0s | _utc_ymd | DateTime::
0 | 0 | 0 | 0s | 0s | _weeks_in_year | DateTime::
0 | 0 | 0 | 0s | 0s | _zero_padded_number | DateTime::
0 | 0 | 0 | 0s | 0s | add | DateTime::
0 | 0 | 0 | 0s | 0s | add_duration | DateTime::
0 | 0 | 0 | 0s | 0s | am_or_pm | DateTime::
0 | 0 | 0 | 0s | 0s | ce_year | DateTime::
0 | 0 | 0 | 0s | 0s | christian_era | DateTime::
0 | 0 | 0 | 0s | 0s | clone | DateTime::
0 | 0 | 0 | 0s | 0s | compare | DateTime::
0 | 0 | 0 | 0s | 0s | compare_ignore_floating | DateTime::
0 | 0 | 0 | 0s | 0s | day_abbr | DateTime::
0 | 0 | 0 | 0s | 0s | day_name | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_month | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_month_0 | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_quarter | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_quarter_0 | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_week | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_week_0 | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_year | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_year_0 | DateTime::
0 | 0 | 0 | 0s | 0s | delta_days | DateTime::
0 | 0 | 0 | 0s | 0s | delta_md | DateTime::
0 | 0 | 0 | 0s | 0s | delta_ms | DateTime::
0 | 0 | 0 | 0s | 0s | dmy | DateTime::
0 | 0 | 0 | 0s | 0s | epoch | DateTime::
0 | 0 | 0 | 0s | 0s | era_abbr | DateTime::
0 | 0 | 0 | 0s | 0s | era_name | DateTime::
0 | 0 | 0 | 0s | 0s | format_cldr | DateTime::
0 | 0 | 0 | 0s | 0s | formatter | DateTime::
0 | 0 | 0 | 0s | 0s | fractional_second | DateTime::
0 | 0 | 0 | 0s | 0s | from_day_of_year | DateTime::
0 | 0 | 0 | 0s | 0s | from_object | DateTime::
0 | 0 | 0 | 0s | 0s | hires_epoch | DateTime::
0 | 0 | 0 | 0s | 0s | hms | DateTime::
0 | 0 | 0 | 0s | 0s | hour | DateTime::
0 | 0 | 0 | 0s | 0s | hour_1 | DateTime::
0 | 0 | 0 | 0s | 0s | hour_12 | DateTime::
0 | 0 | 0 | 0s | 0s | hour_12_0 | DateTime::
0 | 0 | 0 | 0s | 0s | is_dst | DateTime::
0 | 0 | 0 | 0s | 0s | is_finite | DateTime::
0 | 0 | 0 | 0s | 0s | is_infinite | DateTime::
0 | 0 | 0 | 0s | 0s | is_leap_year | DateTime::
0 | 0 | 0 | 0s | 0s | iso8601 | DateTime::
0 | 0 | 0 | 0s | 0s | jd | DateTime::
0 | 0 | 0 | 0s | 0s | last_day_of_month | DateTime::
0 | 0 | 0 | 0s | 0s | leap_seconds | DateTime::
0 | 0 | 0 | 0s | 0s | local_day_of_week | DateTime::
0 | 0 | 0 | 0s | 0s | local_rd_as_seconds | DateTime::
0 | 0 | 0 | 0s | 0s | local_rd_values | DateTime::
0 | 0 | 0 | 0s | 0s | locale | DateTime::
0 | 0 | 0 | 0s | 0s | mdy | DateTime::
0 | 0 | 0 | 0s | 0s | microsecond | DateTime::
0 | 0 | 0 | 0s | 0s | millisecond | DateTime::
0 | 0 | 0 | 0s | 0s | minute | DateTime::
0 | 0 | 0 | 0s | 0s | mjd | DateTime::
0 | 0 | 0 | 0s | 0s | month | DateTime::
0 | 0 | 0 | 0s | 0s | month_0 | DateTime::
0 | 0 | 0 | 0s | 0s | month_abbr | DateTime::
0 | 0 | 0 | 0s | 0s | month_name | DateTime::
0 | 0 | 0 | 0s | 0s | nanosecond | DateTime::
0 | 0 | 0 | 0s | 0s | new | DateTime::
0 | 0 | 0 | 0s | 0s | quarter | DateTime::
0 | 0 | 0 | 0s | 0s | quarter_0 | DateTime::
0 | 0 | 0 | 0s | 0s | quarter_abbr | DateTime::
0 | 0 | 0 | 0s | 0s | quarter_name | DateTime::
0 | 0 | 0 | 0s | 0s | secular_era | DateTime::
0 | 0 | 0 | 0s | 0s | set | DateTime::
0 | 0 | 0 | 0s | 0s | set_day | DateTime::
0 | 0 | 0 | 0s | 0s | set_formatter | DateTime::
0 | 0 | 0 | 0s | 0s | set_hour | DateTime::
0 | 0 | 0 | 0s | 0s | set_locale | DateTime::
0 | 0 | 0 | 0s | 0s | set_minute | DateTime::
0 | 0 | 0 | 0s | 0s | set_month | DateTime::
0 | 0 | 0 | 0s | 0s | set_nanosecond | DateTime::
0 | 0 | 0 | 0s | 0s | set_second | DateTime::
0 | 0 | 0 | 0s | 0s | set_year | DateTime::
0 | 0 | 0 | 0s | 0s | strftime | DateTime::
0 | 0 | 0 | 0s | 0s | subtract | DateTime::
0 | 0 | 0 | 0s | 0s | subtract_datetime | DateTime::
0 | 0 | 0 | 0s | 0s | subtract_datetime_absolute | DateTime::
0 | 0 | 0 | 0s | 0s | subtract_duration | DateTime::
0 | 0 | 0 | 0s | 0s | time_zone | DateTime::
0 | 0 | 0 | 0s | 0s | time_zone_long_name | DateTime::
0 | 0 | 0 | 0s | 0s | time_zone_short_name | DateTime::
0 | 0 | 0 | 0s | 0s | today | DateTime::
0 | 0 | 0 | 0s | 0s | truncate | DateTime::
0 | 0 | 0 | 0s | 0s | utc_rd_values | DateTime::
0 | 0 | 0 | 0s | 0s | utc_year | DateTime::
0 | 0 | 0 | 0s | 0s | week | DateTime::
0 | 0 | 0 | 0s | 0s | week_number | DateTime::
0 | 0 | 0 | 0s | 0s | week_of_month | DateTime::
0 | 0 | 0 | 0s | 0s | week_year | DateTime::
0 | 0 | 0 | 0s | 0s | weekday_of_month | DateTime::
0 | 0 | 0 | 0s | 0s | year | DateTime::
0 | 0 | 0 | 0s | 0s | year_with_christian_era | DateTime::
0 | 0 | 0 | 0s | 0s | year_with_era | DateTime::
0 | 0 | 0 | 0s | 0s | year_with_secular_era | DateTime::
0 | 0 | 0 | 0s | 0s | ymd | DateTime::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DateTime; | ||||
2 | { | ||||
3 | 2 | 3µs | $DateTime::VERSION = '1.04'; | ||
4 | } | ||||
5 | |||||
6 | 2 | 98µs | 1 | 40µs | # spent 40µs within DateTime::BEGIN@6 which was called:
# once (40µs+0s) by Value::Convertor::BEGIN@61 at line 6 # spent 40µs making 1 call to DateTime::BEGIN@6 |
7 | |||||
8 | 2 | 49µs | 2 | 30µs | # spent 23µs (16+7) within DateTime::BEGIN@8 which was called:
# once (16µs+7µs) by Value::Convertor::BEGIN@61 at line 8 # spent 23µs making 1 call to DateTime::BEGIN@8
# spent 7µs making 1 call to strict::import |
9 | 2 | 326µs | 2 | 38µs | # spent 26µs (15+12) within DateTime::BEGIN@9 which was called:
# once (15µs+12µs) by Value::Convertor::BEGIN@61 at line 9 # spent 26µs making 1 call to DateTime::BEGIN@9
# spent 12µs making 1 call to warnings::import |
10 | |||||
11 | { | ||||
12 | 2 | 1µs | my $loaded = 0; | ||
13 | |||||
14 | 1 | 2µs | unless ( $ENV{PERL_DATETIME_PP} ) { | ||
15 | 1 | 700ns | local $@; | ||
16 | 1 | 2µs | eval { | ||
17 | 1 | 1µs | require XSLoader; | ||
18 | 1 | 3µs | XSLoader::load( | ||
19 | __PACKAGE__, | ||||
20 | 1 | 1µs | exists $DateTime::{VERSION} && ${ $DateTime::{VERSION} } | ||
21 | 1 | 323µs | 1 | 306µs | ? ${ $DateTime::{VERSION} } # spent 306µs making 1 call to XSLoader::load |
22 | : 42 | ||||
23 | ); | ||||
24 | |||||
25 | 1 | 2µs | $DateTime::IsPurePerl = 0; | ||
26 | }; | ||||
27 | |||||
28 | 1 | 400ns | die $@ if $@ && $@ !~ /object version|loadable object/; | ||
29 | |||||
30 | 1 | 2µs | $loaded = 1 unless $@; | ||
31 | } | ||||
32 | |||||
33 | 1 | 1µs | if ($loaded) { | ||
34 | require DateTimePPExtra | ||||
35 | 1 | 1µs | unless defined &DateTime::_normalize_tai_seconds; | ||
36 | } | ||||
37 | else { | ||||
38 | require DateTimePP; | ||||
39 | } | ||||
40 | } | ||||
41 | |||||
42 | 2 | 55µs | 2 | 183µs | # spent 100µs (17+83) within DateTime::BEGIN@42 which was called:
# once (17µs+83µs) by Value::Convertor::BEGIN@61 at line 42 # spent 100µs making 1 call to DateTime::BEGIN@42
# spent 83µs making 1 call to Exporter::import |
43 | 2 | 410µs | 1 | 19.2ms | # spent 19.2ms (3.80+15.4) within DateTime::BEGIN@43 which was called:
# once (3.80ms+15.4ms) by Value::Convertor::BEGIN@61 at line 43 # spent 19.2ms making 1 call to DateTime::BEGIN@43 |
44 | 2 | 58µs | 1 | 12µs | # spent 12µs within DateTime::BEGIN@44 which was called:
# once (12µs+0s) by Value::Convertor::BEGIN@61 at line 44 # spent 12µs making 1 call to DateTime::BEGIN@44 |
45 | 3 | 248µs | 2 | 93.4ms | # spent 93.4ms (3.59+89.8) within DateTime::BEGIN@45 which was called:
# once (3.59ms+89.8ms) by Value::Convertor::BEGIN@61 at line 45 # spent 93.4ms making 1 call to DateTime::BEGIN@45
# spent 33µs making 1 call to UNIVERSAL::VERSION |
46 | 3 | 298µs | 2 | 36.8ms | # spent 36.7ms (6.47+30.3) within DateTime::BEGIN@46 which was called:
# once (6.47ms+30.3ms) by Value::Convertor::BEGIN@61 at line 46 # spent 36.7ms making 1 call to DateTime::BEGIN@46
# spent 30µs making 1 call to UNIVERSAL::VERSION |
47 | # spent 162µs (27+135) within DateTime::BEGIN@47 which was called:
# once (27µs+135µs) by Value::Convertor::BEGIN@61 at line 48 | ||||
48 | 3 | 99µs | 3 | 298µs | qw( validate validate_pos UNDEF SCALAR BOOLEAN HASHREF OBJECT ); # spent 162µs making 1 call to DateTime::BEGIN@47
# spent 112µs making 1 call to Exporter::import
# spent 23µs making 1 call to UNIVERSAL::VERSION |
49 | 2 | 222µs | 2 | 19.6ms | # spent 14.9ms (1.32+13.6) within DateTime::BEGIN@49 which was called:
# once (1.32ms+13.6ms) by Value::Convertor::BEGIN@61 at line 49 # spent 14.9ms making 1 call to DateTime::BEGIN@49
# spent 4.71ms making 1 call to POSIX::import |
50 | 2 | 110µs | 2 | 157µs | # spent 88µs (20+68) within DateTime::BEGIN@50 which was called:
# once (20µs+68µs) by Value::Convertor::BEGIN@61 at line 50 # spent 88µs making 1 call to DateTime::BEGIN@50
# spent 68µs making 1 call to Exporter::import |
51 | |||||
52 | # for some reason, overloading doesn't work unless fallback is listed | ||||
53 | # early. | ||||
54 | # | ||||
55 | # 3rd parameter ( $_[2] ) means the parameters are 'reversed'. | ||||
56 | # see: "Calling conventions for binary operations" in overload docs. | ||||
57 | # | ||||
58 | # spent 192µs (17+175) within DateTime::BEGIN@58 which was called:
# once (17µs+175µs) by Value::Convertor::BEGIN@61 at line 67 | ||||
59 | 1 | 175µs | 'fallback' => 1, # spent 175µs making 1 call to overload::import | ||
60 | '<=>' => '_compare_overload', | ||||
61 | 'cmp' => '_string_compare_overload', | ||||
62 | '""' => '_stringify', | ||||
63 | '-' => '_subtract_overload', | ||||
64 | '+' => '_add_overload', | ||||
65 | 'eq' => '_string_equals_overload', | ||||
66 | 'ne' => '_string_not_equals_overload', | ||||
67 | 2 | 81µs | 1 | 192µs | ); # spent 192µs making 1 call to DateTime::BEGIN@58 |
68 | |||||
69 | # Have to load this after overloading is defined, after BEGIN blocks | ||||
70 | # or else weird crashes ensue | ||||
71 | 1 | 163µs | require DateTime::Infinite; | ||
72 | |||||
73 | 2 | 76µs | 2 | 147µs | # spent 80µs (14+67) within DateTime::BEGIN@73 which was called:
# once (14µs+67µs) by Value::Convertor::BEGIN@61 at line 73 # spent 80µs making 1 call to DateTime::BEGIN@73
# spent 67µs making 1 call to constant::import |
74 | |||||
75 | 2 | 69µs | 2 | 146µs | # spent 81µs (15+66) within DateTime::BEGIN@75 which was called:
# once (15µs+66µs) by Value::Convertor::BEGIN@61 at line 75 # spent 81µs making 1 call to DateTime::BEGIN@75
# spent 66µs making 1 call to constant::import |
76 | 2 | 63µs | 2 | 129µs | # spent 71µs (13+58) within DateTime::BEGIN@76 which was called:
# once (13µs+58µs) by Value::Convertor::BEGIN@61 at line 76 # spent 71µs making 1 call to DateTime::BEGIN@76
# spent 58µs making 1 call to constant::import |
77 | 2 | 56µs | 2 | 136µs | # spent 81µs (26+55) within DateTime::BEGIN@77 which was called:
# once (26µs+55µs) by Value::Convertor::BEGIN@61 at line 77 # spent 81µs making 1 call to DateTime::BEGIN@77
# spent 55µs making 1 call to constant::import |
78 | |||||
79 | 2 | 54µs | 2 | 128µs | # spent 70µs (12+58) within DateTime::BEGIN@79 which was called:
# once (12µs+58µs) by Value::Convertor::BEGIN@61 at line 79 # spent 70µs making 1 call to DateTime::BEGIN@79
# spent 58µs making 1 call to constant::import |
80 | |||||
81 | 2 | 114µs | 2 | 123µs | # spent 68µs (12+55) within DateTime::BEGIN@81 which was called:
# once (12µs+55µs) by Value::Convertor::BEGIN@61 at line 81 # spent 68µs making 1 call to DateTime::BEGIN@81
# spent 55µs making 1 call to constant::import |
82 | |||||
83 | 1 | 700ns | my ( @MonthLengths, @LeapYearMonthLengths ); | ||
84 | |||||
85 | # spent 13µs within DateTime::BEGIN@85 which was called:
# once (13µs+0s) by Value::Convertor::BEGIN@61 at line 90 | ||||
86 | 3 | 13µs | @MonthLengths = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ); | ||
87 | |||||
88 | @LeapYearMonthLengths = @MonthLengths; | ||||
89 | $LeapYearMonthLengths[1]++; | ||||
90 | 1 | 6.18ms | 1 | 13µs | } # spent 13µs making 1 call to DateTime::BEGIN@85 |
91 | |||||
92 | { | ||||
93 | |||||
94 | # I'd rather use Class::Data::Inheritable for this, but there's no | ||||
95 | # way to add the module-loading behavior to an accessor it | ||||
96 | # creates, despite what its docs say! | ||||
97 | 2 | 900ns | my $DefaultLocale; | ||
98 | |||||
99 | sub DefaultLocale { | ||||
100 | 8 | 21µs | my $class = shift; | ||
101 | |||||
102 | if (@_) { | ||||
103 | my $lang = shift; | ||||
104 | |||||
105 | 1 | 34µs | $DefaultLocale = DateTime::Locale->load($lang); # spent 34µs making 1 call to DateTime::Locale::load | ||
106 | } | ||||
107 | |||||
108 | return $DefaultLocale; | ||||
109 | } | ||||
110 | |||||
111 | # backwards compat | ||||
112 | 1 | 7µs | *DefaultLanguage = \&DefaultLocale; | ||
113 | } | ||||
114 | 1 | 4µs | 1 | 48µs | __PACKAGE__->DefaultLocale('en_US'); # spent 48µs making 1 call to DateTime::DefaultLocale |
115 | |||||
116 | my $BasicValidate = { | ||||
117 | year => { | ||||
118 | type => SCALAR, | ||||
119 | callbacks => { | ||||
120 | 'is an integer' => sub { $_[0] =~ /^-?\d+$/ } | ||||
121 | }, | ||||
122 | }, | ||||
123 | month => { | ||||
124 | type => SCALAR, | ||||
125 | default => 1, | ||||
126 | callbacks => { | ||||
127 | 'an integer between 1 and 12' => | ||||
128 | sub { $_[0] =~ /^\d+$/ && $_[0] >= 1 && $_[0] <= 12 } | ||||
129 | }, | ||||
130 | }, | ||||
131 | day => { | ||||
132 | type => SCALAR, | ||||
133 | default => 1, | ||||
134 | callbacks => { | ||||
135 | 'an integer which is a possible valid day of month' => | ||||
136 | sub { $_[0] =~ /^\d+$/ && $_[0] >= 1 && $_[0] <= 31 } | ||||
137 | }, | ||||
138 | }, | ||||
139 | hour => { | ||||
140 | type => SCALAR, | ||||
141 | default => 0, | ||||
142 | callbacks => { | ||||
143 | 'an integer between 0 and 23' => | ||||
144 | sub { $_[0] =~ /^\d+$/ && $_[0] >= 0 && $_[0] <= 23 }, | ||||
145 | }, | ||||
146 | }, | ||||
147 | minute => { | ||||
148 | type => SCALAR, | ||||
149 | default => 0, | ||||
150 | callbacks => { | ||||
151 | 'an integer between 0 and 59' => | ||||
152 | sub { $_[0] =~ /^\d+$/ && $_[0] >= 0 && $_[0] <= 59 }, | ||||
153 | }, | ||||
154 | }, | ||||
155 | second => { | ||||
156 | type => SCALAR, | ||||
157 | default => 0, | ||||
158 | callbacks => { | ||||
159 | 'an integer between 0 and 61' => | ||||
160 | sub { $_[0] =~ /^\d+$/ && $_[0] >= 0 && $_[0] <= 61 }, | ||||
161 | }, | ||||
162 | }, | ||||
163 | nanosecond => { | ||||
164 | type => SCALAR, | ||||
165 | default => 0, | ||||
166 | callbacks => { | ||||
167 | 'a positive integer' => sub { $_[0] =~ /^\d+$/ && $_[0] >= 0 }, | ||||
168 | } | ||||
169 | }, | ||||
170 | locale => { | ||||
171 | type => SCALAR | OBJECT, | ||||
172 | default => undef | ||||
173 | }, | ||||
174 | language => { | ||||
175 | type => SCALAR | OBJECT, | ||||
176 | optional => 1 | ||||
177 | }, | ||||
178 | formatter => { | ||||
179 | type => UNDEF | SCALAR | OBJECT, | ||||
180 | optional => 1, | ||||
181 | callbacks => { | ||||
182 | 'can format_datetime' => | ||||
183 | sub { defined $_[0] ? $_[0]->can('format_datetime') : 1 }, | ||||
184 | }, | ||||
185 | }, | ||||
186 | 1 | 64µs | }; | ||
187 | |||||
188 | 1 | 11µs | my $NewValidate = { | ||
189 | %$BasicValidate, | ||||
190 | time_zone => { | ||||
191 | type => SCALAR | OBJECT, | ||||
192 | default => 'floating' | ||||
193 | }, | ||||
194 | }; | ||||
195 | |||||
196 | sub new { | ||||
197 | my $class = shift; | ||||
198 | my %p = validate( @_, $NewValidate ); | ||||
199 | |||||
200 | Carp::croak( | ||||
201 | "Invalid day of month (day = $p{day} - month = $p{month} - year = $p{year})\n" | ||||
202 | ) | ||||
203 | if $p{day} > 28 | ||||
204 | && $p{day} > $class->_month_length( $p{year}, $p{month} ); | ||||
205 | |||||
206 | return $class->_new(%p); | ||||
207 | } | ||||
208 | |||||
209 | # spent 344µs (88+256) within DateTime::_new which was called:
# once (88µs+256µs) by DateTime::from_epoch at line 521 | ||||
210 | 26 | 80µs | my $class = shift; | ||
211 | my %p = @_; | ||||
212 | |||||
213 | Carp::croak('Constructor called with reference, we expected a package') | ||||
214 | if ref $class; | ||||
215 | |||||
216 | # If this method is called from somewhere other than new(), then some of | ||||
217 | # these default may not get applied. | ||||
218 | $p{month} = 1 unless exists $p{month}; | ||||
219 | $p{day} = 1 unless exists $p{day}; | ||||
220 | $p{hour} = 0 unless exists $p{hour}; | ||||
221 | $p{minute} = 0 unless exists $p{minute}; | ||||
222 | $p{second} = 0 unless exists $p{second}; | ||||
223 | $p{nanosecond} = 0 unless exists $p{nanosecond}; | ||||
224 | $p{time_zone} = 'floating' unless exists $p{time_zone}; | ||||
225 | |||||
226 | my $self = bless {}, $class; | ||||
227 | |||||
228 | $p{locale} = delete $p{language} if exists $p{language}; | ||||
229 | |||||
230 | 1 | 19µs | $self->_set_locale( $p{locale} ); # spent 19µs making 1 call to DateTime::_set_locale | ||
231 | |||||
232 | 1 | 94µs | $self->{tz} = ( # spent 94µs making 1 call to DateTime::TimeZone::new | ||
233 | ref $p{time_zone} | ||||
234 | ? $p{time_zone} | ||||
235 | : DateTime::TimeZone->new( name => $p{time_zone} ) | ||||
236 | ); | ||||
237 | |||||
238 | 1 | 6µs | $self->{local_rd_days} = $class->_ymd2rd( @p{qw( year month day )} ); # spent 6µs making 1 call to DateTime::_ymd2rd | ||
239 | |||||
240 | 1 | 3µs | $self->{local_rd_secs} # spent 3µs making 1 call to DateTime::_time_as_seconds | ||
241 | = $class->_time_as_seconds( @p{qw( hour minute second )} ); | ||||
242 | |||||
243 | $self->{offset_modifier} = 0; | ||||
244 | |||||
245 | $self->{rd_nanosecs} = $p{nanosecond}; | ||||
246 | $self->{formatter} = $p{formatter}; | ||||
247 | |||||
248 | 1 | 9µs | $self->_normalize_nanoseconds( $self->{local_rd_secs}, # spent 9µs making 1 call to DateTime::_normalize_nanoseconds | ||
249 | $self->{rd_nanosecs} ); | ||||
250 | |||||
251 | # Set this explicitly since it can't be calculated accurately | ||||
252 | # without knowing our time zone offset, and it's possible that the | ||||
253 | # offset can't be calculated without having at least a rough guess | ||||
254 | # of the datetime's year. This year need not be correct, as long | ||||
255 | # as its equal or greater to the correct number, so we fudge by | ||||
256 | # adding one to the local year given to the constructor. | ||||
257 | $self->{utc_year} = $p{year} + 1; | ||||
258 | |||||
259 | 1 | 27µs | $self->_calc_utc_rd; # spent 27µs making 1 call to DateTime::_calc_utc_rd | ||
260 | |||||
261 | 1 | 42µs | $self->_handle_offset_modifier( $p{second} ); # spent 42µs making 1 call to DateTime::_handle_offset_modifier | ||
262 | |||||
263 | 1 | 57µs | $self->_calc_local_rd; # spent 57µs making 1 call to DateTime::_calc_local_rd | ||
264 | |||||
265 | if ( $p{second} > 59 ) { | ||||
266 | if ( | ||||
267 | $self->{tz}->is_floating | ||||
268 | || | ||||
269 | |||||
270 | # If true, this means that the actual calculated leap | ||||
271 | # second does not occur in the second given to new() | ||||
272 | ( $self->{utc_rd_secs} - 86399 < $p{second} - 59 ) | ||||
273 | ) { | ||||
274 | Carp::croak("Invalid second value ($p{second})\n"); | ||||
275 | } | ||||
276 | } | ||||
277 | |||||
278 | return $self; | ||||
279 | } | ||||
280 | |||||
281 | # spent 19µs (15+4) within DateTime::_set_locale which was called:
# once (15µs+4µs) by DateTime::_new at line 230 | ||||
282 | 5 | 14µs | my $self = shift; | ||
283 | my $locale = shift; | ||||
284 | |||||
285 | if ( defined $locale && ref $locale ) { | ||||
286 | $self->{locale} = $locale; | ||||
287 | } | ||||
288 | else { | ||||
289 | 1 | 4µs | $self->{locale} # spent 4µs making 1 call to DateTime::DefaultLocale | ||
290 | = $locale | ||||
291 | ? DateTime::Locale->load($locale) | ||||
292 | : $self->DefaultLocale(); | ||||
293 | } | ||||
294 | |||||
295 | return; | ||||
296 | } | ||||
297 | |||||
298 | # This method exists for the benefit of internal methods which create | ||||
299 | # a new object based on the current object, like set() and truncate(). | ||||
300 | sub _new_from_self { | ||||
301 | my $self = shift; | ||||
302 | my %p = @_; | ||||
303 | |||||
304 | my %old = map { $_ => $self->$_() } qw( | ||||
305 | year month day | ||||
306 | hour minute second | ||||
307 | nanosecond | ||||
308 | locale time_zone | ||||
309 | ); | ||||
310 | $old{formatter} = $self->formatter() | ||||
311 | if defined $self->formatter(); | ||||
312 | |||||
313 | my $method = delete $p{_skip_validation} ? '_new' : 'new'; | ||||
314 | |||||
315 | return ( ref $self )->$method( %old, %p ); | ||||
316 | } | ||||
317 | |||||
318 | sub _handle_offset_modifier { | ||||
319 | 20 | 58µs | my $self = shift; | ||
320 | |||||
321 | $self->{offset_modifier} = 0; | ||||
322 | |||||
323 | 2 | 4µs | return if $self->{tz}->is_floating; # spent 4µs making 2 calls to DateTime::TimeZone::is_floating, avg 2µs/call | ||
324 | |||||
325 | my $second = shift; | ||||
326 | my $utc_is_valid = shift; | ||||
327 | |||||
328 | my $utc_rd_days = $self->{utc_rd_days}; | ||||
329 | |||||
330 | 2 | 125µs | my $offset # spent 113µs making 1 call to DateTime::offset
# spent 11µs making 1 call to DateTime::_offset_for_local_datetime | ||
331 | = $utc_is_valid ? $self->offset : $self->_offset_for_local_datetime; | ||||
332 | |||||
333 | if ( $offset >= 0 | ||||
334 | && $self->{local_rd_secs} >= $offset ) { | ||||
335 | if ( $second < 60 && $offset > 0 ) { | ||||
336 | 1 | 3µs | $self->{offset_modifier} # spent 3µs making 1 call to DateTime::_day_length | ||
337 | = $self->_day_length( $utc_rd_days - 1 ) - SECONDS_PER_DAY; | ||||
338 | |||||
339 | $self->{local_rd_secs} += $self->{offset_modifier}; | ||||
340 | } | ||||
341 | elsif ( | ||||
342 | $second == 60 | ||||
343 | && ( | ||||
344 | ( $self->{local_rd_secs} == $offset && $offset > 0 ) | ||||
345 | || ( $offset == 0 | ||||
346 | && $self->{local_rd_secs} > 86399 ) | ||||
347 | ) | ||||
348 | ) { | ||||
349 | my $mod | ||||
350 | = $self->_day_length( $utc_rd_days - 1 ) - SECONDS_PER_DAY; | ||||
351 | |||||
352 | unless ( $mod == 0 ) { | ||||
353 | $self->{utc_rd_secs} -= $mod; | ||||
354 | |||||
355 | $self->_normalize_seconds; | ||||
356 | } | ||||
357 | } | ||||
358 | } | ||||
359 | elsif ($offset < 0 | ||||
360 | && $self->{local_rd_secs} >= SECONDS_PER_DAY + $offset ) { | ||||
361 | if ( $second < 60 ) { | ||||
362 | $self->{offset_modifier} | ||||
363 | = $self->_day_length( $utc_rd_days - 1 ) - SECONDS_PER_DAY; | ||||
364 | |||||
365 | $self->{local_rd_secs} += $self->{offset_modifier}; | ||||
366 | } | ||||
367 | elsif ($second == 60 | ||||
368 | && $self->{local_rd_secs} == SECONDS_PER_DAY + $offset ) { | ||||
369 | my $mod | ||||
370 | = $self->_day_length( $utc_rd_days - 1 ) - SECONDS_PER_DAY; | ||||
371 | |||||
372 | unless ( $mod == 0 ) { | ||||
373 | $self->{utc_rd_secs} -= $mod; | ||||
374 | |||||
375 | $self->_normalize_seconds; | ||||
376 | } | ||||
377 | } | ||||
378 | } | ||||
379 | } | ||||
380 | |||||
381 | # spent 126µs (93+33) within DateTime::_calc_utc_rd which was called 3 times, avg 42µs/call:
# once (49µs+19µs) by Value::Convertor::BEGIN@61 at line 61 of DateTime/Infinite.pm
# once (25µs+5µs) by Value::Convertor::BEGIN@61 at line 89 of DateTime/Infinite.pm
# once (18µs+9µs) by DateTime::_new at line 259 | ||||
382 | 18 | 107µs | my $self = shift; | ||
383 | |||||
384 | delete $self->{utc_c}; | ||||
385 | |||||
386 | 5 | 10µs | if ( $self->{tz}->is_utc || $self->{tz}->is_floating ) { # spent 5µs making 2 calls to DateTime::TimeZone::OffsetOnly::is_utc, avg 2µs/call
# spent 4µs making 2 calls to DateTime::TimeZone::Floating::is_floating, avg 2µs/call
# spent 2µs making 1 call to DateTime::TimeZone::UTC::is_utc | ||
387 | $self->{utc_rd_days} = $self->{local_rd_days}; | ||||
388 | $self->{utc_rd_secs} = $self->{local_rd_secs}; | ||||
389 | } | ||||
390 | else { | ||||
391 | my $offset = $self->_offset_for_local_datetime; | ||||
392 | |||||
393 | $offset += $self->{offset_modifier}; | ||||
394 | |||||
395 | $self->{utc_rd_days} = $self->{local_rd_days}; | ||||
396 | $self->{utc_rd_secs} = $self->{local_rd_secs} - $offset; | ||||
397 | } | ||||
398 | |||||
399 | # We account for leap seconds in the new() method and nowhere else | ||||
400 | # except date math. | ||||
401 | 3 | 23µs | $self->_normalize_tai_seconds( $self->{utc_rd_days}, # spent 23µs making 3 calls to DateTime::_normalize_tai_seconds, avg 8µs/call | ||
402 | $self->{utc_rd_secs} ); | ||||
403 | } | ||||
404 | |||||
405 | sub _normalize_seconds { | ||||
406 | my $self = shift; | ||||
407 | |||||
408 | return if $self->{utc_rd_secs} >= 0 && $self->{utc_rd_secs} <= 86399; | ||||
409 | |||||
410 | if ( $self->{tz}->is_floating ) { | ||||
411 | $self->_normalize_tai_seconds( $self->{utc_rd_days}, | ||||
412 | $self->{utc_rd_secs} ); | ||||
413 | } | ||||
414 | else { | ||||
415 | $self->_normalize_leap_seconds( $self->{utc_rd_days}, | ||||
416 | $self->{utc_rd_secs} ); | ||||
417 | } | ||||
418 | } | ||||
419 | |||||
420 | # spent 362µs (108+254) within DateTime::_calc_local_rd which was called 4 times, avg 91µs/call:
# once (42µs+105µs) by DateTime::try {...} at line 2012
# once (28µs+64µs) by Value::Convertor::BEGIN@61 at line 62 of DateTime/Infinite.pm
# once (22µs+45µs) by Value::Convertor::BEGIN@61 at line 90 of DateTime/Infinite.pm
# once (15µs+41µs) by DateTime::_new at line 263 | ||||
421 | 27 | 89µs | my $self = shift; | ||
422 | |||||
423 | delete $self->{local_c}; | ||||
424 | |||||
425 | # We must short circuit for UTC times or else we could end up with | ||||
426 | # loops between DateTime.pm and DateTime::TimeZone | ||||
427 | 7 | 11µs | if ( $self->{tz}->is_utc || $self->{tz}->is_floating ) { # spent 3µs making 2 calls to DateTime::TimeZone::OffsetOnly::is_utc, avg 1µs/call
# spent 3µs making 2 calls to DateTime::TimeZone::Floating::is_floating, avg 1µs/call
# spent 2µs making 1 call to DateTime::TimeZone::is_utc
# spent 2µs making 1 call to DateTime::TimeZone::UTC::is_utc
# spent 2µs making 1 call to DateTime::TimeZone::is_floating | ||
428 | $self->{local_rd_days} = $self->{utc_rd_days}; | ||||
429 | $self->{local_rd_secs} = $self->{utc_rd_secs}; | ||||
430 | } | ||||
431 | else { | ||||
432 | 1 | 72µs | my $offset = $self->offset; # spent 72µs making 1 call to DateTime::offset | ||
433 | |||||
434 | $self->{local_rd_days} = $self->{utc_rd_days}; | ||||
435 | $self->{local_rd_secs} = $self->{utc_rd_secs} + $offset; | ||||
436 | |||||
437 | # intentionally ignore leap seconds here | ||||
438 | 1 | 3µs | $self->_normalize_tai_seconds( $self->{local_rd_days}, # spent 3µs making 1 call to DateTime::_normalize_tai_seconds | ||
439 | $self->{local_rd_secs} ); | ||||
440 | |||||
441 | $self->{local_rd_secs} += $self->{offset_modifier}; | ||||
442 | } | ||||
443 | |||||
444 | 4 | 168µs | $self->_calc_local_components; # spent 168µs making 4 calls to DateTime::_calc_local_components, avg 42µs/call | ||
445 | } | ||||
446 | |||||
447 | # spent 168µs (137+32) within DateTime::_calc_local_components which was called 4 times, avg 42µs/call:
# 4 times (137µs+32µs) by DateTime::_calc_local_rd at line 444, avg 42µs/call | ||||
448 | 20 | 138µs | my $self = shift; | ||
449 | |||||
450 | @{ $self->{local_c} }{ | ||||
451 | 4 | 20µs | qw( year month day day_of_week # spent 11µs making 2 calls to DateTime::Infinite::_rd2ymd, avg 6µs/call
# spent 9µs making 2 calls to DateTime::_rd2ymd, avg 4µs/call | ||
452 | day_of_year quarter day_of_quarter) | ||||
453 | } | ||||
454 | = $self->_rd2ymd( $self->{local_rd_days}, 1 ); | ||||
455 | |||||
456 | 4 | 12µs | @{ $self->{local_c} }{qw( hour minute second )} # spent 7µs making 2 calls to DateTime::Infinite::_seconds_as_components, avg 4µs/call
# spent 4µs making 2 calls to DateTime::_seconds_as_components, avg 2µs/call | ||
457 | = $self->_seconds_as_components( $self->{local_rd_secs}, | ||||
458 | $self->{utc_rd_secs}, $self->{offset_modifier} ); | ||||
459 | } | ||||
460 | |||||
461 | sub _calc_utc_components { | ||||
462 | my $self = shift; | ||||
463 | |||||
464 | die "Cannot get UTC components before UTC RD has been calculated\n" | ||||
465 | unless defined $self->{utc_rd_days}; | ||||
466 | |||||
467 | @{ $self->{utc_c} }{qw( year month day )} | ||||
468 | = $self->_rd2ymd( $self->{utc_rd_days} ); | ||||
469 | |||||
470 | @{ $self->{utc_c} }{qw( hour minute second )} | ||||
471 | = $self->_seconds_as_components( $self->{utc_rd_secs} ); | ||||
472 | } | ||||
473 | |||||
474 | sub _utc_ymd { | ||||
475 | my $self = shift; | ||||
476 | |||||
477 | $self->_calc_utc_components unless exists $self->{utc_c}{year}; | ||||
478 | |||||
479 | return @{ $self->{utc_c} }{qw( year month day )}; | ||||
480 | } | ||||
481 | |||||
482 | sub _utc_hms { | ||||
483 | my $self = shift; | ||||
484 | |||||
485 | $self->_calc_utc_components unless exists $self->{utc_c}{hour}; | ||||
486 | |||||
487 | return @{ $self->{utc_c} }{qw( hour minute second )}; | ||||
488 | } | ||||
489 | |||||
490 | { | ||||
491 | 2 | 30µs | 1 | 10µs | my $spec = { # spent 10µs making 1 call to DateTime::CORE:qr |
492 | epoch => { regex => qr/^-?(?:\d+(?:\.\d*)?|\.\d+)$/ }, | ||||
493 | locale => { type => SCALAR | OBJECT, optional => 1 }, | ||||
494 | language => { type => SCALAR | OBJECT, optional => 1 }, | ||||
495 | time_zone => { type => SCALAR | OBJECT, optional => 1 }, | ||||
496 | formatter => { | ||||
497 | type => SCALAR | OBJECT, can => 'format_datetime', | ||||
498 | optional => 1 | ||||
499 | }, | ||||
500 | }; | ||||
501 | |||||
502 | # spent 999µs (62+936) within DateTime::from_epoch which was called:
# once (62µs+936µs) by DateTime::now at line 530 | ||||
503 | 12 | 148µs | my $class = shift; | ||
504 | 1 | 30µs | 2 | 181µs | my %p = validate( @_, $spec ); # spent 148µs making 1 call to Params::Validate::XS::validate
# spent 33µs making 1 call to Params::Validate::XS::_check_regex_from_xs |
505 | |||||
506 | my %args; | ||||
507 | # Epoch may come from Time::HiRes, so it may not be an integer. | ||||
508 | 1 | 6µs | my ( $int, $dec ) = $p{epoch} =~ /^(-?\d+)?(\.\d+)?/; # spent 6µs making 1 call to DateTime::CORE:match | ||
509 | $int ||= 0; | ||||
510 | |||||
511 | $args{nanosecond} = int( $dec * MAX_NANOSECONDS ) | ||||
512 | if $dec; | ||||
513 | |||||
514 | # Note, for very large negative values this may give a | ||||
515 | # blatantly wrong answer. | ||||
516 | @args{qw( second minute hour day month year )} | ||||
517 | = ( gmtime($int) )[ 0 .. 5 ]; | ||||
518 | $args{year} += 1900; | ||||
519 | $args{month}++; | ||||
520 | |||||
521 | 1 | 344µs | my $self = $class->_new( %p, %args, time_zone => 'UTC' ); # spent 344µs making 1 call to DateTime::_new | ||
522 | |||||
523 | 1 | 438µs | $self->set_time_zone( $p{time_zone} ) if exists $p{time_zone}; # spent 438µs making 1 call to DateTime::set_time_zone | ||
524 | |||||
525 | return $self; | ||||
526 | } | ||||
527 | } | ||||
528 | |||||
529 | # use scalar time in case someone's loaded Time::Piece | ||||
530 | 1 | 19µs | 1 | 999µs | # spent 1.01ms (9µs+999µs) within DateTime::now which was called:
# once (9µs+999µs) by Value::Convertor::BEGIN@153 at line 160 of Value/Convertor.pm # spent 999µs making 1 call to DateTime::from_epoch |
531 | |||||
532 | sub today { shift->now(@_)->truncate( to => 'day' ) } | ||||
533 | |||||
534 | { | ||||
535 | 2 | 8µs | my $spec = { | ||
536 | object => { | ||||
537 | type => OBJECT, | ||||
538 | can => 'utc_rd_values', | ||||
539 | }, | ||||
540 | locale => { type => SCALAR | OBJECT, optional => 1 }, | ||||
541 | language => { type => SCALAR | OBJECT, optional => 1 }, | ||||
542 | formatter => { | ||||
543 | type => SCALAR | OBJECT, can => 'format_datetime', | ||||
544 | optional => 1 | ||||
545 | }, | ||||
546 | }; | ||||
547 | |||||
548 | sub from_object { | ||||
549 | my $class = shift; | ||||
550 | my %p = validate( @_, $spec ); | ||||
551 | |||||
552 | my $object = delete $p{object}; | ||||
553 | |||||
554 | my ( $rd_days, $rd_secs, $rd_nanosecs ) = $object->utc_rd_values; | ||||
555 | |||||
556 | # A kludge because until all calendars are updated to return all | ||||
557 | # three values, $rd_nanosecs could be undef | ||||
558 | $rd_nanosecs ||= 0; | ||||
559 | |||||
560 | # This is a big hack to let _seconds_as_components operate naively | ||||
561 | # on the given value. If the object _is_ on a leap second, we'll | ||||
562 | # add that to the generated seconds value later. | ||||
563 | my $leap_seconds = 0; | ||||
564 | if ( $object->can('time_zone') | ||||
565 | && !$object->time_zone->is_floating | ||||
566 | && $rd_secs > 86399 | ||||
567 | && $rd_secs <= $class->_day_length($rd_days) ) { | ||||
568 | $leap_seconds = $rd_secs - 86399; | ||||
569 | $rd_secs -= $leap_seconds; | ||||
570 | } | ||||
571 | |||||
572 | my %args; | ||||
573 | @args{qw( year month day )} = $class->_rd2ymd($rd_days); | ||||
574 | @args{qw( hour minute second )} | ||||
575 | = $class->_seconds_as_components($rd_secs); | ||||
576 | $args{nanosecond} = $rd_nanosecs; | ||||
577 | |||||
578 | $args{second} += $leap_seconds; | ||||
579 | |||||
580 | my $new = $class->new( %p, %args, time_zone => 'UTC' ); | ||||
581 | |||||
582 | if ( $object->can('time_zone') ) { | ||||
583 | $new->set_time_zone( $object->time_zone ); | ||||
584 | } | ||||
585 | else { | ||||
586 | $new->set_time_zone('floating'); | ||||
587 | } | ||||
588 | |||||
589 | return $new; | ||||
590 | } | ||||
591 | } | ||||
592 | |||||
593 | 1 | 18µs | my $LastDayOfMonthValidate = {%$NewValidate}; | ||
594 | 1 | 5µs | foreach ( keys %$LastDayOfMonthValidate ) { | ||
595 | 22 | 44µs | my %copy = %{ $LastDayOfMonthValidate->{$_} }; | ||
596 | |||||
597 | 11 | 7µs | delete $copy{default}; | ||
598 | 11 | 9µs | $copy{optional} = 1 unless $_ eq 'year' || $_ eq 'month'; | ||
599 | |||||
600 | 11 | 16µs | $LastDayOfMonthValidate->{$_} = \%copy; | ||
601 | } | ||||
602 | |||||
603 | sub last_day_of_month { | ||||
604 | my $class = shift; | ||||
605 | my %p = validate( @_, $LastDayOfMonthValidate ); | ||||
606 | |||||
607 | my $day = $class->_month_length( $p{year}, $p{month} ); | ||||
608 | |||||
609 | return $class->_new( %p, day => $day ); | ||||
610 | } | ||||
611 | |||||
612 | sub _month_length { | ||||
613 | return ( | ||||
614 | $_[0]->_is_leap_year( $_[1] ) | ||||
615 | ? $LeapYearMonthLengths[ $_[2] - 1 ] | ||||
616 | : $MonthLengths[ $_[2] - 1 ] | ||||
617 | ); | ||||
618 | } | ||||
619 | |||||
620 | 1 | 6µs | my $FromDayOfYearValidate = {%$NewValidate}; | ||
621 | 1 | 4µs | foreach ( keys %$FromDayOfYearValidate ) { | ||
622 | 11 | 4µs | next if $_ eq 'month' || $_ eq 'day'; | ||
623 | |||||
624 | 18 | 26µs | my %copy = %{ $FromDayOfYearValidate->{$_} }; | ||
625 | |||||
626 | 9 | 4µs | delete $copy{default}; | ||
627 | 9 | 6µs | $copy{optional} = 1 unless $_ eq 'year' || $_ eq 'month'; | ||
628 | |||||
629 | 9 | 11µs | $FromDayOfYearValidate->{$_} = \%copy; | ||
630 | } | ||||
631 | $FromDayOfYearValidate->{day_of_year} = { | ||||
632 | type => SCALAR, | ||||
633 | callbacks => { | ||||
634 | 'is between 1 and 366' => sub { $_[0] >= 1 && $_[0] <= 366 } | ||||
635 | } | ||||
636 | 1 | 8µs | }; | ||
637 | |||||
638 | sub from_day_of_year { | ||||
639 | my $class = shift; | ||||
640 | my %p = validate( @_, $FromDayOfYearValidate ); | ||||
641 | |||||
642 | Carp::croak("$p{year} is not a leap year.\n") | ||||
643 | if $p{day_of_year} == 366 && !$class->_is_leap_year( $p{year} ); | ||||
644 | |||||
645 | my $month = 1; | ||||
646 | my $day = delete $p{day_of_year}; | ||||
647 | |||||
648 | if ( $day > 31 ) { | ||||
649 | my $length = $class->_month_length( $p{year}, $month ); | ||||
650 | |||||
651 | while ( $day > $length ) { | ||||
652 | $day -= $length; | ||||
653 | $month++; | ||||
654 | $length = $class->_month_length( $p{year}, $month ); | ||||
655 | } | ||||
656 | } | ||||
657 | |||||
658 | return $class->_new( | ||||
659 | %p, | ||||
660 | month => $month, | ||||
661 | day => $day, | ||||
662 | ); | ||||
663 | } | ||||
664 | |||||
665 | sub formatter { $_[0]->{formatter} } | ||||
666 | |||||
667 | sub clone { bless { %{ $_[0] } }, ref $_[0] } | ||||
668 | |||||
669 | sub year { | ||||
670 | Carp::carp('year() is a read-only accessor') if @_ > 1; | ||||
671 | return $_[0]->{local_c}{year}; | ||||
672 | } | ||||
673 | |||||
674 | sub ce_year { | ||||
675 | $_[0]->{local_c}{year} <= 0 | ||||
676 | ? $_[0]->{local_c}{year} - 1 | ||||
677 | : $_[0]->{local_c}{year}; | ||||
678 | } | ||||
679 | |||||
680 | sub era_name { $_[0]->{locale}->era_wide->[ $_[0]->_era_index() ] } | ||||
681 | |||||
682 | sub era_abbr { $_[0]->{locale}->era_abbreviated->[ $_[0]->_era_index() ] } | ||||
683 | |||||
684 | # deprecated | ||||
685 | 1 | 6µs | *era = \&era_abbr; | ||
686 | |||||
687 | sub _era_index { $_[0]->{local_c}{year} <= 0 ? 0 : 1 } | ||||
688 | |||||
689 | sub christian_era { $_[0]->ce_year > 0 ? 'AD' : 'BC' } | ||||
690 | sub secular_era { $_[0]->ce_year > 0 ? 'CE' : 'BCE' } | ||||
691 | |||||
692 | sub year_with_era { ( abs $_[0]->ce_year ) . $_[0]->era_abbr } | ||||
693 | sub year_with_christian_era { ( abs $_[0]->ce_year ) . $_[0]->christian_era } | ||||
694 | sub year_with_secular_era { ( abs $_[0]->ce_year ) . $_[0]->secular_era } | ||||
695 | |||||
696 | sub month { | ||||
697 | Carp::carp('month() is a read-only accessor') if @_ > 1; | ||||
698 | return $_[0]->{local_c}{month}; | ||||
699 | } | ||||
700 | 1 | 3µs | *mon = \&month; | ||
701 | |||||
702 | sub month_0 { $_[0]->{local_c}{month} - 1 } | ||||
703 | 1 | 3µs | *mon_0 = \&month_0; | ||
704 | |||||
705 | sub month_name { $_[0]->{locale}->month_format_wide->[ $_[0]->month_0() ] } | ||||
706 | |||||
707 | sub month_abbr { | ||||
708 | $_[0]->{locale}->month_format_abbreviated->[ $_[0]->month_0() ]; | ||||
709 | } | ||||
710 | |||||
711 | sub day_of_month { | ||||
712 | Carp::carp('day_of_month() is a read-only accessor') if @_ > 1; | ||||
713 | $_[0]->{local_c}{day}; | ||||
714 | } | ||||
715 | 1 | 3µs | *day = \&day_of_month; | ||
716 | 1 | 3µs | *mday = \&day_of_month; | ||
717 | |||||
718 | 2 | 14.8ms | 2 | 286µs | # spent 279µs (272+7) within DateTime::BEGIN@718 which was called:
# once (272µs+7µs) by Value::Convertor::BEGIN@61 at line 718 # spent 279µs making 1 call to DateTime::BEGIN@718
# spent 7µs making 1 call to integer::import |
719 | |||||
720 | sub quarter { $_[0]->{local_c}{quarter} } | ||||
721 | |||||
722 | sub quarter_name { | ||||
723 | $_[0]->{locale}->quarter_format_wide->[ $_[0]->quarter_0() ]; | ||||
724 | } | ||||
725 | |||||
726 | sub quarter_abbr { | ||||
727 | $_[0]->{locale}->quarter_format_abbreviated->[ $_[0]->quarter_0() ]; | ||||
728 | } | ||||
729 | |||||
730 | sub quarter_0 { $_[0]->{local_c}{quarter} - 1 } | ||||
731 | |||||
732 | sub day_of_month_0 { $_[0]->{local_c}{day} - 1 } | ||||
733 | 1 | 2µs | *day_0 = \&day_of_month_0; | ||
734 | 1 | 2µs | *mday_0 = \&day_of_month_0; | ||
735 | |||||
736 | sub day_of_week { $_[0]->{local_c}{day_of_week} } | ||||
737 | 1 | 2µs | *wday = \&day_of_week; | ||
738 | 1 | 2µs | *dow = \&day_of_week; | ||
739 | |||||
740 | sub day_of_week_0 { $_[0]->{local_c}{day_of_week} - 1 } | ||||
741 | 1 | 2µs | *wday_0 = \&day_of_week_0; | ||
742 | 1 | 2µs | *dow_0 = \&day_of_week_0; | ||
743 | |||||
744 | sub local_day_of_week { | ||||
745 | my $self = shift; | ||||
746 | |||||
747 | my $day = $self->day_of_week(); | ||||
748 | |||||
749 | my $local_first_day = $self->{locale}->first_day_of_week(); | ||||
750 | |||||
751 | my $d = ( ( 8 - $local_first_day ) + $day ) % 7; | ||||
752 | |||||
753 | return $d == 0 ? 7 : $d; | ||||
754 | } | ||||
755 | |||||
756 | sub day_name { $_[0]->{locale}->day_format_wide->[ $_[0]->day_of_week_0() ] } | ||||
757 | |||||
758 | sub day_abbr { | ||||
759 | $_[0]->{locale}->day_format_abbreviated->[ $_[0]->day_of_week_0() ]; | ||||
760 | } | ||||
761 | |||||
762 | sub day_of_quarter { $_[0]->{local_c}{day_of_quarter} } | ||||
763 | 1 | 3µs | *doq = \&day_of_quarter; | ||
764 | |||||
765 | sub day_of_quarter_0 { $_[0]->day_of_quarter - 1 } | ||||
766 | 1 | 2µs | *doq_0 = \&day_of_quarter_0; | ||
767 | |||||
768 | sub day_of_year { $_[0]->{local_c}{day_of_year} } | ||||
769 | 1 | 2µs | *doy = \&day_of_year; | ||
770 | |||||
771 | sub day_of_year_0 { $_[0]->{local_c}{day_of_year} - 1 } | ||||
772 | 1 | 2µs | *doy_0 = \&day_of_year_0; | ||
773 | |||||
774 | sub am_or_pm { | ||||
775 | $_[0]->{locale}->am_pm_abbreviated->[ $_[0]->hour() < 12 ? 0 : 1 ]; | ||||
776 | } | ||||
777 | |||||
778 | sub ymd { | ||||
779 | my ( $self, $sep ) = @_; | ||||
780 | $sep = '-' unless defined $sep; | ||||
781 | |||||
782 | return sprintf( | ||||
783 | "%0.4d%s%0.2d%s%0.2d", | ||||
784 | $self->year, $sep, | ||||
785 | $self->{local_c}{month}, $sep, | ||||
786 | $self->{local_c}{day} | ||||
787 | ); | ||||
788 | } | ||||
789 | 1 | 3µs | *date = \&ymd; | ||
790 | |||||
791 | sub mdy { | ||||
792 | my ( $self, $sep ) = @_; | ||||
793 | $sep = '-' unless defined $sep; | ||||
794 | |||||
795 | return sprintf( | ||||
796 | "%0.2d%s%0.2d%s%0.4d", | ||||
797 | $self->{local_c}{month}, $sep, | ||||
798 | $self->{local_c}{day}, $sep, | ||||
799 | $self->year | ||||
800 | ); | ||||
801 | } | ||||
802 | |||||
803 | sub dmy { | ||||
804 | my ( $self, $sep ) = @_; | ||||
805 | $sep = '-' unless defined $sep; | ||||
806 | |||||
807 | return sprintf( | ||||
808 | "%0.2d%s%0.2d%s%0.4d", | ||||
809 | $self->{local_c}{day}, $sep, | ||||
810 | $self->{local_c}{month}, $sep, | ||||
811 | $self->year | ||||
812 | ); | ||||
813 | } | ||||
814 | |||||
815 | sub hour { | ||||
816 | Carp::carp('hour() is a read-only accessor') if @_ > 1; | ||||
817 | return $_[0]->{local_c}{hour}; | ||||
818 | } | ||||
819 | sub hour_1 { $_[0]->{local_c}{hour} == 0 ? 24 : $_[0]->{local_c}{hour} } | ||||
820 | |||||
821 | sub hour_12 { my $h = $_[0]->hour % 12; return $h ? $h : 12 } | ||||
822 | sub hour_12_0 { $_[0]->hour % 12 } | ||||
823 | |||||
824 | sub minute { | ||||
825 | Carp::carp('minute() is a read-only accessor') if @_ > 1; | ||||
826 | return $_[0]->{local_c}{minute}; | ||||
827 | } | ||||
828 | 1 | 2µs | *min = \&minute; | ||
829 | |||||
830 | # spent 4µs within DateTime::second which was called:
# once (4µs+0s) by DateTime::set_time_zone at line 2003 | ||||
831 | 2 | 7µs | Carp::carp('second() is a read-only accessor') if @_ > 1; | ||
832 | return $_[0]->{local_c}{second}; | ||||
833 | } | ||||
834 | 1 | 2µs | *sec = \&second; | ||
835 | |||||
836 | sub fractional_second { $_[0]->second + $_[0]->nanosecond / MAX_NANOSECONDS } | ||||
837 | |||||
838 | sub nanosecond { | ||||
839 | Carp::carp('nanosecond() is a read-only accessor') if @_ > 1; | ||||
840 | return $_[0]->{rd_nanosecs}; | ||||
841 | } | ||||
842 | |||||
843 | sub millisecond { floor( $_[0]->{rd_nanosecs} / 1000000 ) } | ||||
844 | |||||
845 | sub microsecond { floor( $_[0]->{rd_nanosecs} / 1000 ) } | ||||
846 | |||||
847 | sub leap_seconds { | ||||
848 | my $self = shift; | ||||
849 | |||||
850 | return 0 if $self->{tz}->is_floating; | ||||
851 | |||||
852 | return DateTime->_accumulated_leap_seconds( $self->{utc_rd_days} ); | ||||
853 | } | ||||
854 | |||||
855 | sub _stringify { | ||||
856 | my $self = shift; | ||||
857 | |||||
858 | return $self->iso8601 unless $self->{formatter}; | ||||
859 | return $self->{formatter}->format_datetime($self); | ||||
860 | } | ||||
861 | |||||
862 | sub hms { | ||||
863 | my ( $self, $sep ) = @_; | ||||
864 | $sep = ':' unless defined $sep; | ||||
865 | |||||
866 | return sprintf( | ||||
867 | "%0.2d%s%0.2d%s%0.2d", | ||||
868 | $self->{local_c}{hour}, $sep, | ||||
869 | $self->{local_c}{minute}, $sep, | ||||
870 | $self->{local_c}{second} | ||||
871 | ); | ||||
872 | } | ||||
873 | |||||
874 | # don't want to override CORE::time() | ||||
875 | 1 | 2µs | *DateTime::time = \&hms; | ||
876 | |||||
877 | sub iso8601 { join 'T', $_[0]->ymd('-'), $_[0]->hms(':') } | ||||
878 | 1 | 2µs | *datetime = \&iso8601; | ||
879 | |||||
880 | sub is_leap_year { $_[0]->_is_leap_year( $_[0]->year ) } | ||||
881 | |||||
882 | sub week { | ||||
883 | my $self = shift; | ||||
884 | |||||
885 | unless ( defined $self->{local_c}{week_year} ) { | ||||
886 | |||||
887 | # This algorithm was taken from Date::Calc's DateCalc.c file | ||||
888 | my $jan_one_dow_m1 | ||||
889 | = ( ( $self->_ymd2rd( $self->year, 1, 1 ) + 6 ) % 7 ); | ||||
890 | |||||
891 | $self->{local_c}{week_number} | ||||
892 | = int( ( ( $self->day_of_year - 1 ) + $jan_one_dow_m1 ) / 7 ); | ||||
893 | $self->{local_c}{week_number}++ if $jan_one_dow_m1 < 4; | ||||
894 | |||||
895 | if ( $self->{local_c}{week_number} == 0 ) { | ||||
896 | $self->{local_c}{week_year} = $self->year - 1; | ||||
897 | $self->{local_c}{week_number} | ||||
898 | = $self->_weeks_in_year( $self->{local_c}{week_year} ); | ||||
899 | } | ||||
900 | elsif ($self->{local_c}{week_number} == 53 | ||||
901 | && $self->_weeks_in_year( $self->year ) == 52 ) { | ||||
902 | $self->{local_c}{week_number} = 1; | ||||
903 | $self->{local_c}{week_year} = $self->year + 1; | ||||
904 | } | ||||
905 | else { | ||||
906 | $self->{local_c}{week_year} = $self->year; | ||||
907 | } | ||||
908 | } | ||||
909 | |||||
910 | return @{ $self->{local_c} }{ 'week_year', 'week_number' }; | ||||
911 | } | ||||
912 | |||||
913 | sub _weeks_in_year { | ||||
914 | my $self = shift; | ||||
915 | my $year = shift; | ||||
916 | |||||
917 | my $dow = $self->_ymd2rd( $year, 1, 1 ) % 7; | ||||
918 | |||||
919 | # Tears starting with a Thursday and leap years starting with a Wednesday | ||||
920 | # have 53 weeks. | ||||
921 | return ( $dow == 4 || ( $dow == 3 && $self->_is_leap_year($year) ) ) | ||||
922 | ? 53 | ||||
923 | : 52; | ||||
924 | } | ||||
925 | |||||
926 | sub week_year { ( $_[0]->week )[0] } | ||||
927 | sub week_number { ( $_[0]->week )[1] } | ||||
928 | |||||
929 | # ISO says that the first week of a year is the first week containing | ||||
930 | # a Thursday. Extending that says that the first week of the month is | ||||
931 | # the first week containing a Thursday. ICU agrees. | ||||
932 | sub week_of_month { | ||||
933 | my $self = shift; | ||||
934 | my $thu = $self->day + 4 - $self->day_of_week; | ||||
935 | return int( ( $thu + 6 ) / 7 ); | ||||
936 | } | ||||
937 | |||||
938 | sub time_zone { | ||||
939 | Carp::carp('time_zone() is a read-only accessor') if @_ > 1; | ||||
940 | return $_[0]->{tz}; | ||||
941 | } | ||||
942 | |||||
943 | 3 | 28µs | 3 | 232µs | # spent 257µs (25+232) within DateTime::offset which was called 3 times, avg 86µs/call:
# once (12µs+101µs) by DateTime::_handle_offset_modifier at line 330
# once (6µs+67µs) by DateTime::_calc_local_rd at line 432
# once (7µs+65µs) by Value::Convertor::BEGIN@153 at line 160 of Value/Convertor.pm # spent 232µs making 3 calls to DateTime::TimeZone::offset_for_datetime, avg 77µs/call |
944 | |||||
945 | # spent 11µs (9+2) within DateTime::_offset_for_local_datetime which was called:
# once (9µs+2µs) by DateTime::_handle_offset_modifier at line 330 | ||||
946 | 1 | 8µs | 1 | 2µs | $_[0]->{tz}->offset_for_local_datetime( $_[0] ); # spent 2µs making 1 call to DateTime::TimeZone::UTC::offset_for_local_datetime |
947 | } | ||||
948 | |||||
949 | sub is_dst { $_[0]->{tz}->is_dst_for_datetime( $_[0] ) } | ||||
950 | |||||
951 | sub time_zone_long_name { $_[0]->{tz}->name } | ||||
952 | sub time_zone_short_name { $_[0]->{tz}->short_name_for_datetime( $_[0] ) } | ||||
953 | |||||
954 | sub locale { | ||||
955 | Carp::carp('locale() is a read-only accessor') if @_ > 1; | ||||
956 | return $_[0]->{locale}; | ||||
957 | } | ||||
958 | 1 | 3µs | *language = \&locale; | ||
959 | |||||
960 | sub utc_rd_values { | ||||
961 | @{ $_[0] }{ 'utc_rd_days', 'utc_rd_secs', 'rd_nanosecs' }; | ||||
962 | } | ||||
963 | |||||
964 | sub local_rd_values { | ||||
965 | @{ $_[0] }{ 'local_rd_days', 'local_rd_secs', 'rd_nanosecs' }; | ||||
966 | } | ||||
967 | |||||
968 | # NOTE: no nanoseconds, no leap seconds | ||||
969 | # spent 12µs within DateTime::utc_rd_as_seconds which was called 3 times, avg 4µs/call:
# 3 times (12µs+0s) by DateTime::TimeZone::_span_for_datetime at line 183 of DateTime/TimeZone.pm, avg 4µs/call | ||||
970 | 3 | 21µs | ( $_[0]->{utc_rd_days} * SECONDS_PER_DAY ) + $_[0]->{utc_rd_secs}; | ||
971 | } | ||||
972 | |||||
973 | # NOTE: no nanoseconds, no leap seconds | ||||
974 | sub local_rd_as_seconds { | ||||
975 | ( $_[0]->{local_rd_days} * SECONDS_PER_DAY ) + $_[0]->{local_rd_secs}; | ||||
976 | } | ||||
977 | |||||
978 | # RD 1 is JD 1,721,424.5 - a simple offset | ||||
979 | sub jd { | ||||
980 | my $self = shift; | ||||
981 | |||||
982 | my $jd = $self->{utc_rd_days} + 1_721_424.5; | ||||
983 | |||||
984 | my $day_length = $self->_day_length( $self->{utc_rd_days} ); | ||||
985 | |||||
986 | return ( $jd | ||||
987 | + ( $self->{utc_rd_secs} / $day_length ) | ||||
988 | + ( $self->{rd_nanosecs} / $day_length / MAX_NANOSECONDS ) ); | ||||
989 | } | ||||
990 | |||||
991 | sub mjd { $_[0]->jd - 2_400_000.5 } | ||||
992 | |||||
993 | { | ||||
994 | 1 | 800ns | my %strftime_patterns = ( | ||
995 | 'a' => sub { $_[0]->day_abbr }, | ||||
996 | 'A' => sub { $_[0]->day_name }, | ||||
997 | 'b' => sub { $_[0]->month_abbr }, | ||||
998 | 'B' => sub { $_[0]->month_name }, | ||||
999 | 'c' => sub { | ||||
1000 | $_[0]->format_cldr( $_[0]->{locale}->datetime_format_default() ); | ||||
1001 | }, | ||||
1002 | 'C' => sub { int( $_[0]->year / 100 ) }, | ||||
1003 | 'd' => sub { sprintf( '%02d', $_[0]->day_of_month ) }, | ||||
1004 | 'D' => sub { $_[0]->strftime('%m/%d/%y') }, | ||||
1005 | 'e' => sub { sprintf( '%2d', $_[0]->day_of_month ) }, | ||||
1006 | 'F' => sub { $_[0]->ymd('-') }, | ||||
1007 | 'g' => sub { substr( $_[0]->week_year, -2 ) }, | ||||
1008 | 'G' => sub { $_[0]->week_year }, | ||||
1009 | 'H' => sub { sprintf( '%02d', $_[0]->hour ) }, | ||||
1010 | 'I' => sub { sprintf( '%02d', $_[0]->hour_12 ) }, | ||||
1011 | 'j' => sub { sprintf( '%03d', $_[0]->day_of_year ) }, | ||||
1012 | 'k' => sub { sprintf( '%2d', $_[0]->hour ) }, | ||||
1013 | 'l' => sub { sprintf( '%2d', $_[0]->hour_12 ) }, | ||||
1014 | 'm' => sub { sprintf( '%02d', $_[0]->month ) }, | ||||
1015 | 'M' => sub { sprintf( '%02d', $_[0]->minute ) }, | ||||
1016 | 'n' => sub {"\n"}, # should this be OS-sensitive? | ||||
1017 | 'N' => \&_format_nanosecs, | ||||
1018 | 'p' => sub { $_[0]->am_or_pm() }, | ||||
1019 | 'P' => sub { lc $_[0]->am_or_pm() }, | ||||
1020 | 'r' => sub { $_[0]->strftime('%I:%M:%S %p') }, | ||||
1021 | 'R' => sub { $_[0]->strftime('%H:%M') }, | ||||
1022 | 's' => sub { $_[0]->epoch }, | ||||
1023 | 'S' => sub { sprintf( '%02d', $_[0]->second ) }, | ||||
1024 | 't' => sub {"\t"}, | ||||
1025 | 'T' => sub { $_[0]->strftime('%H:%M:%S') }, | ||||
1026 | 'u' => sub { $_[0]->day_of_week }, | ||||
1027 | 'U' => sub { | ||||
1028 | my $sun = $_[0]->day_of_year - ( $_[0]->day_of_week + 7 ) % 7; | ||||
1029 | return sprintf( '%02d', int( ( $sun + 6 ) / 7 ) ); | ||||
1030 | }, | ||||
1031 | 'V' => sub { sprintf( '%02d', $_[0]->week_number ) }, | ||||
1032 | 'w' => sub { | ||||
1033 | my $dow = $_[0]->day_of_week; | ||||
1034 | return $dow % 7; | ||||
1035 | }, | ||||
1036 | 'W' => sub { | ||||
1037 | my $mon = $_[0]->day_of_year - ( $_[0]->day_of_week + 6 ) % 7; | ||||
1038 | return sprintf( '%02d', int( ( $mon + 6 ) / 7 ) ); | ||||
1039 | }, | ||||
1040 | 'x' => sub { | ||||
1041 | $_[0]->format_cldr( $_[0]->{locale}->date_format_default() ); | ||||
1042 | }, | ||||
1043 | 'X' => sub { | ||||
1044 | $_[0]->format_cldr( $_[0]->{locale}->time_format_default() ); | ||||
1045 | }, | ||||
1046 | 'y' => sub { sprintf( '%02d', substr( $_[0]->year, -2 ) ) }, | ||||
1047 | 'Y' => sub { return $_[0]->year }, | ||||
1048 | 'z' => sub { DateTime::TimeZone->offset_as_string( $_[0]->offset ) }, | ||||
1049 | 'Z' => sub { $_[0]->{tz}->short_name_for_datetime( $_[0] ) }, | ||||
1050 | '%' => sub {'%'}, | ||||
1051 | 1 | 121µs | ); | ||
1052 | |||||
1053 | 1 | 2µs | $strftime_patterns{h} = $strftime_patterns{b}; | ||
1054 | |||||
1055 | sub strftime { | ||||
1056 | my $self = shift; | ||||
1057 | |||||
1058 | # make a copy or caller's scalars get munged | ||||
1059 | my @patterns = @_; | ||||
1060 | |||||
1061 | my @r; | ||||
1062 | foreach my $p (@patterns) { | ||||
1063 | $p =~ s/ | ||||
1064 | (?: | ||||
1065 | %\{(\w+)\} # method name like %{day_name} | ||||
1066 | | | ||||
1067 | %([%a-zA-Z]) # single character specifier like %d | ||||
1068 | | | ||||
1069 | %(\d+)N # special case for %N | ||||
1070 | ) | ||||
1071 | / | ||||
1072 | ( $1 | ||||
1073 | ? ( $self->can($1) ? $self->$1() : "\%{$1}" ) | ||||
1074 | : $2 | ||||
1075 | ? ( $strftime_patterns{$2} ? $strftime_patterns{$2}->($self) : "\%$2" ) | ||||
1076 | : $3 | ||||
1077 | ? $strftime_patterns{N}->($self, $3) | ||||
1078 | : '' # this won't happen | ||||
1079 | ) | ||||
1080 | /sgex; | ||||
1081 | |||||
1082 | return $p unless wantarray; | ||||
1083 | |||||
1084 | push @r, $p; | ||||
1085 | } | ||||
1086 | |||||
1087 | return @r; | ||||
1088 | } | ||||
1089 | } | ||||
1090 | |||||
1091 | { | ||||
1092 | |||||
1093 | # It's an array because the order in which the regexes are checked | ||||
1094 | # is important. These patterns are similar to the ones Java uses, | ||||
1095 | # but not quite the same. See | ||||
1096 | # http://www.unicode.org/reports/tr35/tr35-9.html#Date_Format_Patterns. | ||||
1097 | 1 | 6µs | my @patterns = ( | ||
1098 | qr/GGGGG/ => | ||||
1099 | sub { $_[0]->{locale}->era_narrow->[ $_[0]->_era_index() ] }, | ||||
1100 | qr/GGGG/ => 'era_name', | ||||
1101 | qr/G{1,3}/ => 'era_abbr', | ||||
1102 | |||||
1103 | qr/(y{3,5})/ => | ||||
1104 | sub { $_[0]->_zero_padded_number( $1, $_[0]->year() ) }, | ||||
1105 | |||||
1106 | # yy is a weird special case, where it must be exactly 2 digits | ||||
1107 | qr/yy/ => sub { | ||||
1108 | my $year = $_[0]->year(); | ||||
1109 | my $y2 = substr( $year, -2, 2 ) if length $year > 2; | ||||
1110 | $y2 *= -1 if $year < 0; | ||||
1111 | $_[0]->_zero_padded_number( 'yy', $y2 ); | ||||
1112 | }, | ||||
1113 | qr/y/ => sub { $_[0]->year() }, | ||||
1114 | qr/(u+)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->year() ) }, | ||||
1115 | qr/(Y+)/ => | ||||
1116 | sub { $_[0]->_zero_padded_number( $1, $_[0]->week_year() ) }, | ||||
1117 | |||||
1118 | qr/QQQQ/ => 'quarter_name', | ||||
1119 | qr/QQQ/ => 'quarter_abbr', | ||||
1120 | qr/(QQ?)/ => | ||||
1121 | sub { $_[0]->_zero_padded_number( $1, $_[0]->quarter() ) }, | ||||
1122 | |||||
1123 | qr/qqqq/ => sub { | ||||
1124 | $_[0]->{locale}->quarter_stand_alone_wide() | ||||
1125 | ->[ $_[0]->quarter_0() ]; | ||||
1126 | }, | ||||
1127 | qr/qqq/ => sub { | ||||
1128 | $_[0]->{locale}->quarter_stand_alone_abbreviated() | ||||
1129 | ->[ $_[0]->quarter_0() ]; | ||||
1130 | }, | ||||
1131 | qr/(qq?)/ => | ||||
1132 | sub { $_[0]->_zero_padded_number( $1, $_[0]->quarter() ) }, | ||||
1133 | |||||
1134 | qr/MMMMM/ => | ||||
1135 | sub { $_[0]->{locale}->month_format_narrow->[ $_[0]->month_0() ] } | ||||
1136 | , | ||||
1137 | qr/MMMM/ => 'month_name', | ||||
1138 | qr/MMM/ => 'month_abbr', | ||||
1139 | qr/(MM?)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->month() ) }, | ||||
1140 | |||||
1141 | qr/LLLLL/ => sub { | ||||
1142 | $_[0]->{locale}->month_stand_alone_narrow->[ $_[0]->month_0() ]; | ||||
1143 | }, | ||||
1144 | qr/LLLL/ => sub { | ||||
1145 | $_[0]->{locale}->month_stand_alone_wide->[ $_[0]->month_0() ]; | ||||
1146 | }, | ||||
1147 | qr/LLL/ => sub { | ||||
1148 | $_[0]->{locale} | ||||
1149 | ->month_stand_alone_abbreviated->[ $_[0]->month_0() ]; | ||||
1150 | }, | ||||
1151 | qr/(LL?)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->month() ) }, | ||||
1152 | |||||
1153 | qr/(ww?)/ => | ||||
1154 | sub { $_[0]->_zero_padded_number( $1, $_[0]->week_number() ) }, | ||||
1155 | qr/W/ => 'week_of_month', | ||||
1156 | |||||
1157 | qr/(dd?)/ => | ||||
1158 | sub { $_[0]->_zero_padded_number( $1, $_[0]->day_of_month() ) }, | ||||
1159 | qr/(D{1,3})/ => | ||||
1160 | sub { $_[0]->_zero_padded_number( $1, $_[0]->day_of_year() ) }, | ||||
1161 | |||||
1162 | qr/F/ => 'weekday_of_month', | ||||
1163 | qr/(g+)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->mjd() ) }, | ||||
1164 | |||||
1165 | qr/EEEEE/ => sub { | ||||
1166 | $_[0]->{locale}->day_format_narrow->[ $_[0]->day_of_week_0() ]; | ||||
1167 | }, | ||||
1168 | qr/EEEE/ => 'day_name', | ||||
1169 | qr/E{1,3}/ => 'day_abbr', | ||||
1170 | |||||
1171 | qr/eeeee/ => sub { | ||||
1172 | $_[0]->{locale}->day_format_narrow->[ $_[0]->day_of_week_0() ]; | ||||
1173 | }, | ||||
1174 | qr/eeee/ => 'day_name', | ||||
1175 | qr/eee/ => 'day_abbr', | ||||
1176 | qr/(ee?)/ => sub { | ||||
1177 | $_[0]->_zero_padded_number( $1, $_[0]->local_day_of_week() ); | ||||
1178 | }, | ||||
1179 | |||||
1180 | qr/ccccc/ => sub { | ||||
1181 | $_[0]->{locale} | ||||
1182 | ->day_stand_alone_narrow->[ $_[0]->day_of_week_0() ]; | ||||
1183 | }, | ||||
1184 | qr/cccc/ => sub { | ||||
1185 | $_[0]->{locale}->day_stand_alone_wide->[ $_[0]->day_of_week_0() ]; | ||||
1186 | }, | ||||
1187 | qr/ccc/ => sub { | ||||
1188 | $_[0]->{locale} | ||||
1189 | ->day_stand_alone_abbreviated->[ $_[0]->day_of_week_0() ]; | ||||
1190 | }, | ||||
1191 | qr/(cc?)/ => | ||||
1192 | sub { $_[0]->_zero_padded_number( $1, $_[0]->day_of_week() ) }, | ||||
1193 | |||||
1194 | qr/a/ => 'am_or_pm', | ||||
1195 | |||||
1196 | qr/(hh?)/ => | ||||
1197 | sub { $_[0]->_zero_padded_number( $1, $_[0]->hour_12() ) }, | ||||
1198 | qr/(HH?)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->hour() ) }, | ||||
1199 | qr/(KK?)/ => | ||||
1200 | sub { $_[0]->_zero_padded_number( $1, $_[0]->hour_12_0() ) }, | ||||
1201 | qr/(kk?)/ => | ||||
1202 | sub { $_[0]->_zero_padded_number( $1, $_[0]->hour_1() ) }, | ||||
1203 | qr/(jj?)/ => sub { | ||||
1204 | my $h | ||||
1205 | = $_[0]->{locale}->prefers_24_hour_time() | ||||
1206 | ? $_[0]->hour() | ||||
1207 | : $_[0]->hour_12(); | ||||
1208 | $_[0]->_zero_padded_number( $1, $h ); | ||||
1209 | }, | ||||
1210 | |||||
1211 | qr/(mm?)/ => | ||||
1212 | sub { $_[0]->_zero_padded_number( $1, $_[0]->minute() ) }, | ||||
1213 | |||||
1214 | qr/(ss?)/ => | ||||
1215 | sub { $_[0]->_zero_padded_number( $1, $_[0]->second() ) }, | ||||
1216 | |||||
1217 | # I'm not sure this is what is wanted (notably the trailing | ||||
1218 | # and leading zeros it can produce), but once again the LDML | ||||
1219 | # spec is not all that clear. | ||||
1220 | qr/(S+)/ => sub { | ||||
1221 | my $l = length $1; | ||||
1222 | my $val = sprintf( "%.${l}f", | ||||
1223 | $_[0]->fractional_second() - $_[0]->second() ); | ||||
1224 | $val =~ s/^0\.//; | ||||
1225 | $val || 0; | ||||
1226 | }, | ||||
1227 | qr/A+/ => | ||||
1228 | sub { ( $_[0]->{local_rd_secs} * 1000 ) + $_[0]->millisecond() }, | ||||
1229 | |||||
1230 | qr/zzzz/ => sub { $_[0]->time_zone_long_name() }, | ||||
1231 | qr/z{1,3}/ => sub { $_[0]->time_zone_short_name() }, | ||||
1232 | qr/ZZZZ/ => sub { | ||||
1233 | $_[0]->time_zone_short_name() | ||||
1234 | . DateTime::TimeZone->offset_as_string( $_[0]->offset() ); | ||||
1235 | }, | ||||
1236 | qr/Z{1,3}/ => | ||||
1237 | sub { DateTime::TimeZone->offset_as_string( $_[0]->offset() ) }, | ||||
1238 | qr/vvvv/ => sub { $_[0]->time_zone_long_name() }, | ||||
1239 | qr/v{1,3}/ => sub { $_[0]->time_zone_short_name() }, | ||||
1240 | qr/VVVV/ => sub { $_[0]->time_zone_long_name() }, | ||||
1241 | qr/V{1,3}/ => sub { $_[0]->time_zone_short_name() }, | ||||
1242 | 1 | 405µs | 57 | 103µs | ); # spent 103µs making 57 calls to DateTime::CORE:qr, avg 2µs/call |
1243 | |||||
1244 | sub _zero_padded_number { | ||||
1245 | my $self = shift; | ||||
1246 | my $size = length shift; | ||||
1247 | my $val = shift; | ||||
1248 | |||||
1249 | return sprintf( "%0${size}d", $val ); | ||||
1250 | } | ||||
1251 | |||||
1252 | sub _space_padded_string { | ||||
1253 | my $self = shift; | ||||
1254 | my $size = length shift; | ||||
1255 | my $val = shift; | ||||
1256 | |||||
1257 | return sprintf( "% ${size}s", $val ); | ||||
1258 | } | ||||
1259 | |||||
1260 | sub format_cldr { | ||||
1261 | my $self = shift; | ||||
1262 | |||||
1263 | # make a copy or caller's scalars get munged | ||||
1264 | my @patterns = @_; | ||||
1265 | |||||
1266 | my @r; | ||||
1267 | foreach my $p (@patterns) { | ||||
1268 | $p =~ s/\G | ||||
1269 | (?: | ||||
1270 | '((?:[^']|'')*)' # quote escaped bit of text | ||||
1271 | # it needs to end with one | ||||
1272 | # quote not followed by | ||||
1273 | # another | ||||
1274 | | | ||||
1275 | (([a-zA-Z])\3*) # could be a pattern | ||||
1276 | | | ||||
1277 | (.) # anything else | ||||
1278 | ) | ||||
1279 | / | ||||
1280 | defined $1 | ||||
1281 | ? $1 | ||||
1282 | : defined $2 | ||||
1283 | ? $self->_cldr_pattern($2) | ||||
1284 | : defined $4 | ||||
1285 | ? $4 | ||||
1286 | : undef # should never get here | ||||
1287 | /sgex; | ||||
1288 | |||||
1289 | $p =~ s/\'\'/\'/g; | ||||
1290 | |||||
1291 | return $p unless wantarray; | ||||
1292 | |||||
1293 | push @r, $p; | ||||
1294 | } | ||||
1295 | |||||
1296 | return @r; | ||||
1297 | } | ||||
1298 | |||||
1299 | sub _cldr_pattern { | ||||
1300 | my $self = shift; | ||||
1301 | my $pattern = shift; | ||||
1302 | |||||
1303 | for ( my $i = 0; $i < @patterns; $i += 2 ) { | ||||
1304 | if ( $pattern =~ /$patterns[$i]/ ) { | ||||
1305 | my $sub = $patterns[ $i + 1 ]; | ||||
1306 | |||||
1307 | return $self->$sub(); | ||||
1308 | } | ||||
1309 | } | ||||
1310 | |||||
1311 | return $pattern; | ||||
1312 | } | ||||
1313 | } | ||||
1314 | |||||
1315 | sub _format_nanosecs { | ||||
1316 | my $self = shift; | ||||
1317 | my $precision = @_ ? shift : 9; | ||||
1318 | |||||
1319 | my $divide_by = 10**( 9 - $precision ); | ||||
1320 | |||||
1321 | return sprintf( | ||||
1322 | '%0' . $precision . 'u', | ||||
1323 | floor( $self->{rd_nanosecs} / $divide_by ) | ||||
1324 | ); | ||||
1325 | } | ||||
1326 | |||||
1327 | sub epoch { | ||||
1328 | my $self = shift; | ||||
1329 | |||||
1330 | return $self->{utc_c}{epoch} | ||||
1331 | if exists $self->{utc_c}{epoch}; | ||||
1332 | |||||
1333 | return $self->{utc_c}{epoch} | ||||
1334 | = ( $self->{utc_rd_days} - 719163 ) * SECONDS_PER_DAY | ||||
1335 | + $self->{utc_rd_secs}; | ||||
1336 | } | ||||
1337 | |||||
1338 | sub hires_epoch { | ||||
1339 | my $self = shift; | ||||
1340 | |||||
1341 | my $epoch = $self->epoch; | ||||
1342 | |||||
1343 | return undef unless defined $epoch; | ||||
1344 | |||||
1345 | my $nano = $self->{rd_nanosecs} / MAX_NANOSECONDS; | ||||
1346 | |||||
1347 | return $epoch + $nano; | ||||
1348 | } | ||||
1349 | |||||
1350 | sub is_finite {1} | ||||
1351 | sub is_infinite {0} | ||||
1352 | |||||
1353 | # added for benefit of DateTime::TimeZone | ||||
1354 | sub utc_year { $_[0]->{utc_year} } | ||||
1355 | |||||
1356 | # returns a result that is relative to the first datetime | ||||
1357 | sub subtract_datetime { | ||||
1358 | my $dt1 = shift; | ||||
1359 | my $dt2 = shift; | ||||
1360 | |||||
1361 | $dt2 = $dt2->clone->set_time_zone( $dt1->time_zone ) | ||||
1362 | unless $dt1->time_zone eq $dt2->time_zone; | ||||
1363 | |||||
1364 | # We only want a negative duration if $dt2 > $dt1 ($self) | ||||
1365 | my ( $bigger, $smaller, $negative ) = ( | ||||
1366 | $dt1 >= $dt2 | ||||
1367 | ? ( $dt1, $dt2, 0 ) | ||||
1368 | : ( $dt2, $dt1, 1 ) | ||||
1369 | ); | ||||
1370 | |||||
1371 | my $is_floating = $dt1->time_zone->is_floating | ||||
1372 | && $dt2->time_zone->is_floating; | ||||
1373 | |||||
1374 | my $minute_length = 60; | ||||
1375 | unless ($is_floating) { | ||||
1376 | my ( $utc_rd_days, $utc_rd_secs ) = $smaller->utc_rd_values; | ||||
1377 | |||||
1378 | if ( $utc_rd_secs >= 86340 && !$is_floating ) { | ||||
1379 | |||||
1380 | # If the smaller of the two datetimes occurs in the last | ||||
1381 | # UTC minute of the UTC day, then that minute may not be | ||||
1382 | # 60 seconds long. If we need to subtract a minute from | ||||
1383 | # the larger datetime's minutes count in order to adjust | ||||
1384 | # the seconds difference to be positive, we need to know | ||||
1385 | # how long that minute was. If one of the datetimes is | ||||
1386 | # floating, we just assume a minute is 60 seconds. | ||||
1387 | |||||
1388 | $minute_length = $dt1->_day_length($utc_rd_days) - 86340; | ||||
1389 | } | ||||
1390 | } | ||||
1391 | |||||
1392 | # This is a gross hack that basically figures out if the bigger of | ||||
1393 | # the two datetimes is the day of a DST change. If it's a 23 hour | ||||
1394 | # day (switching _to_ DST) then we subtract 60 minutes from the | ||||
1395 | # local time. If it's a 25 hour day then we add 60 minutes to the | ||||
1396 | # local time. | ||||
1397 | # | ||||
1398 | # This produces the most "intuitive" results, though there are | ||||
1399 | # still reversibility problems with the resultant duration. | ||||
1400 | # | ||||
1401 | # However, if the two objects are on the same (local) date, and we | ||||
1402 | # are not crossing a DST change, we don't want to invoke the hack | ||||
1403 | # - see 38local-subtract.t | ||||
1404 | my $bigger_min = $bigger->hour * 60 + $bigger->minute; | ||||
1405 | if ( $bigger->time_zone->has_dst_changes | ||||
1406 | && $bigger->is_dst != $smaller->is_dst ) { | ||||
1407 | |||||
1408 | $bigger_min -= 60 | ||||
1409 | |||||
1410 | # it's a 23 hour (local) day | ||||
1411 | if ( | ||||
1412 | $bigger->is_dst | ||||
1413 | && do { | ||||
1414 | local $@; | ||||
1415 | my $prev_day = eval { $bigger->clone->subtract( days => 1 ) }; | ||||
1416 | $prev_day && !$prev_day->is_dst ? 1 : 0; | ||||
1417 | } | ||||
1418 | ); | ||||
1419 | |||||
1420 | $bigger_min += 60 | ||||
1421 | |||||
1422 | # it's a 25 hour (local) day | ||||
1423 | if ( | ||||
1424 | !$bigger->is_dst | ||||
1425 | && do { | ||||
1426 | local $@; | ||||
1427 | my $prev_day = eval { $bigger->clone->subtract( days => 1 ) }; | ||||
1428 | $prev_day && $prev_day->is_dst ? 1 : 0; | ||||
1429 | } | ||||
1430 | ); | ||||
1431 | } | ||||
1432 | |||||
1433 | my ( $months, $days, $minutes, $seconds, $nanoseconds ) | ||||
1434 | = $dt1->_adjust_for_positive_difference( | ||||
1435 | $bigger->year * 12 + $bigger->month, | ||||
1436 | $smaller->year * 12 + $smaller->month, | ||||
1437 | |||||
1438 | $bigger->day, $smaller->day, | ||||
1439 | |||||
1440 | $bigger_min, $smaller->hour * 60 + $smaller->minute, | ||||
1441 | |||||
1442 | $bigger->second, $smaller->second, | ||||
1443 | |||||
1444 | $bigger->nanosecond, $smaller->nanosecond, | ||||
1445 | |||||
1446 | $minute_length, | ||||
1447 | |||||
1448 | # XXX - using the smaller as the month length is | ||||
1449 | # somewhat arbitrary, we could also use the bigger - | ||||
1450 | # either way we have reversibility problems | ||||
1451 | $dt1->_month_length( $smaller->year, $smaller->month ), | ||||
1452 | ); | ||||
1453 | |||||
1454 | if ($negative) { | ||||
1455 | for ( $months, $days, $minutes, $seconds, $nanoseconds ) { | ||||
1456 | |||||
1457 | # Some versions of Perl can end up with -0 if we do "0 * -1"!! | ||||
1458 | $_ *= -1 if $_; | ||||
1459 | } | ||||
1460 | } | ||||
1461 | |||||
1462 | return $dt1->duration_class->new( | ||||
1463 | months => $months, | ||||
1464 | days => $days, | ||||
1465 | minutes => $minutes, | ||||
1466 | seconds => $seconds, | ||||
1467 | nanoseconds => $nanoseconds, | ||||
1468 | ); | ||||
1469 | } | ||||
1470 | |||||
1471 | sub _adjust_for_positive_difference { | ||||
1472 | my ( | ||||
1473 | $self, | ||||
1474 | $month1, $month2, | ||||
1475 | $day1, $day2, | ||||
1476 | $min1, $min2, | ||||
1477 | $sec1, $sec2, | ||||
1478 | $nano1, $nano2, | ||||
1479 | $minute_length, | ||||
1480 | $month_length, | ||||
1481 | ) = @_; | ||||
1482 | |||||
1483 | if ( $nano1 < $nano2 ) { | ||||
1484 | $sec1--; | ||||
1485 | $nano1 += MAX_NANOSECONDS; | ||||
1486 | } | ||||
1487 | |||||
1488 | if ( $sec1 < $sec2 ) { | ||||
1489 | $min1--; | ||||
1490 | $sec1 += $minute_length; | ||||
1491 | } | ||||
1492 | |||||
1493 | # A day always has 24 * 60 minutes, though the minutes may vary in | ||||
1494 | # length. | ||||
1495 | if ( $min1 < $min2 ) { | ||||
1496 | $day1--; | ||||
1497 | $min1 += 24 * 60; | ||||
1498 | } | ||||
1499 | |||||
1500 | if ( $day1 < $day2 ) { | ||||
1501 | $month1--; | ||||
1502 | $day1 += $month_length; | ||||
1503 | } | ||||
1504 | |||||
1505 | return ( | ||||
1506 | $month1 - $month2, | ||||
1507 | $day1 - $day2, | ||||
1508 | $min1 - $min2, | ||||
1509 | $sec1 - $sec2, | ||||
1510 | $nano1 - $nano2, | ||||
1511 | ); | ||||
1512 | } | ||||
1513 | |||||
1514 | sub subtract_datetime_absolute { | ||||
1515 | my $self = shift; | ||||
1516 | my $dt = shift; | ||||
1517 | |||||
1518 | my $utc_rd_secs1 = $self->utc_rd_as_seconds; | ||||
1519 | $utc_rd_secs1 | ||||
1520 | += DateTime->_accumulated_leap_seconds( $self->{utc_rd_days} ) | ||||
1521 | if !$self->time_zone->is_floating; | ||||
1522 | |||||
1523 | my $utc_rd_secs2 = $dt->utc_rd_as_seconds; | ||||
1524 | $utc_rd_secs2 += DateTime->_accumulated_leap_seconds( $dt->{utc_rd_days} ) | ||||
1525 | if !$dt->time_zone->is_floating; | ||||
1526 | |||||
1527 | my $seconds = $utc_rd_secs1 - $utc_rd_secs2; | ||||
1528 | my $nanoseconds = $self->nanosecond - $dt->nanosecond; | ||||
1529 | |||||
1530 | if ( $nanoseconds < 0 ) { | ||||
1531 | $seconds--; | ||||
1532 | $nanoseconds += MAX_NANOSECONDS; | ||||
1533 | } | ||||
1534 | |||||
1535 | return $self->duration_class->new( | ||||
1536 | seconds => $seconds, | ||||
1537 | nanoseconds => $nanoseconds, | ||||
1538 | ); | ||||
1539 | } | ||||
1540 | |||||
1541 | sub delta_md { | ||||
1542 | my $self = shift; | ||||
1543 | my $dt = shift; | ||||
1544 | |||||
1545 | my ( $smaller, $bigger ) = sort $self, $dt; | ||||
1546 | |||||
1547 | my ( $months, $days, undef, undef, undef ) | ||||
1548 | = $dt->_adjust_for_positive_difference( | ||||
1549 | $bigger->year * 12 + $bigger->month, | ||||
1550 | $smaller->year * 12 + $smaller->month, | ||||
1551 | |||||
1552 | $bigger->day, $smaller->day, | ||||
1553 | |||||
1554 | 0, 0, | ||||
1555 | |||||
1556 | 0, 0, | ||||
1557 | |||||
1558 | 0, 0, | ||||
1559 | |||||
1560 | 60, | ||||
1561 | |||||
1562 | $smaller->_month_length( $smaller->year, $smaller->month ), | ||||
1563 | ); | ||||
1564 | |||||
1565 | return $self->duration_class->new( | ||||
1566 | months => $months, | ||||
1567 | days => $days | ||||
1568 | ); | ||||
1569 | } | ||||
1570 | |||||
1571 | sub delta_days { | ||||
1572 | my $self = shift; | ||||
1573 | my $dt = shift; | ||||
1574 | |||||
1575 | my $days | ||||
1576 | = abs( ( $self->local_rd_values )[0] - ( $dt->local_rd_values )[0] ); | ||||
1577 | |||||
1578 | $self->duration_class->new( days => $days ); | ||||
1579 | } | ||||
1580 | |||||
1581 | sub delta_ms { | ||||
1582 | my $self = shift; | ||||
1583 | my $dt = shift; | ||||
1584 | |||||
1585 | my ( $smaller, $greater ) = sort $self, $dt; | ||||
1586 | |||||
1587 | my $days = int( $greater->jd - $smaller->jd ); | ||||
1588 | |||||
1589 | my $dur = $greater->subtract_datetime($smaller); | ||||
1590 | |||||
1591 | my %p; | ||||
1592 | $p{hours} = $dur->hours + ( $days * 24 ); | ||||
1593 | $p{minutes} = $dur->minutes; | ||||
1594 | $p{seconds} = $dur->seconds; | ||||
1595 | |||||
1596 | return $self->duration_class->new(%p); | ||||
1597 | } | ||||
1598 | |||||
1599 | sub _add_overload { | ||||
1600 | my ( $dt, $dur, $reversed ) = @_; | ||||
1601 | |||||
1602 | if ($reversed) { | ||||
1603 | ( $dur, $dt ) = ( $dt, $dur ); | ||||
1604 | } | ||||
1605 | |||||
1606 | unless ( DateTime::Helpers::isa( $dur, 'DateTime::Duration' ) ) { | ||||
1607 | my $class = ref $dt; | ||||
1608 | my $dt_string = overload::StrVal($dt); | ||||
1609 | |||||
1610 | Carp::croak( "Cannot add $dur to a $class object ($dt_string).\n" | ||||
1611 | . " Only a DateTime::Duration object can " | ||||
1612 | . " be added to a $class object." ); | ||||
1613 | } | ||||
1614 | |||||
1615 | return $dt->clone->add_duration($dur); | ||||
1616 | } | ||||
1617 | |||||
1618 | sub _subtract_overload { | ||||
1619 | my ( $date1, $date2, $reversed ) = @_; | ||||
1620 | |||||
1621 | if ($reversed) { | ||||
1622 | ( $date2, $date1 ) = ( $date1, $date2 ); | ||||
1623 | } | ||||
1624 | |||||
1625 | if ( DateTime::Helpers::isa( $date2, 'DateTime::Duration' ) ) { | ||||
1626 | my $new = $date1->clone; | ||||
1627 | $new->add_duration( $date2->inverse ); | ||||
1628 | return $new; | ||||
1629 | } | ||||
1630 | elsif ( DateTime::Helpers::isa( $date2, 'DateTime' ) ) { | ||||
1631 | return $date1->subtract_datetime($date2); | ||||
1632 | } | ||||
1633 | else { | ||||
1634 | my $class = ref $date1; | ||||
1635 | my $dt_string = overload::StrVal($date1); | ||||
1636 | |||||
1637 | Carp::croak( | ||||
1638 | "Cannot subtract $date2 from a $class object ($dt_string).\n" | ||||
1639 | . " Only a DateTime::Duration or DateTime object can " | ||||
1640 | . " be subtracted from a $class object." ); | ||||
1641 | } | ||||
1642 | } | ||||
1643 | |||||
1644 | sub add { | ||||
1645 | my $self = shift; | ||||
1646 | |||||
1647 | return $self->add_duration( $self->duration_class->new(@_) ); | ||||
1648 | } | ||||
1649 | |||||
1650 | sub subtract { | ||||
1651 | my $self = shift; | ||||
1652 | my %p = @_; | ||||
1653 | |||||
1654 | my %eom; | ||||
1655 | $eom{end_of_month} = delete $p{end_of_month} | ||||
1656 | if exists $p{end_of_month}; | ||||
1657 | |||||
1658 | my $dur = $self->duration_class->new(@_)->inverse(%eom); | ||||
1659 | |||||
1660 | return $self->add_duration($dur); | ||||
1661 | } | ||||
1662 | |||||
1663 | sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) } | ||||
1664 | |||||
1665 | { | ||||
1666 | 2 | 5µs | my @spec = ( { isa => 'DateTime::Duration' } ); | ||
1667 | |||||
1668 | sub add_duration { | ||||
1669 | my $self = shift; | ||||
1670 | my ($dur) = validate_pos( @_, @spec ); | ||||
1671 | |||||
1672 | # simple optimization | ||||
1673 | return $self if $dur->is_zero; | ||||
1674 | |||||
1675 | my %deltas = $dur->deltas; | ||||
1676 | |||||
1677 | # This bit isn't quite right since DateTime::Infinite::Future - | ||||
1678 | # infinite duration should NaN | ||||
1679 | foreach my $val ( values %deltas ) { | ||||
1680 | my $inf; | ||||
1681 | if ( $val == INFINITY ) { | ||||
1682 | $inf = DateTime::Infinite::Future->new; | ||||
1683 | } | ||||
1684 | elsif ( $val == NEG_INFINITY ) { | ||||
1685 | $inf = DateTime::Infinite::Past->new; | ||||
1686 | } | ||||
1687 | |||||
1688 | if ($inf) { | ||||
1689 | %$self = %$inf; | ||||
1690 | bless $self, ref $inf; | ||||
1691 | |||||
1692 | return $self; | ||||
1693 | } | ||||
1694 | } | ||||
1695 | |||||
1696 | return $self if $self->is_infinite; | ||||
1697 | |||||
1698 | if ( $deltas{days} ) { | ||||
1699 | $self->{local_rd_days} += $deltas{days}; | ||||
1700 | |||||
1701 | $self->{utc_year} += int( $deltas{days} / 365 ) + 1; | ||||
1702 | } | ||||
1703 | |||||
1704 | if ( $deltas{months} ) { | ||||
1705 | |||||
1706 | # For preserve mode, if it is the last day of the month, make | ||||
1707 | # it the 0th day of the following month (which then will | ||||
1708 | # normalize back to the last day of the new month). | ||||
1709 | my ( $y, $m, $d ) = ( | ||||
1710 | $dur->is_preserve_mode | ||||
1711 | ? $self->_rd2ymd( $self->{local_rd_days} + 1 ) | ||||
1712 | : $self->_rd2ymd( $self->{local_rd_days} ) | ||||
1713 | ); | ||||
1714 | |||||
1715 | $d -= 1 if $dur->is_preserve_mode; | ||||
1716 | |||||
1717 | if ( !$dur->is_wrap_mode && $d > 28 ) { | ||||
1718 | |||||
1719 | # find the rd for the last day of our target month | ||||
1720 | $self->{local_rd_days} | ||||
1721 | = $self->_ymd2rd( $y, $m + $deltas{months} + 1, 0 ); | ||||
1722 | |||||
1723 | # what day of the month is it? (discard year and month) | ||||
1724 | my $last_day | ||||
1725 | = ( $self->_rd2ymd( $self->{local_rd_days} ) )[2]; | ||||
1726 | |||||
1727 | # if our original day was less than the last day, | ||||
1728 | # use that instead | ||||
1729 | $self->{local_rd_days} -= $last_day - $d if $last_day > $d; | ||||
1730 | } | ||||
1731 | else { | ||||
1732 | $self->{local_rd_days} | ||||
1733 | = $self->_ymd2rd( $y, $m + $deltas{months}, $d ); | ||||
1734 | } | ||||
1735 | |||||
1736 | $self->{utc_year} += int( $deltas{months} / 12 ) + 1; | ||||
1737 | } | ||||
1738 | |||||
1739 | if ( $deltas{days} || $deltas{months} ) { | ||||
1740 | $self->_calc_utc_rd; | ||||
1741 | |||||
1742 | $self->_handle_offset_modifier( $self->second ); | ||||
1743 | } | ||||
1744 | |||||
1745 | if ( $deltas{minutes} ) { | ||||
1746 | $self->{utc_rd_secs} += $deltas{minutes} * 60; | ||||
1747 | |||||
1748 | # This intentionally ignores leap seconds | ||||
1749 | $self->_normalize_tai_seconds( $self->{utc_rd_days}, | ||||
1750 | $self->{utc_rd_secs} ); | ||||
1751 | } | ||||
1752 | |||||
1753 | if ( $deltas{seconds} || $deltas{nanoseconds} ) { | ||||
1754 | $self->{utc_rd_secs} += $deltas{seconds}; | ||||
1755 | |||||
1756 | if ( $deltas{nanoseconds} ) { | ||||
1757 | $self->{rd_nanosecs} += $deltas{nanoseconds}; | ||||
1758 | $self->_normalize_nanoseconds( $self->{utc_rd_secs}, | ||||
1759 | $self->{rd_nanosecs} ); | ||||
1760 | } | ||||
1761 | |||||
1762 | $self->_normalize_seconds; | ||||
1763 | |||||
1764 | # This might be some big number much bigger than 60, but | ||||
1765 | # that's ok (there are tests in 19leap_second.t to confirm | ||||
1766 | # that) | ||||
1767 | $self->_handle_offset_modifier( | ||||
1768 | $self->second + $deltas{seconds} ); | ||||
1769 | } | ||||
1770 | |||||
1771 | my $new = ( ref $self )->from_object( | ||||
1772 | object => $self, | ||||
1773 | locale => $self->{locale}, | ||||
1774 | ( $self->{formatter} ? ( formatter => $self->{formatter} ) : () ), | ||||
1775 | ); | ||||
1776 | |||||
1777 | %$self = %$new; | ||||
1778 | |||||
1779 | return $self; | ||||
1780 | } | ||||
1781 | } | ||||
1782 | |||||
1783 | sub _compare_overload { | ||||
1784 | |||||
1785 | # note: $_[1]->compare( $_[0] ) is an error when $_[1] is not a | ||||
1786 | # DateTime (such as the INFINITY value) | ||||
1787 | return $_[2] ? -$_[0]->compare( $_[1] ) : $_[0]->compare( $_[1] ); | ||||
1788 | } | ||||
1789 | |||||
1790 | sub _string_compare_overload { | ||||
1791 | my ( $dt1, $dt2, $flip ) = @_; | ||||
1792 | |||||
1793 | # One is a DateTime object, one isn't. Just stringify and compare. | ||||
1794 | if ( !DateTime::Helpers::can( $dt2, 'utc_rd_values' ) ) { | ||||
1795 | my $sign = $flip ? -1 : 1; | ||||
1796 | return $sign * ( "$dt1" cmp "$dt2" ); | ||||
1797 | } | ||||
1798 | else { | ||||
1799 | my $meth = $dt1->can('_compare_overload'); | ||||
1800 | goto $meth; | ||||
1801 | } | ||||
1802 | } | ||||
1803 | |||||
1804 | sub compare { | ||||
1805 | shift->_compare( @_, 0 ); | ||||
1806 | } | ||||
1807 | |||||
1808 | sub compare_ignore_floating { | ||||
1809 | shift->_compare( @_, 1 ); | ||||
1810 | } | ||||
1811 | |||||
1812 | sub _compare { | ||||
1813 | my ( $class, $dt1, $dt2, $consistent ) = ref $_[0] ? ( undef, @_ ) : @_; | ||||
1814 | |||||
1815 | return undef unless defined $dt2; | ||||
1816 | |||||
1817 | if ( !ref $dt2 && ( $dt2 == INFINITY || $dt2 == NEG_INFINITY ) ) { | ||||
1818 | return $dt1->{utc_rd_days} <=> $dt2; | ||||
1819 | } | ||||
1820 | |||||
1821 | unless ( DateTime::Helpers::can( $dt1, 'utc_rd_values' ) | ||||
1822 | && DateTime::Helpers::can( $dt2, 'utc_rd_values' ) ) { | ||||
1823 | my $dt1_string = overload::StrVal($dt1); | ||||
1824 | my $dt2_string = overload::StrVal($dt2); | ||||
1825 | |||||
1826 | Carp::croak( "A DateTime object can only be compared to" | ||||
1827 | . " another DateTime object ($dt1_string, $dt2_string)." ); | ||||
1828 | } | ||||
1829 | |||||
1830 | if ( !$consistent | ||||
1831 | && DateTime::Helpers::can( $dt1, 'time_zone' ) | ||||
1832 | && DateTime::Helpers::can( $dt2, 'time_zone' ) ) { | ||||
1833 | my $is_floating1 = $dt1->time_zone->is_floating; | ||||
1834 | my $is_floating2 = $dt2->time_zone->is_floating; | ||||
1835 | |||||
1836 | if ( $is_floating1 && !$is_floating2 ) { | ||||
1837 | $dt1 = $dt1->clone->set_time_zone( $dt2->time_zone ); | ||||
1838 | } | ||||
1839 | elsif ( $is_floating2 && !$is_floating1 ) { | ||||
1840 | $dt2 = $dt2->clone->set_time_zone( $dt1->time_zone ); | ||||
1841 | } | ||||
1842 | } | ||||
1843 | |||||
1844 | my @dt1_components = $dt1->utc_rd_values; | ||||
1845 | my @dt2_components = $dt2->utc_rd_values; | ||||
1846 | |||||
1847 | foreach my $i ( 0 .. 2 ) { | ||||
1848 | return $dt1_components[$i] <=> $dt2_components[$i] | ||||
1849 | if $dt1_components[$i] != $dt2_components[$i]; | ||||
1850 | } | ||||
1851 | |||||
1852 | return 0; | ||||
1853 | } | ||||
1854 | |||||
1855 | sub _string_equals_overload { | ||||
1856 | my ( $class, $dt1, $dt2 ) = ref $_[0] ? ( undef, @_ ) : @_; | ||||
1857 | |||||
1858 | if ( !DateTime::Helpers::can( $dt2, 'utc_rd_values' ) ) { | ||||
1859 | return "$dt1" eq "$dt2"; | ||||
1860 | } | ||||
1861 | |||||
1862 | $class ||= ref $dt1; | ||||
1863 | return !$class->compare( $dt1, $dt2 ); | ||||
1864 | } | ||||
1865 | |||||
1866 | sub _string_not_equals_overload { | ||||
1867 | return !_string_equals_overload(@_); | ||||
1868 | } | ||||
1869 | |||||
1870 | # spent 9µs within DateTime::_normalize_nanoseconds which was called:
# once (9µs+0s) by DateTime::_new at line 248 | ||||
1871 | 2 | 2.62ms | 2 | 41µs | # spent 34µs (28+7) within DateTime::BEGIN@1871 which was called:
# once (28µs+7µs) by Value::Convertor::BEGIN@61 at line 1871 # spent 34µs making 1 call to DateTime::BEGIN@1871
# spent 7µs making 1 call to integer::import |
1872 | |||||
1873 | # seconds, nanoseconds | ||||
1874 | 1 | 13µs | if ( $_[2] < 0 ) { | ||
1875 | my $overflow = 1 + $_[2] / MAX_NANOSECONDS; | ||||
1876 | $_[2] += $overflow * MAX_NANOSECONDS; | ||||
1877 | $_[1] -= $overflow; | ||||
1878 | } | ||||
1879 | elsif ( $_[2] >= MAX_NANOSECONDS ) { | ||||
1880 | my $overflow = $_[2] / MAX_NANOSECONDS; | ||||
1881 | $_[2] -= $overflow * MAX_NANOSECONDS; | ||||
1882 | $_[1] += $overflow; | ||||
1883 | } | ||||
1884 | } | ||||
1885 | |||||
1886 | # Many of the same parameters as new() but all of them are optional, | ||||
1887 | # and there are no defaults. | ||||
1888 | 10 | 6µs | my $SetValidate = { | ||
1889 | map { | ||||
1890 | 11 | 40µs | my %copy = %{ $BasicValidate->{$_} }; | ||
1891 | 10 | 6µs | delete $copy{default}; | ||
1892 | 10 | 5µs | $copy{optional} = 1; | ||
1893 | 10 | 9µs | $_ => \%copy | ||
1894 | } | ||||
1895 | keys %$BasicValidate | ||||
1896 | }; | ||||
1897 | |||||
1898 | sub set { | ||||
1899 | my $self = shift; | ||||
1900 | my %p = validate( @_, $SetValidate ); | ||||
1901 | |||||
1902 | my $new_dt = $self->_new_from_self(%p); | ||||
1903 | |||||
1904 | %$self = %$new_dt; | ||||
1905 | |||||
1906 | return $self; | ||||
1907 | } | ||||
1908 | |||||
1909 | sub set_year { $_[0]->set( year => $_[1] ) } | ||||
1910 | sub set_month { $_[0]->set( month => $_[1] ) } | ||||
1911 | sub set_day { $_[0]->set( day => $_[1] ) } | ||||
1912 | sub set_hour { $_[0]->set( hour => $_[1] ) } | ||||
1913 | sub set_minute { $_[0]->set( minute => $_[1] ) } | ||||
1914 | sub set_second { $_[0]->set( second => $_[1] ) } | ||||
1915 | sub set_nanosecond { $_[0]->set( nanosecond => $_[1] ) } | ||||
1916 | |||||
1917 | # These two are special cased because ... if the local time is the hour of a | ||||
1918 | # DST change where the same local time occurs twice then passing it through | ||||
1919 | # _new() can actually change the underlying UTC time, which is bad. | ||||
1920 | |||||
1921 | sub set_locale { | ||||
1922 | my $self = shift; | ||||
1923 | |||||
1924 | my ($locale) = validate_pos( @_, $BasicValidate->{locale} ); | ||||
1925 | |||||
1926 | $self->_set_locale($locale); | ||||
1927 | |||||
1928 | return $self; | ||||
1929 | } | ||||
1930 | |||||
1931 | sub set_formatter { | ||||
1932 | my $self = shift; | ||||
1933 | my ($formatter) = validate_pos( @_, $BasicValidate->{formatter} ); | ||||
1934 | |||||
1935 | $self->{formatter} = $formatter; | ||||
1936 | |||||
1937 | return $self; | ||||
1938 | } | ||||
1939 | |||||
1940 | { | ||||
1941 | 2 | 4µs | my %TruncateDefault = ( | ||
1942 | month => 1, | ||||
1943 | day => 1, | ||||
1944 | hour => 0, | ||||
1945 | minute => 0, | ||||
1946 | second => 0, | ||||
1947 | nanosecond => 0, | ||||
1948 | ); | ||||
1949 | 6 | 3µs | my $re = join '|', 'year', 'week', | ||
1950 | 1 | 10µs | grep { $_ ne 'nanosecond' } keys %TruncateDefault; | ||
1951 | 1 | 80µs | 2 | 57µs | my $spec = { to => { regex => qr/^(?:$re)$/ } }; # spent 54µs making 1 call to DateTime::CORE:regcomp
# spent 3µs making 1 call to DateTime::CORE:qr |
1952 | |||||
1953 | sub truncate { | ||||
1954 | my $self = shift; | ||||
1955 | my %p = validate( @_, $spec ); | ||||
1956 | |||||
1957 | my %new; | ||||
1958 | if ( $p{to} eq 'week' ) { | ||||
1959 | my $day_diff = $self->day_of_week - 1; | ||||
1960 | |||||
1961 | if ($day_diff) { | ||||
1962 | $self->add( days => -1 * $day_diff ); | ||||
1963 | } | ||||
1964 | |||||
1965 | return $self->truncate( to => 'day' ); | ||||
1966 | } | ||||
1967 | else { | ||||
1968 | my $truncate; | ||||
1969 | foreach my $f (qw( year month day hour minute second nanosecond )) | ||||
1970 | { | ||||
1971 | $new{$f} = $truncate ? $TruncateDefault{$f} : $self->$f(); | ||||
1972 | |||||
1973 | $truncate = 1 if $p{to} eq $f; | ||||
1974 | } | ||||
1975 | } | ||||
1976 | |||||
1977 | my $new_dt = $self->_new_from_self( %new, _skip_validation => 1 ); | ||||
1978 | |||||
1979 | %$self = %$new_dt; | ||||
1980 | |||||
1981 | return $self; | ||||
1982 | } | ||||
1983 | } | ||||
1984 | |||||
1985 | # spent 438µs (59+380) within DateTime::set_time_zone which was called:
# once (59µs+380µs) by DateTime::from_epoch at line 523 | ||||
1986 | 11 | 48µs | my ( $self, $tz ) = @_; | ||
1987 | |||||
1988 | if (ref $tz) { | ||||
1989 | # This is a bit of a hack but it works because time zone objects | ||||
1990 | # are singletons, and if it doesn't work all we lose is a little | ||||
1991 | # bit of speed. | ||||
1992 | return $self if $self->{tz} eq $tz; | ||||
1993 | } | ||||
1994 | else { | ||||
1995 | return $self if $self->{tz}->name() eq $tz; | ||||
1996 | } | ||||
1997 | |||||
1998 | 1 | 2µs | my $was_floating = $self->{tz}->is_floating; # spent 2µs making 1 call to DateTime::TimeZone::is_floating | ||
1999 | |||||
2000 | my $old_tz = $self->{tz}; | ||||
2001 | $self->{tz} = ref $tz ? $tz : DateTime::TimeZone->new( name => $tz ); | ||||
2002 | |||||
2003 | 2 | 156µs | $self->_handle_offset_modifier( $self->second, 1 ); # spent 152µs making 1 call to DateTime::_handle_offset_modifier
# spent 4µs making 1 call to DateTime::second | ||
2004 | |||||
2005 | my $e; | ||||
2006 | try { | ||||
2007 | # if it either was or now is floating (but not both) | ||||
2008 | 2 | 12µs | 1 | 2µs | if ( $self->{tz}->is_floating xor $was_floating ) { # spent 2µs making 1 call to DateTime::TimeZone::is_floating |
2009 | $self->_calc_utc_rd; | ||||
2010 | } | ||||
2011 | elsif ( !$was_floating ) { | ||||
2012 | 1 | 148µs | $self->_calc_local_rd; # spent 148µs making 1 call to DateTime::_calc_local_rd | ||
2013 | } | ||||
2014 | } | ||||
2015 | catch { | ||||
2016 | $e = $_; | ||||
2017 | 2 | 222µs | }; # spent 214µs making 1 call to Try::Tiny::try
# spent 8µs making 1 call to Try::Tiny::catch | ||
2018 | |||||
2019 | # If we can't recalc the RD values then we shouldn't keep the new TZ. RT | ||||
2020 | # #83940 | ||||
2021 | if ($e) { | ||||
2022 | $self->{tz} = $old_tz; | ||||
2023 | die $e; | ||||
2024 | } | ||||
2025 | |||||
2026 | return $self; | ||||
2027 | } | ||||
2028 | |||||
2029 | sub STORABLE_freeze { | ||||
2030 | my $self = shift; | ||||
2031 | my $cloning = shift; | ||||
2032 | |||||
2033 | my $serialized = ''; | ||||
2034 | foreach my $key ( | ||||
2035 | qw( utc_rd_days | ||||
2036 | utc_rd_secs | ||||
2037 | rd_nanosecs ) | ||||
2038 | ) { | ||||
2039 | $serialized .= "$key:$self->{$key}|"; | ||||
2040 | } | ||||
2041 | |||||
2042 | # not used yet, but may be handy in the future. | ||||
2043 | $serialized .= 'version:' . ( $DateTime::VERSION || 'git' ); | ||||
2044 | |||||
2045 | # Formatter needs to be returned as a reference since it may be | ||||
2046 | # undef or a class name, and Storable will complain if extra | ||||
2047 | # return values aren't refs | ||||
2048 | return $serialized, $self->{locale}, $self->{tz}, \$self->{formatter}; | ||||
2049 | } | ||||
2050 | |||||
2051 | sub STORABLE_thaw { | ||||
2052 | my $self = shift; | ||||
2053 | my $cloning = shift; | ||||
2054 | my $serialized = shift; | ||||
2055 | |||||
2056 | my %serialized = map { split /:/ } split /\|/, $serialized; | ||||
2057 | |||||
2058 | my ( $locale, $tz, $formatter ); | ||||
2059 | |||||
2060 | # more recent code version | ||||
2061 | if (@_) { | ||||
2062 | ( $locale, $tz, $formatter ) = @_; | ||||
2063 | } | ||||
2064 | else { | ||||
2065 | $tz = DateTime::TimeZone->new( name => delete $serialized{tz} ); | ||||
2066 | |||||
2067 | $locale = DateTime::Locale->load( | ||||
2068 | exists $serialized{language} | ||||
2069 | ? delete $serialized{language} | ||||
2070 | : delete $serialized{locale} | ||||
2071 | ); | ||||
2072 | } | ||||
2073 | |||||
2074 | delete $serialized{version}; | ||||
2075 | |||||
2076 | my $object = bless { | ||||
2077 | utc_vals => [ | ||||
2078 | $serialized{utc_rd_days}, | ||||
2079 | $serialized{utc_rd_secs}, | ||||
2080 | $serialized{rd_nanosecs}, | ||||
2081 | ], | ||||
2082 | tz => $tz, | ||||
2083 | }, | ||||
2084 | 'DateTime::_Thawed'; | ||||
2085 | |||||
2086 | my %formatter = defined $$formatter ? ( formatter => $$formatter ) : (); | ||||
2087 | my $new = ( ref $self )->from_object( | ||||
2088 | object => $object, | ||||
2089 | locale => $locale, | ||||
2090 | %formatter, | ||||
2091 | ); | ||||
2092 | |||||
2093 | %$self = %$new; | ||||
2094 | |||||
2095 | return $self; | ||||
2096 | } | ||||
2097 | |||||
2098 | package | ||||
2099 | DateTime::_Thawed; | ||||
2100 | |||||
2101 | sub utc_rd_values { @{ $_[0]->{utc_vals} } } | ||||
2102 | |||||
2103 | sub time_zone { $_[0]->{tz} } | ||||
2104 | |||||
2105 | 1 | 172µs | 1; | ||
2106 | |||||
2107 | # ABSTRACT: A date and time object | ||||
2108 | |||||
2109 | __END__ | ||||
# spent 6µs within DateTime::CORE:match which was called:
# once (6µs+0s) by DateTime::from_epoch at line 508 | |||||
sub DateTime::CORE:qr; # opcode | |||||
# spent 54µs within DateTime::CORE:regcomp which was called:
# once (54µs+0s) by Value::Convertor::BEGIN@61 at line 1951 | |||||
# spent 3µs within DateTime::_day_length which was called:
# once (3µs+0s) by DateTime::_handle_offset_modifier at line 336 | |||||
sub DateTime::_normalize_tai_seconds; # xsub | |||||
# spent 9µs within DateTime::_rd2ymd which was called 2 times, avg 4µs/call:
# 2 times (9µs+0s) by DateTime::_calc_local_components at line 451, avg 4µs/call | |||||
# spent 4µs within DateTime::_seconds_as_components which was called 2 times, avg 2µs/call:
# 2 times (4µs+0s) by DateTime::_calc_local_components at line 456, avg 2µs/call | |||||
# spent 3µs within DateTime::_time_as_seconds which was called:
# once (3µs+0s) by DateTime::_new at line 240 | |||||
# spent 6µs within DateTime::_ymd2rd which was called:
# once (6µs+0s) by DateTime::_new at line 238 |