1package DateTime::Format::Strptime;
2{
3  $DateTime::Format::Strptime::VERSION = '1.54';
4}
5
6use strict;
7
8use DateTime 1.00;
9use DateTime::Locale 0.45;
10use DateTime::TimeZone 0.79;
11use Params::Validate 0.64 qw( validate SCALAR SCALARREF BOOLEAN OBJECT CODEREF );
12use Carp;
13
14use Exporter;
15use vars qw( @ISA @EXPORT @EXPORT_OK %ZONEMAP %FORMATS $CROAK $errmsg);
16
17@ISA       = 'Exporter';
18@EXPORT_OK = qw( &strftime &strptime );
19@EXPORT    = ();
20
21%ZONEMAP = (
22    'A'      => '+0100',     'ACDT'   => '+1030',     'ACST'   => '+0930',
23    'ADT'    => 'Ambiguous', 'AEDT'   => '+1100',     'AES'    => '+1000',
24    'AEST'   => '+1000',     'AFT'    => '+0430',     'AHDT'   => '-0900',
25    'AHST'   => '-1000',     'AKDT'   => '-0800',     'AKST'   => '-0900',
26    'AMST'   => '+0400',     'AMT'    => '+0400',     'ANAST'  => '+1300',
27    'ANAT'   => '+1200',     'ART'    => '-0300',     'AST'    => 'Ambiguous',
28    'AT'     => '-0100',     'AWST'   => '+0800',     'AZOST'  => '+0000',
29    'AZOT'   => '-0100',     'AZST'   => '+0500',     'AZT'    => '+0400',
30    'B'      => '+0200',     'BADT'   => '+0400',     'BAT'    => '+0600',
31    'BDST'   => '+0200',     'BDT'    => '+0600',     'BET'    => '-1100',
32    'BNT'    => '+0800',     'BORT'   => '+0800',     'BOT'    => '-0400',
33    'BRA'    => '-0300',     'BST'    => 'Ambiguous', 'BT'     => 'Ambiguous',
34    'BTT'    => '+0600',     'C'      => '+0300',     'CAST'   => '+0930',
35    'CAT'    => 'Ambiguous', 'CCT'    => 'Ambiguous', 'CDT'    => 'Ambiguous',
36    'CEST'   => '+0200',     'CET'    => '+0100',     'CETDST' => '+0200',
37    'CHADT'  => '+1345',     'CHAST'  => '+1245',     'CKT'    => '-1000',
38    'CLST'   => '-0300',     'CLT'    => '-0400',     'COT'    => '-0500',
39    'CST'    => 'Ambiguous', 'CSuT'   => '+1030',     'CUT'    => '+0000',
40    'CVT'    => '-0100',     'CXT'    => '+0700',     'ChST'   => '+1000',
41    'D'      => '+0400',     'DAVT'   => '+0700',     'DDUT'   => '+1000',
42    'DNT'    => '+0100',     'DST'    => '+0200',     'E'      => '+0500',
43    'EASST'  => '-0500',     'EAST'   => 'Ambiguous', 'EAT'    => '+0300',
44    'ECT'    => 'Ambiguous', 'EDT'    => 'Ambiguous', 'EEST'   => '+0300',
45    'EET'    => '+0200',     'EETDST' => '+0300',     'EGST'   => '+0000',
46    'EGT'    => '-0100',     'EMT'    => '+0100',     'EST'    => 'Ambiguous',
47    'ESuT'   => '+1100',     'F'      => '+0600',     'FDT'    => 'Ambiguous',
48    'FJST'   => '+1300',     'FJT'    => '+1200',     'FKST'   => '-0300',
49    'FKT'    => '-0400',     'FST'    => 'Ambiguous', 'FWT'    => '+0100',
50    'G'      => '+0700',     'GALT'   => '-0600',     'GAMT'   => '-0900',
51    'GEST'   => '+0500',     'GET'    => '+0400',     'GFT'    => '-0300',
52    'GILT'   => '+1200',     'GMT'    => '+0000',     'GST'    => 'Ambiguous',
53    'GT'     => '+0000',     'GYT'    => '-0400',     'GZ'     => '+0000',
54    'H'      => '+0800',     'HAA'    => '-0300',     'HAC'    => '-0500',
55    'HAE'    => '-0400',     'HAP'    => '-0700',     'HAR'    => '-0600',
56    'HAT'    => '-0230',     'HAY'    => '-0800',     'HDT'    => '-0930',
57    'HFE'    => '+0200',     'HFH'    => '+0100',     'HG'     => '+0000',
58    'HKT'    => '+0800',     'HL'     => 'local',     'HNA'    => '-0400',
59    'HNC'    => '-0600',     'HNE'    => '-0500',     'HNP'    => '-0800',
60    'HNR'    => '-0700',     'HNT'    => '-0330',     'HNY'    => '-0900',
61    'HOE'    => '+0100',     'HST'    => '-1000',     'I'      => '+0900',
62    'ICT'    => '+0700',     'IDLE'   => '+1200',     'IDLW'   => '-1200',
63    'IDT'    => 'Ambiguous', 'IOT'    => '+0500',     'IRDT'   => '+0430',
64    'IRKST'  => '+0900',     'IRKT'   => '+0800',     'IRST'   => '+0430',
65    'IRT'    => '+0330',     'IST'    => 'Ambiguous', 'IT'     => '+0330',
66    'ITA'    => '+0100',     'JAVT'   => '+0700',     'JAYT'   => '+0900',
67    'JST'    => '+0900',     'JT'     => '+0700',     'K'      => '+1000',
68    'KDT'    => '+1000',     'KGST'   => '+0600',     'KGT'    => '+0500',
69    'KOST'   => '+1200',     'KRAST'  => '+0800',     'KRAT'   => '+0700',
70    'KST'    => '+0900',     'L'      => '+1100',     'LHDT'   => '+1100',
71    'LHST'   => '+1030',     'LIGT'   => '+1000',     'LINT'   => '+1400',
72    'LKT'    => '+0600',     'LST'    => 'local',     'LT'     => 'local',
73    'M'      => '+1200',     'MAGST'  => '+1200',     'MAGT'   => '+1100',
74    'MAL'    => '+0800',     'MART'   => '-0930',     'MAT'    => '+0300',
75    'MAWT'   => '+0600',     'MDT'    => '-0600',     'MED'    => '+0200',
76    'MEDST'  => '+0200',     'MEST'   => '+0200',     'MESZ'   => '+0200',
77    'MET'    => 'Ambiguous', 'MEWT'   => '+0100',     'MEX'    => '-0600',
78    'MEZ'    => '+0100',     'MHT'    => '+1200',     'MMT'    => '+0630',
79    'MPT'    => '+1000',     'MSD'    => '+0400',     'MSK'    => '+0300',
80    'MSKS'   => '+0400',     'MST'    => '-0700',     'MT'     => '+0830',
81    'MUT'    => '+0400',     'MVT'    => '+0500',     'MYT'    => '+0800',
82    'N'      => '-0100',     'NCT'    => '+1100',     'NDT'    => '-0230',
83    'NFT'    => 'Ambiguous', 'NOR'    => '+0100',     'NOVST'  => '+0700',
84    'NOVT'   => '+0600',     'NPT'    => '+0545',     'NRT'    => '+1200',
85    'NST'    => 'Ambiguous', 'NSUT'   => '+0630',     'NT'     => '-1100',
86    'NUT'    => '-1100',     'NZDT'   => '+1300',     'NZST'   => '+1200',
87    'NZT'    => '+1200',     'O'      => '-0200',     'OESZ'   => '+0300',
88    'OEZ'    => '+0200',     'OMSST'  => '+0700',     'OMST'   => '+0600',
89    'OZ'     => 'local',     'P'      => '-0300',     'PDT'    => '-0700',
90    'PET'    => '-0500',     'PETST'  => '+1300',     'PETT'   => '+1200',
91    'PGT'    => '+1000',     'PHOT'   => '+1300',     'PHT'    => '+0800',
92    'PKT'    => '+0500',     'PMDT'   => '-0200',     'PMT'    => '-0300',
93    'PNT'    => '-0830',     'PONT'   => '+1100',     'PST'    => 'Ambiguous',
94    'PWT'    => '+0900',     'PYST'   => '-0300',     'PYT'    => '-0400',
95    'Q'      => '-0400',     'R'      => '-0500',     'R1T'    => '+0200',
96    'R2T'    => '+0300',     'RET'    => '+0400',     'ROK'    => '+0900',
97    'S'      => '-0600',     'SADT'   => '+1030',     'SAST'   => 'Ambiguous',
98    'SBT'    => '+1100',     'SCT'    => '+0400',     'SET'    => '+0100',
99    'SGT'    => '+0800',     'SRT'    => '-0300',     'SST'    => 'Ambiguous',
100    'SWT'    => '+0100',     'T'      => '-0700',     'TFT'    => '+0500',
101    'THA'    => '+0700',     'THAT'   => '-1000',     'TJT'    => '+0500',
102    'TKT'    => '-1000',     'TMT'    => '+0500',     'TOT'    => '+1300',
103    'TRUT'   => '+1000',     'TST'    => '+0300',     'TUC '   => '+0000',
104    'TVT'    => '+1200',     'U'      => '-0800',     'ULAST'  => '+0900',
105    'ULAT'   => '+0800',     'USZ1'   => '+0200',     'USZ1S'  => '+0300',
106    'USZ3'   => '+0400',     'USZ3S'  => '+0500',     'USZ4'   => '+0500',
107    'USZ4S'  => '+0600',     'USZ5'   => '+0600',     'USZ5S'  => '+0700',
108    'USZ6'   => '+0700',     'USZ6S'  => '+0800',     'USZ7'   => '+0800',
109    'USZ7S'  => '+0900',     'USZ8'   => '+0900',     'USZ8S'  => '+1000',
110    'USZ9'   => '+1000',     'USZ9S'  => '+1100',     'UTZ'    => '-0300',
111    'UYT'    => '-0300',     'UZ10'   => '+1100',     'UZ10S'  => '+1200',
112    'UZ11'   => '+1200',     'UZ11S'  => '+1300',     'UZ12'   => '+1200',
113    'UZ12S'  => '+1300',     'UZT'    => '+0500',     'V'      => '-0900',
114    'VET'    => '-0400',     'VLAST'  => '+1100',     'VLAT'   => '+1000',
115    'VTZ'    => '-0200',     'VUT'    => '+1100',     'W'      => '-1000',
116    'WAKT'   => '+1200',     'WAST'   => 'Ambiguous', 'WAT'    => '+0100',
117    'WEST'   => '+0100',     'WESZ'   => '+0100',     'WET'    => '+0000',
118    'WETDST' => '+0100',     'WEZ'    => '+0000',     'WFT'    => '+1200',
119    'WGST'   => '-0200',     'WGT'    => '-0300',     'WIB'    => '+0700',
120    'WIT'    => '+0900',     'WITA'   => '+0800',     'WST'    => 'Ambiguous',
121    'WTZ'    => '-0100',     'WUT'    => '+0100',     'X'      => '-1100',
122    'Y'      => '-1200',     'YAKST'  => '+1000',     'YAKT'   => '+0900',
123    'YAPT'   => '+1000',     'YDT'    => '-0800',     'YEKST'  => '+0600',
124    'YEKT'   => '+0500',     'YST'    => '-0900',     'Z'      => '+0000',
125    'UTC'    => '+0000',
126);
127
128sub new {
129    my $class = shift;
130    my %args  = validate(
131        @_, {
132            pattern    => { type => SCALAR | SCALARREF },
133            time_zone  => { type => SCALAR | OBJECT, optional => 1 },
134            locale     => { type => SCALAR | OBJECT, default => 'English' },
135            on_error   => { type => SCALAR | CODEREF, default => 'undef' },
136            diagnostic => { type => SCALAR, default => 0 },
137        }
138    );
139
140    croak(
141        "The value supplied to on_error must be either 'croak', 'undef' or a code reference."
142        )
143        unless ref( $args{on_error} ) eq 'CODE'
144            or $args{on_error} eq 'croak'
145            or $args{on_error} eq 'undef';
146
147    # Deal with locale
148    unless ( ref( $args{locale} ) ) {
149        my $locale = DateTime::Locale->load( $args{locale} );
150
151        croak("Could not create locale from $args{locale}") unless $locale;
152
153        $args{_locale} = $locale;
154    }
155    else {
156        $args{_locale} = $args{locale};
157        ( $args{locale} ) = ref( $args{_locale} ) =~ /::(\w+)[^:]+$/;
158    }
159
160    if ( $args{time_zone} ) {
161        unless ( ref( $args{time_zone} ) ) {
162            $args{time_zone}
163                = DateTime::TimeZone->new( name => $args{time_zone} );
164
165            croak("Could not create time zone from $args{time_zone}")
166                unless $args{time_zone};
167        }
168        $args{set_time_zone} = $args{time_zone};
169    }
170    else {
171        $args{time_zone} = DateTime::TimeZone->new( name => 'floating' );
172        $args{set_time_zone} = '';
173    }
174
175    my $self = bless \%args, $class;
176
177    # Deal with the parser
178    $self->{parser} = $self->_build_parser( $args{pattern} );
179    if ( $self->{parser} =~ /(%\{\w+\}|%\w)/ and $args{pattern} !~ /\%$1/ ) {
180        croak("Unidentified token in pattern: $1 in $self->{pattern}");
181    }
182
183    return $self;
184}
185
186sub pattern {
187    my $self    = shift;
188    my $pattern = shift;
189
190    if ($pattern) {
191        my $possible_parser = $self->_build_parser($pattern);
192        if ( $possible_parser =~ /(%\{\w+\}|%\w)/ and $pattern !~ /\%$1/ ) {
193            $self->local_carp(
194                "Unidentified token in pattern: $1 in $pattern. Leaving old pattern intact."
195            ) and return undef;
196        }
197        else {
198            $self->{parser}  = $possible_parser;
199            $self->{pattern} = $pattern;
200        }
201    }
202    return $self->{pattern};
203}
204
205sub locale {
206    my $self   = shift;
207    my $locale = shift;
208
209    if ($locale) {
210        my $possible_locale = DateTime::Locale->load($locale);
211        unless ($possible_locale) {
212            $self->local_carp(
213                "Could not create locale from $locale. Leaving old locale intact."
214            ) and return undef;
215        }
216        else {
217            $self->{locale}  = $locale;
218            $self->{_locale} = $possible_locale;
219
220            # When the locale changes we need to rebuild the parser
221            $self->{parser} = $self->_build_parser( $self->{pattern} );
222        }
223    }
224    return $self->{locale};
225}
226
227sub time_zone {
228    my $self      = shift;
229    my $time_zone = shift;
230
231    if ($time_zone) {
232        my $possible_time_zone
233            = DateTime::TimeZone->new( name => $time_zone );
234        unless ($possible_time_zone) {
235            $self->local_carp(
236                "Could not create time zone from $time_zone. Leaving old time zone intact."
237            ) and return undef;
238        }
239        else {
240            $self->{time_zone}     = $possible_time_zone;
241            $self->{set_time_zone} = $self->{time_zone};
242        }
243    }
244    return $self->{time_zone}->name;
245}
246
247sub parse_datetime {
248    my ( $self, $time_string ) = @_;
249
250    local $^W = undef;
251
252    # Variables from the parser
253    my (
254        $dow_name,   $month_name,        $century,    $day,
255        $hour_24,    $hour_12,           $doy,        $month,
256        $minute,     $ampm,              $second,     $week_sun_0,
257        $dow_sun_0,  $dow_mon_1,         $week_mon_1, $year_100,
258        $year,       $iso_week_year_100, $iso_week_year,
259        $epoch,      $tz_offset,         $timezone,   $tz_olson,
260        $nanosecond, $ce_year,
261
262        $doy_dt, $epoch_dt, $use_timezone, $set_time_zone,
263    );
264
265    # Variables for DateTime
266    my (
267        $Year, $Month, $Day,
268        $Hour, $Minute, $Second, $Nanosecond,
269        $Am,   $Pm
270    ) = ();
271
272    # Run the parser
273    my $parser = $self->{parser};
274    eval($parser);
275    die $@ if $@;
276
277    if ( $self->{diagnostic} ) {
278        print qq|
279
280Entered     = $time_string
281Parser		= $parser
282
283dow_name    = $dow_name
284month_name  = $month_name
285century     = $century
286day         = $day
287hour_24     = $hour_24
288hour_12     = $hour_12
289doy         = $doy
290month       = $month
291minute      = $minute
292ampm        = $ampm
293second      = $second
294nanosecond  = $nanosecond
295week_sun_0  = $week_sun_0
296dow_sun_0   = $dow_sun_0
297dow_mon_1   = $dow_mon_1
298week_mon_1  = $week_mon_1
299year_100    = $year_100
300year        = $year
301ce_year     = $ce_year
302tz_offset   = $tz_offset
303tz_olson    = $tz_olson
304timezone    = $timezone
305epoch       = $epoch
306iso_week_year     = $iso_week_year
307iso_week_year_100 = $iso_week_year_100
308
309		|;
310
311    }
312
313    $self->local_croak("Your datetime does not match your pattern.")
314        and return undef
315        if ( ( $self->{parser} =~ /\$dow_name\b/ and $dow_name eq '' )
316        or ( $self->{parser} =~ /\$month_name\b/ and $month_name eq '' )
317        or ( $self->{parser} =~ /\$century\b/    and $century    eq '' )
318        or ( $self->{parser} =~ /\$day\b/        and $day        eq '' )
319        or ( $self->{parser} =~ /\$hour_24\b/    and $hour_24    eq '' )
320        or ( $self->{parser} =~ /\$hour_12\b/    and $hour_12    eq '' )
321        or ( $self->{parser} =~ /\$doy\b/        and $doy        eq '' )
322        or ( $self->{parser} =~ /\$month\b/      and $month      eq '' )
323        or ( $self->{parser} =~ /\$minute\b/     and $minute     eq '' )
324        or ( $self->{parser} =~ /\$ampm\b/       and $ampm       eq '' )
325        or ( $self->{parser} =~ /\$second\b/     and $second     eq '' )
326        or ( $self->{parser} =~ /\$nanosecond\b/ and $nanosecond eq '' )
327        or ( $self->{parser} =~ /\$week_sun_0\b/ and $week_sun_0 eq '' )
328        or ( $self->{parser} =~ /\$dow_sun_0\b/  and $dow_sun_0  eq '' )
329        or ( $self->{parser} =~ /\$dow_mon_1\b/  and $dow_mon_1  eq '' )
330        or ( $self->{parser} =~ /\$week_mon_1\b/ and $week_mon_1 eq '' )
331        or ( $self->{parser} =~ /\$year_100\b/   and $year_100   eq '' )
332        or ( $self->{parser} =~ /\$year\b/       and $year       eq '' )
333        or ( $self->{parser} =~ /\$ce_year\b/    and $ce_year    eq '' )
334        or ( $self->{parser} =~ /\$tz_offset\b/  and $tz_offset  eq '' )
335        or ( $self->{parser} =~ /\$tz_olson\b/   and $tz_olson   eq '' )
336        or ( $self->{parser} =~ /\$timezone\b/   and $timezone   eq '' )
337        or ( $self->{parser} =~ /\$epoch\b/      and $epoch      eq '' ) );
338
339    # Create a timezone to work with
340    if ($tz_offset) {
341        $use_timezone = $tz_offset;
342    }
343
344    if ($timezone) {
345        $self->local_croak("I don't recognise the timezone $timezone.")
346            and return undef
347            unless $ZONEMAP{$timezone};
348        $self->local_croak("The timezone '$timezone' is ambiguous.")
349            and return undef
350            if $ZONEMAP{$timezone} eq 'Ambiguous'
351                and not( $tz_offset or $tz_olson );
352        $self->local_croak(
353            "Your timezones ('$tz_offset' and '$timezone') do not match.")
354            and return undef
355            if $tz_offset
356                and $ZONEMAP{$timezone} ne 'Ambiguous'
357                and $ZONEMAP{$timezone} != $tz_offset;
358        $use_timezone = $ZONEMAP{$timezone}
359            if $ZONEMAP{$timezone} ne 'Ambiguous';
360    }
361
362    if ($tz_olson) {
363        my $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) };
364        if ( not $tz ) {
365            print
366                "Provided olson TZ didn't work ($tz_olson). Attempting to normalize it.\n"
367                if $self->{diagnostic};
368            $tz_olson = ucfirst lc $tz_olson;
369            $tz_olson =~ s|([/_])(\w)|$1\U$2|g;
370            print "   Trying $tz_olson.\n" if $self->{diagnostic};
371            $tz = eval { DateTime::TimeZone->new( name => $tz_olson ) };
372        }
373        $self->local_croak("I don't recognise the time zone '$tz_olson'.")
374            and return undef
375            unless $tz;
376        $use_timezone = $set_time_zone = $tz;
377
378    }
379
380    $use_timezone = $self->{time_zone} unless ($use_timezone);
381
382    print "Using timezone $use_timezone.\n" if $self->{diagnostic};
383
384    # If there's an epoch, we're done. Just need to check all the others
385    if ($epoch) {
386        $epoch_dt = DateTime->from_epoch(
387            epoch     => $epoch,
388            time_zone => $use_timezone
389        );
390
391        $Year  = $epoch_dt->year;
392        $Month = $epoch_dt->month;
393        $Day   = $epoch_dt->day;
394
395        $Hour       = $epoch_dt->hour;
396        $Minute     = $epoch_dt->minute;
397        $Second     = $epoch_dt->second;
398        $Nanosecond = $epoch_dt->nanosecond;
399
400        print $epoch_dt->strftime("Epoch: %D %T.%N\n") if $self->{diagnostic};
401    }
402
403    # Work out the year we're working with:
404    if ($year_100) {
405        if ($century) {
406            $Year = ( ( $century * 100 ) - 0 ) + $year_100;
407        }
408        else {
409            print "No century, guessing for $year_100" if $self->{diagnostic};
410            if ( $year_100 >= 69 and $year_100 <= 99 ) {
411                print "Guessed 1900s" if $self->{diagnostic};
412                $Year = 1900 + $year_100;
413            }
414            else {
415                print "Guessed 2000s" if $self->{diagnostic};
416                $Year = 2000 + $year_100;
417            }
418        }
419    }
420    if ($year) {
421        $self->local_croak(
422            "Your two year values ($year_100 and $year) do not match.")
423            and return undef
424            if ( $Year && ( $year != $Year ) );
425        $Year = $year;
426    }
427    if ($ce_year) {
428        $self->local_croak(
429            "Your two year values ($ce_year and $year) do not match.")
430            and return undef
431            if ( $Year && ( $ce_year != $Year ) );
432        $Year = $ce_year;
433    }
434    $self->local_croak("Your year value does not match your epoch.")
435        and return undef
436        if $epoch_dt
437            and $Year
438            and $Year != $epoch_dt->year;
439
440    # Work out which month we want
441    # Month names
442    if ($month_name) {
443        $self->local_croak(
444            "There is no use providing a month name ($month_name) without providing a year."
445            )
446            and return undef
447            unless $Year;
448        my $month_count  = 0;
449        my $month_number = 0;
450        foreach my $month ( @{ $self->{_locale}->month_format_wide } ) {
451            $month_count++;
452
453            if ( lc $month eq lc $month_name ) {
454                $month_number = $month_count;
455                last;
456            }
457        }
458        unless ($month_number) {
459            my $month_count = 0;
460            foreach
461                my $month ( @{ $self->{_locale}->month_format_abbreviated } )
462            {
463                $month_count++;
464
465                # When abbreviating, sometimes there's a period, sometimes not.
466                $month      =~ s/\.$//;
467                $month_name =~ s/\.$//;
468                if ( lc $month eq lc $month_name ) {
469                    $month_number = $month_count;
470                    last;
471                }
472            }
473        }
474        unless ($month_number) {
475            $self->local_croak(
476                "$month_name is not a recognised month in this locale.")
477                and return undef;
478        }
479        $Month = $month_number;
480    }
481    if ($month) {
482        $self->local_croak(
483            "There is no use providing a month without providing a year.")
484            and return undef
485            unless $Year;
486        $self->local_croak("$month is too large to be a month of the year.")
487            and return undef
488            unless $month <= 12;
489        $self->local_croak(
490            "Your two month values ($month_name and $month) do not match.")
491            and return undef
492            if $Month
493                and $month != $Month;
494        $Month = $month;
495    }
496    $self->local_croak("Your month value does not match your epoch.")
497        and return undef
498        if $epoch_dt
499            and $Month
500            and $Month != $epoch_dt->month;
501    if ($doy) {
502        $self->local_croak(
503            "There is no use providing a day of the year without providing a year."
504            )
505            and return undef
506            unless $Year;
507        $doy_dt = eval {
508            DateTime->from_day_of_year(
509                year      => $Year, day_of_year => $doy,
510                time_zone => $use_timezone
511            );
512        };
513        $self->local_croak("Day of year $Year-$doy is not valid")
514            and return undef
515            if $@;
516
517        my $month = $doy_dt->month;
518        $self->local_croak( "Your day of the year ($doy - in "
519                . $doy_dt->month_name
520                . ") is not in your month ($Month)" )
521            and return undef
522            if $Month
523                and $month != $Month;
524        $Month = $month;
525    }
526    $self->local_croak("Your day of the year does not match your epoch.")
527        and return undef
528        if $epoch_dt
529            and $doy_dt
530            and $doy_dt->doy != $epoch_dt->doy;
531
532    # Day of the month
533    $self->local_croak("$day is too large to be a day of the month.")
534        and return undef
535        unless $day <= 31;
536    $self->local_croak(
537        "Your day of the month ($day) does not match your day of the year.")
538        and return undef
539        if $doy_dt
540            and $day
541            and $day != $doy_dt->day;
542    $Day ||=
543          ($day)    ? $day
544        : ($doy_dt) ? $doy_dt->day
545        :             '';
546    if ($Day) {
547        $self->local_croak(
548            "There is no use providing a day without providing a month and year."
549            )
550            and return undef
551            unless $Year
552                and $Month;
553        my $dt = eval {
554            DateTime->new(
555                year => $Year + 0, month     => $Month + 0, day => $Day + 0,
556                hour => 12,        time_zone => $use_timezone
557            );
558        };
559        $self->local_croak("Datetime $Year-$Month-$Day is not a valid date")
560            and return undef
561            if $@;
562        $self->local_croak("There is no day $Day in $dt->month_name, $Year")
563            and return undef
564            unless $dt->month == $Month;
565    }
566    $self->local_croak("Your day of the month does not match your epoch.")
567        and return undef
568        if $epoch_dt
569            and $Day
570            and $Day != $epoch_dt->day;
571
572    # Hour of the day
573    $self->local_croak("$hour_24 is too large to be an hour of the day.")
574        and return undef
575        unless $hour_24 <= 23;    #OK so leap seconds will break!
576    $self->local_croak("$hour_12 is too large to be an hour of the day.")
577        and return undef
578        unless $hour_12 <= 12;
579    $self->local_croak(
580        "You must specify am or pm for 12 hour clocks ($hour_12|$ampm).")
581        and return undef
582        if ( $hour_12 && ( !$ampm ) );
583    ( $Am, $Pm ) = @{ $self->{_locale}->am_pm_abbreviated };
584    if ( lc $ampm eq lc $Pm ) {
585        if ($hour_12) {
586            $hour_12 += 12 if $hour_12 and $hour_12 != 12;
587        }
588        $self->local_croak(
589            "Your am/pm value ($ampm) does not match your hour ($hour_24)")
590            and return undef
591            if $hour_24
592                and $hour_24 < 12;
593    }
594    elsif ( lc $ampm eq lc $Am ) {
595        if ($hour_12) {
596            $hour_12 = 0 if $hour_12 == 12;
597        }
598        $self->local_croak(
599            "Your am/pm value ($ampm) does not match your hour ($hour_24)")
600            and return undef
601            if $hour_24 >= 12;
602    }
603    if ( $hour_12 and $hour_24 ) {
604        $self->local_croak(
605            "You have specified mis-matching 12 and 24 hour clock information"
606            )
607            and return undef
608            unless $hour_12 == $hour_24;
609        $Hour = $hour_24;
610    }
611    elsif ($hour_12) {
612        $Hour = $hour_12;
613    }
614    elsif ($hour_24) {
615        $Hour = $hour_24;
616    }
617    $self->local_croak("Your hour does not match your epoch.")
618        and return undef
619        if $epoch_dt
620            and $Hour
621            and $Hour != $epoch_dt->hour;
622    print "Set hour to $Hour.\n" if $self->{diagnostic};
623
624    # Minutes
625    $self->local_croak("$minute is too large to be a minute.")
626        and return undef
627        unless $minute <= 59;
628    $Minute ||= $minute;
629    $self->local_croak("Your minute does not match your epoch.")
630        and return undef
631        if $epoch_dt
632            and $Minute
633            and $Minute != $epoch_dt->minute;
634    print "Set minute to $Minute.\n" if $self->{diagnostic};
635
636    # Seconds
637    $self->local_croak("$second is too large to be a second.")
638        and return undef
639        unless $second <= 59;    #OK so leap seconds will break!
640    $Second ||= $second;
641    $self->local_croak("Your second does not match your epoch.")
642        and return undef
643        if $epoch_dt
644            and $Second
645            and $Second != $epoch_dt->second;
646    print "Set second to $Second.\n" if $self->{diagnostic};
647
648    # Nanoeconds
649    $self->local_croak("$nanosecond is too large to be a nanosecond.")
650        and return undef
651        unless length($nanosecond) <= 9;
652    $Nanosecond ||= $nanosecond;
653    $Nanosecond .= '0' while length($Nanosecond) < 9;
654
655    #	Epoch doesn't return nanoseconds
656    #	croak "Your nanosecond does not match your epoch." if $epoch_dt and $Nanosecond and $Nanosecond != $epoch_dt->nanosecond;
657    print "Set nanosecond to $Nanosecond.\n" if $self->{diagnostic};
658
659    my $potential_return = eval {
660        DateTime->new(
661            year  => ( $Year  || 1 ) + 0,
662            month => ( $Month || 1 ) + 0,
663            day   => ( $Day   || 1 ) + 0,
664
665            hour       => ( $Hour       || 0 ) + 0,
666            minute     => ( $Minute     || 0 ) + 0,
667            second     => ( $Second     || 0 ) + 0,
668            nanosecond => ( $Nanosecond || 0 ) + 0,
669
670            locale    => $self->{_locale},
671            time_zone => $use_timezone,
672        );
673    };
674    $self->local_croak("Datetime is not a valid date") and return undef if $@;
675
676    $self->local_croak(
677        "Your day of the week ($dow_mon_1) does not match the date supplied: "
678            . $potential_return->ymd )
679        and return undef
680        if $dow_mon_1
681            and $potential_return->dow != $dow_mon_1;
682
683    $self->local_croak(
684        "Your day of the week ($dow_sun_0) does not match the date supplied: "
685            . $potential_return->ymd )
686        and return undef
687        if $dow_sun_0
688            and ( $potential_return->dow % 7 ) != $dow_sun_0;
689
690    if ($dow_name) {
691        my $dow_count  = 0;
692        my $dow_number = 0;
693        foreach my $dow ( @{ $self->{_locale}->day_format_wide } ) {
694            $dow_count++;
695            if ( lc $dow eq lc $dow_name ) {
696                $dow_number = $dow_count;
697                last;
698            }
699        }
700        unless ($dow_number) {
701            my $dow_count = 0;
702            foreach my $dow ( @{ $self->{_locale}->day_format_abbreviated } )
703            {
704                $dow_count++;
705                if ( lc $dow eq lc $dow_name ) {
706                    $dow_number = $dow_count;
707                    last;
708                }
709            }
710        }
711        unless ($dow_number) {
712            $self->local_croak(
713                "$dow_name is not a recognised day in this locale.")
714                and return undef;
715        }
716        $self->local_croak(
717            "Your day of the week ($dow_name) does not match the date supplied: "
718                . $potential_return->ymd )
719            and return undef
720            if $dow_number
721                and $potential_return->dow != $dow_number;
722    }
723
724    $self->local_croak(
725        "Your week number ($week_sun_0) does not match the date supplied: "
726            . $potential_return->ymd )
727        and return undef
728        if $week_sun_0
729            and $potential_return->strftime('%U') != $week_sun_0;
730    $self->local_croak(
731        "Your week number ($week_mon_1) does not match the date supplied: "
732            . $potential_return->ymd )
733        and return undef
734        if $week_mon_1
735            and $potential_return->strftime('%W') != $week_mon_1;
736    $self->local_croak(
737        "Your ISO week year ($iso_week_year) does not match the date supplied: "
738            . $potential_return->ymd )
739        and return undef
740        if $iso_week_year
741            and $potential_return->strftime('%G') != $iso_week_year;
742    $self->local_croak(
743        "Your ISO week year ($iso_week_year_100) does not match the date supplied: "
744            . $potential_return->ymd )
745        and return undef
746        if $iso_week_year_100
747            and $potential_return->strftime('%g') != $iso_week_year_100;
748
749    # Move into the timezone in the object - if there is one
750    print "Potential Datetime: "
751        . $potential_return->strftime("%F %T %z %Z") . "\n"
752        if $self->{diagnostic};
753    print "Setting timezone: " . $self->{set_time_zone} . "\n"
754        if $self->{diagnostic};
755    if ( $self->{set_time_zone} ) {
756        $potential_return->set_time_zone( $self->{set_time_zone} );
757    }
758    elsif ($set_time_zone) {
759        $potential_return->set_time_zone($set_time_zone);
760    }
761    print "Actual Datetime: "
762        . $potential_return->strftime("%F %T %z %Z") . "\n"
763        if $self->{diagnostic};
764
765    return $potential_return;
766}
767
768sub parse_duration {
769    croak "DateTime::Format::Strptime doesn't do durations.";
770}
771
772sub format_datetime {
773    my ( $self, $dt ) = @_;
774    my $pattern = $self->pattern;
775    $pattern =~ s/%O/$dt->time_zone->name/eg;
776    return $dt->clone->set_locale( $self->locale )->strftime($pattern);
777}
778
779sub format_duration {
780    croak "DateTime::Format::Strptime doesn't do durations.";
781}
782
783sub _build_parser {
784    my $self = shift;
785    my $regex = my $field_list = shift;
786    if ( ref $regex eq 'Regexp' ) {
787        $field_list =~ s/^\(\?-xism:(.+)\)$/$1/;
788    }
789    my @fields = $field_list =~ m/(%\{\w+\}|%\d*.)/g;
790    $field_list = join( '', @fields );
791
792    # Locale-ize the parser
793    my $ampm_list = join( '|', @{ $self->{_locale}->am_pm_abbreviated } );
794    $ampm_list .= '|' . lc $ampm_list;
795
796    my $default_date_format = $self->{_locale}->glibc_date_format;
797    my @locale_format = $default_date_format =~ m/(%\{\w+\}|%\d*.)/g;
798    $default_date_format = join( '', @locale_format );
799
800    my $default_time_format = $self->{_locale}->glibc_time_format;
801    @locale_format = $default_time_format =~ m/(%\{\w+\}|%\d*.)/g;
802    $default_time_format = join( '', @locale_format );
803
804    my $default_datetime_format = $self->{_locale}->glibc_datetime_format;
805    @locale_format = $default_datetime_format =~ m/(%\{\w+\}|%\d*.)/g;
806    $default_datetime_format = join( '', @locale_format );
807
808    print
809        "Date format: $default_date_format\nTime format: $default_time_format\nDatetime format: $default_datetime_format\n"
810        if $self->{diagnostic};
811
812    $regex      =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g;
813    $field_list =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g;
814
815    $regex      =~ s/%c/$self->{_locale}->glibc_datetime_format/eg;
816    $field_list =~ s/%c/$default_datetime_format/eg;
817
818    # %c is the locale's default datetime format.
819
820    $regex      =~ s/%x/$self->{_locale}->glibc_date_format/eg;
821    $field_list =~ s/%x/$default_date_format/eg;
822
823    # %x is the locale's default date format.
824
825    $regex      =~ s/%X/$self->{_locale}->glibc_time_format/eg;
826    $field_list =~ s/%X/$default_time_format/eg;
827
828    # %x is the locale's default time format.
829
830    if ( ref $regex ne 'Regexp' ) {
831        $regex = quotemeta($regex);
832        $regex =~ s/(?<!\\)\\%/%/g;
833        $regex =~ s/%\\\{([^\}]+)\\\}/%{$1}/g;
834    }
835
836    $regex      =~ s/%T/%H:%M:%S/g;
837    $field_list =~ s/%T/%H%M%S/g;
838
839    # %T is the time as %H:%M:%S.
840
841    $regex      =~ s/%r/%I:%M:%S %p/g;
842    $field_list =~ s/%r/%I%M%S%p/g;
843
844    #is the time as %I:%M:%S %p.
845
846    $regex      =~ s/%R/%H:%M/g;
847    $field_list =~ s/%R/%H%M/g;
848
849    #is the time as %H:%M.
850
851    $regex      =~ s|%D|%m\\/%d\\/%y|g;
852    $field_list =~ s|%D|%m%d%y|g;
853
854    #is the same as %m/%d/%y.
855
856    $regex      =~ s|%F|%Y\\-%m\\-%d|g;
857    $field_list =~ s|%F|%Y%m%d|g;
858
859    #is the same as %Y-%m-%d - the ISO date format.
860
861    my $day_re = join(
862        '|',
863        map      { quotemeta $_ }
864            sort { length $b <=> length $a }
865            grep( /\W/, @{ $self->{_locale}->day_format_wide },
866            @{ $self->{_locale}->day_format_abbreviated } )
867    );
868    $day_re .= '|' if $day_re;
869    $regex      =~ s/%a/($day_re\\w+)/gi;
870    $field_list =~ s/%a/#dow_name#/gi;
871
872    # %a is the day of the week, using the locale's weekday names; either the abbreviated or full name may be specified.
873    # %A is the same as %a.
874
875    my $month_re = join(
876        '|',
877        map      { quotemeta $_ }
878            sort { length $b <=> length $a }
879            grep( /\s|\d/, @{ $self->{_locale}->month_format_wide },
880            @{ $self->{_locale}->month_format_abbreviated } )
881    );
882    $month_re .= '|' if $month_re;
883    $month_re .= '[^\\s\\d]+';
884    $regex      =~ s/%[bBh]/($month_re)/g;
885    $field_list =~ s/%[bBh]/#month_name#/g;
886
887    #is the month, using the locale's month names; either the abbreviated or full name may be specified.
888    # %B is the same as %b.
889    # %h is the same as %b.
890
891    #s/%c//g;
892    #is replaced by the locale's appropriate date and time representation.
893
894    $regex      =~ s/%C/([\\d ]?\\d)/g;
895    $field_list =~ s/%C/#century#/g;
896
897    #is the century number [0,99]; leading zeros are permitted by not required.
898
899    $regex      =~ s/%[de]/([\\d ]?\\d)/g;
900    $field_list =~ s/%[de]/#day#/g;
901
902    #is the day of the month [1,31]; leading zeros are permitted but not required.
903    #%e is the same as %d.
904
905    $regex      =~ s/%[Hk]/([\\d ]?\\d)/g;
906    $field_list =~ s/%[Hk]/#hour_24#/g;
907
908    #is the hour (24-hour clock) [0,23]; leading zeros are permitted but not required.
909    # %k is the same as %H
910
911    $regex      =~ s/%g/([\\d ]?\\d)/g;
912    $field_list =~ s/%g/#iso_week_year_100#/g;
913
914    # The year corresponding to the ISO week number, but without the century (0-99).
915
916    $regex      =~ s/%G/(\\d{4})/g;
917    $field_list =~ s/%G/#iso_week_year#/g;
918
919    # The year corresponding to the ISO week number.
920
921    $regex      =~ s/%[Il]/([\\d ]?\\d)/g;
922    $field_list =~ s/%[Il]/#hour_12#/g;
923
924    #is the hour (12-hour clock) [1-12]; leading zeros are permitted but not required.
925    # %l is the same as %I.
926
927    $regex      =~ s/%j/(\\d{1,3})/g;
928    $field_list =~ s/%j/#doy#/g;
929
930    #is the day of the year [1,366]; leading zeros are permitted but not required.
931
932    $regex      =~ s/%m/([\\d ]?\\d)/g;
933    $field_list =~ s/%m/#month#/g;
934
935    #is the month number [1-12]; leading zeros are permitted but not required.
936
937    $regex      =~ s/%M/([\\d ]?\\d)/g;
938    $field_list =~ s/%M/#minute#/g;
939
940    #is the minute [0-59]; leading zeros are permitted but not required.
941
942    $regex      =~ s/%[nt]/\\s+/g;
943    $field_list =~ s/%[nt]//g;
944
945    # %n is any white space.
946    # %t is any white space.
947
948    $regex      =~ s/%p/($ampm_list)/gi;
949    $field_list =~ s/%p/#ampm#/gi;
950
951    # %p is the locale's equivalent of either A.M./P.M. indicator for 12-hour clock.
952
953    $regex      =~ s/%s/(\\d+)/g;
954    $field_list =~ s/%s/#epoch#/g;
955
956    # %s is the seconds since the epoch
957
958    $regex      =~ s/%S/([\\d ]?\\d)/g;
959    $field_list =~ s/%S/#second#/g;
960
961    # %S is the seconds [0-61]; leading zeros are permitted but not required.
962
963    $regex      =~ s/%(\d*)N/($1) ? "(\\d{$1})" : "(\\d+)"/eg;
964    $field_list =~ s/%\d*N/#nanosecond#/g;
965
966    # %N is the nanoseconds (or sub seconds really)
967
968    $regex      =~ s/%U/([\\d ]?\\d)/g;
969    $field_list =~ s/%U/#week_sun_0#/g;
970
971    # %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.
972
973    $regex      =~ s/%w/([0-6])/g;
974    $field_list =~ s/%w/#dow_sun_0#/g;
975
976    # is the weekday as a decimal number [0-6], with 0 representing Sunday.
977
978    $regex      =~ s/%u/([1-7])/g;
979    $field_list =~ s/%u/#dow_mon_1#/g;
980
981    # is the weekday as a decimal number [1-7], with 1 representing Monday - a la DateTime.
982
983    $regex      =~ s/%W/([\\d ]?\\d)/g;
984    $field_list =~ s/%W/#week_mon_1#/g;
985
986    #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.
987
988    $regex      =~ s/%y/([\\d ]?\\d)/g;
989    $field_list =~ s/%y/#year_100#/g;
990
991    # 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.
992
993    $regex      =~ s/%Y/(\\d{4})/g;
994    $field_list =~ s/%Y/#year#/g;
995
996    # is the year including the century (for example, 1998).
997
998    $regex      =~ s|%z|([+-]\\d{4})|g;
999    $field_list =~ s/%z/#tz_offset#/g;
1000
1001    # Timezone Offset.
1002
1003    $regex      =~ s|%Z|(\\w+)|g;
1004    $field_list =~ s/%Z/#timezone#/g;
1005
1006    # The short timezone name.
1007
1008    $regex      =~ s|%O|(\\w+\\/\\w+)|g;
1009    $field_list =~ s/%O/#tz_olson#/g;
1010
1011    # The Olson timezone name.
1012
1013    $regex      =~ s|%\{(\w+)\}|(DateTime->can($1)) ? "(.+)" : ".+"|eg;
1014    $field_list =~ s|(%\{(\w+)\})|(DateTime->can($2)) ? "#$2#" : $1 |eg;
1015
1016    # Any function in DateTime.
1017
1018    $regex      =~ s/__ESCAPED_PERCENT_SIGN_MARKER__/\\%/g;
1019    $field_list =~ s/__ESCAPED_PERCENT_SIGN_MARKER__//g;
1020
1021    # is replaced by %.
1022    #print $regex;
1023
1024    $field_list =~ s/#([a-z0-9_]+)#/\$$1, /gi;
1025    $field_list =~ s/,\s*$//;
1026
1027    return qq|($field_list) = \$time_string =~ /$regex/|;
1028}
1029
1030# Utility functions
1031
1032sub local_croak {
1033    my $self = $_[0];
1034    return &{ $self->{on_error} }(@_) if ref( $self->{on_error} );
1035    croak( $_[1] ) if $self->{on_error} eq 'croak';
1036    $self->{errmsg} = $_[1];
1037    return ( $self->{on_error} eq 'undef' );
1038}
1039
1040sub local_carp {
1041    my $self = $_[0];
1042    return &{ $self->{on_error} }(@_) if ref( $self->{on_error} );
1043    carp( $_[1] ) if $self->{on_error} eq 'croak';
1044    $self->{errmsg} = $_[1];
1045    return ( $self->{on_error} eq 'undef' );
1046}
1047
1048sub errmsg {
1049    $_[0]->{errmsg};
1050}
1051
1052# Exportable functions:
1053
1054sub strftime {
1055    my ( $pattern, $dt ) = @_;
1056    return $dt->strftime($pattern);
1057}
1058
1059sub strptime {
1060    my ( $pattern, $time_string ) = @_;
1061    return DateTime::Format::Strptime->new(
1062        pattern  => $pattern,
1063        on_error => 'croak'
1064    )->parse_datetime($time_string);
1065}
1066
10671;
1068
1069# ABSTRACT: Parse and format strp and strf time patterns
1070
1071__END__
1072
1073=pod
1074
1075=head1 NAME
1076
1077DateTime::Format::Strptime - Parse and format strp and strf time patterns
1078
1079=head1 VERSION
1080
1081version 1.54
1082
1083=head1 SYNOPSIS
1084
1085    use DateTime::Format::Strptime;
1086
1087    my $strp = DateTime::Format::Strptime->new(
1088        pattern   => '%T',
1089        locale    => 'en_AU',
1090        time_zone => 'Australia/Melbourne',
1091    );
1092
1093    my $dt = $strp->parse_datetime('23:16:42');
1094
1095    $strp->format_datetime($dt);
1096
1097    # 23:16:42
1098
1099    # Croak when things go wrong:
1100    my $strp = DateTime::Format::Strptime->new(
1101        pattern   => '%T',
1102        locale    => 'en_AU',
1103        time_zone => 'Australia/Melbourne',
1104        on_error  => 'croak',
1105    );
1106
1107    $newpattern = $strp->pattern('%Q');
1108
1109    # Unidentified token in pattern: %Q in %Q at line 34 of script.pl
1110
1111    # Do something else when things go wrong:
1112    my $strp = DateTime::Format::Strptime->new(
1113        pattern   => '%T',
1114        locale    => 'en_AU',
1115        time_zone => 'Australia/Melbourne',
1116        on_error  => \&phone_police,
1117    );
1118
1119=head1 DESCRIPTION
1120
1121This module implements most of C<strptime(3)>, the POSIX function that
1122is the reverse of C<strftime(3)>, for C<DateTime>. While C<strftime>
1123takes a C<DateTime> and a pattern and returns a string, C<strptime> takes
1124a string and a pattern and returns the C<DateTime> object
1125associated.
1126
1127=head1 CONSTRUCTOR
1128
1129=over 4
1130
1131=item * new( pattern => $strptime_pattern )
1132
1133Creates the format object. You must specify a pattern, you can also
1134specify a C<time_zone> and a C<locale>. If you specify a time zone
1135then any resulting C<DateTime> object will be in that time zone. If you
1136do not specify a C<time_zone> parameter, but there is a time zone in the
1137string you pass to C<parse_datetime>, then the resulting C<DateTime> will
1138use that time zone.
1139
1140You can optionally use an on_error parameter. This parameter has three
1141valid options:
1142
1143=over 4
1144
1145=item * 'undef'
1146
1147(not undef, 'undef', it's a string not an undefined value)
1148
1149This is the default behavior. The module will return undef whenever it gets
1150upset. The error can be accessed using the C<< $object->errmsg >> method.
1151This is the ideal behaviour for interactive use where a user might provide an
1152illegal pattern or a date that doesn't match the pattern.
1153
1154=item * 'croak'
1155
1156(not croak, 'croak', it's a string, not a function)
1157
1158This used to be the default behaviour. The module will croak with an
1159error message whenever it gets upset.
1160
1161=item * sub{...} or \&subname
1162
1163When given a code ref, the module will call that sub when it gets upset.
1164The sub receives two parameters: the object and the error message. Using
1165these two it is possible to emulate the 'undef' behavior. (Returning a
1166true value causes the method to return undef. Returning a false value
1167causes the method to bravely continue):
1168
1169    sub { $_[0]->{errmsg} = $_[1]; 1 },
1170
1171=back
1172
1173=back
1174
1175=head1 METHODS
1176
1177This class offers the following methods.
1178
1179=over 4
1180
1181=item * parse_datetime($string)
1182
1183Given a string in the pattern specified in the constructor, this method
1184will return a new C<DateTime> object.
1185
1186If given a string that doesn't match the pattern, the formatter will
1187croak or return undef, depending on the setting of on_error in the constructor.
1188
1189=item * format_datetime($datetime)
1190
1191Given a C<DateTime> object, this methods returns a string formatted in
1192the object's format. This method is synonymous with C<DateTime>'s
1193strftime method.
1194
1195=item * locale($locale)
1196
1197When given a locale or C<DateTime::Locale> object, this method sets
1198its locale appropriately. If the locale is not understood, the method
1199will croak or return undef (depending on the setting of on_error in
1200the constructor)
1201
1202If successful this method returns the current locale. (After
1203processing as above).
1204
1205=item * pattern($strptime_pattern)
1206
1207When given a pattern, this method sets the object's pattern. If the
1208pattern is invalid, the method will croak or return undef (depending on
1209the value of the C<on_error> parameter)
1210
1211If successful this method returns the current pattern. (After processing
1212as above)
1213
1214=item * time_zone($time_zone)
1215
1216When given a name, offset or C<DateTime::TimeZone> object, this method
1217sets the object's time zone. This effects the C<DateTime> object
1218returned by parse_datetime
1219
1220If the time zone is invalid, the method will croak or return undef
1221(depending on the value of the C<on_error> parameter)
1222
1223If successful this method returns the current time zone. (After processing
1224as above)
1225
1226=item * errmsg
1227
1228If the on_error behavior of the object is 'undef', error messages with
1229this method so you can work out why things went wrong.
1230
1231This code emulates a C<$DateTime::Format::Strptime> with
1232the C<on_error> parameter equal to C<'croak'>:
1233
1234C<< $strp->pattern($pattern) or die $DateTime::Format::Strptime::errmsg >>
1235
1236=back
1237
1238=head1 EXPORTS
1239
1240There are no methods exported by default, however the following are
1241available:
1242
1243=over 4
1244
1245=item * strptime( $strptime_pattern, $string )
1246
1247Given a pattern and a string this function will return a new C<DateTime>
1248object.
1249
1250=item * strftime( $strftime_pattern, $datetime )
1251
1252Given a pattern and a C<DateTime> object this function will return a
1253formatted string.
1254
1255=back
1256
1257=head1 STRPTIME PATTERN TOKENS
1258
1259The following tokens are allowed in the pattern string for strptime
1260(parse_datetime):
1261
1262=over 4
1263
1264=item * %%
1265
1266The % character.
1267
1268=item * %a or %A
1269
1270The weekday name according to the current locale, in abbreviated form or
1271the full name.
1272
1273=item * %b or %B or %h
1274
1275The month name according to the current locale, in abbreviated form or
1276the full name.
1277
1278=item * %C
1279
1280The century number (0-99).
1281
1282=item * %d or %e
1283
1284The day of month (01-31). This will parse single digit numbers as well.
1285
1286=item * %D
1287
1288Equivalent to %m/%d/%y. (This is the American style date, very confusing
1289to non-Americans, especially since %d/%m/%y is	widely used in Europe.
1290The ISO 8601 standard pattern is %F.)
1291
1292=item * %F
1293
1294Equivalent to %Y-%m-%d. (This is the ISO style date)
1295
1296=item * %g
1297
1298The year corresponding to the ISO week number, but without the century
1299(0-99).
1300
1301=item * %G
1302
1303The year corresponding to the ISO week number.
1304
1305=item * %H
1306
1307The hour (00-23). This will parse single digit numbers as well.
1308
1309=item * %I
1310
1311The hour on a 12-hour clock (1-12).
1312
1313=item * %j
1314
1315The day number in the year (1-366).
1316
1317=item * %m
1318
1319The month number (01-12). This will parse single digit numbers as well.
1320
1321=item * %M
1322
1323The minute (00-59). This will parse single digit numbers as well.
1324
1325=item * %n
1326
1327Arbitrary whitespace.
1328
1329=item * %N
1330
1331Nanoseconds. For other sub-second values use C<%[number]N>.
1332
1333=item * %p
1334
1335The equivalent of AM or PM according to the locale in use. (See
1336L<DateTime::Locale>)
1337
1338=item * %r
1339
1340Equivalent to %I:%M:%S %p.
1341
1342=item * %R
1343
1344Equivalent to %H:%M.
1345
1346=item * %s
1347
1348Number of seconds since the Epoch.
1349
1350=item * %S
1351
1352The second (0-60; 60 may occur for leap seconds. See
1353L<DateTime::LeapSecond>).
1354
1355=item * %t
1356
1357Arbitrary whitespace.
1358
1359=item * %T
1360
1361Equivalent to %H:%M:%S.
1362
1363=item * %U
1364
1365The week number with Sunday the first day of the week (0-53). The first
1366Sunday of January is the first day of week 1.
1367
1368=item * %u
1369
1370The weekday number (1-7) with Monday = 1. This is the C<DateTime> standard.
1371
1372=item * %w
1373
1374The weekday number (0-6) with Sunday = 0.
1375
1376=item * %W
1377
1378The week number with Monday the first day of the week (0-53). The first
1379Monday of January is the first day of week 1.
1380
1381=item * %y
1382
1383The year within century (0-99). When a century is not otherwise specified
1384(with a value for %C), values in the range 69-99 refer to years in the
1385twentieth century (1969-1999); values in the range 00-68 refer to years in the
1386twenty-first century (2000-2068).
1387
1388=item * %Y
1389
1390The year, including century (for example, 1991).
1391
1392=item * %z
1393
1394An RFC-822/ISO 8601 standard time zone specification. (For example
1395+1100) [See note below]
1396
1397=item * %Z
1398
1399The timezone name. (For example EST -- which is ambiguous) [See note
1400below]
1401
1402=item * %O
1403
1404This extended token allows the use of Olson Time Zone names to appear
1405in parsed strings. B<NOTE>: This pattern cannot be passed to C<DateTime>'s
1406C<strftime()> method, but can be passed to C<format_datetime()>.
1407
1408=back
1409
1410=head1 AUTHOR EMERITUS
1411
1412This module was created by Rick Measham.
1413
1414=head1 BUGS
1415
1416Please report any bugs or feature requests to
1417C<bug-datetime-format-strptime@rt.cpan.org>, or through the web interface at
1418L<http://rt.cpan.org>. I will be notified, and then you'll automatically be
1419notified of progress on your bug as I make changes.
1420
1421=head1 SEE ALSO
1422
1423C<datetime@perl.org> mailing list.
1424
1425http://datetime.perl.org/
1426
1427L<perl>, L<DateTime>, L<DateTime::TimeZone>, L<DateTime::Locale>
1428
1429=head1 AUTHORS
1430
1431=over 4
1432
1433=item *
1434
1435Dave Rolsky <autarch@urth.org>
1436
1437=item *
1438
1439Rick Measham <rickm@cpan.org>
1440
1441=back
1442
1443=head1 COPYRIGHT AND LICENSE
1444
1445This software is Copyright (c) 2013 by Dave Rolsky.
1446
1447This is free software, licensed under:
1448
1449  The Artistic License 2.0 (GPL Compatible)
1450
1451=cut
1452