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.21s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
13000 | 3 | 1 | 362ms | 908ms | _new | DateTime::
10000 | 2 | 1 | 302ms | 1.57s | _new_from_self | DateTime::
4000 | 2 | 2 | 114ms | 593ms | truncate | DateTime::
13000 | 1 | 1 | 94.5ms | 144ms | _handle_offset_modifier | DateTime::
13002 | 1 | 1 | 94.4ms | 109ms | _calc_local_components | DateTime::
6000 | 2 | 1 | 83.3ms | 1.37s | set | DateTime::
13002 | 3 | 2 | 72.9ms | 186ms | _calc_local_rd | DateTime::
3000 | 1 | 1 | 71.7ms | 414ms | from_epoch | DateTime::
13002 | 3 | 2 | 67.6ms | 82.4ms | _calc_utc_rd | DateTime::
6000 | 1 | 1 | 65.6ms | 940ms | new | DateTime::
51000 | 8 | 1 | 38.9ms | 38.9ms | CORE:match (opcode) | DateTime::
13000 | 1 | 1 | 37.4ms | 43.1ms | _offset_for_local_datetime | DateTime::
9000 | 2 | 1 | 32.2ms | 39.9ms | __ANON__[:127] | DateTime::
9000 | 2 | 1 | 30.6ms | 38.3ms | __ANON__[:135] | DateTime::
13000 | 1 | 1 | 27.4ms | 30.3ms | _set_locale | DateTime::
6000 | 1 | 1 | 22.6ms | 26.5ms | __ANON__[:159] | DateTime::
6000 | 1 | 1 | 20.9ms | 24.7ms | __ANON__[:166] | DateTime::
6000 | 1 | 1 | 20.5ms | 25.1ms | __ANON__[:143] | DateTime::
6000 | 1 | 1 | 19.8ms | 25.3ms | __ANON__[:119] | DateTime::
3000 | 1 | 1 | 18.2ms | 434ms | now | DateTime::
16000 | 2 | 1 | 18.0ms | 18.0ms | _maybe_future_dst_warning | DateTime::
17000 | 3 | 1 | 16.8ms | 16.8ms | year | DateTime::
3000 | 1 | 1 | 16.2ms | 890ms | today | DateTime::
6000 | 1 | 1 | 14.2ms | 18.4ms | __ANON__[:151] | DateTime::
14000 | 2 | 1 | 10.8ms | 10.8ms | month | DateTime::
14000 | 2 | 1 | 10.3ms | 10.3ms | day_of_month | DateTime::
13000 | 1 | 1 | 9.87ms | 9.87ms | _normalize_nanoseconds | DateTime::
3000 | 1 | 1 | 9.73ms | 691ms | set_month | DateTime::
13002 | 1 | 1 | 8.66ms | 8.66ms | _normalize_tai_seconds (xsub) | DateTime::
13000 | 1 | 1 | 8.17ms | 8.17ms | _rd2ymd (xsub) | DateTime::
13000 | 1 | 1 | 8.09ms | 8.09ms | _ymd2rd (xsub) | DateTime::
10000 | 1 | 1 | 7.03ms | 7.03ms | time_zone | DateTime::
3000 | 1 | 1 | 6.93ms | 698ms | set_day | DateTime::
10000 | 1 | 1 | 6.81ms | 6.81ms | minute | DateTime::
10000 | 1 | 1 | 6.80ms | 6.80ms | hour | DateTime::
10000 | 1 | 1 | 6.79ms | 6.79ms | locale | DateTime::
10000 | 1 | 1 | 6.67ms | 6.67ms | nanosecond | DateTime::
13000 | 1 | 1 | 6.58ms | 6.58ms | _seconds_as_components (xsub) | DateTime::
10000 | 1 | 1 | 6.25ms | 6.25ms | second | DateTime::
10000 | 1 | 1 | 6.21ms | 6.21ms | formatter | DateTime::
13000 | 1 | 1 | 5.64ms | 5.64ms | _time_as_seconds (xsub) | DateTime::
1 | 1 | 1 | 3.41ms | 6.73ms | BEGIN@18 | DateTime::
3001 | 2 | 1 | 2.93ms | 2.95ms | DefaultLocale | DateTime::
1 | 1 | 1 | 2.80ms | 9.73ms | BEGIN@15 | DateTime::
1 | 1 | 1 | 1.92ms | 13.2ms | BEGIN@12 | DateTime::
3000 | 1 | 1 | 1.84ms | 1.84ms | _core_time | DateTime::
1 | 1 | 1 | 1.69ms | 19.2ms | BEGIN@14 | DateTime::
1 | 1 | 1 | 363µs | 366µs | BEGIN@763 | DateTime::
60 | 3 | 1 | 47µs | 47µs | CORE:qr (opcode) | DateTime::
1 | 1 | 1 | 26µs | 26µs | BEGIN@3 | DateTime::
1 | 1 | 1 | 24µs | 24µs | CORE:regcomp (opcode) | DateTime::
1 | 1 | 1 | 12µs | 63µs | BEGIN@16 | DateTime::
1 | 1 | 1 | 11µs | 211µs | try {...} | DateTime::
1 | 1 | 1 | 10µs | 12µs | BEGIN@1925 | DateTime::
1 | 1 | 1 | 9µs | 12µs | BEGIN@5 | DateTime::
1 | 1 | 1 | 9µs | 60µs | BEGIN@57 | DateTime::
1 | 1 | 1 | 8µs | 52µs | BEGIN@11 | DateTime::
1 | 1 | 1 | 8µs | 89µs | BEGIN@7 | DateTime::
1 | 1 | 1 | 8µs | 34µs | BEGIN@19 | DateTime::
1 | 1 | 1 | 8µs | 13µs | BEGIN@6 | DateTime::
1 | 1 | 1 | 8µs | 40µs | BEGIN@75 | DateTime::
1 | 1 | 1 | 7µs | 47µs | BEGIN@74 | DateTime::
1 | 1 | 1 | 7µs | 34µs | BEGIN@76 | DateTime::
1 | 1 | 1 | 7µs | 48µs | BEGIN@72 | DateTime::
1 | 1 | 1 | 6µs | 34µs | BEGIN@78 | DateTime::
1 | 1 | 1 | 6µs | 32µs | BEGIN@80 | DateTime::
1 | 1 | 1 | 5µs | 5µs | BEGIN@13 | DateTime::
1 | 1 | 1 | 5µs | 5µs | BEGIN@84 | DateTime::
0 | 0 | 0 | 0s | 0s | STORABLE_freeze | DateTime::
0 | 0 | 0 | 0s | 0s | STORABLE_thaw | DateTime::
0 | 0 | 0 | 0s | 0s | time_zone | DateTime::_Thawed::
0 | 0 | 0 | 0s | 0s | utc_rd_values | DateTime::_Thawed::
0 | 0 | 0 | 0s | 0s | __ANON__[:1034] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1035] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1036] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1037] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1040] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1041] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1042] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1043] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1044] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1045] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1046] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1047] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1048] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1049] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1050] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1051] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1052] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1053] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1054] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1055] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1057] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1058] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1059] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1060] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1061] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1062] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1063] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1064] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1065] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1069] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1070] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1074] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1078] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1081] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1084] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1085] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1086] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1087] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1088] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1089] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1138] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1143] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1151] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1152] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1153] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1155] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1160] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1165] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1169] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1171] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1174] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1178] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1182] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1185] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1189] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1190] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1193] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1197] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1199] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1202] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1206] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1212] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1217] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1222] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1225] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1229] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1231] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1236] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1237] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1239] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1241] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1248] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1251] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1254] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1267] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1269] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1271] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1272] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1280] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1284] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1286] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1287] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1288] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1289] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1290] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1463] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:1474] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:182] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:2029] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:2033] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:2083] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:2086] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:36] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:39] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:679] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:828] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:914] | DateTime::
0 | 0 | 0 | 0s | 0s | __ANON__[:917] | DateTime::
0 | 0 | 0 | 0s | 0s | _add_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _adjust_for_positive_difference | DateTime::
0 | 0 | 0 | 0s | 0s | _cldr_pattern | DateTime::
0 | 0 | 0 | 0s | 0s | _compare | DateTime::
0 | 0 | 0 | 0s | 0s | _compare_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _default_time_zone | DateTime::
0 | 0 | 0 | 0s | 0s | _era_index | DateTime::
0 | 0 | 0 | 0s | 0s | _format_nanosecs | DateTime::
0 | 0 | 0 | 0s | 0s | _month_length | DateTime::
0 | 0 | 0 | 0s | 0s | _normalize_seconds | DateTime::
0 | 0 | 0 | 0s | 0s | _space_padded_string | DateTime::
0 | 0 | 0 | 0s | 0s | _string_compare_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _string_equals_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _string_not_equals_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _stringify | DateTime::
0 | 0 | 0 | 0s | 0s | _subtract_overload | DateTime::
0 | 0 | 0 | 0s | 0s | _weeks_in_year | DateTime::
0 | 0 | 0 | 0s | 0s | _zero_padded_number | DateTime::
0 | 0 | 0 | 0s | 0s | add | DateTime::
0 | 0 | 0 | 0s | 0s | add_duration | DateTime::
0 | 0 | 0 | 0s | 0s | am_or_pm | DateTime::
0 | 0 | 0 | 0s | 0s | catch {...} | DateTime::
0 | 0 | 0 | 0s | 0s | ce_year | DateTime::
0 | 0 | 0 | 0s | 0s | christian_era | DateTime::
0 | 0 | 0 | 0s | 0s | clone | DateTime::
0 | 0 | 0 | 0s | 0s | compare | DateTime::
0 | 0 | 0 | 0s | 0s | compare_ignore_floating | DateTime::
0 | 0 | 0 | 0s | 0s | day_abbr | DateTime::
0 | 0 | 0 | 0s | 0s | day_name | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_month_0 | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_quarter | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_quarter_0 | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_week | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_week_0 | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_year | DateTime::
0 | 0 | 0 | 0s | 0s | day_of_year_0 | DateTime::
0 | 0 | 0 | 0s | 0s | delta_days | DateTime::
0 | 0 | 0 | 0s | 0s | delta_md | DateTime::
0 | 0 | 0 | 0s | 0s | delta_ms | DateTime::
0 | 0 | 0 | 0s | 0s | dmy | DateTime::
0 | 0 | 0 | 0s | 0s | epoch | DateTime::
0 | 0 | 0 | 0s | 0s | era_abbr | DateTime::
0 | 0 | 0 | 0s | 0s | era_name | DateTime::
0 | 0 | 0 | 0s | 0s | format_cldr | DateTime::
0 | 0 | 0 | 0s | 0s | fractional_second | DateTime::
0 | 0 | 0 | 0s | 0s | from_day_of_year | DateTime::
0 | 0 | 0 | 0s | 0s | from_object | DateTime::
0 | 0 | 0 | 0s | 0s | hires_epoch | DateTime::
0 | 0 | 0 | 0s | 0s | hms | DateTime::
0 | 0 | 0 | 0s | 0s | hour_1 | DateTime::
0 | 0 | 0 | 0s | 0s | hour_12 | DateTime::
0 | 0 | 0 | 0s | 0s | hour_12_0 | DateTime::
0 | 0 | 0 | 0s | 0s | is_dst | DateTime::
0 | 0 | 0 | 0s | 0s | is_finite | DateTime::
0 | 0 | 0 | 0s | 0s | is_infinite | DateTime::
0 | 0 | 0 | 0s | 0s | is_leap_year | DateTime::
0 | 0 | 0 | 0s | 0s | iso8601 | DateTime::
0 | 0 | 0 | 0s | 0s | jd | DateTime::
0 | 0 | 0 | 0s | 0s | last_day_of_month | DateTime::
0 | 0 | 0 | 0s | 0s | leap_seconds | DateTime::
0 | 0 | 0 | 0s | 0s | local_day_of_week | DateTime::
0 | 0 | 0 | 0s | 0s | local_rd_as_seconds | DateTime::
0 | 0 | 0 | 0s | 0s | local_rd_values | DateTime::
0 | 0 | 0 | 0s | 0s | mdy | DateTime::
0 | 0 | 0 | 0s | 0s | microsecond | DateTime::
0 | 0 | 0 | 0s | 0s | millisecond | DateTime::
0 | 0 | 0 | 0s | 0s | mjd | DateTime::
0 | 0 | 0 | 0s | 0s | month_0 | DateTime::
0 | 0 | 0 | 0s | 0s | month_abbr | DateTime::
0 | 0 | 0 | 0s | 0s | month_name | DateTime::
0 | 0 | 0 | 0s | 0s | offset | DateTime::
0 | 0 | 0 | 0s | 0s | quarter | DateTime::
0 | 0 | 0 | 0s | 0s | quarter_0 | DateTime::
0 | 0 | 0 | 0s | 0s | quarter_abbr | DateTime::
0 | 0 | 0 | 0s | 0s | quarter_name | DateTime::
0 | 0 | 0 | 0s | 0s | secular_era | DateTime::
0 | 0 | 0 | 0s | 0s | set_formatter | DateTime::
0 | 0 | 0 | 0s | 0s | set_hour | DateTime::
0 | 0 | 0 | 0s | 0s | set_locale | DateTime::
0 | 0 | 0 | 0s | 0s | set_minute | DateTime::
0 | 0 | 0 | 0s | 0s | set_nanosecond | DateTime::
0 | 0 | 0 | 0s | 0s | set_second | DateTime::
0 | 0 | 0 | 0s | 0s | set_time_zone | DateTime::
0 | 0 | 0 | 0s | 0s | set_year | DateTime::
0 | 0 | 0 | 0s | 0s | strftime | DateTime::
0 | 0 | 0 | 0s | 0s | subtract | DateTime::
0 | 0 | 0 | 0s | 0s | subtract_datetime | DateTime::
0 | 0 | 0 | 0s | 0s | subtract_datetime_absolute | DateTime::
0 | 0 | 0 | 0s | 0s | subtract_duration | DateTime::
0 | 0 | 0 | 0s | 0s | time_zone_long_name | DateTime::
0 | 0 | 0 | 0s | 0s | time_zone_short_name | DateTime::
0 | 0 | 0 | 0s | 0s | utc_rd_as_seconds | DateTime::
0 | 0 | 0 | 0s | 0s | utc_rd_values | DateTime::
0 | 0 | 0 | 0s | 0s | utc_year | DateTime::
0 | 0 | 0 | 0s | 0s | week | DateTime::
0 | 0 | 0 | 0s | 0s | week_number | DateTime::
0 | 0 | 0 | 0s | 0s | week_of_month | DateTime::
0 | 0 | 0 | 0s | 0s | week_year | DateTime::
0 | 0 | 0 | 0s | 0s | weekday_of_month | DateTime::
0 | 0 | 0 | 0s | 0s | year_with_christian_era | DateTime::
0 | 0 | 0 | 0s | 0s | year_with_era | DateTime::
0 | 0 | 0 | 0s | 0s | year_with_secular_era | DateTime::
0 | 0 | 0 | 0s | 0s | ymd | DateTime::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DateTime; | ||||
2 | |||||
3 | 2 | 51µs | 1 | 26µs | # spent 26µs within DateTime::BEGIN@3 which was called:
# once (26µs+0s) by DateTime::Format::Alami::parse_datetime at line 3 # spent 26µs making 1 call to DateTime::BEGIN@3 |
4 | |||||
5 | 2 | 24µs | 2 | 15µs | # spent 12µs (9+3) within DateTime::BEGIN@5 which was called:
# once (9µs+3µs) by DateTime::Format::Alami::parse_datetime at line 5 # spent 12µs making 1 call to DateTime::BEGIN@5
# spent 3µs making 1 call to strict::import |
6 | 2 | 23µs | 2 | 19µs | # spent 13µs (8+6) within DateTime::BEGIN@6 which was called:
# once (8µs+6µs) by DateTime::Format::Alami::parse_datetime at line 6 # spent 13µs making 1 call to DateTime::BEGIN@6
# spent 6µs making 1 call to warnings::import |
7 | 2 | 38µs | 2 | 170µs | # spent 89µs (8+81) within DateTime::BEGIN@7 which was called:
# once (8µs+81µs) by DateTime::Format::Alami::parse_datetime at line 7 # spent 89µs making 1 call to DateTime::BEGIN@7
# spent 81µs making 1 call to warnings::register::import |
8 | |||||
9 | 1 | 500ns | our $VERSION = '1.27'; | ||
10 | |||||
11 | 2 | 25µs | 2 | 95µs | # spent 52µs (8+44) within DateTime::BEGIN@11 which was called:
# once (8µs+44µs) by DateTime::Format::Alami::parse_datetime at line 11 # spent 52µs making 1 call to DateTime::BEGIN@11
# spent 44µs making 1 call to Exporter::import |
12 | 2 | 318µs | 1 | 13.2ms | # spent 13.2ms (1.92+11.2) within DateTime::BEGIN@12 which was called:
# once (1.92ms+11.2ms) by DateTime::Format::Alami::parse_datetime at line 12 # spent 13.2ms making 1 call to DateTime::BEGIN@12 |
13 | 2 | 25µs | 1 | 5µs | # spent 5µs within DateTime::BEGIN@13 which was called:
# once (5µs+0s) by DateTime::Format::Alami::parse_datetime at line 13 # spent 5µs making 1 call to DateTime::BEGIN@13 |
14 | 3 | 314µs | 2 | 19.2ms | # spent 19.2ms (1.69+17.5) within DateTime::BEGIN@14 which was called:
# once (1.69ms+17.5ms) by DateTime::Format::Alami::parse_datetime at line 14 # spent 19.2ms making 1 call to DateTime::BEGIN@14
# spent 14µs making 1 call to UNIVERSAL::VERSION |
15 | 3 | 226µs | 2 | 9.74ms | # spent 9.73ms (2.80+6.93) within DateTime::BEGIN@15 which was called:
# once (2.80ms+6.93ms) by DateTime::Format::Alami::parse_datetime at line 15 # spent 9.73ms making 1 call to DateTime::BEGIN@15
# spent 9µs making 1 call to UNIVERSAL::VERSION |
16 | # spent 63µs (12+51) within DateTime::BEGIN@16 which was called:
# once (12µs+51µs) by DateTime::Format::Alami::parse_datetime at line 17 | ||||
17 | 3 | 40µs | 3 | 115µs | qw( validate validate_pos UNDEF SCALAR BOOLEAN HASHREF OBJECT ); # spent 63µs making 1 call to DateTime::BEGIN@16
# spent 45µs making 1 call to Exporter::import
# spent 7µs making 1 call to UNIVERSAL::VERSION |
18 | 2 | 161µs | 2 | 8.05ms | # spent 6.73ms (3.41+3.32) within DateTime::BEGIN@18 which was called:
# once (3.41ms+3.32ms) by DateTime::Format::Alami::parse_datetime at line 18 # spent 6.73ms making 1 call to DateTime::BEGIN@18
# spent 1.32ms making 1 call to POSIX::import |
19 | 2 | 206µs | 2 | 60µs | # spent 34µs (8+26) within DateTime::BEGIN@19 which was called:
# once (8µs+26µs) by DateTime::Format::Alami::parse_datetime at line 19 # spent 34µs making 1 call to DateTime::BEGIN@19
# spent 26µs making 1 call to Exporter::import |
20 | |||||
21 | { | ||||
22 | 2 | 800ns | my $loaded = 0; | ||
23 | |||||
24 | 1 | 6µs | unless ( $ENV{PERL_DATETIME_PP} ) { | ||
25 | # spent 211µs (11+200) within DateTime::try {...} which was called:
# once (11µs+200µs) by Try::Tiny::try at line 92 of Try/Tiny.pm | ||||
26 | 1 | 900ns | require XSLoader; | ||
27 | XSLoader::load( | ||||
28 | __PACKAGE__, | ||||
29 | exists $DateTime::{VERSION} && ${ $DateTime::{VERSION} } | ||||
30 | 1 | 208µs | 1 | 200µs | ? ${ $DateTime::{VERSION} } # spent 200µs making 1 call to XSLoader::load |
31 | : 42 | ||||
32 | ); | ||||
33 | |||||
34 | 1 | 400ns | $loaded = 1; | ||
35 | 1 | 3µs | $DateTime::IsPurePerl = 0; | ||
36 | } | ||||
37 | catch { | ||||
38 | die $_ if $_ && $_ !~ /object version|loadable object/; | ||||
39 | 1 | 7µs | 2 | 255µs | }; # spent 234µs making 1 call to Try::Tiny::try
# spent 20µs making 1 call to Try::Tiny::catch |
40 | } | ||||
41 | |||||
42 | 1 | 600ns | 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 60µs (9+51) within DateTime::BEGIN@57 which was called:
# once (9µs+51µs) by DateTime::Format::Alami::parse_datetime at line 66 | ||||
58 | 1 | 6µs | 1 | 51µs | 'fallback' => 1, # spent 51µ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 | 31µs | 1 | 60µs | ); # spent 60µ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 | 91µs | require DateTime::Infinite; | ||
71 | |||||
72 | 2 | 34µs | 2 | 88µs | # spent 48µs (7+40) within DateTime::BEGIN@72 which was called:
# once (7µs+40µs) by DateTime::Format::Alami::parse_datetime at line 72 # spent 48µs making 1 call to DateTime::BEGIN@72
# spent 40µs making 1 call to constant::import |
73 | |||||
74 | 2 | 42µs | 2 | 87µs | # spent 47µs (7+40) within DateTime::BEGIN@74 which was called:
# once (7µs+40µs) by DateTime::Format::Alami::parse_datetime at line 74 # spent 47µs making 1 call to DateTime::BEGIN@74
# spent 40µs making 1 call to constant::import |
75 | 2 | 34µs | 2 | 72µs | # spent 40µs (8+32) within DateTime::BEGIN@75 which was called:
# once (8µs+32µs) by DateTime::Format::Alami::parse_datetime at line 75 # spent 40µs making 1 call to DateTime::BEGIN@75
# spent 32µs making 1 call to constant::import |
76 | 2 | 25µs | 2 | 62µs | # spent 34µs (7+27) within DateTime::BEGIN@76 which was called:
# once (7µs+27µs) by DateTime::Format::Alami::parse_datetime at line 76 # spent 34µs making 1 call to DateTime::BEGIN@76
# spent 27µs making 1 call to constant::import |
77 | |||||
78 | 2 | 25µs | 2 | 61µs | # spent 34µs (6+27) within DateTime::BEGIN@78 which was called:
# once (6µs+27µs) by DateTime::Format::Alami::parse_datetime at line 78 # spent 34µs making 1 call to DateTime::BEGIN@78
# spent 27µs making 1 call to constant::import |
79 | |||||
80 | 2 | 58µs | 2 | 58µs | # spent 32µs (6+26) within DateTime::BEGIN@80 which was called:
# once (6µs+26µs) by DateTime::Format::Alami::parse_datetime at line 80 # spent 32µs making 1 call to DateTime::BEGIN@80
# spent 26µs making 1 call to constant::import |
81 | |||||
82 | 1 | 400ns | my ( @MonthLengths, @LeapYearMonthLengths ); | ||
83 | |||||
84 | # spent 5µs within DateTime::BEGIN@84 which was called:
# once (5µs+0s) by DateTime::Format::Alami::parse_datetime at line 89 | ||||
85 | 1 | 1µs | @MonthLengths = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ); | ||
86 | |||||
87 | 1 | 500ns | @LeapYearMonthLengths = @MonthLengths; | ||
88 | 1 | 4µs | $LeapYearMonthLengths[1]++; | ||
89 | 1 | 2.59ms | 1 | 5µs | } # spent 5µ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 | 600ns | my $DefaultLocale; | ||
97 | |||||
98 | sub DefaultLocale { | ||||
99 | 3001 | 444µs | my $class = shift; | ||
100 | |||||
101 | 3001 | 612µs | if (@_) { | ||
102 | 1 | 400ns | my $lang = shift; | ||
103 | |||||
104 | 1 | 1µs | 1 | 13µs | $DefaultLocale = DateTime::Locale->load($lang); # spent 13µs making 1 call to DateTime::Locale::load |
105 | } | ||||
106 | |||||
107 | 3001 | 5.13ms | return $DefaultLocale; | ||
108 | } | ||||
109 | |||||
110 | # backwards compat | ||||
111 | 1 | 2µs | *DefaultLanguage = \&DefaultLocale; | ||
112 | } | ||||
113 | 1 | 2µs | 1 | 20µs | __PACKAGE__->DefaultLocale('en_US'); # spent 20µs making 1 call to DateTime::DefaultLocale |
114 | |||||
115 | my $BasicValidate = { | ||||
116 | year => { | ||||
117 | type => SCALAR, | ||||
118 | callbacks => { | ||||
119 | 6000 | 35.9ms | 6000 | 5.48ms | # spent 25.3ms (19.8+5.48) 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 4µs/call:
# 6000 times (19.8ms+5.48ms) by Params::Validate::XS::validate at line 197, avg 4µs/call # spent 5.48ms making 6000 calls to DateTime::CORE:match, avg 913ns/call |
120 | }, | ||||
121 | }, | ||||
122 | month => { | ||||
123 | type => SCALAR, | ||||
124 | default => 1, | ||||
125 | callbacks => { | ||||
126 | 'an integer between 1 and 12' => | ||||
127 | 9000 | 64.1ms | 9000 | 7.66ms | # spent 39.9ms (32.2+7.66) 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 (23.5ms+3.89ms) by Params::Validate::XS::validate at line 197, avg 5µs/call
# 3000 times (8.66ms+3.76ms) by Params::Validate::XS::validate at line 1954, avg 4µs/call # spent 7.66ms making 9000 calls to DateTime::CORE:match, avg 851ns/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 | 74.1ms | 9000 | 7.69ms | # spent 38.3ms (30.6+7.69) 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 (17.6ms+4.20ms) by Params::Validate::XS::validate at line 197, avg 4µs/call
# 3000 times (13.0ms+3.49ms) by Params::Validate::XS::validate at line 1954, avg 5µs/call # spent 7.69ms making 9000 calls to DateTime::CORE:match, avg 855ns/call |
136 | }, | ||||
137 | }, | ||||
138 | hour => { | ||||
139 | type => SCALAR, | ||||
140 | default => 0, | ||||
141 | callbacks => { | ||||
142 | 'an integer between 0 and 23' => | ||||
143 | 6000 | 42.4ms | 6000 | 4.61ms | # spent 25.1ms (20.5+4.61) 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 (20.5ms+4.61ms) by Params::Validate::XS::validate at line 197, avg 4µs/call # spent 4.61ms making 6000 calls to DateTime::CORE:match, avg 769ns/call |
144 | }, | ||||
145 | }, | ||||
146 | minute => { | ||||
147 | type => SCALAR, | ||||
148 | default => 0, | ||||
149 | callbacks => { | ||||
150 | 'an integer between 0 and 59' => | ||||
151 | 6000 | 37.4ms | 6000 | 4.11ms | # spent 18.4ms (14.2+4.11) 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 3µs/call:
# 6000 times (14.2ms+4.11ms) by Params::Validate::XS::validate at line 197, avg 3µs/call # spent 4.11ms making 6000 calls to DateTime::CORE:match, avg 686ns/call |
152 | }, | ||||
153 | }, | ||||
154 | second => { | ||||
155 | type => SCALAR, | ||||
156 | default => 0, | ||||
157 | callbacks => { | ||||
158 | 'an integer between 0 and 61' => | ||||
159 | 6000 | 52.9ms | 6000 | 3.91ms | # spent 26.5ms (22.6+3.91) 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 (22.6ms+3.91ms) by Params::Validate::XS::validate at line 197, avg 4µs/call # spent 3.91ms making 6000 calls to DateTime::CORE:match, avg 651ns/call |
160 | }, | ||||
161 | }, | ||||
162 | nanosecond => { | ||||
163 | type => SCALAR, | ||||
164 | default => 0, | ||||
165 | callbacks => { | ||||
166 | 6000 | 48.2ms | 6000 | 3.77ms | # spent 24.7ms (20.9+3.77) 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 (20.9ms+3.77ms) by Params::Validate::XS::validate at line 197, avg 4µs/call # spent 3.77ms making 6000 calls to DateTime::CORE:match, avg 629ns/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 | 25µs | }; | ||
186 | |||||
187 | 1 | 4µs | my $NewValidate = { | ||
188 | %$BasicValidate, | ||||
189 | time_zone => { | ||||
190 | type => SCALAR | OBJECT, | ||||
191 | optional => 1, | ||||
192 | }, | ||||
193 | }; | ||||
194 | |||||
195 | # spent 940ms (65.6+875) within DateTime::new which was called 6000 times, avg 157µs/call:
# 6000 times (65.6ms+875ms) by DateTime::_new_from_self at line 324, avg 157µs/call | ||||
196 | 6000 | 847µs | my $class = shift; | ||
197 | 6000 | 244ms | 48000 | 676ms | my %p = validate( @_, $NewValidate ); # spent 507ms making 6000 calls to Params::Validate::XS::validate, avg 84µs/call
# spent 27.4ms making 6000 calls to DateTime::__ANON__[DateTime.pm:127], avg 5µs/call
# spent 26.5ms making 6000 calls to DateTime::__ANON__[DateTime.pm:159], avg 4µs/call
# spent 25.3ms making 6000 calls to DateTime::__ANON__[DateTime.pm:119], avg 4µs/call
# spent 25.1ms making 6000 calls to DateTime::__ANON__[DateTime.pm:143], avg 4µs/call
# spent 24.7ms making 6000 calls to DateTime::__ANON__[DateTime.pm:166], avg 4µs/call
# spent 21.8ms making 6000 calls to DateTime::__ANON__[DateTime.pm:135], avg 4µs/call
# spent 18.4ms making 6000 calls to DateTime::__ANON__[DateTime.pm:151], 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.80ms | && $p{day} > $class->_month_length( $p{year}, $p{month} ); | ||
204 | |||||
205 | 6000 | 27.3ms | 6000 | 368ms | return $class->_new(%p); # spent 368ms making 6000 calls to DateTime::_new, avg 61µs/call |
206 | } | ||||
207 | |||||
208 | # spent 908ms (362+546) within DateTime::_new which was called 13000 times, avg 70µs/call:
# 6000 times (155ms+213ms) by DateTime::new at line 205, avg 61µs/call
# 4000 times (115ms+147ms) by DateTime::_new_from_self at line 324, avg 66µs/call
# 3000 times (91.2ms+186ms) by DateTime::from_epoch at line 536, avg 93µs/call | ||||
209 | 13000 | 2.66ms | my $class = shift; | ||
210 | 13000 | 17.5ms | my %p = @_; | ||
211 | |||||
212 | 13000 | 1.70ms | 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.37ms | $p{month} = 1 unless exists $p{month}; | ||
218 | 13000 | 1.26ms | $p{day} = 1 unless exists $p{day}; | ||
219 | 13000 | 1.07ms | $p{hour} = 0 unless exists $p{hour}; | ||
220 | 13000 | 1.17ms | $p{minute} = 0 unless exists $p{minute}; | ||
221 | 13000 | 1.10ms | $p{second} = 0 unless exists $p{second}; | ||
222 | 13000 | 1.80ms | $p{nanosecond} = 0 unless exists $p{nanosecond}; | ||
223 | 13000 | 998µs | $p{time_zone} = $class->_default_time_zone unless exists $p{time_zone}; | ||
224 | |||||
225 | 13000 | 6.14ms | my $self = bless {}, $class; | ||
226 | |||||
227 | 13000 | 1.44ms | $p{locale} = delete $p{language} if exists $p{language}; | ||
228 | |||||
229 | 13000 | 12.1ms | 13000 | 30.3ms | $self->_set_locale( $p{locale} ); # spent 30.3ms making 13000 calls to DateTime::_set_locale, avg 2µ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 | 9.79ms | 3000 | 65.6ms | ); # spent 65.6ms making 3000 calls to DateTime::TimeZone::new, avg 22µs/call |
236 | |||||
237 | 13000 | 46.5ms | 13000 | 8.09ms | $self->{local_rd_days} = $class->_ymd2rd( @p{qw( year month day )} ); # spent 8.09ms making 13000 calls to DateTime::_ymd2rd, avg 623ns/call |
238 | |||||
239 | $self->{local_rd_secs} | ||||
240 | 13000 | 32.3ms | 13000 | 5.64ms | = $class->_time_as_seconds( @p{qw( hour minute second )} ); # spent 5.64ms making 13000 calls to DateTime::_time_as_seconds, avg 434ns/call |
241 | |||||
242 | 13000 | 2.20ms | $self->{offset_modifier} = 0; | ||
243 | |||||
244 | 13000 | 3.36ms | $self->{rd_nanosecs} = $p{nanosecond}; | ||
245 | 13000 | 2.76ms | $self->{formatter} = $p{formatter}; | ||
246 | |||||
247 | $self->_normalize_nanoseconds( | ||||
248 | $self->{local_rd_secs}, | ||||
249 | $self->{rd_nanosecs} | ||||
250 | 13000 | 10.9ms | 13000 | 9.87ms | ); # spent 9.87ms making 13000 calls to DateTime::_normalize_nanoseconds, avg 760ns/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.9ms | $self->{utc_year} = $p{year} + 1; | ||
259 | |||||
260 | 13000 | 9.86ms | 13000 | 14.3ms | $self->_maybe_future_dst_warning( $p{year}, $p{time_zone} ); # spent 14.3ms making 13000 calls to DateTime::_maybe_future_dst_warning, avg 1µs/call |
261 | |||||
262 | 13000 | 8.53ms | 13000 | 82.2ms | $self->_calc_utc_rd; # spent 82.2ms making 13000 calls to DateTime::_calc_utc_rd, avg 6µs/call |
263 | |||||
264 | 13000 | 9.45ms | 13000 | 144ms | $self->_handle_offset_modifier( $p{second} ); # spent 144ms making 13000 calls to DateTime::_handle_offset_modifier, avg 11µs/call |
265 | |||||
266 | 13000 | 10.5ms | 13000 | 186ms | $self->_calc_local_rd; # spent 186ms making 13000 calls to DateTime::_calc_local_rd, avg 14µs/call |
267 | |||||
268 | 13000 | 3.27ms | 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 | 27.9ms | 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 30.3ms (27.4+2.93) within DateTime::_set_locale which was called 13000 times, avg 2µs/call:
# 13000 times (27.4ms+2.93ms) by DateTime::_new at line 229, avg 2µs/call | ||||
291 | 13000 | 1.43ms | my $self = shift; | ||
292 | 13000 | 2.24ms | my $locale = shift; | ||
293 | |||||
294 | 13000 | 7.43ms | if ( defined $locale && ref $locale ) { | ||
295 | $self->{locale} = $locale; | ||||
296 | } | ||||
297 | else { | ||||
298 | $self->{locale} | ||||
299 | 3000 | 3.68ms | 3000 | 2.93ms | = $locale # spent 2.93ms making 3000 calls to DateTime::DefaultLocale, avg 975ns/call |
300 | ? DateTime::Locale->load($locale) | ||||
301 | : $self->DefaultLocale(); | ||||
302 | } | ||||
303 | |||||
304 | 13000 | 30.5ms | 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 | 1.86ms | my $self = shift; | ||
311 | 10000 | 7.38ms | my %p = @_; | ||
312 | |||||
313 | 10000 | 102ms | 90000 | 64.1ms | my %old = map { $_ => $self->$_() } qw( # spent 9.42ms making 10000 calls to DateTime::year, avg 942ns/call
# spent 7.41ms making 10000 calls to DateTime::month, avg 741ns/call
# spent 7.03ms making 10000 calls to DateTime::time_zone, avg 703ns/call
# spent 6.96ms making 10000 calls to DateTime::day_of_month, avg 696ns/call
# spent 6.81ms making 10000 calls to DateTime::minute, avg 681ns/call
# spent 6.80ms making 10000 calls to DateTime::hour, avg 680ns/call
# spent 6.79ms making 10000 calls to DateTime::locale, avg 679ns/call
# spent 6.67ms making 10000 calls to DateTime::nanosecond, avg 667ns/call
# spent 6.25ms making 10000 calls to DateTime::second, avg 625ns/call |
314 | year month day | ||||
315 | hour minute second | ||||
316 | nanosecond | ||||
317 | locale time_zone | ||||
318 | ); | ||||
319 | 10000 | 8.28ms | 10000 | 6.21ms | $old{formatter} = $self->formatter() # spent 6.21ms making 10000 calls to DateTime::formatter, avg 621ns/call |
320 | if defined $self->formatter(); | ||||
321 | |||||
322 | 10000 | 4.50ms | my $method = delete $p{_skip_validation} ? '_new' : 'new'; | ||
323 | |||||
324 | 10000 | 52.5ms | 10000 | 1.20s | return ( ref $self )->$method( %old, %p ); # spent 940ms making 6000 calls to DateTime::new, avg 157µs/call
# spent 262ms making 4000 calls to DateTime::_new, avg 66µs/call |
325 | } | ||||
326 | |||||
327 | # spent 144ms (94.5+49.4) within DateTime::_handle_offset_modifier which was called 13000 times, avg 11µs/call:
# 13000 times (94.5ms+49.4ms) by DateTime::_new at line 264, avg 11µs/call | ||||
328 | 13000 | 2.37ms | my $self = shift; | ||
329 | |||||
330 | 13000 | 2.67ms | $self->{offset_modifier} = 0; | ||
331 | |||||
332 | 13000 | 10.5ms | 13000 | 6.31ms | return if $self->{tz}->is_floating; # spent 6.31ms making 13000 calls to DateTime::TimeZone::is_floating, avg 485ns/call |
333 | |||||
334 | 13000 | 2.03ms | my $second = shift; | ||
335 | 13000 | 1.52ms | my $utc_is_valid = shift; | ||
336 | |||||
337 | 13000 | 2.75ms | my $utc_rd_days = $self->{utc_rd_days}; | ||
338 | |||||
339 | 13000 | 10.5ms | 13000 | 43.1ms | my $offset # spent 43.1ms making 13000 calls to DateTime::_offset_for_local_datetime, avg 3µs/call |
340 | = $utc_is_valid ? $self->offset : $self->_offset_for_local_datetime; | ||||
341 | |||||
342 | 13000 | 37.7ms | if ( $offset >= 0 | ||
343 | && $self->{local_rd_secs} >= $offset ) { | ||||
344 | 13000 | 5.06ms | 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 82.4ms (67.6+14.8) within DateTime::_calc_utc_rd which was called 13002 times, avg 6µs/call:
# 13000 times (67.4ms+14.8ms) by DateTime::_new at line 262, avg 6µs/call
# once (67µs+6µs) by DateTime::Format::Alami::parse_datetime at line 89 of DateTime/Infinite.pm
# once (40µs+2µs) by DateTime::Format::Alami::parse_datetime at line 114 of DateTime/Infinite.pm | ||||
391 | 13002 | 1.51ms | my $self = shift; | ||
392 | |||||
393 | 13002 | 2.64ms | delete $self->{utc_c}; | ||
394 | |||||
395 | 13002 | 11.8ms | 13004 | 6.14ms | if ( $self->{tz}->is_utc || $self->{tz}->is_floating ) { # spent 6.13ms making 13000 calls to DateTime::TimeZone::UTC::is_utc, avg 472ns/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 |
396 | 13002 | 3.84ms | $self->{utc_rd_days} = $self->{local_rd_days}; | ||
397 | 13002 | 3.88ms | $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 | 55.2ms | 13002 | 8.66ms | ); # spent 8.66ms making 13002 calls to DateTime::_normalize_tai_seconds, avg 666ns/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 186ms (72.9+113) within DateTime::_calc_local_rd which was called 13002 times, avg 14µs/call:
# 13000 times (72.9ms+113ms) by DateTime::_new at line 266, avg 14µs/call
# once (17µs+27µs) by DateTime::Format::Alami::parse_datetime at line 90 of DateTime/Infinite.pm
# once (10µs+17µs) by DateTime::Format::Alami::parse_datetime at line 115 of DateTime/Infinite.pm | ||||
436 | 13002 | 1.86ms | my $self = shift; | ||
437 | |||||
438 | 13002 | 1.96ms | 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.46ms | 13004 | 4.25ms | if ( $self->{tz}->is_utc || $self->{tz}->is_floating ) { # spent 4.25ms making 13000 calls to DateTime::TimeZone::UTC::is_utc, avg 327ns/call
# spent 1µs making 2 calls to DateTime::TimeZone::Floating::is_floating, avg 600ns/call
# spent 1µs making 2 calls to DateTime::TimeZone::OffsetOnly::is_utc, avg 500ns/call |
443 | 13002 | 3.97ms | $self->{local_rd_days} = $self->{utc_rd_days}; | ||
444 | 13002 | 3.32ms | $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 | 35.1ms | 13002 | 109ms | $self->_calc_local_components; # spent 109ms making 13002 calls to DateTime::_calc_local_components, avg 8µs/call |
462 | } | ||||
463 | |||||
464 | # spent 109ms (94.4+14.8) within DateTime::_calc_local_components which was called 13002 times, avg 8µs/call:
# 13002 times (94.4ms+14.8ms) by DateTime::_calc_local_rd at line 461, avg 8µs/call | ||||
465 | 13002 | 1.47ms | 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 | 51.5ms | 13002 | 8.17ms | = $self->_rd2ymd( $self->{local_rd_days}, 1 ); # spent 8.17ms making 13000 calls to DateTime::_rd2ymd, avg 628ns/call
# spent 5µs making 2 calls to DateTime::Infinite::_rd2ymd, avg 3µ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 | 74.8ms | 13002 | 6.58ms | ); # spent 6.58ms making 13000 calls to DateTime::_seconds_as_components, avg 506ns/call
# spent 3µs making 2 calls to DateTime::Infinite::_seconds_as_components, avg 1µs/call |
478 | } | ||||
479 | |||||
480 | { | ||||
481 | 1 | 7µs | 1 | 3µs | my $float = qr/ # spent 3µs making 1 call to DateTime::CORE:qr |
482 | ^ -? (?: [0-9]+ (?: \.[0-9]*)? | \. [0-9]+) (?: [eE][+-]?[0-9]+)? $ | ||||
483 | /x; | ||||
484 | 1 | 5µ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 414ms (71.7+343) within DateTime::from_epoch which was called 3000 times, avg 138µs/call:
# 3000 times (71.7ms+343ms) by DateTime::now at line 549, avg 138µs/call | ||||
496 | 3000 | 487µs | my $class = shift; | ||
497 | 3000 | 44.5ms | 6000 | 82.9ms | my %p = validate( @_, $spec ); # spent 56.7ms making 3000 calls to Params::Validate::XS::validate, avg 19µs/call
# spent 26.2ms making 3000 calls to Params::Validate::XS::_check_regex_from_xs, avg 9µs/call |
498 | |||||
499 | 3000 | 330µ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 | 9.16ms | 3000 | 1.70ms | if ( $p{epoch} =~ /[.eE]/ ) { # spent 1.70ms making 3000 calls to DateTime::CORE:match, avg 566ns/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.41ms | = ( gmtime( $p{epoch} ) )[ 0 .. 5 ]; | ||
533 | 3000 | 1.42ms | $args{year} += 1900; | ||
534 | 3000 | 450µs | $args{month}++; | ||
535 | |||||
536 | 3000 | 5.96ms | 3000 | 278ms | my $self = $class->_new( %p, %args, time_zone => 'UTC' ); # spent 278ms making 3000 calls to DateTime::_new, avg 93µs/call |
537 | |||||
538 | 3000 | 631µs | my $tz = $p{time_zone}; | ||
539 | 3000 | 6.35ms | 6000 | 6.74ms | $self->_maybe_future_dst_warning( $self->year(), $p{time_zone} ); # spent 3.71ms making 3000 calls to DateTime::_maybe_future_dst_warning, avg 1µs/call
# spent 3.03ms making 3000 calls to DateTime::year, avg 1µs/call |
540 | |||||
541 | 3000 | 515µs | $self->set_time_zone( $p{time_zone} ) if exists $p{time_zone}; | ||
542 | |||||
543 | 3000 | 10.1ms | return $self; | ||
544 | } | ||||
545 | } | ||||
546 | |||||
547 | 1 | 500ns | # spent 434ms (18.2+416) within DateTime::now which was called 3000 times, avg 145µs/call:
# 3000 times (18.2ms+416ms) by DateTime::today at line 573, avg 145µs/call | ||
548 | 3000 | 512µs | my $class = shift; | ||
549 | 3000 | 7.03ms | 6000 | 416ms | return $class->from_epoch( epoch => $class->_core_time(), @_ ); # spent 414ms making 3000 calls to DateTime::from_epoch, avg 138µs/call
# spent 1.84ms making 3000 calls to DateTime::_core_time, avg 614ns/call |
550 | } | ||||
551 | |||||
552 | sub _maybe_future_dst_warning { | ||||
553 | 16000 | 1.61ms | shift; | ||
554 | 16000 | 2.25ms | my $year = shift; | ||
555 | 16000 | 2.47ms | my $tz = shift; | ||
556 | |||||
557 | 16000 | 47.8ms | 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.84ms within DateTime::_core_time which was called 3000 times, avg 614ns/call:
# 3000 times (1.84ms+0s) by DateTime::now at line 549, avg 614ns/call | ||||
570 | 3000 | 8.18ms | return scalar time; | ||
571 | } | ||||
572 | |||||
573 | 3000 | 7.78ms | 6000 | 874ms | # spent 890ms (16.2+874) within DateTime::today which was called 3000 times, avg 297µs/call:
# 3000 times (16.2ms+874ms) by DateTime::Format::Alami::a_today at line 460 of lib/DateTime/Format/Alami.pm, avg 297µs/call # spent 439ms making 3000 calls to DateTime::truncate, avg 146µs/call
# spent 434ms making 3000 calls to DateTime::now, avg 145µs/call |
574 | |||||
575 | { | ||||
576 | 1 | 4µ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 | 4µs | my $LastDayOfMonthValidate = {%$NewValidate}; | ||
639 | 1 | 2µs | foreach ( keys %$LastDayOfMonthValidate ) { | ||
640 | 11 | 11µs | my %copy = %{ $LastDayOfMonthValidate->{$_} }; | ||
641 | |||||
642 | 11 | 2µs | delete $copy{default}; | ||
643 | 11 | 4µs | $copy{optional} = 1 unless $_ eq 'year' || $_ eq 'month'; | ||
644 | |||||
645 | 11 | 4µ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 | 2µs | my $FromDayOfYearValidate = {%$NewValidate}; | ||
666 | 1 | 2µs | foreach ( keys %$FromDayOfYearValidate ) { | ||
667 | 11 | 2µs | next if $_ eq 'month' || $_ eq 'day'; | ||
668 | |||||
669 | 9 | 8µs | my %copy = %{ $FromDayOfYearValidate->{$_} }; | ||
670 | |||||
671 | 9 | 1µs | delete $copy{default}; | ||
672 | 9 | 2µs | $copy{optional} = 1 unless $_ eq 'year' || $_ eq 'month'; | ||
673 | |||||
674 | 9 | 3µ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 | 3µ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 | 15.5ms | # spent 6.21ms within DateTime::formatter which was called 10000 times, avg 621ns/call:
# 10000 times (6.21ms+0s) by DateTime::_new_from_self at line 319, avg 621ns/call | ||
711 | |||||
712 | sub clone { bless { %{ $_[0] } }, ref $_[0] } | ||||
713 | |||||
714 | # spent 16.8ms within DateTime::year which was called 17000 times, avg 991ns/call:
# 10000 times (9.42ms+0s) by DateTime::_new_from_self at line 313, avg 942ns/call
# 4000 times (4.40ms+0s) by DateTime::truncate at line 2039, avg 1µs/call
# 3000 times (3.03ms+0s) by DateTime::from_epoch at line 539, avg 1µs/call | ||||
715 | 17000 | 3.87ms | Carp::carp('year() is a read-only accessor') if @_ > 1; | ||
716 | 17000 | 37.9ms | 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 | 2µ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.41ms | Carp::carp('month() is a read-only accessor') if @_ > 1; | ||
743 | 14000 | 31.4ms | 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.35ms | Carp::carp('day_of_month() is a read-only accessor') if @_ > 1; | ||
758 | 14000 | 26.8ms | $_[0]->{local_c}{day}; | ||
759 | } | ||||
760 | 1 | 800ns | *day = \&day_of_month; | ||
761 | 1 | 800ns | *mday = \&day_of_month; | ||
762 | |||||
763 | 2 | 6.73ms | 2 | 369µs | # spent 366µs (363+3) within DateTime::BEGIN@763 which was called:
# once (363µs+3µs) by DateTime::Format::Alami::parse_datetime at line 763 # spent 366µ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 | 800ns | *day_0 = \&day_of_month_0; | ||
779 | 1 | 700ns | *mday_0 = \&day_of_month_0; | ||
780 | |||||
781 | sub day_of_week { $_[0]->{local_c}{day_of_week} } | ||||
782 | 1 | 900ns | *wday = \&day_of_week; | ||
783 | 1 | 800ns | *dow = \&day_of_week; | ||
784 | |||||
785 | sub day_of_week_0 { $_[0]->{local_c}{day_of_week} - 1 } | ||||
786 | 1 | 900ns | *wday_0 = \&day_of_week_0; | ||
787 | 1 | 700ns | *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 | 800ns | *doq = \&day_of_quarter; | ||
803 | |||||
804 | sub day_of_quarter_0 { $_[0]->day_of_quarter - 1 } | ||||
805 | 1 | 800ns | *doq_0 = \&day_of_quarter_0; | ||
806 | |||||
807 | sub day_of_year { $_[0]->{local_c}{day_of_year} } | ||||
808 | 1 | 900ns | *doy = \&day_of_year; | ||
809 | |||||
810 | sub day_of_year_0 { $_[0]->{local_c}{day_of_year} - 1 } | ||||
811 | 1 | 900ns | *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 | 2µ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 6.80ms within DateTime::hour which was called 10000 times, avg 680ns/call:
# 10000 times (6.80ms+0s) by DateTime::_new_from_self at line 313, avg 680ns/call | ||||
855 | 10000 | 1.60ms | Carp::carp('hour() is a read-only accessor') if @_ > 1; | ||
856 | 10000 | 10.9ms | 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 6.81ms within DateTime::minute which was called 10000 times, avg 681ns/call:
# 10000 times (6.81ms+0s) by DateTime::_new_from_self at line 313, avg 681ns/call | ||||
864 | 10000 | 1.56ms | Carp::carp('minute() is a read-only accessor') if @_ > 1; | ||
865 | 10000 | 14.1ms | return $_[0]->{local_c}{minute}; | ||
866 | } | ||||
867 | 1 | 800ns | *min = \&minute; | ||
868 | |||||
869 | # spent 6.25ms within DateTime::second which was called 10000 times, avg 625ns/call:
# 10000 times (6.25ms+0s) by DateTime::_new_from_self at line 313, avg 625ns/call | ||||
870 | 10000 | 1.43ms | Carp::carp('second() is a read-only accessor') if @_ > 1; | ||
871 | 10000 | 16.3ms | 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 6.67ms within DateTime::nanosecond which was called 10000 times, avg 667ns/call:
# 10000 times (6.67ms+0s) by DateTime::_new_from_self at line 313, avg 667ns/call | ||||
878 | 10000 | 1.56ms | Carp::carp('nanosecond() is a read-only accessor') if @_ > 1; | ||
879 | 10000 | 26.7ms | 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.03ms within DateTime::time_zone which was called 10000 times, avg 703ns/call:
# 10000 times (7.03ms+0s) by DateTime::_new_from_self at line 313, avg 703ns/call | ||||
978 | 10000 | 1.59ms | Carp::carp('time_zone() is a read-only accessor') if @_ > 1; | ||
979 | 10000 | 26.1ms | return $_[0]->{tz}; | ||
980 | } | ||||
981 | |||||
982 | sub offset { $_[0]->{tz}->offset_for_datetime( $_[0] ) } | ||||
983 | |||||
984 | # spent 43.1ms (37.4+5.70) within DateTime::_offset_for_local_datetime which was called 13000 times, avg 3µs/call:
# 13000 times (37.4ms+5.70ms) by DateTime::_handle_offset_modifier at line 339, avg 3µs/call | ||||
985 | 13000 | 34.2ms | 13000 | 5.70ms | $_[0]->{tz}->offset_for_local_datetime( $_[0] ); # spent 5.70ms making 13000 calls to DateTime::TimeZone::UTC::offset_for_local_datetime, avg 438ns/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 6.79ms within DateTime::locale which was called 10000 times, avg 679ns/call:
# 10000 times (6.79ms+0s) by DateTime::_new_from_self at line 313, avg 679ns/call | ||||
994 | 10000 | 1.61ms | Carp::carp('locale() is a read-only accessor') if @_ > 1; | ||
995 | 10000 | 14.4ms | return $_[0]->{locale}; | ||
996 | } | ||||
997 | 1 | 900ns | *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 | 51µ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 | 200ns | 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 | 165µs | 58 | 44µs | ); # spent 44µs making 58 calls to DateTime::CORE:qr, avg 755ns/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 | 2µ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 | 400ns | 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 9.87ms within DateTime::_normalize_nanoseconds which was called 13000 times, avg 760ns/call:
# 13000 times (9.87ms+0s) by DateTime::_new at line 250, avg 760ns/call | ||||
1925 | 2 | 1.07ms | 2 | 15µs | # spent 12µs (10+2) within DateTime::BEGIN@1925 which was called:
# once (10µs+2µs) by DateTime::Format::Alami::parse_datetime at line 1925 # spent 12µs making 1 call to DateTime::BEGIN@1925
# spent 2µs making 1 call to integer::import |
1926 | |||||
1927 | # seconds, nanoseconds | ||||
1928 | 13000 | 36.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 | 15µs | my %copy = %{ $BasicValidate->{$_} }; | ||
1945 | 10 | 1µs | delete $copy{default}; | ||
1946 | 10 | 2µs | $copy{optional} = 1; | ||
1947 | 10 | 2µs | $_ => \%copy | ||
1948 | } | ||||
1949 | keys %$BasicValidate | ||||
1950 | }; | ||||
1951 | |||||
1952 | sub set { | ||||
1953 | 6000 | 958µs | my $self = shift; | ||
1954 | 6000 | 97.0ms | 12000 | 151ms | my %p = validate( @_, $SetValidate ); # spent 122ms making 6000 calls to Params::Validate::XS::validate, avg 20µs/call
# spent 16.4ms making 3000 calls to DateTime::__ANON__[DateTime.pm:135], avg 5µs/call
# spent 12.4ms making 3000 calls to DateTime::__ANON__[DateTime.pm:127], avg 4µs/call |
1955 | |||||
1956 | 6000 | 9.93ms | 6000 | 1.17s | my $new_dt = $self->_new_from_self(%p); # spent 1.17s making 6000 calls to DateTime::_new_from_self, avg 195µs/call |
1957 | |||||
1958 | 6000 | 30.0ms | %$self = %$new_dt; | ||
1959 | |||||
1960 | 6000 | 17.1ms | return $self; | ||
1961 | } | ||||
1962 | |||||
1963 | sub set_year { $_[0]->set( year => $_[1] ) } | ||||
1964 | 3000 | 5.11ms | 3000 | 682ms | # spent 691ms (9.73+682) within DateTime::set_month which was called 3000 times, avg 230µs/call:
# 3000 times (9.73ms+682ms) by DateTime::Format::Alami::a_dateymd at line 499 of lib/DateTime/Format/Alami.pm, avg 230µs/call # spent 682ms making 3000 calls to DateTime::set, avg 227µs/call |
1965 | 3000 | 5.24ms | 3000 | 691ms | # spent 698ms (6.93+691) within DateTime::set_day which was called 3000 times, avg 233µs/call:
# 3000 times (6.93ms+691ms) by DateTime::Format::Alami::a_dateymd at line 490 of lib/DateTime/Format/Alami.pm, avg 233µs/call # spent 691ms making 3000 calls to DateTime::set, avg 230µ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 | 2µ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 | 4µs | grep { $_ ne 'nanosecond' } keys %TruncateDefault; | ||
2005 | 1 | 33µs | 2 | 25µs | my $spec = { to => { regex => qr/^(?:$re)$/ } }; # spent 24µs making 1 call to DateTime::CORE:regcomp
# spent 800ns making 1 call to DateTime::CORE:qr |
2006 | |||||
2007 | # spent 593ms (114+479) within DateTime::truncate which was called 4000 times, avg 148µs/call:
# 3000 times (81.5ms+358ms) by DateTime::today at line 573, avg 146µs/call
# 1000 times (32.4ms+121ms) by DateTime::Format::Alami::parse_datetime at line 190 of lib/DateTime/Format/Alami.pm, avg 154µs/call | ||||
2008 | 4000 | 655µs | my $self = shift; | ||
2009 | 4000 | 46.7ms | 8000 | 88.1ms | my %p = validate( @_, $spec ); # spent 60.7ms making 4000 calls to Params::Validate::XS::validate, avg 15µs/call
# spent 27.5ms making 4000 calls to Params::Validate::XS::_check_regex_from_xs, avg 7µs/call |
2010 | |||||
2011 | 4000 | 415µs | my %new; | ||
2012 | 4000 | 2.57ms | 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 | 376µs | my $truncate; | ||
2037 | 4000 | 2.68ms | foreach my $f (qw( year month day hour minute second nanosecond )) | ||
2038 | { | ||||
2039 | 28000 | 19.2ms | 12000 | 11.2ms | $new{$f} = $truncate ? $TruncateDefault{$f} : $self->$f(); # spent 4.40ms making 4000 calls to DateTime::year, avg 1µs/call
# spent 3.44ms making 4000 calls to DateTime::month, avg 859ns/call
# spent 3.34ms making 4000 calls to DateTime::day_of_month, avg 834ns/call |
2040 | |||||
2041 | 28000 | 8.49ms | $truncate = 1 if $p{to} eq $f; | ||
2042 | } | ||||
2043 | } | ||||
2044 | |||||
2045 | 4000 | 8.21ms | 4000 | 407ms | my $new_dt = $self->_new_from_self( %new, _skip_validation => 1 ); # spent 407ms making 4000 calls to DateTime::_new_from_self, avg 102µs/call |
2046 | |||||
2047 | 4000 | 20.1ms | %$self = %$new_dt; | ||
2048 | |||||
2049 | 4000 | 17.3ms | return $self; | ||
2050 | } | ||||
2051 | } | ||||
2052 | |||||
2053 | 1 | 1µ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 | 44µs | 1; | ||
2175 | |||||
2176 | # ABSTRACT: A date and time object for Perl | ||||
2177 | |||||
2178 | __END__ | ||||
# spent 38.9ms within DateTime::CORE:match which was called 51000 times, avg 763ns/call:
# 9000 times (7.69ms+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 855ns/call
# 9000 times (7.66ms+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 851ns/call
# 6000 times (5.48ms+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 913ns/call
# 6000 times (4.61ms+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 769ns/call
# 6000 times (4.11ms+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 686ns/call
# 6000 times (3.91ms+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 651ns/call
# 6000 times (3.77ms+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 629ns/call
# 3000 times (1.70ms+0s) by DateTime::from_epoch at line 517, avg 566ns/call | |||||
# spent 47µs within DateTime::CORE:qr which was called 60 times, avg 790ns/call:
# 58 times (44µs+0s) by DateTime::Format::Alami::parse_datetime at line 1291, avg 755ns/call
# once (3µs+0s) by DateTime::Format::Alami::parse_datetime at line 481
# once (800ns+0s) by DateTime::Format::Alami::parse_datetime at line 2005 | |||||
# spent 24µs within DateTime::CORE:regcomp which was called:
# once (24µs+0s) by DateTime::Format::Alami::parse_datetime at line 2005 | |||||
# spent 8.66ms within DateTime::_normalize_tai_seconds which was called 13002 times, avg 666ns/call:
# 13002 times (8.66ms+0s) by DateTime::_calc_utc_rd at line 413, avg 666ns/call | |||||
# spent 8.17ms within DateTime::_rd2ymd which was called 13000 times, avg 628ns/call:
# 13000 times (8.17ms+0s) by DateTime::_calc_local_components at line 471, avg 628ns/call | |||||
# spent 6.58ms within DateTime::_seconds_as_components which was called 13000 times, avg 506ns/call:
# 13000 times (6.58ms+0s) by DateTime::_calc_local_components at line 477, avg 506ns/call | |||||
# spent 5.64ms within DateTime::_time_as_seconds which was called 13000 times, avg 434ns/call:
# 13000 times (5.64ms+0s) by DateTime::_new at line 240, avg 434ns/call | |||||
# spent 8.09ms within DateTime::_ymd2rd which was called 13000 times, avg 623ns/call:
# 13000 times (8.09ms+0s) by DateTime::_new at line 237, avg 623ns/call |