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