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