← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mentat.storage.mongo.pl
  Run on Tue Jun 24 10:04:38 2014
Reported on Tue Jun 24 10:05:23 2014

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