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

Filename/usr/share/perl5/DateTime/Format/Strptime.pm
StatementsExecuted 26 statements in 4.66ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11111µs21µsDateTime::Format::Strptime::::BEGIN@5DateTime::Format::Strptime::BEGIN@5
11111µs17µsDateTime::Format::Strptime::::BEGIN@9DateTime::Format::Strptime::BEGIN@9
11110µs54µsDateTime::Format::Strptime::::BEGIN@10DateTime::Format::Strptime::BEGIN@10
11110µs16µsDateTime::Format::Strptime::::BEGIN@8DateTime::Format::Strptime::BEGIN@8
11110µs18µsDateTime::Format::Strptime::::BEGIN@7DateTime::Format::Strptime::BEGIN@7
1118µs22µsDateTime::Format::Strptime::::BEGIN@13DateTime::Format::Strptime::BEGIN@13
1117µs32µsDateTime::Format::Strptime::::BEGIN@11DateTime::Format::Strptime::BEGIN@11
1116µs66µsDateTime::Format::Strptime::::BEGIN@14DateTime::Format::Strptime::BEGIN@14
0000s0sDateTime::Format::Strptime::::_build_parserDateTime::Format::Strptime::_build_parser
0000s0sDateTime::Format::Strptime::::errmsgDateTime::Format::Strptime::errmsg
0000s0sDateTime::Format::Strptime::::format_datetimeDateTime::Format::Strptime::format_datetime
0000s0sDateTime::Format::Strptime::::format_durationDateTime::Format::Strptime::format_duration
0000s0sDateTime::Format::Strptime::::local_carpDateTime::Format::Strptime::local_carp
0000s0sDateTime::Format::Strptime::::local_croakDateTime::Format::Strptime::local_croak
0000s0sDateTime::Format::Strptime::::localeDateTime::Format::Strptime::locale
0000s0sDateTime::Format::Strptime::::newDateTime::Format::Strptime::new
0000s0sDateTime::Format::Strptime::::parse_datetimeDateTime::Format::Strptime::parse_datetime
0000s0sDateTime::Format::Strptime::::parse_durationDateTime::Format::Strptime::parse_duration
0000s0sDateTime::Format::Strptime::::patternDateTime::Format::Strptime::pattern
0000s0sDateTime::Format::Strptime::::strftimeDateTime::Format::Strptime::strftime
0000s0sDateTime::Format::Strptime::::strptimeDateTime::Format::Strptime::strptime
0000s0sDateTime::Format::Strptime::::time_zoneDateTime::Format::Strptime::time_zone
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package DateTime::Format::Strptime;
2# git description: v1.54-8-g6aa82d9
31500ns$DateTime::Format::Strptime::VERSION = '1.56';
4
5224µs231µs
# spent 21µs (11+10) within DateTime::Format::Strptime::BEGIN@5 which was called: # once (11µs+10µs) by DateTime::Format::Builder::Parser::Strptime::BEGIN@10 at line 5
use strict;
# spent 21µs making 1 call to DateTime::Format::Strptime::BEGIN@5 # spent 10µs making 1 call to strict::import
6
7336µs226µs
# spent 18µs (10+8) within DateTime::Format::Strptime::BEGIN@7 which was called: # once (10µs+8µs) by DateTime::Format::Builder::Parser::Strptime::BEGIN@10 at line 7
use DateTime 1.00;
# spent 18µs making 1 call to DateTime::Format::Strptime::BEGIN@7 # spent 8µs making 1 call to version::_VERSION
8336µs223µs
# spent 16µs (10+7) within DateTime::Format::Strptime::BEGIN@8 which was called: # once (10µs+7µs) by DateTime::Format::Builder::Parser::Strptime::BEGIN@10 at line 8
use DateTime::Locale 0.45;
# spent 16µs making 1 call to DateTime::Format::Strptime::BEGIN@8 # spent 6µs making 1 call to version::_VERSION
9339µs223µs
# spent 17µs (11+6) within DateTime::Format::Strptime::BEGIN@9 which was called: # once (11µs+6µs) by DateTime::Format::Builder::Parser::Strptime::BEGIN@10 at line 9
use DateTime::TimeZone 0.79;
# spent 17µs making 1 call to DateTime::Format::Strptime::BEGIN@9 # spent 6µs making 1 call to version::_VERSION
10332µs398µs
# spent 54µs (10+44) within DateTime::Format::Strptime::BEGIN@10 which was called: # once (10µs+44µs) by DateTime::Format::Builder::Parser::Strptime::BEGIN@10 at line 10
use Params::Validate 0.64 qw( validate SCALAR SCALARREF BOOLEAN OBJECT CODEREF );
# spent 54µs making 1 call to DateTime::Format::Strptime::BEGIN@10 # spent 38µs making 1 call to Exporter::import # spent 6µs making 1 call to version::_VERSION
11221µs257µs
# spent 32µs (7+25) within DateTime::Format::Strptime::BEGIN@11 which was called: # once (7µs+25µs) by DateTime::Format::Builder::Parser::Strptime::BEGIN@10 at line 11
use Carp;
# spent 32µs making 1 call to DateTime::Format::Strptime::BEGIN@11 # spent 25µs making 1 call to Exporter::import
12
13224µs237µs
# spent 22µs (8+15) within DateTime::Format::Strptime::BEGIN@13 which was called: # once (8µs+15µs) by DateTime::Format::Builder::Parser::Strptime::BEGIN@10 at line 13
use Exporter;
# spent 22µs making 1 call to DateTime::Format::Strptime::BEGIN@13 # spent 15µs making 1 call to Exporter::import
1424.30ms2126µs
# spent 66µs (6+60) within DateTime::Format::Strptime::BEGIN@14 which was called: # once (6µs+60µs) by DateTime::Format::Builder::Parser::Strptime::BEGIN@10 at line 14
use vars qw( @ISA @EXPORT @EXPORT_OK %ZONEMAP %FORMATS $CROAK $errmsg);
# spent 66µs making 1 call to DateTime::Format::Strptime::BEGIN@14 # spent 60µs making 1 call to vars::import
15
1617µs@ISA = 'Exporter';
171400ns@EXPORT_OK = qw( &strftime &strptime );
181200ns@EXPORT = ();
19
201114µs%ZONEMAP = (
21 'A' => '+0100', 'ACDT' => '+1030', 'ACST' => '+0930',
22 'ADT' => 'Ambiguous', 'AEDT' => '+1100', 'AES' => '+1000',
23 'AEST' => '+1000', 'AFT' => '+0430', 'AHDT' => '-0900',
24 'AHST' => '-1000', 'AKDT' => '-0800', 'AKST' => '-0900',
25 'AMST' => '+0400', 'AMT' => '+0400', 'ANAST' => '+1300',
26 'ANAT' => '+1200', 'ART' => '-0300', 'AST' => 'Ambiguous',
27 'AT' => '-0100', 'AWST' => '+0800', 'AZOST' => '+0000',
28 'AZOT' => '-0100', 'AZST' => '+0500', 'AZT' => '+0400',
29 'B' => '+0200', 'BADT' => '+0400', 'BAT' => '+0600',
30 'BDST' => '+0200', 'BDT' => '+0600', 'BET' => '-1100',
31 'BNT' => '+0800', 'BORT' => '+0800', 'BOT' => '-0400',
32 'BRA' => '-0300', 'BST' => 'Ambiguous', 'BT' => 'Ambiguous',
33 'BTT' => '+0600', 'C' => '+0300', 'CAST' => '+0930',
34 'CAT' => 'Ambiguous', 'CCT' => 'Ambiguous', 'CDT' => 'Ambiguous',
35 'CEST' => '+0200', 'CET' => '+0100', 'CETDST' => '+0200',
36 'CHADT' => '+1345', 'CHAST' => '+1245', 'CKT' => '-1000',
37 'CLST' => '-0300', 'CLT' => '-0400', 'COT' => '-0500',
38 'CST' => 'Ambiguous', 'CSuT' => '+1030', 'CUT' => '+0000',
39 'CVT' => '-0100', 'CXT' => '+0700', 'ChST' => '+1000',
40 'D' => '+0400', 'DAVT' => '+0700', 'DDUT' => '+1000',
41 'DNT' => '+0100', 'DST' => '+0200', 'E' => '+0500',
42 'EASST' => '-0500', 'EAST' => 'Ambiguous', 'EAT' => '+0300',
43 'ECT' => 'Ambiguous', 'EDT' => 'Ambiguous', 'EEST' => '+0300',
44 'EET' => '+0200', 'EETDST' => '+0300', 'EGST' => '+0000',
45 'EGT' => '-0100', 'EMT' => '+0100', 'EST' => 'Ambiguous',
46 'ESuT' => '+1100', 'F' => '+0600', 'FDT' => 'Ambiguous',
47 'FJST' => '+1300', 'FJT' => '+1200', 'FKST' => '-0300',
48 'FKT' => '-0400', 'FST' => 'Ambiguous', 'FWT' => '+0100',
49 'G' => '+0700', 'GALT' => '-0600', 'GAMT' => '-0900',
50 'GEST' => '+0500', 'GET' => '+0400', 'GFT' => '-0300',
51 'GILT' => '+1200', 'GMT' => '+0000', 'GST' => 'Ambiguous',
52 'GT' => '+0000', 'GYT' => '-0400', 'GZ' => '+0000',
53 'H' => '+0800', 'HAA' => '-0300', 'HAC' => '-0500',
54 'HAE' => '-0400', 'HAP' => '-0700', 'HAR' => '-0600',
55 'HAT' => '-0230', 'HAY' => '-0800', 'HDT' => '-0930',
56 'HFE' => '+0200', 'HFH' => '+0100', 'HG' => '+0000',
57 'HKT' => '+0800', 'HL' => 'local', 'HNA' => '-0400',
58 'HNC' => '-0600', 'HNE' => '-0500', 'HNP' => '-0800',
59 'HNR' => '-0700', 'HNT' => '-0330', 'HNY' => '-0900',
60 'HOE' => '+0100', 'HST' => '-1000', 'I' => '+0900',
61 'ICT' => '+0700', 'IDLE' => '+1200', 'IDLW' => '-1200',
62 'IDT' => 'Ambiguous', 'IOT' => '+0500', 'IRDT' => '+0430',
63 'IRKST' => '+0900', 'IRKT' => '+0800', 'IRST' => '+0430',
64 'IRT' => '+0330', 'IST' => 'Ambiguous', 'IT' => '+0330',
65 'ITA' => '+0100', 'JAVT' => '+0700', 'JAYT' => '+0900',
66 'JST' => '+0900', 'JT' => '+0700', 'K' => '+1000',
67 'KDT' => '+1000', 'KGST' => '+0600', 'KGT' => '+0500',
68 'KOST' => '+1200', 'KRAST' => '+0800', 'KRAT' => '+0700',
69 'KST' => '+0900', 'L' => '+1100', 'LHDT' => '+1100',
70 'LHST' => '+1030', 'LIGT' => '+1000', 'LINT' => '+1400',
71 'LKT' => '+0600', 'LST' => 'local', 'LT' => 'local',
72 'M' => '+1200', 'MAGST' => '+1200', 'MAGT' => '+1100',
73 'MAL' => '+0800', 'MART' => '-0930', 'MAT' => '+0300',
74 'MAWT' => '+0600', 'MDT' => '-0600', 'MED' => '+0200',
75 'MEDST' => '+0200', 'MEST' => '+0200', 'MESZ' => '+0200',
76 'MET' => 'Ambiguous', 'MEWT' => '+0100', 'MEX' => '-0600',
77 'MEZ' => '+0100', 'MHT' => '+1200', 'MMT' => '+0630',
78 'MPT' => '+1000', 'MSD' => '+0400', 'MSK' => '+0300',
79 'MSKS' => '+0400', 'MST' => '-0700', 'MT' => '+0830',
80 'MUT' => '+0400', 'MVT' => '+0500', 'MYT' => '+0800',
81 'N' => '-0100', 'NCT' => '+1100', 'NDT' => '-0230',
82 'NFT' => 'Ambiguous', 'NOR' => '+0100', 'NOVST' => '+0700',
83 'NOVT' => '+0600', 'NPT' => '+0545', 'NRT' => '+1200',
84 'NST' => 'Ambiguous', 'NSUT' => '+0630', 'NT' => '-1100',
85 'NUT' => '-1100', 'NZDT' => '+1300', 'NZST' => '+1200',
86 'NZT' => '+1200', 'O' => '-0200', 'OESZ' => '+0300',
87 'OEZ' => '+0200', 'OMSST' => '+0700', 'OMST' => '+0600',
88 'OZ' => 'local', 'P' => '-0300', 'PDT' => '-0700',
89 'PET' => '-0500', 'PETST' => '+1300', 'PETT' => '+1200',
90 'PGT' => '+1000', 'PHOT' => '+1300', 'PHT' => '+0800',
91 'PKT' => '+0500', 'PMDT' => '-0200', 'PMT' => '-0300',
92 'PNT' => '-0830', 'PONT' => '+1100', 'PST' => 'Ambiguous',
93 'PWT' => '+0900', 'PYST' => '-0300', 'PYT' => '-0400',
94 'Q' => '-0400', 'R' => '-0500', 'R1T' => '+0200',
95 'R2T' => '+0300', 'RET' => '+0400', 'ROK' => '+0900',
96 'S' => '-0600', 'SADT' => '+1030', 'SAST' => 'Ambiguous',
97 'SBT' => '+1100', 'SCT' => '+0400', 'SET' => '+0100',
98 'SGT' => '+0800', 'SRT' => '-0300', 'SST' => 'Ambiguous',
99 'SWT' => '+0100', 'T' => '-0700', 'TFT' => '+0500',
100 'THA' => '+0700', 'THAT' => '-1000', 'TJT' => '+0500',
101 'TKT' => '-1000', 'TMT' => '+0500', 'TOT' => '+1300',
102 'TRUT' => '+1000', 'TST' => '+0300', 'TUC ' => '+0000',
103 'TVT' => '+1200', 'U' => '-0800', 'ULAST' => '+0900',
104 'ULAT' => '+0800', 'USZ1' => '+0200', 'USZ1S' => '+0300',
105 'USZ3' => '+0400', 'USZ3S' => '+0500', 'USZ4' => '+0500',
106 'USZ4S' => '+0600', 'USZ5' => '+0600', 'USZ5S' => '+0700',
107 'USZ6' => '+0700', 'USZ6S' => '+0800', 'USZ7' => '+0800',
108 'USZ7S' => '+0900', 'USZ8' => '+0900', 'USZ8S' => '+1000',
109 'USZ9' => '+1000', 'USZ9S' => '+1100', 'UTZ' => '-0300',
110 'UYT' => '-0300', 'UZ10' => '+1100', 'UZ10S' => '+1200',
111 'UZ11' => '+1200', 'UZ11S' => '+1300', 'UZ12' => '+1200',
112 'UZ12S' => '+1300', 'UZT' => '+0500', 'V' => '-0900',
113 'VET' => '-0400', 'VLAST' => '+1100', 'VLAT' => '+1000',
114 'VTZ' => '-0200', 'VUT' => '+1100', 'W' => '-1000',
115 'WAKT' => '+1200', 'WAST' => 'Ambiguous', 'WAT' => '+0100',
116 'WEST' => '+0100', 'WESZ' => '+0100', 'WET' => '+0000',
117 'WETDST' => '+0100', 'WEZ' => '+0000', 'WFT' => '+1200',
118 'WGST' => '-0200', 'WGT' => '-0300', 'WIB' => '+0700',
119 'WIT' => '+0900', 'WITA' => '+0800', 'WST' => 'Ambiguous',
120 'WTZ' => '-0100', 'WUT' => '+0100', 'X' => '-1100',
121 'Y' => '-1200', 'YAKST' => '+1000', 'YAKT' => '+0900',
122 'YAPT' => '+1000', 'YDT' => '-0800', 'YEKST' => '+0600',
123 'YEKT' => '+0500', 'YST' => '-0900', 'Z' => '+0000',
124 'UTC' => '+0000',
125);
126
127sub new {
128 my $class = shift;
129 my %args = validate(
130 @_, {
131 pattern => { type => SCALAR | SCALARREF },
132 time_zone => { type => SCALAR | OBJECT, optional => 1 },
133 locale => { type => SCALAR | OBJECT, default => 'English' },
134 on_error => { type => SCALAR | CODEREF, default => 'undef' },
135 diagnostic => { type => SCALAR, default => 0 },
136 }
137 );
138
139 croak(
140 "The value supplied to on_error must be either 'croak', 'undef' or a code reference."
141 )
142 unless ref( $args{on_error} ) eq 'CODE'
143 or $args{on_error} eq 'croak'
144 or $args{on_error} eq 'undef';
145
146 # Deal with locale
147 unless ( ref( $args{locale} ) ) {
148 my $locale = DateTime::Locale->load( $args{locale} );
149
150 croak("Could not create locale from $args{locale}") unless $locale;
151
152 $args{_locale} = $locale;
153 }
154 else {
155 $args{_locale} = $args{locale};
156 ( $args{locale} ) = ref( $args{_locale} ) =~ /::(\w+)[^:]+$/;
157 }
158
159 if ( $args{time_zone} ) {
160 unless ( ref( $args{time_zone} ) ) {
161 $args{time_zone}
162 = DateTime::TimeZone->new( name => $args{time_zone} );
163
164 croak("Could not create time zone from $args{time_zone}")
165 unless $args{time_zone};
166 }
167 $args{set_time_zone} = $args{time_zone};
168 }
169 else {
170 $args{time_zone} = DateTime::TimeZone->new( name => 'floating' );
171 $args{set_time_zone} = '';
172 }
173
174 my $self = bless \%args, $class;
175
176 # Deal with the parser
177 $self->{parser} = $self->_build_parser( $args{pattern} );
178 if ( $self->{parser} =~ /(%\{\w+\}|%\w)/ and $args{pattern} !~ /\%$1/ ) {
179 croak("Unidentified token in pattern: $1 in $self->{pattern}");
180 }
181
182 return $self;
183}
184
185sub pattern {
186 my $self = shift;
187 my $pattern = shift;
188
189 if ($pattern) {
190 my $possible_parser = $self->_build_parser($pattern);
191 if ( $possible_parser =~ /(%\{\w+\}|%\w)/ and $pattern !~ /\%$1/ ) {
192 $self->local_carp(
193 "Unidentified token in pattern: $1 in $pattern. Leaving old pattern intact."
194 ) and return undef;
195 }
196 else {
197 $self->{parser} = $possible_parser;
198 $self->{pattern} = $pattern;
199 }
200 }
201 return $self->{pattern};
202}
203
204sub locale {
205 my $self = shift;
206 my $locale = shift;
207
208 if ($locale) {
209 my $possible_locale = DateTime::Locale->load($locale);
210 unless ($possible_locale) {
211 $self->local_carp(
212 "Could not create locale from $locale. Leaving old locale intact."
213 ) and return undef;
214 }
215 else {
216 $self->{locale} = $locale;
217 $self->{_locale} = $possible_locale;
218
219 # When the locale changes we need to rebuild the parser
220 $self->{parser} = $self->_build_parser( $self->{pattern} );
221 }
222 }
223 return $self->{locale};
224}
225
226sub time_zone {
227 my $self = shift;
228 my $time_zone = shift;
229
230 if ($time_zone) {
231 my $possible_time_zone
232 = DateTime::TimeZone->new( name => $time_zone );
233 unless ($possible_time_zone) {
234 $self->local_carp(
235 "Could not create time zone from $time_zone. Leaving old time zone intact."
236 ) and return undef;
237 }
238 else {
239 $self->{time_zone} = $possible_time_zone;
240 $self->{set_time_zone} = $self->{time_zone};
241 }
242 }
243 return $self->{time_zone}->name;
244}
245
246sub parse_datetime {
247 my ( $self, $time_string ) = @_;
248
249 local $^W = undef;
250
251 # Variables from the parser
252 my (
253 $dow_name, $month_name, $century, $day,
254 $hour_24, $hour_12, $doy, $month,
255 $minute, $ampm, $second, $week_sun_0,
256 $dow_sun_0, $dow_mon_1, $week_mon_1, $year_100,
257 $year, $iso_week_year_100, $iso_week_year,
258 $epoch, $tz_offset, $timezone, $tz_olson,
259 $nanosecond, $ce_year,
260
261 $doy_dt, $epoch_dt, $use_timezone, $set_time_zone,
262 );
263
264 # Variables for DateTime
265 my (
266 $Year, $Month, $Day,
267 $Hour, $Minute, $Second, $Nanosecond,
268 $Am, $Pm
269 ) = ();
270
271 # Run the parser
272 my $parser = $self->{parser};
273 eval($parser);
274 die $@ if $@;
275
276 if ( $self->{diagnostic} ) {
277 print qq|
278
279Entered = $time_string
280Parser = $parser
281
282dow_name = $dow_name
283month_name = $month_name
284century = $century
285day = $day
286hour_24 = $hour_24
287hour_12 = $hour_12
288doy = $doy
289month = $month
290minute = $minute
291ampm = $ampm
292second = $second
293nanosecond = $nanosecond
294week_sun_0 = $week_sun_0
295dow_sun_0 = $dow_sun_0
296dow_mon_1 = $dow_mon_1
297week_mon_1 = $week_mon_1
298year_100 = $year_100
299year = $year
300ce_year = $ce_year
301tz_offset = $tz_offset
302tz_olson = $tz_olson
303timezone = $timezone
304epoch = $epoch
305iso_week_year = $iso_week_year
306iso_week_year_100 = $iso_week_year_100
307
308 |;
309
310 }
311
312 $self->local_croak("Your datetime does not match your pattern.")
313 and return undef
314 if ( ( $self->{parser} =~ /\$dow_name\b/ and $dow_name eq '' )
315 or ( $self->{parser} =~ /\$month_name\b/ and $month_name eq '' )
316 or ( $self->{parser} =~ /\$century\b/ and $century eq '' )
317 or ( $self->{parser} =~ /\$day\b/ and $day eq '' )
318 or ( $self->{parser} =~ /\$hour_24\b/ and $hour_24 eq '' )
319 or ( $self->{parser} =~ /\$hour_12\b/ and $hour_12 eq '' )
320 or ( $self->{parser} =~ /\$doy\b/ and $doy eq '' )
321 or ( $self->{parser} =~ /\$month\b/ and $month eq '' )
322 or ( $self->{parser} =~ /\$minute\b/ and $minute eq '' )
323 or ( $self->{parser} =~ /\$ampm\b/ and $ampm eq '' )
324 or ( $self->{parser} =~ /\$second\b/ and $second eq '' )
325 or ( $self->{parser} =~ /\$nanosecond\b/ and $nanosecond eq '' )
326 or ( $self->{parser} =~ /\$week_sun_0\b/ and $week_sun_0 eq '' )
327 or ( $self->{parser} =~ /\$dow_sun_0\b/ and $dow_sun_0 eq '' )
328 or ( $self->{parser} =~ /\$dow_mon_1\b/ and $dow_mon_1 eq '' )
329 or ( $self->{parser} =~ /\$week_mon_1\b/ and $week_mon_1 eq '' )
330 or ( $self->{parser} =~ /\$year_100\b/ and $year_100 eq '' )
331 or ( $self->{parser} =~ /\$year\b/ and $year eq '' )
332 or ( $self->{parser} =~ /\$ce_year\b/ and $ce_year eq '' )
333 or ( $self->{parser} =~ /\$tz_offset\b/ and $tz_offset eq '' )
334 or ( $self->{parser} =~ /\$tz_olson\b/ and $tz_olson eq '' )
335 or ( $self->{parser} =~ /\$timezone\b/ and $timezone eq '' )
336 or ( $self->{parser} =~ /\$epoch\b/ and $epoch eq '' ) );
337
338 # Create a timezone to work with
339 if ($tz_offset) {
340 $use_timezone = $tz_offset;
341 }
342
343 if ($timezone) {
344 $self->local_croak("I don't recognise the timezone $timezone.")
345 and return undef
346 unless $ZONEMAP{$timezone};
347 $self->local_croak("The timezone '$timezone' is ambiguous.")
348 and return undef
349 if $ZONEMAP{$timezone} eq 'Ambiguous'
350 and not( $tz_offset or $tz_olson );
351 $self->local_croak(
352 "Your timezones ('$tz_offset' and '$timezone') do not match.")
353 and return undef
354 if $tz_offset
355 and $ZONEMAP{$timezone} ne 'Ambiguous'
356 and $ZONEMAP{$timezone} != $tz_offset;
357 $use_timezone = $ZONEMAP{$timezone}
358 if $ZONEMAP{$timezone} ne 'Ambiguous';
359 }
360
361 if ($tz_olson) {
362 my $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) };
363 if ( not $tz ) {
364 print
365 "Provided olson TZ didn't work ($tz_olson). Attempting to normalize it.\n"
366 if $self->{diagnostic};
367 $tz_olson = ucfirst lc $tz_olson;
368 $tz_olson =~ s|([/_])(\w)|$1\U$2|g;
369 print " Trying $tz_olson.\n" if $self->{diagnostic};
370 $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) };
371 }
372 $self->local_croak("I don't recognise the time zone '$tz_olson'.")
373 and return undef
374 unless $tz;
375 $use_timezone = $set_time_zone = $tz;
376
377 }
378
379 $use_timezone = $self->{time_zone} unless ($use_timezone);
380
381 print "Using timezone $use_timezone.\n" if $self->{diagnostic};
382
383 # If there's an epoch, we're done. Just need to check all the others
384 if ($epoch) {
385 $epoch_dt = DateTime->from_epoch(
386 epoch => $epoch,
387 time_zone => $use_timezone
388 );
389
390 $Year = $epoch_dt->year;
391 $Month = $epoch_dt->month;
392 $Day = $epoch_dt->day;
393
394 $Hour = $epoch_dt->hour;
395 $Minute = $epoch_dt->minute;
396 $Second = $epoch_dt->second;
397 $Nanosecond = $epoch_dt->nanosecond;
398
399 print $epoch_dt->strftime("Epoch: %D %T.%N\n") if $self->{diagnostic};
400 }
401
402 # Work out the year we're working with:
403 if ($year_100) {
404 if ($century) {
405 $Year = ( ( $century * 100 ) - 0 ) + $year_100;
406 }
407 else {
408 print "No century, guessing for $year_100" if $self->{diagnostic};
409 if ( $year_100 >= 69 and $year_100 <= 99 ) {
410 print "Guessed 1900s" if $self->{diagnostic};
411 $Year = 1900 + $year_100;
412 }
413 else {
414 print "Guessed 2000s" if $self->{diagnostic};
415 $Year = 2000 + $year_100;
416 }
417 }
418 }
419 if ($year) {
420 $self->local_croak(
421 "Your two year values ($year_100 and $year) do not match.")
422 and return undef
423 if ( $Year && ( $year != $Year ) );
424 $Year = $year;
425 }
426 if ($ce_year) {
427 $self->local_croak(
428 "Your two year values ($ce_year and $year) do not match.")
429 and return undef
430 if ( $Year && ( $ce_year != $Year ) );
431 $Year = $ce_year;
432 }
433 $self->local_croak("Your year value does not match your epoch.")
434 and return undef
435 if $epoch_dt
436 and $Year
437 and $Year != $epoch_dt->year;
438
439 # Work out which month we want
440 # Month names
441 if ($month_name) {
442 $self->local_croak(
443 "There is no use providing a month name ($month_name) without providing a year."
444 )
445 and return undef
446 unless $Year;
447 my $month_count = 0;
448 my $month_number = 0;
449 foreach my $month ( @{ $self->{_locale}->month_format_wide } ) {
450 $month_count++;
451
452 if ( lc $month eq lc $month_name ) {
453 $month_number = $month_count;
454 last;
455 }
456 }
457 unless ($month_number) {
458 my $month_count = 0;
459 foreach
460 my $month ( @{ $self->{_locale}->month_format_abbreviated } )
461 {
462 $month_count++;
463
464 # When abbreviating, sometimes there's a period, sometimes not.
465 $month =~ s/\.$//;
466 $month_name =~ s/\.$//;
467 if ( lc $month eq lc $month_name ) {
468 $month_number = $month_count;
469 last;
470 }
471 }
472 }
473 unless ($month_number) {
474 $self->local_croak(
475 "$month_name is not a recognised month in this locale.")
476 and return undef;
477 }
478 $Month = $month_number;
479 }
480 if ($month) {
481 $self->local_croak(
482 "There is no use providing a month without providing a year.")
483 and return undef
484 unless $Year;
485 $self->local_croak("$month is too large to be a month of the year.")
486 and return undef
487 unless $month <= 12;
488 $self->local_croak(
489 "Your two month values ($month_name and $month) do not match.")
490 and return undef
491 if $Month
492 and $month != $Month;
493 $Month = $month;
494 }
495 $self->local_croak("Your month value does not match your epoch.")
496 and return undef
497 if $epoch_dt
498 and $Month
499 and $Month != $epoch_dt->month;
500 if ($doy) {
501 $self->local_croak(
502 "There is no use providing a day of the year without providing a year."
503 )
504 and return undef
505 unless $Year;
506 $doy_dt = eval {
507 DateTime->from_day_of_year(
508 year => $Year, day_of_year => $doy,
509 time_zone => $use_timezone
510 );
511 };
512 $self->local_croak("Day of year $Year-$doy is not valid")
513 and return undef
514 if $@;
515
516 my $month = $doy_dt->month;
517 $self->local_croak( "Your day of the year ($doy - in "
518 . $doy_dt->month_name
519 . ") is not in your month ($Month)" )
520 and return undef
521 if $Month
522 and $month != $Month;
523 $Month = $month;
524 }
525 $self->local_croak("Your day of the year does not match your epoch.")
526 and return undef
527 if $epoch_dt
528 and $doy_dt
529 and $doy_dt->doy != $epoch_dt->doy;
530
531 # Day of the month
532 $self->local_croak("$day is too large to be a day of the month.")
533 and return undef
534 unless $day <= 31;
535 $self->local_croak(
536 "Your day of the month ($day) does not match your day of the year.")
537 and return undef
538 if $doy_dt
539 and $day
540 and $day != $doy_dt->day;
541 $Day ||=
542 ($day) ? $day
543 : ($doy_dt) ? $doy_dt->day
544 : '';
545 if ($Day) {
546 $self->local_croak(
547 "There is no use providing a day without providing a month and year."
548 )
549 and return undef
550 unless $Year
551 and $Month;
552 my $dt = eval {
553 DateTime->new(
554 year => $Year + 0, month => $Month + 0, day => $Day + 0,
555 hour => 12, time_zone => $use_timezone
556 );
557 };
558 $self->local_croak("Datetime $Year-$Month-$Day is not a valid date")
559 and return undef
560 if $@;
561 $self->local_croak("There is no day $Day in $dt->month_name, $Year")
562 and return undef
563 unless $dt->month == $Month;
564 }
565 $self->local_croak("Your day of the month does not match your epoch.")
566 and return undef
567 if $epoch_dt
568 and $Day
569 and $Day != $epoch_dt->day;
570
571 # Hour of the day
572 $self->local_croak("$hour_24 is too large to be an hour of the day.")
573 and return undef
574 unless $hour_24 <= 23; #OK so leap seconds will break!
575 $self->local_croak("$hour_12 is too large to be an hour of the day.")
576 and return undef
577 unless $hour_12 <= 12;
578 $self->local_croak(
579 "You must specify am or pm for 12 hour clocks ($hour_12|$ampm).")
580 and return undef
581 if ( $hour_12 && ( !$ampm ) );
582 ( $Am, $Pm ) = @{ $self->{_locale}->am_pm_abbreviated };
583 if ( lc $ampm eq lc $Pm ) {
584 if ($hour_12) {
585 $hour_12 += 12 if $hour_12 and $hour_12 != 12;
586 }
587 $self->local_croak(
588 "Your am/pm value ($ampm) does not match your hour ($hour_24)")
589 and return undef
590 if $hour_24
591 and $hour_24 < 12;
592 }
593 elsif ( lc $ampm eq lc $Am ) {
594 if ($hour_12) {
595 $hour_12 = 0 if $hour_12 == 12;
596 }
597 $self->local_croak(
598 "Your am/pm value ($ampm) does not match your hour ($hour_24)")
599 and return undef
600 if $hour_24 >= 12;
601 }
602 if ( $hour_12 and $hour_24 ) {
603 $self->local_croak(
604 "You have specified mis-matching 12 and 24 hour clock information"
605 )
606 and return undef
607 unless $hour_12 == $hour_24;
608 $Hour = $hour_24;
609 }
610 elsif ($hour_12) {
611 $Hour = $hour_12;
612 }
613 elsif ($hour_24) {
614 $Hour = $hour_24;
615 }
616 $self->local_croak("Your hour does not match your epoch.")
617 and return undef
618 if $epoch_dt
619 and $Hour
620 and $Hour != $epoch_dt->hour;
621 print "Set hour to $Hour.\n" if $self->{diagnostic};
622
623 # Minutes
624 $self->local_croak("$minute is too large to be a minute.")
625 and return undef
626 unless $minute <= 59;
627 $Minute ||= $minute;
628 $self->local_croak("Your minute does not match your epoch.")
629 and return undef
630 if $epoch_dt
631 and $Minute
632 and $Minute != $epoch_dt->minute;
633 print "Set minute to $Minute.\n" if $self->{diagnostic};
634
635 # Seconds
636 $self->local_croak("$second is too large to be a second.")
637 and return undef
638 unless $second <= 59; #OK so leap seconds will break!
639 $Second ||= $second;
640 $self->local_croak("Your second does not match your epoch.")
641 and return undef
642 if $epoch_dt
643 and $Second
644 and $Second != $epoch_dt->second;
645 print "Set second to $Second.\n" if $self->{diagnostic};
646
647 # Nanoeconds
648 $self->local_croak("$nanosecond is too large to be a nanosecond.")
649 and return undef
650 unless length($nanosecond) <= 9;
651 $Nanosecond ||= $nanosecond;
652 $Nanosecond .= '0' while length($Nanosecond) < 9;
653
654 # Epoch doesn't return nanoseconds
655 # croak "Your nanosecond does not match your epoch." if $epoch_dt and $Nanosecond and $Nanosecond != $epoch_dt->nanosecond;
656 print "Set nanosecond to $Nanosecond.\n" if $self->{diagnostic};
657
658 my $potential_return = eval {
659 DateTime->new(
660 year => ( $Year || 1 ) + 0,
661 month => ( $Month || 1 ) + 0,
662 day => ( $Day || 1 ) + 0,
663
664 hour => ( $Hour || 0 ) + 0,
665 minute => ( $Minute || 0 ) + 0,
666 second => ( $Second || 0 ) + 0,
667 nanosecond => ( $Nanosecond || 0 ) + 0,
668
669 locale => $self->{_locale},
670 time_zone => $use_timezone,
671 );
672 };
673 $self->local_croak("Datetime is not a valid date") and return undef if $@;
674
675 $self->local_croak(
676 "Your day of the week ($dow_mon_1) does not match the date supplied: "
677 . $potential_return->ymd )
678 and return undef
679 if $dow_mon_1
680 and $potential_return->dow != $dow_mon_1;
681
682 $self->local_croak(
683 "Your day of the week ($dow_sun_0) does not match the date supplied: "
684 . $potential_return->ymd )
685 and return undef
686 if $dow_sun_0
687 and ( $potential_return->dow % 7 ) != $dow_sun_0;
688
689 if ($dow_name) {
690 my $dow_count = 0;
691 my $dow_number = 0;
692 foreach my $dow ( @{ $self->{_locale}->day_format_wide } ) {
693 $dow_count++;
694 if ( lc $dow eq lc $dow_name ) {
695 $dow_number = $dow_count;
696 last;
697 }
698 }
699 unless ($dow_number) {
700 my $dow_count = 0;
701 foreach my $dow ( @{ $self->{_locale}->day_format_abbreviated } )
702 {
703 $dow_count++;
704 if ( lc $dow eq lc $dow_name ) {
705 $dow_number = $dow_count;
706 last;
707 }
708 }
709 }
710 unless ($dow_number) {
711 $self->local_croak(
712 "$dow_name is not a recognised day in this locale.")
713 and return undef;
714 }
715 $self->local_croak(
716 "Your day of the week ($dow_name) does not match the date supplied: "
717 . $potential_return->ymd )
718 and return undef
719 if $dow_number
720 and $potential_return->dow != $dow_number;
721 }
722
723 $self->local_croak(
724 "Your week number ($week_sun_0) does not match the date supplied: "
725 . $potential_return->ymd )
726 and return undef
727 if $week_sun_0
728 and $potential_return->strftime('%U') != $week_sun_0;
729 $self->local_croak(
730 "Your week number ($week_mon_1) does not match the date supplied: "
731 . $potential_return->ymd )
732 and return undef
733 if $week_mon_1
734 and $potential_return->strftime('%W') != $week_mon_1;
735 $self->local_croak(
736 "Your ISO week year ($iso_week_year) does not match the date supplied: "
737 . $potential_return->ymd )
738 and return undef
739 if $iso_week_year
740 and $potential_return->strftime('%G') != $iso_week_year;
741 $self->local_croak(
742 "Your ISO week year ($iso_week_year_100) does not match the date supplied: "
743 . $potential_return->ymd )
744 and return undef
745 if $iso_week_year_100
746 and $potential_return->strftime('%g') != $iso_week_year_100;
747
748 # Move into the timezone in the object - if there is one
749 print "Potential Datetime: "
750 . $potential_return->strftime("%F %T %z %Z") . "\n"
751 if $self->{diagnostic};
752 print "Setting timezone: " . $self->{set_time_zone} . "\n"
753 if $self->{diagnostic};
754 if ( $self->{set_time_zone} ) {
755 $potential_return->set_time_zone( $self->{set_time_zone} );
756 }
757 elsif ($set_time_zone) {
758 $potential_return->set_time_zone($set_time_zone);
759 }
760 print "Actual Datetime: "
761 . $potential_return->strftime("%F %T %z %Z") . "\n"
762 if $self->{diagnostic};
763
764 return $potential_return;
765}
766
767sub parse_duration {
768 croak "DateTime::Format::Strptime doesn't do durations.";
769}
770
771sub format_datetime {
772 my ( $self, $dt ) = @_;
773 my $pattern = $self->pattern;
774 $pattern =~ s/%O/$dt->time_zone->name/eg;
775 return $dt->clone->set_locale( $self->locale )->strftime($pattern);
776}
777
778sub format_duration {
779 croak "DateTime::Format::Strptime doesn't do durations.";
780}
781
782sub _build_parser {
783 my $self = shift;
784 my $regex = my $field_list = shift;
785 if ( ref $regex eq 'Regexp' ) {
786 $field_list =~ s/^\(\?-xism:(.+)\)$/$1/;
787 }
788 my @fields = $field_list =~ m/(%\{\w+\}|%\d*.)/g;
789 $field_list = join( '', @fields );
790
791 # Locale-ize the parser
792 my $ampm_list = join( '|', @{ $self->{_locale}->am_pm_abbreviated } );
793 $ampm_list .= '|' . lc $ampm_list;
794
795 my $default_date_format = $self->{_locale}->glibc_date_format;
796 my @locale_format = $default_date_format =~ m/(%\{\w+\}|%\d*.)/g;
797 $default_date_format = join( '', @locale_format );
798
799 my $default_time_format = $self->{_locale}->glibc_time_format;
800 @locale_format = $default_time_format =~ m/(%\{\w+\}|%\d*.)/g;
801 $default_time_format = join( '', @locale_format );
802
803 my $default_datetime_format = $self->{_locale}->glibc_datetime_format;
804 @locale_format = $default_datetime_format =~ m/(%\{\w+\}|%\d*.)/g;
805 $default_datetime_format = join( '', @locale_format );
806
807 print
808 "Date format: $default_date_format\nTime format: $default_time_format\nDatetime format: $default_datetime_format\n"
809 if $self->{diagnostic};
810
811 $regex =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g;
812 $field_list =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g;
813
814 $regex =~ s/%c/$self->{_locale}->glibc_datetime_format/eg;
815 $field_list =~ s/%c/$default_datetime_format/eg;
816
817 # %c is the locale's default datetime format.
818
819 $regex =~ s/%x/$self->{_locale}->glibc_date_format/eg;
820 $field_list =~ s/%x/$default_date_format/eg;
821
822 # %x is the locale's default date format.
823
824 $regex =~ s/%X/$self->{_locale}->glibc_time_format/eg;
825 $field_list =~ s/%X/$default_time_format/eg;
826
827 # %x is the locale's default time format.
828
829 if ( ref $regex ne 'Regexp' ) {
830 $regex = quotemeta($regex);
831 $regex =~ s/(?<!\\)\\%/%/g;
832 $regex =~ s/%\\\{([^\}]+)\\\}/%{$1}/g;
833 }
834
835 $regex =~ s/%T/%H:%M:%S/g;
836 $field_list =~ s/%T/%H%M%S/g;
837
838 # %T is the time as %H:%M:%S.
839
840 $regex =~ s/%r/%I:%M:%S %p/g;
841 $field_list =~ s/%r/%I%M%S%p/g;
842
843 #is the time as %I:%M:%S %p.
844
845 $regex =~ s/%R/%H:%M/g;
846 $field_list =~ s/%R/%H%M/g;
847
848 #is the time as %H:%M.
849
850 $regex =~ s|%D|%m\\/%d\\/%y|g;
851 $field_list =~ s|%D|%m%d%y|g;
852
853 #is the same as %m/%d/%y.
854
855 $regex =~ s|%F|%Y\\-%m\\-%d|g;
856 $field_list =~ s|%F|%Y%m%d|g;
857
858 #is the same as %Y-%m-%d - the ISO date format.
859
860 my $day_re = join(
861 '|',
862 map { quotemeta $_ }
863 sort { length $b <=> length $a }
864 grep( /\W/, @{ $self->{_locale}->day_format_wide },
865 @{ $self->{_locale}->day_format_abbreviated } )
866 );
867 $day_re .= '|' if $day_re;
868 $regex =~ s/%a/($day_re\\w+)/gi;
869 $field_list =~ s/%a/#dow_name#/gi;
870
871 # %a is the day of the week, using the locale's weekday names; either the abbreviated or full name may be specified.
872 # %A is the same as %a.
873
874 my $month_re = join(
875 '|',
876 map { quotemeta $_ }
877 sort { length $b <=> length $a }
878 grep( /\s|\d/, @{ $self->{_locale}->month_format_wide },
879 @{ $self->{_locale}->month_format_abbreviated } )
880 );
881 $month_re .= '|' if $month_re;
882 $month_re .= '[^\\s\\d]+';
883 $regex =~ s/%[bBh]/($month_re)/g;
884 $field_list =~ s/%[bBh]/#month_name#/g;
885
886 #is the month, using the locale's month names; either the abbreviated or full name may be specified.
887 # %B is the same as %b.
888 # %h is the same as %b.
889
890 #s/%c//g;
891 #is replaced by the locale's appropriate date and time representation.
892
893 $regex =~ s/%C/([\\d ]?\\d)/g;
894 $field_list =~ s/%C/#century#/g;
895
896 #is the century number [0,99]; leading zeros are permitted by not required.
897
898 $regex =~ s/%[de]/([\\d ]?\\d)/g;
899 $field_list =~ s/%[de]/#day#/g;
900
901 #is the day of the month [1,31]; leading zeros are permitted but not required.
902 #%e is the same as %d.
903
904 $regex =~ s/%[Hk]/([\\d ]?\\d)/g;
905 $field_list =~ s/%[Hk]/#hour_24#/g;
906
907 #is the hour (24-hour clock) [0,23]; leading zeros are permitted but not required.
908 # %k is the same as %H
909
910 $regex =~ s/%g/([\\d ]?\\d)/g;
911 $field_list =~ s/%g/#iso_week_year_100#/g;
912
913 # The year corresponding to the ISO week number, but without the century (0-99).
914
915 $regex =~ s/%G/(\\d{4})/g;
916 $field_list =~ s/%G/#iso_week_year#/g;
917
918 # The year corresponding to the ISO week number.
919
920 $regex =~ s/%[Il]/([\\d ]?\\d)/g;
921 $field_list =~ s/%[Il]/#hour_12#/g;
922
923 #is the hour (12-hour clock) [1-12]; leading zeros are permitted but not required.
924 # %l is the same as %I.
925
926 $regex =~ s/%j/(\\d{1,3})/g;
927 $field_list =~ s/%j/#doy#/g;
928
929 #is the day of the year [1,366]; leading zeros are permitted but not required.
930
931 $regex =~ s/%m/([\\d ]?\\d)/g;
932 $field_list =~ s/%m/#month#/g;
933
934 #is the month number [1-12]; leading zeros are permitted but not required.
935
936 $regex =~ s/%M/([\\d ]?\\d)/g;
937 $field_list =~ s/%M/#minute#/g;
938
939 #is the minute [0-59]; leading zeros are permitted but not required.
940
941 $regex =~ s/%[nt]/\\s+/g;
942 $field_list =~ s/%[nt]//g;
943
944 # %n is any white space.
945 # %t is any white space.
946
947 $regex =~ s/%p/($ampm_list)/gi;
948 $field_list =~ s/%p/#ampm#/gi;
949
950 # %p is the locale's equivalent of either A.M./P.M. indicator for 12-hour clock.
951
952 $regex =~ s/%s/(\\d+)/g;
953 $field_list =~ s/%s/#epoch#/g;
954
955 # %s is the seconds since the epoch
956
957 $regex =~ s/%S/([\\d ]?\\d)/g;
958 $field_list =~ s/%S/#second#/g;
959
960 # %S is the seconds [0-61]; leading zeros are permitted but not required.
961
962 $regex =~ s/%(\d*)N/($1) ? "(\\d{$1})" : "(\\d+)"/eg;
963 $field_list =~ s/%\d*N/#nanosecond#/g;
964
965 # %N is the nanoseconds (or sub seconds really)
966
967 $regex =~ s/%U/([\\d ]?\\d)/g;
968 $field_list =~ s/%U/#week_sun_0#/g;
969
970 # %U is the week number of the year (Sunday as the first day of the week) as a decimal number [0-53]; leading zeros are permitted but not required.
971
972 $regex =~ s/%w/([0-6])/g;
973 $field_list =~ s/%w/#dow_sun_0#/g;
974
975 # is the weekday as a decimal number [0-6], with 0 representing Sunday.
976
977 $regex =~ s/%u/([1-7])/g;
978 $field_list =~ s/%u/#dow_mon_1#/g;
979
980 # is the weekday as a decimal number [1-7], with 1 representing Monday - a la DateTime.
981
982 $regex =~ s/%W/([\\d ]?\\d)/g;
983 $field_list =~ s/%W/#week_mon_1#/g;
984
985 #is the week number of the year (Monday as the first day of the week) as a decimal number [0,53]; leading zeros are permitted but not required.
986
987 $regex =~ s/%y/([\\d ]?\\d)/g;
988 $field_list =~ s/%y/#year_100#/g;
989
990 # is the year within the century. When a century is not otherwise specified, values in the range 69-99 refer to years in the twentieth century (1969 to 1999 inclusive); values in the range 0-68 refer to years in the twenty-first century (2000-2068 inclusive). Leading zeros are permitted but not required.
991
992 $regex =~ s/%Y/(\\d{4})/g;
993 $field_list =~ s/%Y/#year#/g;
994
995 # is the year including the century (for example, 1998).
996
997 $regex =~ s|%z|([+-]\\d{4})|g;
998 $field_list =~ s/%z/#tz_offset#/g;
999
1000 # Timezone Offset.
1001
1002 $regex =~ s|%Z|(\\w+)|g;
1003 $field_list =~ s/%Z/#timezone#/g;
1004
1005 # The short timezone name.
1006
1007 $regex =~ s|%O|(\\w+\\/\\w+)|g;
1008 $field_list =~ s/%O/#tz_olson#/g;
1009
1010 # The Olson timezone name.
1011
1012 $regex =~ s|%\{(\w+)\}|(DateTime->can($1)) ? "(.+)" : ".+"|eg;
1013 $field_list =~ s|(%\{(\w+)\})|(DateTime->can($2)) ? "#$2#" : $1 |eg;
1014
1015 # Any function in DateTime.
1016
1017 $regex =~ s/__ESCAPED_PERCENT_SIGN_MARKER__/\\%/g;
1018 $field_list =~ s/__ESCAPED_PERCENT_SIGN_MARKER__//g;
1019
1020 # is replaced by %.
1021 #print $regex;
1022
1023 $field_list =~ s/#([a-z0-9_]+)#/\$$1, /gi;
1024 $field_list =~ s/,\s*$//;
1025
1026 return qq|($field_list) = \$time_string =~ /$regex/|;
1027}
1028
1029# Utility functions
1030
1031sub local_croak {
1032 my $self = $_[0];
1033 return &{ $self->{on_error} }(@_) if ref( $self->{on_error} );
1034 croak( $_[1] ) if $self->{on_error} eq 'croak';
1035 $self->{errmsg} = $_[1];
1036 return ( $self->{on_error} eq 'undef' );
1037}
1038
1039sub local_carp {
1040 my $self = $_[0];
1041 return &{ $self->{on_error} }(@_) if ref( $self->{on_error} );
1042 carp( $_[1] ) if $self->{on_error} eq 'croak';
1043 $self->{errmsg} = $_[1];
1044 return ( $self->{on_error} eq 'undef' );
1045}
1046
1047sub errmsg {
1048 $_[0]->{errmsg};
1049}
1050
1051# Exportable functions:
1052
1053sub strftime {
1054 my ( $pattern, $dt ) = @_;
1055 return $dt->strftime($pattern);
1056}
1057
1058sub strptime {
1059 my ( $pattern, $time_string ) = @_;
1060 return DateTime::Format::Strptime->new(
1061 pattern => $pattern,
1062 on_error => 'croak'
1063 )->parse_datetime($time_string);
1064}
1065
1066127µs1;
1067
1068# ABSTRACT: Parse and format strp and strf time patterns
1069
1070__END__
Report produced by the NYTProf 5.06 Perl profiler, developed by Tim Bunce and Adam Kaplan.