1package DateTime::Format::Builder::Parser::Strptime; 2{ 3 $DateTime::Format::Builder::Parser::Strptime::VERSION = '0.81'; 4} 5 6 7use strict; 8use warnings; 9use vars qw( @ISA ); 10use DateTime::Format::Strptime 1.04; 11use Params::Validate qw( validate SCALAR HASHREF ); 12 13use DateTime::Format::Builder::Parser::generic; 14@ISA = qw( DateTime::Format::Builder::Parser::generic ); 15 16__PACKAGE__->valid_params( 17 strptime => { 18 type => SCALAR 19 | HASHREF, # straight pattern or options to DTF::Strptime 20 }, 21); 22 23sub create_parser { 24 my ( $self, %args ) = @_; 25 26 # Arguments to DTF::Strptime 27 my $pattern = $args{strptime}; 28 29 # Create our strptime parser 30 my $strptime = DateTime::Format::Strptime->new( 31 ( ref $pattern ? %$pattern : ( pattern => $pattern ) ), 32 ); 33 unless ( ref $self ) { 34 $self = $self->new(%args); 35 } 36 $self->{strptime} = $strptime; 37 38 # Create our parser 39 return $self->generic_parser( 40 ( 41 map { exists $args{$_} ? ( $_ => $args{$_} ) : () } 42 qw( 43 on_match on_fail preprocess postprocess 44 ) 45 ), 46 label => $args{label}, 47 ); 48} 49 50sub do_match { 51 my $self = shift; 52 my $date = shift; 53 local $^W; # bizarre bug 54 # Do the match! 55 my $dt = eval { $self->{strptime}->parse_datetime($date) }; 56 return $@ ? undef : $dt; 57} 58 59sub post_match { 60 return $_[2]; 61} 62 631; 64 65# ABSTRACT: strptime based date parsing 66 67__END__ 68 69=pod 70 71=head1 NAME 72 73DateTime::Format::Builder::Parser::Strptime - strptime based date parsing 74 75=head1 VERSION 76 77version 0.81 78 79=head1 SYNOPSIS 80 81 my $parser = DateTime::Format::Builder->create_parser( 82 strptime => '%e/%b/%Y:%H:%M:%S %z', 83 ); 84 85=head1 SPECIFICATION 86 87=over 4 88 89=item * 90 91B<strptime> takes as its argument a strptime string. 92See L<DateTime::Format::Strptime> for more information 93on valid patterns. 94 95=back 96 97=head1 SUPPORT 98 99See L<DateTime::Format::Builder> for details. 100 101=head1 SEE ALSO 102 103C<datetime@perl.org> mailing list. 104 105http://datetime.perl.org/ 106 107L<perl>, L<DateTime>, 108L<DateTime::Format::Builder> 109 110=head1 AUTHORS 111 112=over 4 113 114=item * 115 116Dave Rolsky <autarch@urth.org> 117 118=item * 119 120Iain Truskett 121 122=back 123 124=head1 COPYRIGHT AND LICENSE 125 126This software is Copyright (c) 2013 by Dave Rolsky. 127 128This is free software, licensed under: 129 130 The Artistic License 2.0 (GPL Compatible) 131 132=cut 133