<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package DateTime::Format::Strptime;
BEGIN {
  $DateTime::Format::Strptime::VERSION = '1.5000';
}

use strict;

use DateTime;
use DateTime::Locale;
use DateTime::TimeZone;
use Params::Validate qw( validate SCALAR SCALARREF BOOLEAN OBJECT CODEREF );
use Carp;

use Exporter;
use vars
    qw( @ISA @EXPORT @EXPORT_OK %ZONEMAP %FORMATS $CROAK $errmsg);

@ISA       = 'Exporter';
@EXPORT_OK = qw( &amp;strftime &amp;strptime );
@EXPORT    = ();

%ZONEMAP = (
    'A'      =&gt; '+0100',     'ACDT'   =&gt; '+1030',     'ACST'   =&gt; '+0930',
    'ADT'    =&gt; 'Ambiguous', 'AEDT'   =&gt; '+1100',     'AES'    =&gt; '+1000',
    'AEST'   =&gt; '+1000',     'AFT'    =&gt; '+0430',     'AHDT'   =&gt; '-0900',
    'AHST'   =&gt; '-1000',     'AKDT'   =&gt; '-0800',     'AKST'   =&gt; '-0900',
    'AMST'   =&gt; '+0400',     'AMT'    =&gt; '+0400',     'ANAST'  =&gt; '+1300',
    'ANAT'   =&gt; '+1200',     'ART'    =&gt; '-0300',     'AST'    =&gt; 'Ambiguous',
    'AT'     =&gt; '-0100',     'AWST'   =&gt; '+0800',     'AZOST'  =&gt; '+0000',
    'AZOT'   =&gt; '-0100',     'AZST'   =&gt; '+0500',     'AZT'    =&gt; '+0400',
    'B'      =&gt; '+0200',     'BADT'   =&gt; '+0400',     'BAT'    =&gt; '+0600',
    'BDST'   =&gt; '+0200',     'BDT'    =&gt; '+0600',     'BET'    =&gt; '-1100',
    'BNT'    =&gt; '+0800',     'BORT'   =&gt; '+0800',     'BOT'    =&gt; '-0400',
    'BRA'    =&gt; '-0300',     'BST'    =&gt; 'Ambiguous', 'BT'     =&gt; 'Ambiguous',
    'BTT'    =&gt; '+0600',     'C'      =&gt; '+0300',     'CAST'   =&gt; '+0930',
    'CAT'    =&gt; 'Ambiguous', 'CCT'    =&gt; 'Ambiguous', 'CDT'    =&gt; 'Ambiguous',
    'CEST'   =&gt; '+0200',     'CET'    =&gt; '+0100',     'CETDST' =&gt; '+0200',
    'CHADT'  =&gt; '+1345',     'CHAST'  =&gt; '+1245',     'CKT'    =&gt; '-1000',
    'CLST'   =&gt; '-0300',     'CLT'    =&gt; '-0400',     'COT'    =&gt; '-0500',
    'CST'    =&gt; 'Ambiguous', 'CSuT'   =&gt; '+1030',     'CUT'    =&gt; '+0000',
    'CVT'    =&gt; '-0100',     'CXT'    =&gt; '+0700',     'ChST'   =&gt; '+1000',
    'D'      =&gt; '+0400',     'DAVT'   =&gt; '+0700',     'DDUT'   =&gt; '+1000',
    'DNT'    =&gt; '+0100',     'DST'    =&gt; '+0200',     'E'      =&gt; '+0500',
    'EASST'  =&gt; '-0500',     'EAST'   =&gt; 'Ambiguous', 'EAT'    =&gt; '+0300',
    'ECT'    =&gt; 'Ambiguous', 'EDT'    =&gt; 'Ambiguous', 'EEST'   =&gt; '+0300',
    'EET'    =&gt; '+0200',     'EETDST' =&gt; '+0300',     'EGST'   =&gt; '+0000',
    'EGT'    =&gt; '-0100',     'EMT'    =&gt; '+0100',     'EST'    =&gt; 'Ambiguous',
    'ESuT'   =&gt; '+1100',     'F'      =&gt; '+0600',     'FDT'    =&gt; 'Ambiguous',
    'FJST'   =&gt; '+1300',     'FJT'    =&gt; '+1200',     'FKST'   =&gt; '-0300',
    'FKT'    =&gt; '-0400',     'FST'    =&gt; 'Ambiguous', 'FWT'    =&gt; '+0100',
    'G'      =&gt; '+0700',     'GALT'   =&gt; '-0600',     'GAMT'   =&gt; '-0900',
    'GEST'   =&gt; '+0500',     'GET'    =&gt; '+0400',     'GFT'    =&gt; '-0300',
    'GILT'   =&gt; '+1200',     'GMT'    =&gt; '+0000',     'GST'    =&gt; 'Ambiguous',
    'GT'     =&gt; '+0000',     'GYT'    =&gt; '-0400',     'GZ'     =&gt; '+0000',
    'H'      =&gt; '+0800',     'HAA'    =&gt; '-0300',     'HAC'    =&gt; '-0500',
    'HAE'    =&gt; '-0400',     'HAP'    =&gt; '-0700',     'HAR'    =&gt; '-0600',
    'HAT'    =&gt; '-0230',     'HAY'    =&gt; '-0800',     'HDT'    =&gt; '-0930',
    'HFE'    =&gt; '+0200',     'HFH'    =&gt; '+0100',     'HG'     =&gt; '+0000',
    'HKT'    =&gt; '+0800',     'HL'     =&gt; 'local',     'HNA'    =&gt; '-0400',
    'HNC'    =&gt; '-0600',     'HNE'    =&gt; '-0500',     'HNP'    =&gt; '-0800',
    'HNR'    =&gt; '-0700',     'HNT'    =&gt; '-0330',     'HNY'    =&gt; '-0900',
    'HOE'    =&gt; '+0100',     'HST'    =&gt; '-1000',     'I'      =&gt; '+0900',
    'ICT'    =&gt; '+0700',     'IDLE'   =&gt; '+1200',     'IDLW'   =&gt; '-1200',
    'IDT'    =&gt; 'Ambiguous', 'IOT'    =&gt; '+0500',     'IRDT'   =&gt; '+0430',
    'IRKST'  =&gt; '+0900',     'IRKT'   =&gt; '+0800',     'IRST'   =&gt; '+0430',
    'IRT'    =&gt; '+0330',     'IST'    =&gt; 'Ambiguous', 'IT'     =&gt; '+0330',
    'ITA'    =&gt; '+0100',     'JAVT'   =&gt; '+0700',     'JAYT'   =&gt; '+0900',
    'JST'    =&gt; '+0900',     'JT'     =&gt; '+0700',     'K'      =&gt; '+1000',
    'KDT'    =&gt; '+1000',     'KGST'   =&gt; '+0600',     'KGT'    =&gt; '+0500',
    'KOST'   =&gt; '+1200',     'KRAST'  =&gt; '+0800',     'KRAT'   =&gt; '+0700',
    'KST'    =&gt; '+0900',     'L'      =&gt; '+1100',     'LHDT'   =&gt; '+1100',
    'LHST'   =&gt; '+1030',     'LIGT'   =&gt; '+1000',     'LINT'   =&gt; '+1400',
    'LKT'    =&gt; '+0600',     'LST'    =&gt; 'local',     'LT'     =&gt; 'local',
    'M'      =&gt; '+1200',     'MAGST'  =&gt; '+1200',     'MAGT'   =&gt; '+1100',
    'MAL'    =&gt; '+0800',     'MART'   =&gt; '-0930',     'MAT'    =&gt; '+0300',
    'MAWT'   =&gt; '+0600',     'MDT'    =&gt; '-0600',     'MED'    =&gt; '+0200',
    'MEDST'  =&gt; '+0200',     'MEST'   =&gt; '+0200',     'MESZ'   =&gt; '+0200',
    'MET'    =&gt; 'Ambiguous', 'MEWT'   =&gt; '+0100',     'MEX'    =&gt; '-0600',
    'MEZ'    =&gt; '+0100',     'MHT'    =&gt; '+1200',     'MMT'    =&gt; '+0630',
    'MPT'    =&gt; '+1000',     'MSD'    =&gt; '+0400',     'MSK'    =&gt; '+0300',
    'MSKS'   =&gt; '+0400',     'MST'    =&gt; '-0700',     'MT'     =&gt; '+0830',
    'MUT'    =&gt; '+0400',     'MVT'    =&gt; '+0500',     'MYT'    =&gt; '+0800',
    'N'      =&gt; '-0100',     'NCT'    =&gt; '+1100',     'NDT'    =&gt; '-0230',
    'NFT'    =&gt; 'Ambiguous', 'NOR'    =&gt; '+0100',     'NOVST'  =&gt; '+0700',
    'NOVT'   =&gt; '+0600',     'NPT'    =&gt; '+0545',     'NRT'    =&gt; '+1200',
    'NST'    =&gt; 'Ambiguous', 'NSUT'   =&gt; '+0630',     'NT'     =&gt; '-1100',
    'NUT'    =&gt; '-1100',     'NZDT'   =&gt; '+1300',     'NZST'   =&gt; '+1200',
    'NZT'    =&gt; '+1200',     'O'      =&gt; '-0200',     'OESZ'   =&gt; '+0300',
    'OEZ'    =&gt; '+0200',     'OMSST'  =&gt; '+0700',     'OMST'   =&gt; '+0600',
    'OZ'     =&gt; 'local',     'P'      =&gt; '-0300',     'PDT'    =&gt; '-0700',
    'PET'    =&gt; '-0500',     'PETST'  =&gt; '+1300',     'PETT'   =&gt; '+1200',
    'PGT'    =&gt; '+1000',     'PHOT'   =&gt; '+1300',     'PHT'    =&gt; '+0800',
    'PKT'    =&gt; '+0500',     'PMDT'   =&gt; '-0200',     'PMT'    =&gt; '-0300',
    'PNT'    =&gt; '-0830',     'PONT'   =&gt; '+1100',     'PST'    =&gt; 'Ambiguous',
    'PWT'    =&gt; '+0900',     'PYST'   =&gt; '-0300',     'PYT'    =&gt; '-0400',
    'Q'      =&gt; '-0400',     'R'      =&gt; '-0500',     'R1T'    =&gt; '+0200',
    'R2T'    =&gt; '+0300',     'RET'    =&gt; '+0400',     'ROK'    =&gt; '+0900',
    'S'      =&gt; '-0600',     'SADT'   =&gt; '+1030',     'SAST'   =&gt; 'Ambiguous',
    'SBT'    =&gt; '+1100',     'SCT'    =&gt; '+0400',     'SET'    =&gt; '+0100',
    'SGT'    =&gt; '+0800',     'SRT'    =&gt; '-0300',     'SST'    =&gt; 'Ambiguous',
    'SWT'    =&gt; '+0100',     'T'      =&gt; '-0700',     'TFT'    =&gt; '+0500',
    'THA'    =&gt; '+0700',     'THAT'   =&gt; '-1000',     'TJT'    =&gt; '+0500',
    'TKT'    =&gt; '-1000',     'TMT'    =&gt; '+0500',     'TOT'    =&gt; '+1300',
    'TRUT'   =&gt; '+1000',     'TST'    =&gt; '+0300',     'TUC '   =&gt; '+0000',
    'TVT'    =&gt; '+1200',     'U'      =&gt; '-0800',     'ULAST'  =&gt; '+0900',
    'ULAT'   =&gt; '+0800',     'USZ1'   =&gt; '+0200',     'USZ1S'  =&gt; '+0300',
    'USZ3'   =&gt; '+0400',     'USZ3S'  =&gt; '+0500',     'USZ4'   =&gt; '+0500',
    'USZ4S'  =&gt; '+0600',     'USZ5'   =&gt; '+0600',     'USZ5S'  =&gt; '+0700',
    'USZ6'   =&gt; '+0700',     'USZ6S'  =&gt; '+0800',     'USZ7'   =&gt; '+0800',
    'USZ7S'  =&gt; '+0900',     'USZ8'   =&gt; '+0900',     'USZ8S'  =&gt; '+1000',
    'USZ9'   =&gt; '+1000',     'USZ9S'  =&gt; '+1100',     'UTZ'    =&gt; '-0300',
    'UYT'    =&gt; '-0300',     'UZ10'   =&gt; '+1100',     'UZ10S'  =&gt; '+1200',
    'UZ11'   =&gt; '+1200',     'UZ11S'  =&gt; '+1300',     'UZ12'   =&gt; '+1200',
    'UZ12S'  =&gt; '+1300',     'UZT'    =&gt; '+0500',     'V'      =&gt; '-0900',
    'VET'    =&gt; '-0400',     'VLAST'  =&gt; '+1100',     'VLAT'   =&gt; '+1000',
    'VTZ'    =&gt; '-0200',     'VUT'    =&gt; '+1100',     'W'      =&gt; '-1000',
    'WAKT'   =&gt; '+1200',     'WAST'   =&gt; 'Ambiguous', 'WAT'    =&gt; '+0100',
    'WEST'   =&gt; '+0100',     'WESZ'   =&gt; '+0100',     'WET'    =&gt; '+0000',
    'WETDST' =&gt; '+0100',     'WEZ'    =&gt; '+0000',     'WFT'    =&gt; '+1200',
    'WGST'   =&gt; '-0200',     'WGT'    =&gt; '-0300',     'WIB'    =&gt; '+0700',
    'WIT'    =&gt; '+0900',     'WITA'   =&gt; '+0800',     'WST'    =&gt; 'Ambiguous',
    'WTZ'    =&gt; '-0100',     'WUT'    =&gt; '+0100',     'X'      =&gt; '-1100',
    'Y'      =&gt; '-1200',     'YAKST'  =&gt; '+1000',     'YAKT'   =&gt; '+0900',
    'YAPT'   =&gt; '+1000',     'YDT'    =&gt; '-0800',     'YEKST'  =&gt; '+0600',
    'YEKT'   =&gt; '+0500',     'YST'    =&gt; '-0900',     'Z'      =&gt; '+0000',
    'UTC'    =&gt; '+0000',
);

sub new {
    my $class = shift;
    my %args  = validate(
        @_, {
            pattern    =&gt; { type =&gt; SCALAR | SCALARREF },
            time_zone  =&gt; { type =&gt; SCALAR | OBJECT, optional =&gt; 1 },
            locale     =&gt; { type =&gt; SCALAR | OBJECT, default =&gt; 'English' },
            on_error   =&gt; { type =&gt; SCALAR | CODEREF, default =&gt; 'undef' },
            diagnostic =&gt; { type =&gt; SCALAR, default =&gt; 0 },
        }
    );

    croak(
        "The value supplied to on_error must be either 'croak', 'undef' or a code reference."
        )
        unless ref( $args{on_error} ) eq 'CODE'
            or $args{on_error} eq 'croak'
            or $args{on_error} eq 'undef';

    # Deal with locale
    unless ( ref( $args{locale} ) ) {
        my $locale = DateTime::Locale-&gt;load( $args{locale} );

        croak("Could not create locale from $args{locale}") unless $locale;

        $args{_locale} = $locale;
    }
    else {
        $args{_locale} = $args{locale};
        ( $args{locale} ) = ref( $args{_locale} ) =~ /::(\w+)[^:]+$/;
    }

    if ( $args{time_zone} ) {
        unless ( ref( $args{time_zone} ) ) {
            $args{time_zone}
                = DateTime::TimeZone-&gt;new( name =&gt; $args{time_zone} );

            croak("Could not create time zone from $args{time_zone}")
                unless $args{time_zone};
        }
        $args{set_time_zone} = $args{time_zone};
    }
    else {
        $args{time_zone} = DateTime::TimeZone-&gt;new( name =&gt; 'floating' );
        $args{set_time_zone} = '';
    }

    my $self = bless \%args, $class;

    # Deal with the parser
    $self-&gt;{parser} = $self-&gt;_build_parser( $args{pattern} );
    if ( $self-&gt;{parser} =~ /(%\{\w+\}|%\w)/ and $args{pattern} !~ /\%$1/ ) {
        croak("Unidentified token in pattern: $1 in $self-&gt;{pattern}");
    }

    return $self;
}

sub pattern {
    my $self    = shift;
    my $pattern = shift;

    if ($pattern) {
        my $possible_parser = $self-&gt;_build_parser($pattern);
        if ( $possible_parser =~ /(%\{\w+\}|%\w)/ and $pattern !~ /\%$1/ ) {
            $self-&gt;local_carp(
                "Unidentified token in pattern: $1 in $pattern. Leaving old pattern intact."
            ) and return undef;
        }
        else {
            $self-&gt;{parser}  = $possible_parser;
            $self-&gt;{pattern} = $pattern;
        }
    }
    return $self-&gt;{pattern};
}

sub locale {
    my $self   = shift;
    my $locale = shift;

    if ($locale) {
        my $possible_locale = DateTime::Locale-&gt;load($locale);
        unless ($possible_locale) {
            $self-&gt;local_carp(
                "Could not create locale from $locale. Leaving old locale intact."
            ) and return undef;
        }
        else {
            $self-&gt;{locale}  = $locale;
            $self-&gt;{_locale} = $possible_locale;

            # When the locale changes we need to rebuild the parser
            $self-&gt;{parser} = $self-&gt;_build_parser( $self-&gt;{pattern} );
        }
    }
    return $self-&gt;{locale};
}

sub time_zone {
    my $self      = shift;
    my $time_zone = shift;

    if ($time_zone) {
        my $possible_time_zone
            = DateTime::TimeZone-&gt;new( name =&gt; $time_zone );
        unless ($possible_time_zone) {
            $self-&gt;local_carp(
                "Could not create time zone from $time_zone. Leaving old time zone intact."
            ) and return undef;
        }
        else {
            $self-&gt;{time_zone}     = $possible_time_zone;
            $self-&gt;{set_time_zone} = $self-&gt;{time_zone};
        }
    }
    return $self-&gt;{time_zone}-&gt;name;
}

sub parse_datetime {
    my ( $self, $time_string ) = @_;

    local $^W = undef;

    # Variables from the parser
    my (
        $dow_name,   $month_name,        $century,    $day,
        $hour_24,    $hour_12,           $doy,        $month,
        $minute,     $ampm,              $second,     $week_sun_0,
        $dow_sun_0,  $dow_mon_1,         $week_mon_1, $year_100,
        $year,       $iso_week_year_100, $iso_week_year,
        $epoch,      $tz_offset,         $timezone,   $tz_olson,
        $nanosecond, $ce_year,

        $doy_dt, $epoch_dt, $use_timezone, $set_time_zone,
    );

    # Variables for DateTime
    my (
        $Year, $Month, $Day,
        $Hour, $Minute, $Second, $Nanosecond,
        $Am,   $Pm
    ) = ();

    # Run the parser
    my $parser = $self-&gt;{parser};
    eval($parser);
    die $@ if $@;

    if ( $self-&gt;{diagnostic} ) {
        print qq|

Entered     = $time_string
Parser		= $parser

dow_name    = $dow_name
month_name  = $month_name
century     = $century
day         = $day
hour_24     = $hour_24
hour_12     = $hour_12
doy         = $doy
month       = $month
minute      = $minute
ampm        = $ampm
second      = $second
nanosecond  = $nanosecond
week_sun_0  = $week_sun_0
dow_sun_0   = $dow_sun_0
dow_mon_1   = $dow_mon_1
week_mon_1  = $week_mon_1
year_100    = $year_100
year        = $year
ce_year     = $ce_year
tz_offset   = $tz_offset
tz_olson    = $tz_olson
timezone    = $timezone
epoch       = $epoch
iso_week_year     = $iso_week_year
iso_week_year_100 = $iso_week_year_100

		|;

    }

    $self-&gt;local_croak("Your datetime does not match your pattern.")
        and return undef
        if ( ( $self-&gt;{parser} =~ /\$dow_name\b/ and $dow_name eq '' )
        or ( $self-&gt;{parser} =~ /\$month_name\b/ and $month_name eq '' )
        or ( $self-&gt;{parser} =~ /\$century\b/    and $century    eq '' )
        or ( $self-&gt;{parser} =~ /\$day\b/        and $day        eq '' )
        or ( $self-&gt;{parser} =~ /\$hour_24\b/    and $hour_24    eq '' )
        or ( $self-&gt;{parser} =~ /\$hour_12\b/    and $hour_12    eq '' )
        or ( $self-&gt;{parser} =~ /\$doy\b/        and $doy        eq '' )
        or ( $self-&gt;{parser} =~ /\$month\b/      and $month      eq '' )
        or ( $self-&gt;{parser} =~ /\$minute\b/     and $minute     eq '' )
        or ( $self-&gt;{parser} =~ /\$ampm\b/       and $ampm       eq '' )
        or ( $self-&gt;{parser} =~ /\$second\b/     and $second     eq '' )
        or ( $self-&gt;{parser} =~ /\$nanosecond\b/ and $nanosecond eq '' )
        or ( $self-&gt;{parser} =~ /\$week_sun_0\b/ and $week_sun_0 eq '' )
        or ( $self-&gt;{parser} =~ /\$dow_sun_0\b/  and $dow_sun_0  eq '' )
        or ( $self-&gt;{parser} =~ /\$dow_mon_1\b/  and $dow_mon_1  eq '' )
        or ( $self-&gt;{parser} =~ /\$week_mon_1\b/ and $week_mon_1 eq '' )
        or ( $self-&gt;{parser} =~ /\$year_100\b/   and $year_100   eq '' )
        or ( $self-&gt;{parser} =~ /\$year\b/       and $year       eq '' )
        or ( $self-&gt;{parser} =~ /\$ce_year\b/    and $ce_year    eq '' )
        or ( $self-&gt;{parser} =~ /\$tz_offset\b/  and $tz_offset  eq '' )
        or ( $self-&gt;{parser} =~ /\$tz_olson\b/   and $tz_olson   eq '' )
        or ( $self-&gt;{parser} =~ /\$timezone\b/   and $timezone   eq '' )
        or ( $self-&gt;{parser} =~ /\$epoch\b/      and $epoch      eq '' ) );

    # Create a timezone to work with
    if ($tz_offset) {
        $use_timezone = $tz_offset;
    }

    if ($timezone) {
        $self-&gt;local_croak("I don't recognise the timezone $timezone.")
            and return undef
            unless $ZONEMAP{$timezone};
        $self-&gt;local_croak("The timezone '$timezone' is ambiguous.")
            and return undef
            if $ZONEMAP{$timezone} eq 'Ambiguous'
                and not( $tz_offset or $tz_olson );
        $self-&gt;local_croak(
            "Your timezones ('$tz_offset' and '$timezone') do not match.")
            and return undef
            if $tz_offset
                and $ZONEMAP{$timezone} ne 'Ambiguous'
                and $ZONEMAP{$timezone} != $tz_offset;
        $use_timezone = $ZONEMAP{$timezone}
            if $ZONEMAP{$timezone} ne 'Ambiguous';
    }

    if ($tz_olson) {
        my $tz = eval { DateTime::TimeZone-&gt;new( name =&gt; $tz_olson ) };
        if ( not $tz ) {
            print
                "Provided olson TZ didn't work ($tz_olson). Attempting to normalize it.\n"
                if $self-&gt;{diagnostic};
            $tz_olson = ucfirst lc $tz_olson;
            $tz_olson =~ s|([/_])(\w)|$1\U$2|g;
            print "   Trying $tz_olson.\n" if $self-&gt;{diagnostic};
            $tz = eval { DateTime::TimeZone-&gt;new( name =&gt; $tz_olson ) };
        }
        $self-&gt;local_croak("I don't recognise the time zone '$tz_olson'.")
            and return undef
            unless $tz;
        $use_timezone = $set_time_zone = $tz;

    }

    $use_timezone = $self-&gt;{time_zone} unless ($use_timezone);

    print "Using timezone $use_timezone.\n" if $self-&gt;{diagnostic};

    # If there's an epoch, we're done. Just need to check all the others
    if ($epoch) {
        $epoch_dt = DateTime-&gt;from_epoch(
            epoch     =&gt; $epoch,
            time_zone =&gt; $use_timezone
        );

        $Year  = $epoch_dt-&gt;year;
        $Month = $epoch_dt-&gt;month;
        $Day   = $epoch_dt-&gt;day;

        $Hour       = $epoch_dt-&gt;hour;
        $Minute     = $epoch_dt-&gt;minute;
        $Second     = $epoch_dt-&gt;second;
        $Nanosecond = $epoch_dt-&gt;nanosecond;

        print $epoch_dt-&gt;strftime("Epoch: %D %T.%N\n") if $self-&gt;{diagnostic};
    }

    # Work out the year we're working with:
    if ($year_100) {
        if ($century) {
            $Year = ( ( $century * 100 ) - 0 ) + $year_100;
        }
        else {
            print "No century, guessing for $year_100" if $self-&gt;{diagnostic};
            if ( $year_100 &gt;= 69 and $year_100 &lt;= 99 ) {
                print "Guessed 1900s" if $self-&gt;{diagnostic};
                $Year = 1900 + $year_100;
            }
            else {
                print "Guessed 2000s" if $self-&gt;{diagnostic};
                $Year = 2000 + $year_100;
            }
        }
    }
    if ($year) {
        $self-&gt;local_croak(
            "Your two year values ($year_100 and $year) do not match.")
            and return undef
            if ( $Year &amp;&amp; ( $year != $Year ) );
        $Year = $year;
    }
    if ($ce_year) {
        $self-&gt;local_croak(
            "Your two year values ($ce_year and $year) do not match.")
            and return undef
            if ( $Year &amp;&amp; ( $ce_year != $Year ) );
        $Year = $ce_year;
    }
    $self-&gt;local_croak("Your year value does not match your epoch.")
        and return undef
        if $epoch_dt
            and $Year
            and $Year != $epoch_dt-&gt;year;

    # Work out which month we want
    # Month names
    if ($month_name) {
        $self-&gt;local_croak(
            "There is no use providing a month name ($month_name) without providing a year."
            )
            and return undef
            unless $Year;
        my $month_count  = 0;
        my $month_number = 0;
        foreach my $month ( @{ $self-&gt;{_locale}-&gt;month_format_wide } ) {
            $month_count++;

            # 			use bytes;
            if ( lc $month eq lc $month_name ) {
                $month_number = $month_count;
                last;
            }
        }
        unless ($month_number) {
            my $month_count = 0;
            foreach
                my $month ( @{ $self-&gt;{_locale}-&gt;month_format_abbreviated } )
            {
                $month_count++;

                # 				use bytes;
                # When abbreviating, sometimes there's a period, sometimes not.
                $month      =~ s/\.$//;
                $month_name =~ s/\.$//;
                if ( lc $month eq lc $month_name ) {
                    $month_number = $month_count;
                    last;
                }
            }
        }
        unless ($month_number) {
            $self-&gt;local_croak(
                "$month_name is not a recognised month in this locale.")
                and return undef;
        }
        $Month = $month_number;
    }
    if ($month) {
        $self-&gt;local_croak(
            "There is no use providing a month without providing a year.")
            and return undef
            unless $Year;
        $self-&gt;local_croak("$month is too large to be a month of the year.")
            and return undef
            unless $month &lt;= 12;
        $self-&gt;local_croak(
            "Your two month values ($month_name and $month) do not match.")
            and return undef
            if $Month
                and $month != $Month;
        $Month = $month;
    }
    $self-&gt;local_croak("Your month value does not match your epoch.")
        and return undef
        if $epoch_dt
            and $Month
            and $Month != $epoch_dt-&gt;month;
    if ($doy) {
        $self-&gt;local_croak(
            "There is no use providing a day of the year without providing a year."
            )
            and return undef
            unless $Year;
        $doy_dt = eval {
            DateTime-&gt;from_day_of_year(
                year      =&gt; $Year, day_of_year =&gt; $doy,
                time_zone =&gt; $use_timezone
            );
        };
        $self-&gt;local_croak("Day of year $Year-$doy is not valid")
            and return undef
            if $@;

        my $month = $doy_dt-&gt;month;
        $self-&gt;local_croak( "Your day of the year ($doy - in "
                . $doy_dt-&gt;month_name
                . ") is not in your month ($Month)" )
            and return undef
            if $Month
                and $month != $Month;
        $Month = $month;
    }
    $self-&gt;local_croak("Your day of the year does not match your epoch.")
        and return undef
        if $epoch_dt
            and $doy_dt
            and $doy_dt-&gt;doy != $epoch_dt-&gt;doy;

    # Day of the month
    $self-&gt;local_croak("$day is too large to be a day of the month.")
        and return undef
        unless $day &lt;= 31;
    $self-&gt;local_croak(
        "Your day of the month ($day) does not match your day of the year.")
        and return undef
        if $doy_dt
            and $day
            and $day != $doy_dt-&gt;day;
    $Day ||=
          ($day)    ? $day
        : ($doy_dt) ? $doy_dt-&gt;day
        :             '';
    if ($Day) {
        $self-&gt;local_croak(
            "There is no use providing a day without providing a month and year."
            )
            and return undef
            unless $Year
                and $Month;
        my $dt = eval {
            DateTime-&gt;new(
                year =&gt; $Year + 0, month     =&gt; $Month + 0, day =&gt; $Day + 0,
                hour =&gt; 12,        time_zone =&gt; $use_timezone
            );
        };
        $self-&gt;local_croak("Datetime $Year-$Month-$Day is not a valid date")
            and return undef
            if $@;
        $self-&gt;local_croak("There is no day $Day in $dt-&gt;month_name, $Year")
            and return undef
            unless $dt-&gt;month == $Month;
    }
    $self-&gt;local_croak("Your day of the month does not match your epoch.")
        and return undef
        if $epoch_dt
            and $Day
            and $Day != $epoch_dt-&gt;day;

    # Hour of the day
    $self-&gt;local_croak("$hour_24 is too large to be an hour of the day.")
        and return undef
        unless $hour_24 &lt;= 23;    #OK so leap seconds will break!
    $self-&gt;local_croak("$hour_12 is too large to be an hour of the day.")
        and return undef
        unless $hour_12 &lt;= 12;
    $self-&gt;local_croak(
        "You must specify am or pm for 12 hour clocks ($hour_12|$ampm).")
        and return undef
        if ( $hour_12 &amp;&amp; ( !$ampm ) );
    ( $Am, $Pm ) = @{ $self-&gt;{_locale}-&gt;am_pm_abbreviated };
    if ( lc $ampm eq lc $Pm ) {
        if ($hour_12) {
            $hour_12 += 12 if $hour_12 and $hour_12 != 12;
        }
        $self-&gt;local_croak(
            "Your am/pm value ($ampm) does not match your hour ($hour_24)")
            and return undef
            if $hour_24
                and $hour_24 &lt; 12;
    }
    elsif ( lc $ampm eq lc $Am ) {
        if ($hour_12) {
            $hour_12 = 0 if $hour_12 == 12;
        }
        $self-&gt;local_croak(
            "Your am/pm value ($ampm) does not match your hour ($hour_24)")
            and return undef
            if $hour_24 &gt;= 12;
    }
    if ( $hour_12 and $hour_24 ) {
        $self-&gt;local_croak(
            "You have specified mis-matching 12 and 24 hour clock information"
            )
            and return undef
            unless $hour_12 == $hour_24;
        $Hour = $hour_24;
    }
    elsif ($hour_12) {
        $Hour = $hour_12;
    }
    elsif ($hour_24) {
        $Hour = $hour_24;
    }
    $self-&gt;local_croak("Your hour does not match your epoch.")
        and return undef
        if $epoch_dt
            and $Hour
            and $Hour != $epoch_dt-&gt;hour;
    print "Set hour to $Hour.\n" if $self-&gt;{diagnostic};

    # Minutes
    $self-&gt;local_croak("$minute is too large to be a minute.")
        and return undef
        unless $minute &lt;= 59;
    $Minute ||= $minute;
    $self-&gt;local_croak("Your minute does not match your epoch.")
        and return undef
        if $epoch_dt
            and $Minute
            and $Minute != $epoch_dt-&gt;minute;
    print "Set minute to $Minute.\n" if $self-&gt;{diagnostic};

    # Seconds
    $self-&gt;local_croak("$second is too large to be a second.")
        and return undef
        unless $second &lt;= 59;    #OK so leap seconds will break!
    $Second ||= $second;
    $self-&gt;local_croak("Your second does not match your epoch.")
        and return undef
        if $epoch_dt
            and $Second
            and $Second != $epoch_dt-&gt;second;
    print "Set second to $Second.\n" if $self-&gt;{diagnostic};

    # Nanoeconds
    $self-&gt;local_croak("$nanosecond is too large to be a nanosecond.")
        and return undef
        unless length($nanosecond) &lt;= 9;
    $Nanosecond ||= $nanosecond;
    $Nanosecond .= '0' while length($Nanosecond) &lt; 9;

    #	Epoch doesn't return nanoseconds
    #	croak "Your nanosecond does not match your epoch." if $epoch_dt and $Nanosecond and $Nanosecond != $epoch_dt-&gt;nanosecond;
    print "Set nanosecond to $Nanosecond.\n" if $self-&gt;{diagnostic};

    my $potential_return = eval {
        DateTime-&gt;new(
            year  =&gt; ( $Year  || 1 ) + 0,
            month =&gt; ( $Month || 1 ) + 0,
            day   =&gt; ( $Day   || 1 ) + 0,

            hour       =&gt; ( $Hour       || 0 ) + 0,
            minute     =&gt; ( $Minute     || 0 ) + 0,
            second     =&gt; ( $Second     || 0 ) + 0,
            nanosecond =&gt; ( $Nanosecond || 0 ) + 0,

            locale    =&gt; $self-&gt;{_locale},
            time_zone =&gt; $use_timezone,
        );
    };
    $self-&gt;local_croak("Datetime is not a valid date") and return undef if $@;

    $self-&gt;local_croak(
        "Your day of the week ($dow_mon_1) does not match the date supplied: "
            . $potential_return-&gt;ymd )
        and return undef
        if $dow_mon_1
            and $potential_return-&gt;dow != $dow_mon_1;

    $self-&gt;local_croak(
        "Your day of the week ($dow_sun_0) does not match the date supplied: "
            . $potential_return-&gt;ymd )
        and return undef
        if $dow_sun_0
            and ( $potential_return-&gt;dow % 7 ) != $dow_sun_0;

    if ($dow_name) {
        my $dow_count  = 0;
        my $dow_number = 0;
        foreach my $dow ( @{ $self-&gt;{_locale}-&gt;day_format_wide } ) {
            $dow_count++;
            use bytes;
            if ( lc $dow eq lc $dow_name ) {
                $dow_number = $dow_count;
                last;
            }
        }
        unless ($dow_number) {
            my $dow_count = 0;
            foreach my $dow ( @{ $self-&gt;{_locale}-&gt;day_format_abbreviated } )
            {
                $dow_count++;
                use bytes;
                if ( lc $dow eq lc $dow_name ) {
                    $dow_number = $dow_count;
                    last;
                }
            }
        }
        unless ($dow_number) {
            $self-&gt;local_croak(
                "$dow_name is not a recognised day in this locale.")
                and return undef;
        }
        $self-&gt;local_croak(
            "Your day of the week ($dow_name) does not match the date supplied: "
                . $potential_return-&gt;ymd )
            and return undef
            if $dow_number
                and $potential_return-&gt;dow != $dow_number;
    }

    $self-&gt;local_croak(
        "Your week number ($week_sun_0) does not match the date supplied: "
            . $potential_return-&gt;ymd )
        and return undef
        if $week_sun_0
            and $potential_return-&gt;strftime('%U') != $week_sun_0;
    $self-&gt;local_croak(
        "Your week number ($week_mon_1) does not match the date supplied: "
            . $potential_return-&gt;ymd )
        and return undef
        if $week_mon_1
            and $potential_return-&gt;strftime('%W') != $week_mon_1;
    $self-&gt;local_croak(
        "Your ISO week year ($iso_week_year) does not match the date supplied: "
            . $potential_return-&gt;ymd )
        and return undef
        if $iso_week_year
            and $potential_return-&gt;strftime('%G') != $iso_week_year;
    $self-&gt;local_croak(
        "Your ISO week year ($iso_week_year_100) does not match the date supplied: "
            . $potential_return-&gt;ymd )
        and return undef
        if $iso_week_year_100
            and $potential_return-&gt;strftime('%g') != $iso_week_year_100;

    # Move into the timezone in the object - if there is one
    print "Potential Datetime: "
        . $potential_return-&gt;strftime("%F %T %z %Z") . "\n"
        if $self-&gt;{diagnostic};
    print "Setting timezone: " . $self-&gt;{set_time_zone} . "\n"
        if $self-&gt;{diagnostic};
    if ( $self-&gt;{set_time_zone} ) {
        $potential_return-&gt;set_time_zone( $self-&gt;{set_time_zone} );
    }
    elsif ($set_time_zone) {
        $potential_return-&gt;set_time_zone($set_time_zone);
    }
    print "Actual Datetime: "
        . $potential_return-&gt;strftime("%F %T %z %Z") . "\n"
        if $self-&gt;{diagnostic};

    return $potential_return;
}

sub parse_duration {
    croak "DateTime::Format::Strptime doesn't do durations.";
}

sub format_datetime {
    my ( $self, $dt ) = @_;
    my $pattern = $self-&gt;pattern;
    $pattern =~ s/%O/$dt-&gt;time_zone-&gt;name/eg;
    return $dt-&gt;clone-&gt;set_locale( $self-&gt;locale )-&gt;strftime($pattern);
}

sub format_duration {
    croak "DateTime::Format::Strptime doesn't do durations.";
}

sub _build_parser {
    my $self = shift;
    my $regex = my $field_list = shift;
    if ( ref $regex eq 'Regexp' ) {
        $field_list =~ s/^\(\?-xism:(.+)\)$/$1/;
    }
    my @fields = $field_list =~ m/(%\{\w+\}|%\d*.)/g;
    $field_list = join( '', @fields );

    # Locale-ize the parser
    my $ampm_list = join( '|', @{ $self-&gt;{_locale}-&gt;am_pm_abbreviated } );
    $ampm_list .= '|' . lc $ampm_list;

    my $default_date_format = $self-&gt;{_locale}-&gt;glibc_date_format;
    my @locale_format = $default_date_format =~ m/(%\{\w+\}|%\d*.)/g;
    $default_date_format = join( '', @locale_format );

    my $default_time_format = $self-&gt;{_locale}-&gt;glibc_time_format;
    @locale_format = $default_time_format =~ m/(%\{\w+\}|%\d*.)/g;
    $default_time_format = join( '', @locale_format );

    my $default_datetime_format = $self-&gt;{_locale}-&gt;glibc_datetime_format;
    @locale_format = $default_datetime_format =~ m/(%\{\w+\}|%\d*.)/g;
    $default_datetime_format = join( '', @locale_format );

    print
        "Date format: $default_date_format\nTime format: $default_time_format\nDatetime format: $default_datetime_format\n"
        if $self-&gt;{diagnostic};

    $regex      =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g;
    $field_list =~ s/%%/__ESCAPED_PERCENT_SIGN_MARKER__/g;

    $regex      =~ s/%c/$self-&gt;{_locale}-&gt;glibc_datetime_format/eg;
    $field_list =~ s/%c/$default_datetime_format/eg;

    # %c is the locale's default datetime format.

    $regex      =~ s/%x/$self-&gt;{_locale}-&gt;glibc_date_format/eg;
    $field_list =~ s/%x/$default_date_format/eg;

    # %x is the locale's default date format.

    $regex      =~ s/%X/$self-&gt;{_locale}-&gt;glibc_time_format/eg;
    $field_list =~ s/%X/$default_time_format/eg;

    # %x is the locale's default time format.

    if ( ref $regex ne 'Regexp' ) {
        $regex = quotemeta($regex);
        $regex =~ s/(?&lt;!\\)\\%/%/g;
        $regex =~ s/%\\\{([^\}]+)\\\}/%{$1}/g;
    }

    $regex      =~ s/%T/%H:%M:%S/g;
    $field_list =~ s/%T/%H%M%S/g;

    # %T is the time as %H:%M:%S.

    $regex      =~ s/%r/%I:%M:%S %p/g;
    $field_list =~ s/%r/%I%M%S%p/g;

    #is the time as %I:%M:%S %p.

    $regex      =~ s/%R/%H:%M/g;
    $field_list =~ s/%R/%H%M/g;

    #is the time as %H:%M.

    $regex      =~ s|%D|%m\\/%d\\/%y|g;
    $field_list =~ s|%D|%m%d%y|g;

    #is the same as %m/%d/%y.

    $regex      =~ s|%F|%Y\\-%m\\-%d|g;
    $field_list =~ s|%F|%Y%m%d|g;

    #is the same as %Y-%m-%d - the ISO date format.

    my $day_re = join(
        '|',
        map      { quotemeta $_ }
            sort { length $b &lt;=&gt; length $a }
            grep( /\W/, @{ $self-&gt;{_locale}-&gt;day_format_wide },
            @{ $self-&gt;{_locale}-&gt;day_format_abbreviated } )
    );
    $day_re .= '|' if $day_re;
    $regex      =~ s/%a/($day_re\\w+)/gi;
    $field_list =~ s/%a/#dow_name#/gi;

    # %a is the day of the week, using the locale's weekday names; either the abbreviated or full name may be specified.
    # %A is the same as %a.

    my $month_re = join(
        '|',
        map      { quotemeta $_ }
            sort { length $b &lt;=&gt; length $a }
            grep( /\s|\d/, @{ $self-&gt;{_locale}-&gt;month_format_wide },
            @{ $self-&gt;{_locale}-&gt;month_format_abbreviated } )
    );
    $month_re .= '|' if $month_re;
    $month_re .= '[^\\s\\d]+';
    $regex      =~ s/%[bBh]/($month_re)/g;
    $field_list =~ s/%[bBh]/#month_name#/g;

    #is the month, using the locale's month names; either the abbreviated or full name may be specified.
    # %B is the same as %b.
    # %h is the same as %b.

    #s/%c//g;
    #is replaced by the locale's appropriate date and time representation.

    $regex      =~ s/%C/([\\d ]?\\d)/g;
    $field_list =~ s/%C/#century#/g;

    #is the century number [0,99]; leading zeros are permitted by not required.

    $regex      =~ s/%[de]/([\\d ]?\\d)/g;
    $field_list =~ s/%[de]/#day#/g;

    #is the day of the month [1,31]; leading zeros are permitted but not required.
    #%e is the same as %d.

    $regex      =~ s/%[Hk]/([\\d ]?\\d)/g;
    $field_list =~ s/%[Hk]/#hour_24#/g;

    #is the hour (24-hour clock) [0,23]; leading zeros are permitted but not required.
    # %k is the same as %H

    $regex      =~ s/%g/([\\d ]?\\d)/g;
    $field_list =~ s/%g/#iso_week_year_100#/g;

    # The year corresponding to the ISO week number, but without the century (0-99).

    $regex      =~ s/%G/(\\d{4})/g;
    $field_list =~ s/%G/#iso_week_year#/g;

    # The year corresponding to the ISO week number.

    $regex      =~ s/%[Il]/([\\d ]?\\d)/g;
    $field_list =~ s/%[Il]/#hour_12#/g;

    #is the hour (12-hour clock) [1-12]; leading zeros are permitted but not required.
    # %l is the same as %I.

    $regex      =~ s/%j/(\\d{1,3})/g;
    $field_list =~ s/%j/#doy#/g;

    #is the day of the year [1,366]; leading zeros are permitted but not required.

    $regex      =~ s/%m/([\\d ]?\\d)/g;
    $field_list =~ s/%m/#month#/g;

    #is the month number [1-12]; leading zeros are permitted but not required.

    $regex      =~ s/%M/([\\d ]?\\d)/g;
    $field_list =~ s/%M/#minute#/g;

    #is the minute [0-59]; leading zeros are permitted but not required.

    $regex      =~ s/%[nt]/\\s+/g;
    $field_list =~ s/%[nt]//g;

    # %n is any white space.
    # %t is any white space.

    $regex      =~ s/%p/($ampm_list)/gi;
    $field_list =~ s/%p/#ampm#/gi;

    # %p is the locale's equivalent of either A.M./P.M. indicator for 12-hour clock.

    $regex      =~ s/%s/(\\d+)/g;
    $field_list =~ s/%s/#epoch#/g;

    # %s is the seconds since the epoch

    $regex      =~ s/%S/([\\d ]?\\d)/g;
    $field_list =~ s/%S/#second#/g;

    # %S is the seconds [0-61]; leading zeros are permitted but not required.

    $regex      =~ s/%(\d*)N/($1) ? "(\\d{$1})" : "(\\d+)"/eg;
    $field_list =~ s/%\d*N/#nanosecond#/g;

    # %N is the nanoseconds (or sub seconds really)

    $regex      =~ s/%U/([\\d ]?\\d)/g;
    $field_list =~ s/%U/#week_sun_0#/g;

    # %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.

    $regex      =~ s/%w/([0-6])/g;
    $field_list =~ s/%w/#dow_sun_0#/g;

    # is the weekday as a decimal number [0-6], with 0 representing Sunday.

    $regex      =~ s/%u/([1-7])/g;
    $field_list =~ s/%u/#dow_mon_1#/g;

    # is the weekday as a decimal number [1-7], with 1 representing Monday - a la DateTime.

    $regex      =~ s/%W/([\\d ]?\\d)/g;
    $field_list =~ s/%W/#week_mon_1#/g;

    #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.

    $regex      =~ s/%y/([\\d ]?\\d)/g;
    $field_list =~ s/%y/#year_100#/g;

    # 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.

    $regex      =~ s/%Y/(\\d{4})/g;
    $field_list =~ s/%Y/#year#/g;

    # is the year including the century (for example, 1998).

    $regex      =~ s|%z|([+-]\\d{4})|g;
    $field_list =~ s/%z/#tz_offset#/g;

    # Timezone Offset.

    $regex      =~ s|%Z|(\\w+)|g;
    $field_list =~ s/%Z/#timezone#/g;

    # The short timezone name.

    $regex      =~ s|%O|(\\w+\\/\\w+)|g;
    $field_list =~ s/%O/#tz_olson#/g;

    # The Olson timezone name.

    $regex      =~ s|%{(\w+)}|(DateTime-&gt;can($1)) ? "(.+)" : ".+"|eg;
    $field_list =~ s|(%{(\w+)})|(DateTime-&gt;can($2)) ? "#$2#" : $1 |eg;

    # Any function in DateTime.

    $regex      =~ s/__ESCAPED_PERCENT_SIGN_MARKER__/\\%/g;
    $field_list =~ s/__ESCAPED_PERCENT_SIGN_MARKER__//g;

    # is replaced by %.
    #print $regex;

    $field_list =~ s/#([a-z0-9_]+)#/\$$1, /gi;
    $field_list =~ s/,\s*$//;

    return qq|($field_list) = \$time_string =~ /$regex/|;
}

# Utility functions

sub local_croak {
    my $self = $_[0];
    return &amp;{ $self-&gt;{on_error} }(@_) if ref( $self-&gt;{on_error} );
    croak( $_[1] ) if $self-&gt;{on_error} eq 'croak';
    $self-&gt;{errmsg} = $_[1];
    return ( $self-&gt;{on_error} eq 'undef' );
}

sub local_carp {
    my $self = $_[0];
    return &amp;{ $self-&gt;{on_error} }(@_) if ref( $self-&gt;{on_error} );
    carp( $_[1] ) if $self-&gt;{on_error} eq 'croak';
    $self-&gt;{errmsg} = $_[1];
    return ( $self-&gt;{on_error} eq 'undef' );
}

sub errmsg {
    $_[0]-&gt;{errmsg};
}

# Exportable functions:

sub strftime {
    my ( $pattern, $dt ) = @_;
    return $dt-&gt;strftime($pattern);
}

sub strptime {
    my ( $pattern, $time_string ) = @_;
    return DateTime::Format::Strptime-&gt;new(
        pattern  =&gt; $pattern,
        on_error =&gt; 'croak'
    )-&gt;parse_datetime($time_string);
}

1;
# ABSTRACT: Parse and format strp and strf time patterns



=pod

=head1 NAME

DateTime::Format::Strptime - Parse and format strp and strf time patterns

=head1 VERSION

version 1.5000

=head1 SYNOPSIS

  use DateTime::Format::Strptime;

  my $Strp = new DateTime::Format::Strptime(
  				pattern     =&gt; '%T',
  				locale      =&gt; 'en_AU',
  				time_zone   =&gt; 'Australia/Melbourne',
  			);

  my $dt = $Strp-&gt;parse_datetime('23:16:42');

  $Strp-&gt;format_datetime($dt);
	# 23:16:42



  # Croak when things go wrong:
  my $Strp = new DateTime::Format::Strptime(
  				pattern 	=&gt; '%T',
  				locale	    =&gt; 'en_AU',
  				time_zone	=&gt; 'Australia/Melbourne',
  				on_error	=&gt; 'croak',
  			);

  $newpattern = $Strp-&gt;pattern('%Q');
  # Unidentified token in pattern: %Q in %Q at line 34 of script.pl

  # Do something else when things go wrong:
  my $Strp = new DateTime::Format::Strptime(
  				pattern 	=&gt; '%T',
  				locale	    =&gt; 'en_AU',
  				time_zone	=&gt; 'Australia/Melbourne',
  				on_error	=&gt; \&amp;phone_police,
  			);

=head1 DESCRIPTION

This module implements most of C&lt;strptime(3)&gt;, the POSIX function that
is the reverse of C&lt;strftime(3)&gt;, for C&lt;DateTime&gt;. While C&lt;strftime&gt;
takes a C&lt;DateTime&gt; and a pattern and returns a string, C&lt;strptime&gt; takes
a string and a pattern and returns the C&lt;DateTime&gt; object
associated.

=head1 CONSTRUCTOR

=over 4

=item * new( pattern=&gt;$strptime_pattern )

Creates the format object. You must specify a pattern, you can also
specify a C&lt;time_zone&gt; and a C&lt;locale&gt;. If you specify a time zone
then any resulting C&lt;DateTime&gt; object will be in that time zone. If you
do not specify a C&lt;time_zone&gt; parameter, but there is a time zone in the
string you pass to C&lt;parse_datetime&gt;, then the resulting C&lt;DateTime&gt; will
use that time zone.

You can optionally use an on_error parameter. This parameter has three
valid options:

=over 4

=item * 'undef'

(not undef, 'undef', it's a string not an undefined value)

This is the default behavior. The module will return undef whenever it
gets upset. The error can be accessed using the $object-&gt;errstr method.
This is the ideal behaviour for interactive use where a user might
provide an illegal pattern or a date that doesn't match the pattern.

=item * 'croak'

(not croak, 'croak', it's a string, not a function)

This used to be the default behaviour. The module will croak with an
error message whenever it gets upset.

=item * sub{...} or \&amp;subname

When given a code ref, the module will call that sub when it gets upset.
The sub receives two parameters: the object and the error message. Using
these two it is possible to emulate the 'undef' behavior. (Returning a
true value causes the method to return undef. Returning a false value
causes the method to bravely continue):

sub{$_[0]-&gt;{errmsg} = $_[1]; 1},

=back

=back

=head1 METHODS

This class offers the following methods.

=over 4

=item * parse_datetime($string)

Given a string in the pattern specified in the constructor, this method
will return a new C&lt;DateTime&gt; object.

If given a string that doesn't match the pattern, the formatter will
croak or return undef, depending on the setting of on_error in the constructor.

=item * format_datetime($datetime)

Given a C&lt;DateTime&gt; object, this methods returns a string formatted in
the object's format. This method is synonymous with C&lt;DateTime&gt;'s
strftime method.

=item * locale($locale)

When given a locale or C&lt;DateTime::Locale&gt; object, this method sets
its locale appropriately. If the locale is not understood, the method
will croak or return undef (depending on the setting of on_error in
the constructor)

If successful this method returns the current locale. (After
processing as above).

=item * pattern($strptime_pattern)

When given a pattern, this method sets the object's pattern. If the
pattern is invalid, the method will croak or return undef (depending on
the value of the C&lt;on_error&gt; parameter)

If successful this method returns the current pattern. (After processing
as above)

=item * time_zone($time_zone)

When given a name, offset or C&lt;DateTime::TimeZone&gt; object, this method
sets the object's time zone. This effects the C&lt;DateTime&gt; object
returned by parse_datetime

If the time zone is invalid, the method will croak or return undef
(depending on the value of the C&lt;on_error&gt; parameter)

If successful this method returns the current time zone. (After processing
as above)

=item * errmsg

If the on_error behavior of the object is 'undef', error messages with
this method so you can work out why things went wrong.

This code emulates a C&lt;$DateTime::Format::Strptime&gt; with
the C&lt;on_error&gt; parameter equal to C&lt;'croak'&gt;:

C&lt;$Strp-&gt;pattern($pattern) or die $DateTime::Format::Strptime::errmsg&gt;

=back

=head1 EXPORTS

There are no methods exported by default, however the following are
available:

=over 4

=item * strptime($strptime_pattern, $string)

Given a pattern and a string this function will return a new C&lt;DateTime&gt;
object.

=item * strftime($strftime_pattern, $datetime)

Given a pattern and a C&lt;DateTime&gt; object this function will return a
formatted string.

=back

=head1 STRPTIME PATTERN TOKENS

The following tokens are allowed in the pattern string for strptime
(parse_datetime):

=over 4

=item * %%

The % character.

=item * %a or %A

The weekday name according to the current locale, in abbreviated form or
the full name.

=item * %b or %B or %h

The month name according to the current locale, in abbreviated form or
the full name.

=item * %C

The century number (0-99).

=item * %d or %e

The day of month (1-31).

=item * %D

Equivalent to %m/%d/%y. (This is the American style date, very confusing
to non-Americans, especially since %d/%m/%y is	widely used in Europe.
The ISO 8601 standard pattern is %F.)

=item * %F

Equivalent to %Y-%m-%d. (This is the ISO style date)

=item * %g

The year corresponding to the ISO week number, but without the century
(0-99).

=item * %G

The year corresponding to the ISO week number.

=item * %H

The hour (0-23).

=item * %I

The hour on a 12-hour clock (1-12).

=item * %j

The day number in the year (1-366).

=item * %m

The month number (1-12).

=item * %M

The minute (0-59).

=item * %n

Arbitrary whitespace.

=item * %N

Nanoseconds. For other sub-second values use C&lt;%[number]N&gt;.

=item * %p

The equivalent of AM or PM according to the locale in use. (See
L&lt;DateTime::Locale&gt;)

=item * %r

Equivalent to %I:%M:%S %p.

=item * %R

Equivalent to %H:%M.

=item * %s

Number of seconds since the Epoch.

=item * %S

The second (0-60; 60 may occur for leap seconds. See
L&lt;DateTime::LeapSecond&gt;).

=item * %t

Arbitrary whitespace.

=item * %T

Equivalent to %H:%M:%S.

=item * %U

The week number with Sunday the first day of the week (0-53). The first
Sunday of January is the first day of week 1.

=item * %u

The weekday number (1-7) with Monday = 1. This is the C&lt;DateTime&gt; standard.

=item * %w

The weekday number (0-6) with Sunday = 0.

=item * %W

The week number with Monday the first day of the week (0-53). The first
Monday of January is the first day of week 1.

=item * %y

The year within century (0-99). When a century is not otherwise
specified, values in the range 69-99 refer to years in the twentieth
century (1969-1999); values in the range 00-68 refer to years in the
twenty-first century (2000-2068).

=item * %Y

The year, including century (for example, 1991).

=item * %z

An RFC-822/ISO 8601 standard time zone specification. (For example
+1100) [See note below]

=item * %Z

The timezone name. (For example EST -- which is ambiguous) [See note
below]

=item * %O

This extended token allows the use of Olson Time Zone names to appear
in parsed strings. B&lt;NOTE&gt;: This pattern cannot be passed to C&lt;DateTime&gt;'s
C&lt;strftime()&gt; method, but can be passed to C&lt;format_datetime()&gt;.

=back

=head1 AUTHOR EMERITUS

This module was created by Rick Measham.

=head1 BUGS

Please report any bugs or feature requests to
C&lt;bug-datetime-format-strptime@rt.cpan.org&gt;, or through the web interface at
L&lt;http://rt.cpan.org&gt;. I will be notified, and then you'll automatically be
notified of progress on your bug as I make changes.

=head1 SEE ALSO

C&lt;datetime@perl.org&gt; mailing list.

http://datetime.perl.org/

L&lt;perl&gt;, L&lt;DateTime&gt;, L&lt;DateTime::TimeZone&gt;, L&lt;DateTime::Locale&gt;

=head1 AUTHOR

Dave Rolsky &lt;autarch@urth.org&gt;

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2010 by Dave Rolsky.

This is free software, licensed under:

  The Artistic License 2.0

=cut


__END__

</pre></body></html>