← Index
NYTProf Performance Profile   « block view • line view • sub view »
For mongo_pain.pl
  Run on Fri Mar 25 17:00:29 2011
Reported on Fri Mar 25 17:07:09 2011

Filename/usr/local/lib/perl/5.10.1/DateTime.pm
StatementsExecuted 290 statements in 19.0ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1114.17ms16.6msDateTime::::BEGIN@46 DateTime::BEGIN@46
1112.59ms5.70msDateTime::::BEGIN@44 DateTime::BEGIN@44
1112.27ms104msDateTime::::BEGIN@45 DateTime::BEGIN@45
1111.53ms2.02msDateTime::::BEGIN@47 DateTime::BEGIN@47
111295µs352µsDateTime::::BEGIN@12 DateTime::BEGIN@12
593186µs86µsDateTime::::CORE:qr DateTime::CORE:qr (opcode)
21152µs64µsDateTime::::_calc_local_components DateTime::_calc_local_components
22148µs68µsDateTime::::_calc_utc_rd DateTime::_calc_utc_rd
22141µs110µsDateTime::::_calc_local_rd DateTime::_calc_local_rd
11129µs29µsDateTime::::CORE:regcomp DateTime::CORE:regcomp (opcode)
11122µs22µsDateTime::::BEGIN@6 DateTime::BEGIN@6
11117µs179µsDateTime::::BEGIN@14 DateTime::BEGIN@14
11114µs14µsDateTime::::BEGIN@84 DateTime::BEGIN@84
21114µs14µsDateTime::::_normalize_tai_seconds DateTime::_normalize_tai_seconds (xsub)
11112µs16µsDateTime::::BEGIN@1871 DateTime::BEGIN@1871
11111µs15µsDateTime::::BEGIN@697 DateTime::BEGIN@697
11111µs128µsDateTime::::BEGIN@57 DateTime::BEGIN@57
11111µs6.32msDateTime::::DefaultLocale DateTime::DefaultLocale
11111µs11µsDateTime::::BEGIN@2 DateTime::BEGIN@2
11110µs43µsDateTime::::BEGIN@75 DateTime::BEGIN@75
11110µs81µsDateTime::::BEGIN@49 DateTime::BEGIN@49
11110µs22µsDateTime::::BEGIN@9 DateTime::BEGIN@9
11110µs56µsDateTime::::BEGIN@11 DateTime::BEGIN@11
1119µs45µsDateTime::::BEGIN@74 DateTime::BEGIN@74
1119µs12µsDateTime::::BEGIN@8 DateTime::BEGIN@8
1119µs40µsDateTime::::BEGIN@76 DateTime::BEGIN@76
1119µs44µsDateTime::::BEGIN@72 DateTime::BEGIN@72
1118µs42µsDateTime::::BEGIN@78 DateTime::BEGIN@78
1118µs41µsDateTime::::BEGIN@80 DateTime::BEGIN@80
1116µs6µsDateTime::_Thawed::::BEGIN@2059DateTime::_Thawed::BEGIN@2059
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__[:1000] DateTime::__ANON__[:1000]
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__[: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__[:1017] DateTime::__ANON__[:1017]
0000s0sDateTime::::__ANON__[:1018] DateTime::__ANON__[:1018]
0000s0sDateTime::::__ANON__[:1026] DateTime::__ANON__[:1026]
0000s0sDateTime::::__ANON__[:1027] DateTime::__ANON__[:1027]
0000s0sDateTime::::__ANON__[:1031] DateTime::__ANON__[:1031]
0000s0sDateTime::::__ANON__[:1036] DateTime::__ANON__[:1036]
0000s0sDateTime::::__ANON__[:1039] DateTime::__ANON__[:1039]
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__[:1096] DateTime::__ANON__[:1096]
0000s0sDateTime::::__ANON__[:1101] DateTime::__ANON__[:1101]
0000s0sDateTime::::__ANON__[:1109] DateTime::__ANON__[:1109]
0000s0sDateTime::::__ANON__[:1110] DateTime::__ANON__[:1110]
0000s0sDateTime::::__ANON__[:1111] DateTime::__ANON__[:1111]
0000s0sDateTime::::__ANON__[:1113] DateTime::__ANON__[:1113]
0000s0sDateTime::::__ANON__[:1118] DateTime::__ANON__[:1118]
0000s0sDateTime::::__ANON__[:1123] DateTime::__ANON__[:1123]
0000s0sDateTime::::__ANON__[:1127] DateTime::__ANON__[:1127]
0000s0sDateTime::::__ANON__[:1129] DateTime::__ANON__[:1129]
0000s0sDateTime::::__ANON__[:1132] DateTime::__ANON__[:1132]
0000s0sDateTime::::__ANON__[:1136] DateTime::__ANON__[:1136]
0000s0sDateTime::::__ANON__[:1140] DateTime::__ANON__[:1140]
0000s0sDateTime::::__ANON__[:1143] DateTime::__ANON__[:1143]
0000s0sDateTime::::__ANON__[:1147] DateTime::__ANON__[:1147]
0000s0sDateTime::::__ANON__[:1148] DateTime::__ANON__[:1148]
0000s0sDateTime::::__ANON__[:1151] DateTime::__ANON__[:1151]
0000s0sDateTime::::__ANON__[:1155] DateTime::__ANON__[:1155]
0000s0sDateTime::::__ANON__[:1157] DateTime::__ANON__[:1157]
0000s0sDateTime::::__ANON__[:1160] DateTime::__ANON__[:1160]
0000s0sDateTime::::__ANON__[:1164] DateTime::__ANON__[:1164]
0000s0sDateTime::::__ANON__[:1170] DateTime::__ANON__[:1170]
0000s0sDateTime::::__ANON__[:1175] DateTime::__ANON__[:1175]
0000s0sDateTime::::__ANON__[:1180] DateTime::__ANON__[:1180]
0000s0sDateTime::::__ANON__[:1183] DateTime::__ANON__[:1183]
0000s0sDateTime::::__ANON__[:1187] DateTime::__ANON__[:1187]
0000s0sDateTime::::__ANON__[:1189] DateTime::__ANON__[:1189]
0000s0sDateTime::::__ANON__[:1194] DateTime::__ANON__[:1194]
0000s0sDateTime::::__ANON__[:1195] DateTime::__ANON__[:1195]
0000s0sDateTime::::__ANON__[:1197] DateTime::__ANON__[:1197]
0000s0sDateTime::::__ANON__[:1199] DateTime::__ANON__[:1199]
0000s0sDateTime::::__ANON__[:1206] DateTime::__ANON__[:1206]
0000s0sDateTime::::__ANON__[:1209] DateTime::__ANON__[:1209]
0000s0sDateTime::::__ANON__[:1212] DateTime::__ANON__[:1212]
0000s0sDateTime::::__ANON__[:121] DateTime::__ANON__[:121]
0000s0sDateTime::::__ANON__[:1223] DateTime::__ANON__[:1223]
0000s0sDateTime::::__ANON__[:1225] DateTime::__ANON__[:1225]
0000s0sDateTime::::__ANON__[:1227] DateTime::__ANON__[:1227]
0000s0sDateTime::::__ANON__[:1228] DateTime::__ANON__[:1228]
0000s0sDateTime::::__ANON__[:1232] DateTime::__ANON__[:1232]
0000s0sDateTime::::__ANON__[:1234] DateTime::__ANON__[:1234]
0000s0sDateTime::::__ANON__[:1235] DateTime::__ANON__[:1235]
0000s0sDateTime::::__ANON__[:1236] DateTime::__ANON__[:1236]
0000s0sDateTime::::__ANON__[:1237] DateTime::__ANON__[:1237]
0000s0sDateTime::::__ANON__[:1238] DateTime::__ANON__[:1238]
0000s0sDateTime::::__ANON__[:129] DateTime::__ANON__[:129]
0000s0sDateTime::::__ANON__[:137] DateTime::__ANON__[:137]
0000s0sDateTime::::__ANON__[:145] DateTime::__ANON__[:145]
0000s0sDateTime::::__ANON__[:153] DateTime::__ANON__[:153]
0000s0sDateTime::::__ANON__[:161] DateTime::__ANON__[:161]
0000s0sDateTime::::__ANON__[:168] DateTime::__ANON__[:168]
0000s0sDateTime::::__ANON__[:184] DateTime::__ANON__[:184]
0000s0sDateTime::::__ANON__[:615] DateTime::__ANON__[:615]
0000s0sDateTime::::__ANON__[:987] DateTime::__ANON__[:987]
0000s0sDateTime::::__ANON__[:988] DateTime::__ANON__[:988]
0000s0sDateTime::::__ANON__[:989] DateTime::__ANON__[:989]
0000s0sDateTime::::__ANON__[:990] DateTime::__ANON__[:990]
0000s0sDateTime::::__ANON__[:993] DateTime::__ANON__[:993]
0000s0sDateTime::::__ANON__[:994] DateTime::__ANON__[:994]
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::::__ANON__[:999] DateTime::__ANON__[:999]
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::::_handle_offset_modifier DateTime::_handle_offset_modifier
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::::_round DateTime::_round
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_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
# spent 11µs within DateTime::BEGIN@2 which was called: # once (11µs+0s) by MongoDB::GridFS::BEGIN@24 at line 4
BEGIN {
316µs $DateTime::VERSION = '0.66';
4125µs111µs}
# spent 11µs making 1 call to DateTime::BEGIN@2
5
6348µs122µs
# spent 22µs within DateTime::BEGIN@6 which was called: # once (22µs+0s) by MongoDB::GridFS::BEGIN@24 at line 6
use 5.006;
# spent 22µs making 1 call to DateTime::BEGIN@6
7
8329µs216µs
# spent 12µs (9+3) within DateTime::BEGIN@8 which was called: # once (9µs+3µs) by MongoDB::GridFS::BEGIN@24 at line 8
use strict;
# spent 12µs making 1 call to DateTime::BEGIN@8 # spent 3µs making 1 call to strict::import
9332µs234µs
# spent 22µs (10+12) within DateTime::BEGIN@9 which was called: # once (10µs+12µs) by MongoDB::GridFS::BEGIN@24 at line 9
use warnings;
# spent 22µs making 1 call to DateTime::BEGIN@9 # spent 12µs making 1 call to warnings::import
10
11332µs2102µs
# spent 56µs (10+46) within DateTime::BEGIN@11 which was called: # once (10µs+46µs) by MongoDB::GridFS::BEGIN@24 at line 11
use Carp;
# spent 56µs making 1 call to DateTime::BEGIN@11 # spent 46µs making 1 call to Exporter::import
123291µs1352µs
# spent 352µs (295+56) within DateTime::BEGIN@12 which was called: # once (295µs+56µs) by MongoDB::GridFS::BEGIN@24 at line 12
use DateTime::Helpers;
# spent 352µs making 1 call to DateTime::BEGIN@12
13
14
# spent 179µs (17+162) within DateTime::BEGIN@14 which was called: # once (17µs+162µs) by MongoDB::GridFS::BEGIN@24 at line 42
BEGIN {
151500ns my $loaded = 0;
16
1711µs unless ( $ENV{PERL_DATETIME_PP} ) {
181300ns local $@;
191800ns eval {
201500ns require XSLoader;
21 XSLoader::load( __PACKAGE__,
22 exists $DateTime::{VERSION}
231168µs1162µs ? ${ $DateTime::{VERSION} }
# spent 162µs making 1 call to XSLoader::load
24 : ()
25 );
26
271900ns $DateTime::IsPurePerl = 0;
28 };
29
301200ns die $@ if $@ && $@ !~ /object version|loadable object/;
31
321700ns $loaded = 1 unless $@;
33 }
34
3515µs if ($loaded) {
36 require DateTimePPExtra
37 unless defined &DateTime::_normalize_tai_seconds;
38 }
39 else {
40 require DateTimePP;
41 }
42140µs1179µs}
# spent 179µs making 1 call to DateTime::BEGIN@14
43
443135µs15.70ms
# spent 5.70ms (2.59+3.11) within DateTime::BEGIN@44 which was called: # once (2.59ms+3.11ms) by MongoDB::GridFS::BEGIN@24 at line 44
use DateTime::Duration;
# spent 5.70ms making 1 call to DateTime::BEGIN@44
453165µs2104ms
# spent 104ms (2.27+102) within DateTime::BEGIN@45 which was called: # once (2.27ms+102ms) by MongoDB::GridFS::BEGIN@24 at line 45
use DateTime::Locale 0.40;
# spent 104ms making 1 call to DateTime::BEGIN@45 # spent 24µs making 1 call to UNIVERSAL::VERSION
463178µs216.6ms
# spent 16.6ms (4.17+12.4) within DateTime::BEGIN@46 which was called: # once (4.17ms+12.4ms) by MongoDB::GridFS::BEGIN@24 at line 46
use DateTime::TimeZone 0.59;
# spent 16.6ms making 1 call to DateTime::BEGIN@46 # spent 25µs making 1 call to UNIVERSAL::VERSION
473161µs22.07ms
# spent 2.02ms (1.53+487µs) within DateTime::BEGIN@47 which was called: # once (1.53ms+487µs) by MongoDB::GridFS::BEGIN@24 at line 47
use Time::Local qw( timegm_nocheck );
# spent 2.02ms making 1 call to DateTime::BEGIN@47 # spent 50µs making 1 call to Exporter::import
48use Params::Validate
49375µs2152µs
# spent 81µs (10+71) within DateTime::BEGIN@49 which was called: # once (10µs+71µs) by MongoDB::GridFS::BEGIN@24 at line 49
qw( validate validate_pos UNDEF SCALAR BOOLEAN HASHREF OBJECT );
# spent 81µs making 1 call to DateTime::BEGIN@49 # spent 71µs making 1 call to Exporter::import
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 128µs (11+117) within DateTime::BEGIN@57 which was called: # once (11µs+117µs) by MongoDB::GridFS::BEGIN@24 at line 66
use overload (
5819µs1117µs 'fallback' => 1,
# spent 117µ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',
66244µs1128µs);
# spent 128µ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
701122µsrequire DateTime::Infinite;
71
72344µs279µs
# spent 44µs (9+35) within DateTime::BEGIN@72 which was called: # once (9µs+35µs) by MongoDB::GridFS::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 35µs making 1 call to constant::import
73
74342µs282µs
# spent 45µs (9+36) within DateTime::BEGIN@74 which was called: # once (9µs+36µs) by MongoDB::GridFS::BEGIN@24 at line 74
use constant INFINITY => ( 9**9**9 );
# spent 45µs making 1 call to DateTime::BEGIN@74 # spent 36µs making 1 call to constant::import
75339µs276µs
# spent 43µs (10+33) within DateTime::BEGIN@75 which was called: # once (10µs+33µs) by MongoDB::GridFS::BEGIN@24 at line 75
use constant NEG_INFINITY => -1 * ( 9**9**9 );
# spent 43µs making 1 call to DateTime::BEGIN@75 # spent 33µs making 1 call to constant::import
76335µs272µs
# spent 40µs (9+31) within DateTime::BEGIN@76 which was called: # once (9µs+31µs) by MongoDB::GridFS::BEGIN@24 at line 76
use constant NAN => INFINITY - INFINITY;
# spent 40µs making 1 call to DateTime::BEGIN@76 # spent 31µs making 1 call to constant::import
77
78336µs275µs
# spent 42µs (8+33) within DateTime::BEGIN@78 which was called: # once (8µs+33µs) by MongoDB::GridFS::BEGIN@24 at line 78
use constant SECONDS_PER_DAY => 86400;
# spent 42µs making 1 call to DateTime::BEGIN@78 # spent 33µs making 1 call to constant::import
79
80375µs274µs
# spent 41µs (8+33) within DateTime::BEGIN@80 which was called: # once (8µs+33µs) by MongoDB::GridFS::BEGIN@24 at line 80
use constant duration_class => 'DateTime::Duration';
# spent 41µs making 1 call to DateTime::BEGIN@80 # spent 33µs making 1 call to constant::import
81
821500nsmy ( @MonthLengths, @LeapYearMonthLengths );
83
84
# spent 14µs within DateTime::BEGIN@84 which was called: # once (14µs+0s) by MongoDB::GridFS::BEGIN@24 at line 89
BEGIN {
8512µs @MonthLengths = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
86
8717µs @LeapYearMonthLengths = @MonthLengths;
8816µs $LeapYearMonthLengths[1]++;
8914.02ms114µs}
# spent 14µ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!
962600ns my $DefaultLocale;
97
98
# spent 6.32ms (11µs+6.31) within DateTime::DefaultLocale which was called: # once (11µs+6.31ms) by MongoDB::GridFS::BEGIN@24 at line 115
sub DefaultLocale {
991500ns my $class = shift;
100
1011500ns if (@_) {
1021500ns my $lang = shift;
103
10414µs16.31ms DateTime::Locale->load($lang);
# spent 6.31ms making 1 call to DateTime::Locale::load
105
1061700ns $DefaultLocale = $lang;
107 }
108
10914µs return $DefaultLocale;
110 }
111
112 # backwards compat
11314µs *DefaultLanguage = \&DefaultLocale;
114}
11512µs16.32ms__PACKAGE__->DefaultLocale('en_US');
# spent 6.32ms making 1 call to DateTime::DefaultLocale
116
117my $BasicValidate = {
118 year => {
119 type => SCALAR,
120 callbacks => {
121 'is an integer' => sub { $_[0] =~ /^-?\d+$/ }
122 },
123 },
124 month => {
125 type => SCALAR,
126 default => 1,
127 callbacks => {
128 'an integer between 1 and 12' =>
129 sub { $_[0] =~ /^\d+$/ && $_[0] >= 1 && $_[0] <= 12 }
130 },
131 },
132 day => {
133 type => SCALAR,
134 default => 1,
135 callbacks => {
136 'an integer which is a possible valid day of month' =>
137 sub { $_[0] =~ /^\d+$/ && $_[0] >= 1 && $_[0] <= 31 }
138 },
139 },
140 hour => {
141 type => SCALAR,
142 default => 0,
143 callbacks => {
144 'an integer between 0 and 23' =>
145 sub { $_[0] =~ /^\d+$/ && $_[0] >= 0 && $_[0] <= 23 },
146 },
147 },
148 minute => {
149 type => SCALAR,
150 default => 0,
151 callbacks => {
152 'an integer between 0 and 59' =>
153 sub { $_[0] =~ /^\d+$/ && $_[0] >= 0 && $_[0] <= 59 },
154 },
155 },
156 second => {
157 type => SCALAR,
158 default => 0,
159 callbacks => {
160 'an integer between 0 and 61' =>
161 sub { $_[0] =~ /^\d+$/ && $_[0] >= 0 && $_[0] <= 61 },
162 },
163 },
164 nanosecond => {
165 type => SCALAR,
166 default => 0,
167 callbacks => {
168 'a positive integer' => sub { $_[0] =~ /^\d+$/ && $_[0] >= 0 },
169 }
170 },
171 locale => {
172 type => SCALAR | OBJECT,
173 default => undef
174 },
175 language => {
176 type => SCALAR | OBJECT,
177 optional => 1
178 },
179 formatter => {
180 type => UNDEF | SCALAR | OBJECT,
181 optional => 1,
182 callbacks => {
183 'can format_datetime' =>
184 sub { defined $_[0] ? $_[0]->can('format_datetime') : 1 },
185 },
186 },
187136µs};
188
18916µsmy $NewValidate = {
190 %$BasicValidate,
191 time_zone => {
192 type => SCALAR | OBJECT,
193 default => 'floating'
194 },
195};
196
197sub new {
198 my $class = shift;
199 my %p = validate( @_, $NewValidate );
200
201 Carp::croak(
202 "Invalid day of month (day = $p{day} - month = $p{month} - year = $p{year})\n"
203 ) if $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 # If this method is called from somewhere other than new(), then some of
213 # these default may not get applied.
214 $p{month} = 1 unless exists $p{month};
215 $p{day} = 1 unless exists $p{day};
216 $p{hour} = 0 unless exists $p{hour};
217 $p{minute} = 0 unless exists $p{minute};
218 $p{second} = 0 unless exists $p{second};
219 $p{nanosecond} = 0 unless exists $p{nanosecond};
220 $p{time_zone} = 'floating' unless exists $p{time_zone};
221
222 my $self = bless {}, $class;
223
224 $p{locale} = delete $p{language} if exists $p{language};
225 $p{locale} = $class->DefaultLocale unless defined $p{locale};
226
227 if ( ref $p{locale} ) {
228 $self->{locale} = $p{locale};
229 }
230 else {
231 $self->{locale} = DateTime::Locale->load( $p{locale} );
232 }
233
234 $self->{tz} = (
235 ref $p{time_zone}
236 ? $p{time_zone}
237 : DateTime::TimeZone->new( name => $p{time_zone} )
238 );
239
240 $self->{local_rd_days} = $class->_ymd2rd( @p{qw( year month day )} );
241
242 $self->{local_rd_secs}
243 = $class->_time_as_seconds( @p{qw( hour minute second )} );
244
245 $self->{offset_modifier} = 0;
246
247 $self->{rd_nanosecs} = $p{nanosecond};
248 $self->{formatter} = $p{formatter};
249
250 $self->_normalize_nanoseconds( $self->{local_rd_secs},
251 $self->{rd_nanosecs} );
252
253 # Set this explicitly since it can't be calculated accurately
254 # without knowing our time zone offset, and it's possible that the
255 # offset can't be calculated without having at least a rough guess
256 # of the datetime's year. This year need not be correct, as long
257 # as its equal or greater to the correct number, so we fudge by
258 # adding one to the local year given to the constructor.
259 $self->{utc_year} = $p{year} + 1;
260
261 $self->_calc_utc_rd;
262
263 $self->_handle_offset_modifier( $p{second} );
264
265 $self->_calc_local_rd;
266
267 if ( $p{second} > 59 ) {
268 if (
269 $self->{tz}->is_floating
270 ||
271
272 # If true, this means that the actual calculated leap
273 # second does not occur in the second given to new()
274 ( $self->{utc_rd_secs} - 86399 < $p{second} - 59 )
275 ) {
276 Carp::croak("Invalid second value ($p{second})\n");
277 }
278 }
279
280 return $self;
281}
282
283# This method exists for the benefit of internal methods which create
284# a new object based on the current object, like set() and truncate().
285sub _new_from_self {
286 my $self = shift;
287 my %p = @_;
288
289 my %old = map { $_ => $self->$_() }
290 qw( year month day hour minute second nanosecond
291 locale time_zone );
292 $old{formatter} = $self->formatter()
293 if defined $self->formatter();
294
295 my $method = delete $p{_skip_validation} ? '_new' : 'new';
296
297 return ( ref $self )->$method( %old, %p );
298}
299
300sub _handle_offset_modifier {
301 my $self = shift;
302
303 $self->{offset_modifier} = 0;
304
305 return if $self->{tz}->is_floating;
306
307 my $second = shift;
308 my $utc_is_valid = shift;
309
310 my $utc_rd_days = $self->{utc_rd_days};
311
312 my $offset
313 = $utc_is_valid ? $self->offset : $self->_offset_for_local_datetime;
314
315 if ( $offset >= 0
316 && $self->{local_rd_secs} >= $offset ) {
317 if ( $second < 60 && $offset > 0 ) {
318 $self->{offset_modifier}
319 = $self->_day_length( $utc_rd_days - 1 ) - SECONDS_PER_DAY;
320
321 $self->{local_rd_secs} += $self->{offset_modifier};
322 }
323 elsif (
324 $second == 60
325 && (
326 ( $self->{local_rd_secs} == $offset && $offset > 0 )
327 || ( $offset == 0
328 && $self->{local_rd_secs} > 86399 )
329 )
330 ) {
331 my $mod
332 = $self->_day_length( $utc_rd_days - 1 ) - SECONDS_PER_DAY;
333
334 unless ( $mod == 0 ) {
335 $self->{utc_rd_secs} -= $mod;
336
337 $self->_normalize_seconds;
338 }
339 }
340 }
341 elsif ($offset < 0
342 && $self->{local_rd_secs} >= SECONDS_PER_DAY + $offset ) {
343 if ( $second < 60 ) {
344 $self->{offset_modifier}
345 = $self->_day_length( $utc_rd_days - 1 ) - SECONDS_PER_DAY;
346
347 $self->{local_rd_secs} += $self->{offset_modifier};
348 }
349 elsif ($second == 60
350 && $self->{local_rd_secs} == SECONDS_PER_DAY + $offset ) {
351 my $mod
352 = $self->_day_length( $utc_rd_days - 1 ) - SECONDS_PER_DAY;
353
354 unless ( $mod == 0 ) {
355 $self->{utc_rd_secs} -= $mod;
356
357 $self->_normalize_seconds;
358 }
359 }
360 }
361}
362
363
# spent 68µs (48+20) within DateTime::_calc_utc_rd which was called 2 times, avg 34µs/call: # once (30µs+16µs) by MongoDB::GridFS::BEGIN@24 at line 57 of DateTime/Infinite.pm # once (17µs+4µs) by MongoDB::GridFS::BEGIN@24 at line 81 of DateTime/Infinite.pm
sub _calc_utc_rd {
3642900ns my $self = shift;
365
36623µs delete $self->{utc_c};
367
368212µs46µs if ( $self->{tz}->is_utc || $self->{tz}->is_floating ) {
# spent 3µs making 2 calls to DateTime::TimeZone::OffsetOnly::is_utc, avg 2µs/call # spent 3µs making 2 calls to DateTime::TimeZone::Floating::is_floating, avg 1µs/call
36922µs $self->{utc_rd_days} = $self->{local_rd_days};
37022µs $self->{utc_rd_secs} = $self->{local_rd_secs};
371 }
372 else {
373 my $offset = $self->_offset_for_local_datetime;
374
375 $offset += $self->{offset_modifier};
376
377 $self->{utc_rd_days} = $self->{local_rd_days};
378 $self->{utc_rd_secs} = $self->{local_rd_secs} - $offset;
379 }
380
381 # We account for leap seconds in the new() method and nowhere else
382 # except date math.
383237µs214µs $self->_normalize_tai_seconds( $self->{utc_rd_days},
# spent 14µs making 2 calls to DateTime::_normalize_tai_seconds, avg 7µs/call
384 $self->{utc_rd_secs} );
385}
386
387sub _normalize_seconds {
388 my $self = shift;
389
390 return if $self->{utc_rd_secs} >= 0 && $self->{utc_rd_secs} <= 86399;
391
392 if ( $self->{tz}->is_floating ) {
393 $self->_normalize_tai_seconds( $self->{utc_rd_days},
394 $self->{utc_rd_secs} );
395 }
396 else {
397 $self->_normalize_leap_seconds( $self->{utc_rd_days},
398 $self->{utc_rd_secs} );
399 }
400}
401
402
# spent 110µs (41+69) within DateTime::_calc_local_rd which was called 2 times, avg 55µs/call: # once (25µs+38µs) by MongoDB::GridFS::BEGIN@24 at line 58 of DateTime/Infinite.pm # once (15µs+31µs) by MongoDB::GridFS::BEGIN@24 at line 82 of DateTime/Infinite.pm
sub _calc_local_rd {
40321µs my $self = shift;
404
40521µs delete $self->{local_c};
406
407 # We must short circuit for UTC times or else we could end up with
408 # loops between DateTime.pm and DateTime::TimeZone
40927µs45µs if ( $self->{tz}->is_utc || $self->{tz}->is_floating ) {
# spent 3µs making 2 calls to DateTime::TimeZone::Floating::is_floating, avg 1µs/call # spent 2µs making 2 calls to DateTime::TimeZone::OffsetOnly::is_utc, avg 1µs/call
41022µs $self->{local_rd_days} = $self->{utc_rd_days};
41122µs $self->{local_rd_secs} = $self->{utc_rd_secs};
412 }
413 else {
414 my $offset = $self->offset;
415
416 $self->{local_rd_days} = $self->{utc_rd_days};
417 $self->{local_rd_secs} = $self->{utc_rd_secs} + $offset;
418
419 # intentionally ignore leap seconds here
420 $self->_normalize_tai_seconds( $self->{local_rd_days},
421 $self->{local_rd_secs} );
422
423 $self->{local_rd_secs} += $self->{offset_modifier};
424 }
425
426216µs264µs $self->_calc_local_components;
# spent 64µs making 2 calls to DateTime::_calc_local_components, avg 32µs/call
427}
428
429
# spent 64µs (52+13) within DateTime::_calc_local_components which was called 2 times, avg 32µs/call: # 2 times (52µs+13µs) by DateTime::_calc_local_rd at line 426, avg 32µs/call
sub _calc_local_components {
4302900ns my $self = shift;
431
432 @{ $self->{local_c} }{
433220µs28µs qw( year month day day_of_week
# spent 8µs making 2 calls to DateTime::Infinite::_rd2ymd, avg 4µs/call
434 day_of_year quarter day_of_quarter)
435 }
436 = $self->_rd2ymd( $self->{local_rd_days}, 1 );
437
438224µs25µs @{ $self->{local_c} }{qw( hour minute second )}
# spent 5µs making 2 calls to DateTime::Infinite::_seconds_as_components, avg 2µs/call
439 = $self->_seconds_as_components( $self->{local_rd_secs},
440 $self->{utc_rd_secs}, $self->{offset_modifier} );
441}
442
443sub _calc_utc_components {
444 my $self = shift;
445
446 die "Cannot get UTC components before UTC RD has been calculated\n"
447 unless defined $self->{utc_rd_days};
448
449 @{ $self->{utc_c} }{qw( year month day )}
450 = $self->_rd2ymd( $self->{utc_rd_days} );
451
452 @{ $self->{utc_c} }{qw( hour minute second )}
453 = $self->_seconds_as_components( $self->{utc_rd_secs} );
454}
455
456sub _utc_ymd {
457 my $self = shift;
458
459 $self->_calc_utc_components unless exists $self->{utc_c}{year};
460
461 return @{ $self->{utc_c} }{qw( year month day )};
462}
463
464sub _utc_hms {
465 my $self = shift;
466
467 $self->_calc_utc_components unless exists $self->{utc_c}{hour};
468
469 return @{ $self->{utc_c} }{qw( hour minute second )};
470}
471
472{
473220µs17µs my $spec = {
# spent 7µs making 1 call to DateTime::CORE:qr
474 epoch => { regex => qr/^-?(?:\d+(?:\.\d*)?|\.\d+)$/ },
475 locale => { type => SCALAR | OBJECT, optional => 1 },
476 language => { type => SCALAR | OBJECT, optional => 1 },
477 time_zone => { type => SCALAR | OBJECT, optional => 1 },
478 formatter => {
479 type => SCALAR | OBJECT, can => 'format_datetime',
480 optional => 1
481 },
482 };
483
484 sub from_epoch {
485 my $class = shift;
486 my %p = validate( @_, $spec );
487
488 my %args;
489
490 # Because epoch may come from Time::HiRes
491 my $fraction = $p{epoch} - int( $p{epoch} );
492 $args{nanosecond} = int( $fraction * MAX_NANOSECONDS )
493 if $fraction;
494
495 # Note, for very large negative values this may give a
496 # blatantly wrong answer.
497 @args{qw( second minute hour day month year )}
498 = ( gmtime( int delete $p{epoch} ) )[ 0 .. 5 ];
499 $args{year} += 1900;
500 $args{month}++;
501
502 my $self = $class->_new( %p, %args, time_zone => 'UTC' );
503
504 $self->set_time_zone( $p{time_zone} ) if exists $p{time_zone};
505
506 return $self;
507 }
508}
509
510# use scalar time in case someone's loaded Time::Piece
511sub now { shift->from_epoch( epoch => ( scalar time ), @_ ) }
512
513sub today { shift->now(@_)->truncate( to => 'day' ) }
514
515{
51625µs my $spec = {
517 object => {
518 type => OBJECT,
519 can => 'utc_rd_values',
520 },
521 locale => { type => SCALAR | OBJECT, optional => 1 },
522 language => { type => SCALAR | OBJECT, optional => 1 },
523 formatter => {
524 type => SCALAR | OBJECT, can => 'format_datetime',
525 optional => 1
526 },
527 };
528
529 sub from_object {
530 my $class = shift;
531 my %p = validate( @_, $spec );
532
533 my $object = delete $p{object};
534
535 my ( $rd_days, $rd_secs, $rd_nanosecs ) = $object->utc_rd_values;
536
537 # A kludge because until all calendars are updated to return all
538 # three values, $rd_nanosecs could be undef
539 $rd_nanosecs ||= 0;
540
541 # This is a big hack to let _seconds_as_components operate naively
542 # on the given value. If the object _is_ on a leap second, we'll
543 # add that to the generated seconds value later.
544 my $leap_seconds = 0;
545 if ( $object->can('time_zone')
546 && !$object->time_zone->is_floating
547 && $rd_secs > 86399
548 && $rd_secs <= $class->_day_length($rd_days) ) {
549 $leap_seconds = $rd_secs - 86399;
550 $rd_secs -= $leap_seconds;
551 }
552
553 my %args;
554 @args{qw( year month day )} = $class->_rd2ymd($rd_days);
555 @args{qw( hour minute second )}
556 = $class->_seconds_as_components($rd_secs);
557 $args{nanosecond} = $rd_nanosecs;
558
559 $args{second} += $leap_seconds;
560
561 my $new = $class->new( %p, %args, time_zone => 'UTC' );
562
563 if ( $object->can('time_zone') ) {
564 $new->set_time_zone( $object->time_zone );
565 }
566 else {
567 $new->set_time_zone('floating');
568 }
569
570 return $new;
571 }
572}
573
57415µsmy $LastDayOfMonthValidate = {%$NewValidate};
57513µsforeach ( keys %$LastDayOfMonthValidate ) {
5761121µs my %copy = %{ $LastDayOfMonthValidate->{$_} };
577
578114µs delete $copy{default};
579116µs $copy{optional} = 1 unless $_ eq 'year' || $_ eq 'month';
580
5811110µs $LastDayOfMonthValidate->{$_} = \%copy;
582}
583
584sub last_day_of_month {
585 my $class = shift;
586 my %p = validate( @_, $LastDayOfMonthValidate );
587
588 my $day = $class->_month_length( $p{year}, $p{month} );
589
590 return $class->_new( %p, day => $day );
591}
592
593sub _month_length {
594 return (
595 $_[0]->_is_leap_year( $_[1] )
596 ? $LeapYearMonthLengths[ $_[2] - 1 ]
597 : $MonthLengths[ $_[2] - 1 ]
598 );
599}
600
60114µsmy $FromDayOfYearValidate = {%$NewValidate};
60213µsforeach ( keys %$FromDayOfYearValidate ) {
603114µs next if $_ eq 'month' || $_ eq 'day';
604
605914µs my %copy = %{ $FromDayOfYearValidate->{$_} };
606
60793µs delete $copy{default};
60894µs $copy{optional} = 1 unless $_ eq 'year' || $_ eq 'month';
609
61098µs $FromDayOfYearValidate->{$_} = \%copy;
611}
612$FromDayOfYearValidate->{day_of_year} = {
613 type => SCALAR,
614 callbacks => {
615 'is between 1 and 366' => sub { $_[0] >= 1 && $_[0] <= 366 }
616 }
61715µs};
618
619sub from_day_of_year {
620 my $class = shift;
621 my %p = validate( @_, $FromDayOfYearValidate );
622
623 my $is_leap_year = $class->_is_leap_year( $p{year} );
624
625 Carp::croak("$p{year} is not a leap year.\n")
626 if $p{day_of_year} == 366 && !$is_leap_year;
627
628 my $month = 1;
629 my $day = delete $p{day_of_year};
630
631 while ( $month <= 12 && $day > $class->_month_length( $p{year}, $month ) )
632 {
633 $day -= $class->_month_length( $p{year}, $month );
634 $month++;
635 }
636
637 return $class->_new(
638 %p,
639 month => $month,
640 day => $day,
641 );
642}
643
644sub formatter { $_[0]->{formatter} }
645
646sub clone { bless { %{ $_[0] } }, ref $_[0] }
647
648sub year {
649 Carp::carp('year() is a read-only accessor') if @_ > 1;
650 return $_[0]->{local_c}{year};
651}
652
653sub ce_year {
654 $_[0]->{local_c}{year} <= 0
655 ? $_[0]->{local_c}{year} - 1
656 : $_[0]->{local_c}{year};
657}
658
659sub era_name { $_[0]->{locale}->era_wide->[ $_[0]->_era_index() ] }
660
661sub era_abbr { $_[0]->{locale}->era_abbreviated->[ $_[0]->_era_index() ] }
662
663# deprecated
66414µs*era = \&era_abbr;
665
666sub _era_index { $_[0]->{local_c}{year} <= 0 ? 0 : 1 }
667
668sub christian_era { $_[0]->ce_year > 0 ? 'AD' : 'BC' }
669sub secular_era { $_[0]->ce_year > 0 ? 'CE' : 'BCE' }
670
671sub year_with_era { ( abs $_[0]->ce_year ) . $_[0]->era_abbr }
672sub year_with_christian_era { ( abs $_[0]->ce_year ) . $_[0]->christian_era }
673sub year_with_secular_era { ( abs $_[0]->ce_year ) . $_[0]->secular_era }
674
675sub month {
676 Carp::carp('month() is a read-only accessor') if @_ > 1;
677 return $_[0]->{local_c}{month};
678}
67912µs*mon = \&month;
680
681sub month_0 { $_[0]->{local_c}{month} - 1 }
68212µs*mon_0 = \&month_0;
683
684sub month_name { $_[0]->{locale}->month_format_wide->[ $_[0]->month_0() ] }
685
686sub month_abbr {
687 $_[0]->{locale}->month_format_abbreviated->[ $_[0]->month_0() ];
688}
689
690sub day_of_month {
691 Carp::carp('day_of_month() is a read-only accessor') if @_ > 1;
692 $_[0]->{local_c}{day};
693}
69412µs*day = \&day_of_month;
69512µs*mday = \&day_of_month;
696
697310.1ms218µs
# spent 15µs (11+3) within DateTime::BEGIN@697 which was called: # once (11µs+3µs) by MongoDB::GridFS::BEGIN@24 at line 697
sub weekday_of_month { use integer; ( ( $_[0]->day - 1 ) / 7 ) + 1 }
# spent 15µs making 1 call to DateTime::BEGIN@697 # spent 3µs making 1 call to integer::import
698
699sub quarter { $_[0]->{local_c}{quarter} }
700
701sub quarter_name {
702 $_[0]->{locale}->quarter_format_wide->[ $_[0]->quarter_0() ];
703}
704
705sub quarter_abbr {
706 $_[0]->{locale}->quarter_format_abbreviated->[ $_[0]->quarter_0() ];
707}
708
709sub quarter_0 { $_[0]->{local_c}{quarter} - 1 }
710
711sub day_of_month_0 { $_[0]->{local_c}{day} - 1 }
71212µs*day_0 = \&day_of_month_0;
71312µs*mday_0 = \&day_of_month_0;
714
715sub day_of_week { $_[0]->{local_c}{day_of_week} }
71612µs*wday = \&day_of_week;
71712µs*dow = \&day_of_week;
718
719sub day_of_week_0 { $_[0]->{local_c}{day_of_week} - 1 }
72012µs*wday_0 = \&day_of_week_0;
72112µs*dow_0 = \&day_of_week_0;
722
723sub local_day_of_week {
724 my $self = shift;
725
726 my $day = $self->day_of_week();
727
728 my $local_first_day = $self->{locale}->first_day_of_week();
729
730 my $d = ( ( 8 - $local_first_day ) + $day ) % 7;
731
732 return $d == 0 ? 7 : $d;
733}
734
735sub day_name { $_[0]->{locale}->day_format_wide->[ $_[0]->day_of_week_0() ] }
736
737sub day_abbr {
738 $_[0]->{locale}->day_format_abbreviated->[ $_[0]->day_of_week_0() ];
739}
740
741sub day_of_quarter { $_[0]->{local_c}{day_of_quarter} }
74212µs*doq = \&day_of_quarter;
743
744sub day_of_quarter_0 { $_[0]->day_of_quarter - 1 }
74512µs*doq_0 = \&day_of_quarter_0;
746
747sub day_of_year { $_[0]->{local_c}{day_of_year} }
74812µs*doy = \&day_of_year;
749
750sub day_of_year_0 { $_[0]->{local_c}{day_of_year} - 1 }
75112µs*doy_0 = \&day_of_year_0;
752
753sub am_or_pm {
754 $_[0]->{locale}->am_pm_abbreviated->[ $_[0]->hour() < 12 ? 0 : 1 ];
755}
756
757sub ymd {
758 my ( $self, $sep ) = @_;
759 $sep = '-' unless defined $sep;
760
761 return sprintf(
762 "%0.4d%s%0.2d%s%0.2d",
763 $self->year, $sep,
764 $self->{local_c}{month}, $sep,
765 $self->{local_c}{day}
766 );
767}
76812µs*date = \&ymd;
769
770sub mdy {
771 my ( $self, $sep ) = @_;
772 $sep = '-' unless defined $sep;
773
774 return sprintf(
775 "%0.2d%s%0.2d%s%0.4d",
776 $self->{local_c}{month}, $sep,
777 $self->{local_c}{day}, $sep,
778 $self->year
779 );
780}
781
782sub dmy {
783 my ( $self, $sep ) = @_;
784 $sep = '-' unless defined $sep;
785
786 return sprintf(
787 "%0.2d%s%0.2d%s%0.4d",
788 $self->{local_c}{day}, $sep,
789 $self->{local_c}{month}, $sep,
790 $self->year
791 );
792}
793
794sub hour {
795 Carp::carp('hour() is a read-only accessor') if @_ > 1;
796 return $_[0]->{local_c}{hour};
797}
798sub hour_1 { $_[0]->{local_c}{hour} == 0 ? 24 : $_[0]->{local_c}{hour} }
799
800sub hour_12 { my $h = $_[0]->hour % 12; return $h ? $h : 12 }
801sub hour_12_0 { $_[0]->hour % 12 }
802
803sub minute {
804 Carp::carp('minute() is a read-only accessor') if @_ > 1;
805 return $_[0]->{local_c}{minute};
806}
80712µs*min = \&minute;
808
809sub second {
810 Carp::carp('second() is a read-only accessor') if @_ > 1;
811 return $_[0]->{local_c}{second};
812}
81312µs*sec = \&second;
814
815sub fractional_second { $_[0]->second + $_[0]->nanosecond / MAX_NANOSECONDS }
816
817sub nanosecond {
818 Carp::carp('nanosecond() is a read-only accessor') if @_ > 1;
819 return $_[0]->{rd_nanosecs};
820}
821
822sub millisecond { _round( $_[0]->{rd_nanosecs} / 1000000 ) }
823
824sub microsecond { _round( $_[0]->{rd_nanosecs} / 1000 ) }
825
826sub _round {
827 my $val = shift;
828 my $int = int $val;
829
830 return $val - $int >= 0.5 ? $int + 1 : $int;
831}
832
833sub leap_seconds {
834 my $self = shift;
835
836 return 0 if $self->{tz}->is_floating;
837
838 return DateTime->_accumulated_leap_seconds( $self->{utc_rd_days} );
839}
840
841sub _stringify {
842 my $self = shift;
843
844 return $self->iso8601 unless $self->{formatter};
845 return $self->{formatter}->format_datetime($self);
846}
847
848sub hms {
849 my ( $self, $sep ) = @_;
850 $sep = ':' unless defined $sep;
851
852 return sprintf(
853 "%0.2d%s%0.2d%s%0.2d",
854 $self->{local_c}{hour}, $sep,
855 $self->{local_c}{minute}, $sep,
856 $self->{local_c}{second}
857 );
858}
859
860# don't want to override CORE::time()
86112µs*DateTime::time = \&hms;
862
863sub iso8601 { join 'T', $_[0]->ymd('-'), $_[0]->hms(':') }
86412µs*datetime = \&iso8601;
865
866sub is_leap_year { $_[0]->_is_leap_year( $_[0]->year ) }
867
868sub week {
869 my $self = shift;
870
871 unless ( defined $self->{local_c}{week_year} ) {
872
873 # This algorithm was taken from Date::Calc's DateCalc.c file
874 my $jan_one_dow_m1
875 = ( ( $self->_ymd2rd( $self->year, 1, 1 ) + 6 ) % 7 );
876
877 $self->{local_c}{week_number}
878 = int( ( ( $self->day_of_year - 1 ) + $jan_one_dow_m1 ) / 7 );
879 $self->{local_c}{week_number}++ if $jan_one_dow_m1 < 4;
880
881 if ( $self->{local_c}{week_number} == 0 ) {
882 $self->{local_c}{week_year} = $self->year - 1;
883 $self->{local_c}{week_number}
884 = $self->_weeks_in_year( $self->{local_c}{week_year} );
885 }
886 elsif ($self->{local_c}{week_number} == 53
887 && $self->_weeks_in_year( $self->year ) == 52 ) {
888 $self->{local_c}{week_number} = 1;
889 $self->{local_c}{week_year} = $self->year + 1;
890 }
891 else {
892 $self->{local_c}{week_year} = $self->year;
893 }
894 }
895
896 return @{ $self->{local_c} }{ 'week_year', 'week_number' };
897}
898
899# Also from DateCalc.c
900sub _weeks_in_year {
901 my $self = shift;
902 my $year = shift;
903
904 my $jan_one_dow = ( ( $self->_ymd2rd( $year, 1, 1 ) + 6 ) % 7 ) + 1;
905 my $dec_31_dow = ( ( $self->_ymd2rd( $year, 12, 31 ) + 6 ) % 7 ) + 1;
906
907 return $jan_one_dow == 4 || $dec_31_dow == 4 ? 53 : 52;
908}
909
910sub week_year { ( $_[0]->week )[0] }
911sub week_number { ( $_[0]->week )[1] }
912
913# ISO says that the first week of a year is the first week containing
914# a Thursday. Extending that says that the first week of the month is
915# the first week containing a Thursday. ICU agrees.
916#
917# Algorithm supplied by Rick Measham, who doesn't understand how it
918# works. Neither do I. Please feel free to explain this to me!
919sub week_of_month {
920 my $self = shift;
921
922 # Faster than cloning just to get the dow
923 my $first_wday_of_month = ( 8 - ( $self->day - $self->dow ) % 7 ) % 7;
924 $first_wday_of_month = 7 unless $first_wday_of_month;
925
926 my $wom = int( ( $self->day + $first_wday_of_month - 2 ) / 7 );
927 return ( $first_wday_of_month <= 4 ) ? $wom + 1 : $wom;
928}
929
930sub time_zone {
931 Carp::carp('time_zone() is a read-only accessor') if @_ > 1;
932 return $_[0]->{tz};
933}
934
935sub offset { $_[0]->{tz}->offset_for_datetime( $_[0] ) }
936
937sub _offset_for_local_datetime {
938 $_[0]->{tz}->offset_for_local_datetime( $_[0] );
939}
940
941sub is_dst { $_[0]->{tz}->is_dst_for_datetime( $_[0] ) }
942
943sub time_zone_long_name { $_[0]->{tz}->name }
944sub time_zone_short_name { $_[0]->{tz}->short_name_for_datetime( $_[0] ) }
945
946sub locale {
947 Carp::carp('locale() is a read-only accessor') if @_ > 1;
948 return $_[0]->{locale};
949}
95012µs*language = \&locale;
951
952sub utc_rd_values {
953 @{ $_[0] }{ 'utc_rd_days', 'utc_rd_secs', 'rd_nanosecs' };
954}
955
956sub local_rd_values {
957 @{ $_[0] }{ 'local_rd_days', 'local_rd_secs', 'rd_nanosecs' };
958}
959
960# NOTE: no nanoseconds, no leap seconds
961sub utc_rd_as_seconds {
962 ( $_[0]->{utc_rd_days} * SECONDS_PER_DAY ) + $_[0]->{utc_rd_secs};
963}
964
965# NOTE: no nanoseconds, no leap seconds
966sub local_rd_as_seconds {
967 ( $_[0]->{local_rd_days} * SECONDS_PER_DAY ) + $_[0]->{local_rd_secs};
968}
969
970# RD 1 is JD 1,721,424.5 - a simple offset
971sub jd {
972 my $self = shift;
973
974 my $jd = $self->{utc_rd_days} + 1_721_424.5;
975
976 my $day_length = $self->_day_length( $self->{utc_rd_days} );
977
978 return ( $jd
979 + ( $self->{utc_rd_secs} / $day_length )
980 + ( $self->{rd_nanosecs} / $day_length / MAX_NANOSECONDS ) );
981}
982
983sub mjd { $_[0]->jd - 2_400_000.5 }
984
985{
9861500ns my %strftime_patterns = (
987 'a' => sub { $_[0]->day_abbr },
988 'A' => sub { $_[0]->day_name },
989 'b' => sub { $_[0]->month_abbr },
990 'B' => sub { $_[0]->month_name },
991 'c' => sub {
992 $_[0]->format_cldr( $_[0]->{locale}->datetime_format_default() );
993 },
994 'C' => sub { int( $_[0]->year / 100 ) },
995 'd' => sub { sprintf( '%02d', $_[0]->day_of_month ) },
996 'D' => sub { $_[0]->strftime('%m/%d/%y') },
997 'e' => sub { sprintf( '%2d', $_[0]->day_of_month ) },
998 'F' => sub { $_[0]->ymd('-') },
999 'g' => sub { substr( $_[0]->week_year, -2 ) },
1000 'G' => sub { $_[0]->week_year },
1001 'H' => sub { sprintf( '%02d', $_[0]->hour ) },
1002 'I' => sub { sprintf( '%02d', $_[0]->hour_12 ) },
1003 'j' => sub { $_[0]->day_of_year },
1004 'k' => sub { sprintf( '%2d', $_[0]->hour ) },
1005 'l' => sub { sprintf( '%2d', $_[0]->hour_12 ) },
1006 'm' => sub { sprintf( '%02d', $_[0]->month ) },
1007 'M' => sub { sprintf( '%02d', $_[0]->minute ) },
1008 'n' => sub {"\n"}, # should this be OS-sensitive?
1009 'N' => \&_format_nanosecs,
1010 'p' => sub { $_[0]->am_or_pm() },
1011 'P' => sub { lc $_[0]->am_or_pm() },
1012 'r' => sub { $_[0]->strftime('%I:%M:%S %p') },
1013 'R' => sub { $_[0]->strftime('%H:%M') },
1014 's' => sub { $_[0]->epoch },
1015 'S' => sub { sprintf( '%02d', $_[0]->second ) },
1016 't' => sub {"\t"},
1017 'T' => sub { $_[0]->strftime('%H:%M:%S') },
1018 'u' => sub { $_[0]->day_of_week },
1019
1020 # algorithm from Date::Format::wkyr
1021 'U' => sub {
1022 my $dow = $_[0]->day_of_week;
1023 $dow = 0 if $dow == 7; # convert to 0-6, Sun-Sat
1024 my $doy = $_[0]->day_of_year - 1;
1025 return sprintf( '%02d', int( ( $doy - $dow + 13 ) / 7 - 1 ) );
1026 },
1027 'V' => sub { sprintf( '%02d', $_[0]->week_number ) },
1028 'w' => sub {
1029 my $dow = $_[0]->day_of_week;
1030 return $dow % 7;
1031 },
1032 'W' => sub {
1033 my $dow = $_[0]->day_of_week;
1034 my $doy = $_[0]->day_of_year - 1;
1035 return sprintf( '%02d', int( ( $doy - $dow + 13 ) / 7 - 1 ) );
1036 },
1037 'x' => sub {
1038 $_[0]->format_cldr( $_[0]->{locale}->date_format_default() );
1039 },
1040 'X' => sub {
1041 $_[0]->format_cldr( $_[0]->{locale}->time_format_default() );
1042 },
1043 'y' => sub { sprintf( '%02d', substr( $_[0]->year, -2 ) ) },
1044 'Y' => sub { return $_[0]->year },
1045 'z' => sub { DateTime::TimeZone->offset_as_string( $_[0]->offset ) },
1046 'Z' => sub { $_[0]->{tz}->short_name_for_datetime( $_[0] ) },
1047 '%' => sub {'%'},
1048198µs );
1049
105011µs $strftime_patterns{h} = $strftime_patterns{b};
1051
1052 sub strftime {
1053 my $self = shift;
1054
1055 # make a copy or caller's scalars get munged
1056 my @patterns = @_;
1057
1058 my @r;
1059 foreach my $p (@patterns) {
1060 $p =~ s/
1061 (?:
1062 %{(\w+)} # method name like %{day_name}
1063 |
1064 %([%a-zA-Z]) # single character specifier like %d
1065 |
1066 %(\d+)N # special case for %N
1067 )
1068 /
1069 ( $1
1070 ? ( $self->can($1) ? $self->$1() : "\%{$1}" )
1071 : $2
1072 ? ( $strftime_patterns{$2} ? $strftime_patterns{$2}->($self) : "\%$2" )
1073 : $3
1074 ? $strftime_patterns{N}->($self, $3)
1075 : '' # this won't happen
1076 )
1077 /sgex;
1078
1079 return $p unless wantarray;
1080
1081 push @r, $p;
1082 }
1083
1084 return @r;
1085 }
1086}
1087
1088{
1089
1090 # It's an array because the order in which the regexes are checked
1091 # is important. These patterns are similar to the ones Java uses,
1092 # but not quite the same. See
1093 # http://www.unicode.org/reports/tr35/tr35-9.html#Date_Format_Patterns.
109415µs my @patterns = (
1095 qr/GGGGG/ =>
1096 sub { $_[0]->{locale}->era_narrow->[ $_[0]->_era_index() ] },
1097 qr/GGGG/ => 'era_name',
1098 qr/G{1,3}/ => 'era_abbr',
1099
1100 qr/(y{3,5})/ =>
1101 sub { $_[0]->_zero_padded_number( $1, $_[0]->year() ) },
1102
1103 # yy is a weird special case, where it must be exactly 2 digits
1104 qr/yy/ => sub {
1105 my $year = $_[0]->year();
1106 my $y2 = substr( $year, -2, 2 ) if length $year > 2;
1107 $y2 *= -1 if $year < 0;
1108 $_[0]->_zero_padded_number( 'yy', $y2 );
1109 },
1110 qr/y/ => sub { $_[0]->year() },
1111 qr/(u+)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->year() ) },
1112 qr/(Y+)/ =>
1113 sub { $_[0]->_zero_padded_number( $1, $_[0]->week_year() ) },
1114
1115 qr/QQQQ/ => 'quarter_name',
1116 qr/QQQ/ => 'quarter_abbr',
1117 qr/(QQ?)/ =>
1118 sub { $_[0]->_zero_padded_number( $1, $_[0]->quarter() ) },
1119
1120 qr/qqqq/ => sub {
1121 $_[0]->{locale}->quarter_stand_alone_wide()
1122 ->[ $_[0]->quarter_0() ];
1123 },
1124 qr/qqq/ => sub {
1125 $_[0]->{locale}->quarter_stand_alone_abbreviated()
1126 ->[ $_[0]->quarter_0() ];
1127 },
1128 qr/(qq?)/ =>
1129 sub { $_[0]->_zero_padded_number( $1, $_[0]->quarter() ) },
1130
1131 qr/MMMMM/ =>
1132 sub { $_[0]->{locale}->month_format_narrow->[ $_[0]->month_0() ] }
1133 ,
1134 qr/MMMM/ => 'month_name',
1135 qr/MMM/ => 'month_abbr',
1136 qr/(MM?)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->month() ) },
1137
1138 qr/LLLLL/ => sub {
1139 $_[0]->{locale}->month_stand_alone_narrow->[ $_[0]->month_0() ];
1140 },
1141 qr/LLLL/ => sub {
1142 $_[0]->{locale}->month_stand_alone_wide->[ $_[0]->month_0() ];
1143 },
1144 qr/LLL/ => sub {
1145 $_[0]->{locale}
1146 ->month_stand_alone_abbreviated->[ $_[0]->month_0() ];
1147 },
1148 qr/(LL?)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->month() ) },
1149
1150 qr/(ww?)/ =>
1151 sub { $_[0]->_zero_padded_number( $1, $_[0]->week_number() ) },
1152 qr/W/ => 'week_of_month',
1153
1154 qr/(dd?)/ =>
1155 sub { $_[0]->_zero_padded_number( $1, $_[0]->day_of_month() ) },
1156 qr/(D{1,3})/ =>
1157 sub { $_[0]->_zero_padded_number( $1, $_[0]->day_of_year() ) },
1158
1159 qr/F/ => 'weekday_of_month',
1160 qr/(g+)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->mjd() ) },
1161
1162 qr/EEEEE/ => sub {
1163 $_[0]->{locale}->day_format_narrow->[ $_[0]->day_of_week_0() ];
1164 },
1165 qr/EEEE/ => 'day_name',
1166 qr/E{1,3}/ => 'day_abbr',
1167
1168 qr/eeeee/ => sub {
1169 $_[0]->{locale}->day_format_narrow->[ $_[0]->day_of_week_0() ];
1170 },
1171 qr/eeee/ => 'day_name',
1172 qr/eee/ => 'day_abbr',
1173 qr/(ee?)/ => sub {
1174 $_[0]->_zero_padded_number( $1, $_[0]->local_day_of_week() );
1175 },
1176
1177 qr/ccccc/ => sub {
1178 $_[0]->{locale}
1179 ->day_stand_alone_narrow->[ $_[0]->day_of_week_0() ];
1180 },
1181 qr/cccc/ => sub {
1182 $_[0]->{locale}->day_stand_alone_wide->[ $_[0]->day_of_week_0() ];
1183 },
1184 qr/ccc/ => sub {
1185 $_[0]->{locale}
1186 ->day_stand_alone_abbreviated->[ $_[0]->day_of_week_0() ];
1187 },
1188 qr/(cc?)/ =>
1189 sub { $_[0]->_zero_padded_number( $1, $_[0]->day_of_week() ) },
1190
1191 qr/a/ => 'am_or_pm',
1192
1193 qr/(hh?)/ =>
1194 sub { $_[0]->_zero_padded_number( $1, $_[0]->hour_12() ) },
1195 qr/(HH?)/ => sub { $_[0]->_zero_padded_number( $1, $_[0]->hour() ) },
1196 qr/(KK?)/ =>
1197 sub { $_[0]->_zero_padded_number( $1, $_[0]->hour_12_0() ) },
1198 qr/(kk?)/ =>
1199 sub { $_[0]->_zero_padded_number( $1, $_[0]->hour_1() ) },
1200 qr/(jj?)/ => sub {
1201 my $h
1202 = $_[0]->{locale}->prefers_24_hour_time()
1203 ? $_[0]->hour()
1204 : $_[0]->hour_12();
1205 $_[0]->_zero_padded_number( $1, $h );
1206 },
1207
1208 qr/(mm?)/ =>
1209 sub { $_[0]->_zero_padded_number( $1, $_[0]->minute() ) },
1210
1211 qr/(ss?)/ =>
1212 sub { $_[0]->_zero_padded_number( $1, $_[0]->second() ) },
1213
1214 # I'm not sure this is what is wanted (notably the trailing
1215 # and leading zeros it can produce), but once again the LDML
1216 # spec is not all that clear.
1217 qr/(S+)/ => sub {
1218 my $l = length $1;
1219 my $val = sprintf( "%.${l}f",
1220 $_[0]->fractional_second() - $_[0]->second() );
1221 $val =~ s/^0\.//;
1222 $val || 0;
1223 },
1224 qr/A+/ =>
1225 sub { ( $_[0]->{local_rd_secs} * 1000 ) + $_[0]->millisecond() },
1226
1227 qr/zzzz/ => sub { $_[0]->time_zone_long_name() },
1228 qr/z{1,3}/ => sub { $_[0]->time_zone_short_name() },
1229 qr/ZZZZ/ => sub {
1230 $_[0]->time_zone_short_name()
1231 . DateTime::TimeZone->offset_as_string( $_[0]->offset() );
1232 },
1233 qr/Z{1,3}/ =>
1234 sub { DateTime::TimeZone->offset_as_string( $_[0]->offset() ) },
1235 qr/vvvv/ => sub { $_[0]->time_zone_long_name() },
1236 qr/v{1,3}/ => sub { $_[0]->time_zone_short_name() },
1237 qr/VVVV/ => sub { $_[0]->time_zone_long_name() },
1238 qr/V{1,3}/ => sub { $_[0]->time_zone_short_name() },
12391310µs5777µs );
# spent 77µs making 57 calls to DateTime::CORE:qr, avg 1µs/call
1240
1241 sub _zero_padded_number {
1242 my $self = shift;
1243 my $size = length shift;
1244 my $val = shift;
1245
1246 return sprintf( "%0${size}d", $val );
1247 }
1248
1249 sub _space_padded_string {
1250 my $self = shift;
1251 my $size = length shift;
1252 my $val = shift;
1253
1254 return sprintf( "% ${size}s", $val );
1255 }
1256
1257 sub format_cldr {
1258 my $self = shift;
1259
1260 # make a copy or caller's scalars get munged
1261 my @patterns = @_;
1262
1263 my @r;
1264 foreach my $p (@patterns) {
1265 $p =~ s/\G
1266 (?:
1267 '((?:[^']|'')*)' # quote escaped bit of text
1268 # it needs to end with one
1269 # quote not followed by
1270 # another
1271 |
1272 (([a-zA-Z])\3*) # could be a pattern
1273 |
1274 (.) # anything else
1275 )
1276 /
1277 defined $1
1278 ? $1
1279 : defined $2
1280 ? $self->_cldr_pattern($2)
1281 : defined $4
1282 ? $4
1283 : undef # should never get here
1284 /sgex;
1285
1286 $p =~ s/\'\'/\'/g;
1287
1288 return $p unless wantarray;
1289
1290 push @r, $p;
1291 }
1292
1293 return @r;
1294 }
1295
1296 sub _cldr_pattern {
1297 my $self = shift;
1298 my $pattern = shift;
1299
1300 for ( my $i = 0; $i < @patterns; $i += 2 ) {
1301 if ( $pattern =~ /$patterns[$i]/ ) {
1302 my $sub = $patterns[ $i + 1 ];
1303
1304 return $self->$sub();
1305 }
1306 }
1307
1308 return $pattern;
1309 }
1310}
1311
1312sub _format_nanosecs {
1313 my $self = shift;
1314 my $precision = shift;
1315
1316 my $ret = sprintf( "%09d", $self->{rd_nanosecs} );
1317 return $ret unless $precision; # default = 9 digits
1318
1319 # rd_nanosecs might contain a fractional separator
1320 my ( $int, $frac ) = split /[.,]/, $self->{rd_nanosecs};
1321 $ret .= $frac if $frac;
1322
1323 return substr( $ret, 0, $precision );
1324}
1325
1326sub epoch {
1327 my $self = shift;
1328
1329 return $self->{utc_c}{epoch}
1330 if exists $self->{utc_c}{epoch};
1331
1332 my ( $year, $month, $day ) = $self->_utc_ymd;
1333 my @hms = $self->_utc_hms;
1334
1335 $self->{utc_c}{epoch} = timegm_nocheck(
1336 ( reverse @hms ),
1337 $day,
1338 $month - 1,
1339 $year,
1340 );
1341
1342 return $self->{utc_c}{epoch};
1343}
1344
1345sub hires_epoch {
1346 my $self = shift;
1347
1348 my $epoch = $self->epoch;
1349
1350 return undef unless defined $epoch;
1351
1352 my $nano = $self->{rd_nanosecs} / MAX_NANOSECONDS;
1353
1354 return $epoch + $nano;
1355}
1356
1357sub is_finite {1}
1358sub is_infinite {0}
1359
1360# added for benefit of DateTime::TimeZone
1361sub utc_year { $_[0]->{utc_year} }
1362
1363# returns a result that is relative to the first datetime
1364sub subtract_datetime {
1365 my $dt1 = shift;
1366 my $dt2 = shift;
1367
1368 $dt2 = $dt2->clone->set_time_zone( $dt1->time_zone )
1369 unless $dt1->time_zone eq $dt2->time_zone;
1370
1371 # We only want a negative duration if $dt2 > $dt1 ($self)
1372 my ( $bigger, $smaller, $negative ) = (
1373 $dt1 >= $dt2
1374 ? ( $dt1, $dt2, 0 )
1375 : ( $dt2, $dt1, 1 )
1376 );
1377
1378 my $is_floating = $dt1->time_zone->is_floating
1379 && $dt2->time_zone->is_floating;
1380
1381 my $minute_length = 60;
1382 unless ($is_floating) {
1383 my ( $utc_rd_days, $utc_rd_secs ) = $smaller->utc_rd_values;
1384
1385 if ( $utc_rd_secs >= 86340 && !$is_floating ) {
1386
1387 # If the smaller of the two datetimes occurs in the last
1388 # UTC minute of the UTC day, then that minute may not be
1389 # 60 seconds long. If we need to subtract a minute from
1390 # the larger datetime's minutes count in order to adjust
1391 # the seconds difference to be positive, we need to know
1392 # how long that minute was. If one of the datetimes is
1393 # floating, we just assume a minute is 60 seconds.
1394
1395 $minute_length = $dt1->_day_length($utc_rd_days) - 86340;
1396 }
1397 }
1398
1399 # This is a gross hack that basically figures out if the bigger of
1400 # the two datetimes is the day of a DST change. If it's a 23 hour
1401 # day (switching _to_ DST) then we subtract 60 minutes from the
1402 # local time. If it's a 25 hour day then we add 60 minutes to the
1403 # local time.
1404 #
1405 # This produces the most "intuitive" results, though there are
1406 # still reversibility problems with the resultant duration.
1407 #
1408 # However, if the two objects are on the same (local) date, and we
1409 # are not crossing a DST change, we don't want to invoke the hack
1410 # - see 38local-subtract.t
1411 my $bigger_min = $bigger->hour * 60 + $bigger->minute;
1412 if ( $bigger->time_zone->has_dst_changes
1413 && $bigger->is_dst != $smaller->is_dst ) {
1414
1415 $bigger_min -= 60
1416
1417 # it's a 23 hour (local) day
1418 if (
1419 $bigger->is_dst
1420 && do {
1421 local $@;
1422 my $prev_day = eval { $bigger->clone->subtract( days => 1 ) };
1423 $prev_day && !$prev_day->is_dst ? 1 : 0;
1424 }
1425 );
1426
1427 $bigger_min += 60
1428
1429 # it's a 25 hour (local) day
1430 if (
1431 !$bigger->is_dst
1432 && do {
1433 local $@;
1434 my $prev_day = eval { $bigger->clone->subtract( days => 1 ) };
1435 $prev_day && $prev_day->is_dst ? 1 : 0;
1436 }
1437 );
1438 }
1439
1440 my ( $months, $days, $minutes, $seconds, $nanoseconds )
1441 = $dt1->_adjust_for_positive_difference(
1442 $bigger->year * 12 + $bigger->month,
1443 $smaller->year * 12 + $smaller->month,
1444
1445 $bigger->day, $smaller->day,
1446
1447 $bigger_min, $smaller->hour * 60 + $smaller->minute,
1448
1449 $bigger->second, $smaller->second,
1450
1451 $bigger->nanosecond, $smaller->nanosecond,
1452
1453 $minute_length,
1454
1455 # XXX - using the smaller as the month length is
1456 # somewhat arbitrary, we could also use the bigger -
1457 # either way we have reversibility problems
1458 $dt1->_month_length( $smaller->year, $smaller->month ),
1459 );
1460
1461 if ($negative) {
1462 for ( $months, $days, $minutes, $seconds, $nanoseconds ) {
1463
1464 # Some versions of Perl can end up with -0 if we do "0 * -1"!!
1465 $_ *= -1 if $_;
1466 }
1467 }
1468
1469 return $dt1->duration_class->new(
1470 months => $months,
1471 days => $days,
1472 minutes => $minutes,
1473 seconds => $seconds,
1474 nanoseconds => $nanoseconds,
1475 );
1476}
1477
1478sub _adjust_for_positive_difference {
1479 my (
1480 $self,
1481 $month1, $month2,
1482 $day1, $day2,
1483 $min1, $min2,
1484 $sec1, $sec2,
1485 $nano1, $nano2,
1486 $minute_length,
1487 $month_length,
1488 ) = @_;
1489
1490 if ( $nano1 < $nano2 ) {
1491 $sec1--;
1492 $nano1 += MAX_NANOSECONDS;
1493 }
1494
1495 if ( $sec1 < $sec2 ) {
1496 $min1--;
1497 $sec1 += $minute_length;
1498 }
1499
1500 # A day always has 24 * 60 minutes, though the minutes may vary in
1501 # length.
1502 if ( $min1 < $min2 ) {
1503 $day1--;
1504 $min1 += 24 * 60;
1505 }
1506
1507 if ( $day1 < $day2 ) {
1508 $month1--;
1509 $day1 += $month_length;
1510 }
1511
1512 return (
1513 $month1 - $month2,
1514 $day1 - $day2,
1515 $min1 - $min2,
1516 $sec1 - $sec2,
1517 $nano1 - $nano2,
1518 );
1519}
1520
1521sub subtract_datetime_absolute {
1522 my $self = shift;
1523 my $dt = shift;
1524
1525 my $utc_rd_secs1 = $self->utc_rd_as_seconds;
1526 $utc_rd_secs1
1527 += DateTime->_accumulated_leap_seconds( $self->{utc_rd_days} )
1528 if !$self->time_zone->is_floating;
1529
1530 my $utc_rd_secs2 = $dt->utc_rd_as_seconds;
1531 $utc_rd_secs2 += DateTime->_accumulated_leap_seconds( $dt->{utc_rd_days} )
1532 if !$dt->time_zone->is_floating;
1533
1534 my $seconds = $utc_rd_secs1 - $utc_rd_secs2;
1535 my $nanoseconds = $self->nanosecond - $dt->nanosecond;
1536
1537 if ( $nanoseconds < 0 ) {
1538 $seconds--;
1539 $nanoseconds += MAX_NANOSECONDS;
1540 }
1541
1542 return $self->duration_class->new(
1543 seconds => $seconds,
1544 nanoseconds => $nanoseconds,
1545 );
1546}
1547
1548sub delta_md {
1549 my $self = shift;
1550 my $dt = shift;
1551
1552 my ( $smaller, $bigger ) = sort $self, $dt;
1553
1554 my ( $months, $days, undef, undef, undef )
1555 = $dt->_adjust_for_positive_difference(
1556 $bigger->year * 12 + $bigger->month,
1557 $smaller->year * 12 + $smaller->month,
1558
1559 $bigger->day, $smaller->day,
1560
1561 0, 0,
1562
1563 0, 0,
1564
1565 0, 0,
1566
1567 60,
1568
1569 $smaller->_month_length( $smaller->year, $smaller->month ),
1570 );
1571
1572 return $self->duration_class->new(
1573 months => $months,
1574 days => $days
1575 );
1576}
1577
1578sub delta_days {
1579 my $self = shift;
1580 my $dt = shift;
1581
1582 my $days
1583 = abs( ( $self->local_rd_values )[0] - ( $dt->local_rd_values )[0] );
1584
1585 $self->duration_class->new( days => $days );
1586}
1587
1588sub delta_ms {
1589 my $self = shift;
1590 my $dt = shift;
1591
1592 my ( $smaller, $greater ) = sort $self, $dt;
1593
1594 my $days = int( $greater->jd - $smaller->jd );
1595
1596 my $dur = $greater->subtract_datetime($smaller);
1597
1598 my %p;
1599 $p{hours} = $dur->hours + ( $days * 24 );
1600 $p{minutes} = $dur->minutes;
1601 $p{seconds} = $dur->seconds;
1602
1603 return $self->duration_class->new(%p);
1604}
1605
1606sub _add_overload {
1607 my ( $dt, $dur, $reversed ) = @_;
1608
1609 if ($reversed) {
1610 ( $dur, $dt ) = ( $dt, $dur );
1611 }
1612
1613 unless ( DateTime::Helpers::isa( $dur, 'DateTime::Duration' ) ) {
1614 my $class = ref $dt;
1615 my $dt_string = overload::StrVal($dt);
1616
1617 Carp::croak( "Cannot add $dur to a $class object ($dt_string).\n"
1618 . " Only a DateTime::Duration object can "
1619 . " be added to a $class object." );
1620 }
1621
1622 return $dt->clone->add_duration($dur);
1623}
1624
1625sub _subtract_overload {
1626 my ( $date1, $date2, $reversed ) = @_;
1627
1628 if ($reversed) {
1629 ( $date2, $date1 ) = ( $date1, $date2 );
1630 }
1631
1632 if ( DateTime::Helpers::isa( $date2, 'DateTime::Duration' ) ) {
1633 my $new = $date1->clone;
1634 $new->add_duration( $date2->inverse );
1635 return $new;
1636 }
1637 elsif ( DateTime::Helpers::isa( $date2, 'DateTime' ) ) {
1638 return $date1->subtract_datetime($date2);
1639 }
1640 else {
1641 my $class = ref $date1;
1642 my $dt_string = overload::StrVal($date1);
1643
1644 Carp::croak(
1645 "Cannot subtract $date2 from a $class object ($dt_string).\n"
1646 . " Only a DateTime::Duration or DateTime object can "
1647 . " be subtracted from a $class object." );
1648 }
1649}
1650
1651sub add {
1652 my $self = shift;
1653
1654 return $self->add_duration( $self->duration_class->new(@_) );
1655}
1656
1657sub subtract {
1658 my $self = shift;
1659
1660 return $self->subtract_duration( $self->duration_class->new(@_) );
1661}
1662
1663sub subtract_duration { return $_[0]->add_duration( $_[1]->inverse ) }
1664
1665{
166623µ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
1870sub _normalize_nanoseconds {
187131.40ms219µs
# spent 16µs (12+3) within DateTime::BEGIN@1871 which was called: # once (12µs+3µs) by MongoDB::GridFS::BEGIN@24 at line 1871
use integer;
# spent 16µs making 1 call to DateTime::BEGIN@1871 # spent 4µs making 1 call to integer::import
1872
1873 # seconds, nanoseconds
1874 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.
1888my $SetValidate = {
1889 map {
18901125µs my %copy = %{ $BasicValidate->{$_} };
1891103µs delete $copy{default};
1892104µs $copy{optional} = 1;
1893106µ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] ) }
1916sub set_locale { $_[0]->set( locale => $_[1] ) }
1917sub set_formatter { $_[0]->set( formatter => $_[1] ) }
1918
1919{
192022µs my %TruncateDefault = (
1921 month => 1,
1922 day => 1,
1923 hour => 0,
1924 minute => 0,
1925 second => 0,
1926 nanosecond => 0,
1927 );
1928 my $re = join '|', 'year', 'week',
192915µs grep { $_ ne 'nanosecond' } keys %TruncateDefault;
1930143µs231µs my $spec = { to => { regex => qr/^(?:$re)/ } };
# spent 29µs making 1 call to DateTime::CORE:regcomp # spent 2µs making 1 call to DateTime::CORE:qr
1931
1932 sub truncate {
1933 my $self = shift;
1934 my %p = validate( @_, $spec );
1935
1936 my %new;
1937 if ( $p{to} eq 'week' ) {
1938 my $day_diff = $self->day_of_week - 1;
1939
1940 if ($day_diff) {
1941 $self->add( days => -1 * $day_diff );
1942 }
1943
1944 return $self->truncate( to => 'day' );
1945 }
1946 else {
1947 my $truncate;
1948 foreach my $f (qw( year month day hour minute second nanosecond ))
1949 {
1950 $new{$f} = $truncate ? $TruncateDefault{$f} : $self->$f();
1951
1952 $truncate = 1 if $p{to} eq $f;
1953 }
1954 }
1955
1956 my $new_dt = $self->_new_from_self( %new, _skip_validation => 1 );
1957
1958 %$self = %$new_dt;
1959
1960 return $self;
1961 }
1962}
1963
1964sub set_time_zone {
1965 my ( $self, $tz ) = @_;
1966
1967 # This is a bit of a hack but it works because time zone objects
1968 # are singletons, and if it doesn't work all we lose is a little
1969 # bit of speed.
1970 return $self if $self->{tz} eq $tz;
1971
1972 my $was_floating = $self->{tz}->is_floating;
1973
1974 $self->{tz} = ref $tz ? $tz : DateTime::TimeZone->new( name => $tz );
1975
1976 $self->_handle_offset_modifier( $self->second, 1 );
1977
1978 # if it either was or now is floating (but not both)
1979 if ( $self->{tz}->is_floating xor $was_floating ) {
1980 $self->_calc_utc_rd;
1981 }
1982 elsif ( !$was_floating ) {
1983 $self->_calc_local_rd;
1984 }
1985
1986 return $self;
1987}
1988
1989sub STORABLE_freeze {
1990 my $self = shift;
1991 my $cloning = shift;
1992
1993 my $serialized = '';
1994 foreach my $key (
1995 qw( utc_rd_days
1996 utc_rd_secs
1997 rd_nanosecs )
1998 ) {
1999 $serialized .= "$key:$self->{$key}|";
2000 }
2001
2002 # not used yet, but may be handy in the future.
2003 $serialized .= "version:$DateTime::VERSION";
2004
2005 # Formatter needs to be returned as a reference since it may be
2006 # undef or a class name, and Storable will complain if extra
2007 # return values aren't refs
2008 return $serialized, $self->{locale}, $self->{tz}, \$self->{formatter};
2009}
2010
2011sub STORABLE_thaw {
2012 my $self = shift;
2013 my $cloning = shift;
2014 my $serialized = shift;
2015
2016 my %serialized = map { split /:/ } split /\|/, $serialized;
2017
2018 my ( $locale, $tz, $formatter );
2019
2020 # more recent code version
2021 if (@_) {
2022 ( $locale, $tz, $formatter ) = @_;
2023 }
2024 else {
2025 $tz = DateTime::TimeZone->new( name => delete $serialized{tz} );
2026
2027 $locale = DateTime::Locale->load(
2028 exists $serialized{language}
2029 ? delete $serialized{language}
2030 : delete $serialized{locale}
2031 );
2032 }
2033
2034 delete $serialized{version};
2035
2036 my $object = bless {
2037 utc_vals => [
2038 $serialized{utc_rd_days},
2039 $serialized{utc_rd_secs},
2040 $serialized{rd_nanosecs},
2041 ],
2042 tz => $tz,
2043 },
2044 'DateTime::_Thawed';
2045
2046 my %formatter = defined $$formatter ? ( formatter => $$formatter ) : ();
2047 my $new = ( ref $self )->from_object(
2048 object => $object,
2049 locale => $locale,
2050 %formatter,
2051 );
2052
2053 %$self = %$new;
2054
2055 return $self;
2056}
2057
2058package DateTime::_Thawed;
2059
# spent 6µs within DateTime::_Thawed::BEGIN@2059 which was called: # once (6µs+0s) by MongoDB::GridFS::BEGIN@24 at line 2061
BEGIN {
206016µs $DateTime::_Thawed::VERSION = '0.66';
20611579µs16µs}
# spent 6µs making 1 call to DateTime::_Thawed::BEGIN@2059
2062
2063sub utc_rd_values { @{ $_[0]->{utc_vals} } }
2064
2065sub time_zone { $_[0]->{tz} }
2066
20671113µs1;
2068
2069# ABSTRACT: A date and time object
2070
- -
2073=pod
2074
- -
4194__END__
 
# spent 86µs within DateTime::CORE:qr which was called 59 times, avg 1µs/call: # 57 times (77µs+0s) by MongoDB::GridFS::BEGIN@24 at line 1239, avg 1µs/call # once (7µs+0s) by MongoDB::GridFS::BEGIN@24 at line 473 # once (2µs+0s) by MongoDB::GridFS::BEGIN@24 at line 1930
sub DateTime::CORE:qr; # opcode
# spent 29µs within DateTime::CORE:regcomp which was called: # once (29µs+0s) by MongoDB::GridFS::BEGIN@24 at line 1930
sub DateTime::CORE:regcomp; # opcode
# spent 14µs within DateTime::_normalize_tai_seconds which was called 2 times, avg 7µs/call: # 2 times (14µs+0s) by DateTime::_calc_utc_rd at line 383, avg 7µs/call
sub DateTime::_normalize_tai_seconds; # xsub
Report produced by the NYTProf 4.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.