← Index
NYTProf Performance Profile   « line view »
For svc/members/upsert
  Run on Tue Jan 13 11:50:22 2015
Reported on Tue Jan 13 12:09:48 2015

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