1package DateTime::Format::Builder::Parser::Regex; 2{ 3 $DateTime::Format::Builder::Parser::Regex::VERSION = '0.81'; 4} 5 6 7use strict; 8use warnings; 9use vars qw( @ISA ); 10use Params::Validate qw( validate ARRAYREF SCALARREF HASHREF CODEREF ); 11 12use DateTime::Format::Builder::Parser::generic; 13@ISA = qw( DateTime::Format::Builder::Parser::generic ); 14 15__PACKAGE__->valid_params( 16 17 # How to match 18 params => { 19 type => ARRAYREF, # mapping $1,$2,... to new() args 20 }, 21 regex => { 22 type => SCALARREF, 23 callbacks => { 24 'is a regex' => sub { ref(shift) eq 'Regexp' } 25 } 26 }, 27 28 # How to create 29 extra => { 30 type => HASHREF, 31 optional => 1, 32 }, 33 constructor => { 34 type => CODEREF | ARRAYREF, 35 optional => 1, 36 callbacks => { 37 'array has 2 elements' => sub { 38 ref( $_[0] ) eq 'ARRAY' ? ( @{ $_[0] } == 2 ) : 1; 39 } 40 } 41 }, 42); 43 44sub do_match { 45 my $self = shift; 46 my $date = shift; 47 my @matches = $date =~ $self->{regex}; 48 return @matches ? \@matches : undef; 49} 50 51sub post_match { 52 my $self = shift; 53 my ( $date, $matches, $p ) = @_; 54 55 # Fill %p from match 56 @{$p}{ @{ $self->{params} } } = @$matches; 57 return; 58} 59 60sub make { 61 my $self = shift; 62 my ( $date, $dt, $p ) = @_; 63 my @args = ( %$p, %{ $self->{extra} } ); 64 if ( my $cons = $self->{constructor} ) { 65 if ( ref $cons eq 'ARRAY' ) { 66 my ( $class, $method ) = @$cons; 67 return $class->$method(@args); 68 } 69 elsif ( ref $cons eq 'CODE' ) { 70 return $self->$cons(@args); 71 } 72 } 73 else { 74 return DateTime->new(@args); 75 } 76} 77 78sub create_parser { 79 my ( $self, %args ) = @_; 80 $args{extra} ||= {}; 81 unless ( ref $self ) { 82 $self = $self->new(%args); 83 } 84 85 # Create our parser 86 return $self->generic_parser( 87 ( 88 map { exists $args{$_} ? ( $_ => $args{$_} ) : () } 89 qw( 90 on_match on_fail preprocess postprocess 91 ) 92 ), 93 label => $args{label}, 94 ); 95} 96 971; 98 99# ABSTRACT: Regex based date parsing 100 101__END__ 102 103=pod 104 105=head1 NAME 106 107DateTime::Format::Builder::Parser::Regex - Regex based date parsing 108 109=head1 VERSION 110 111version 0.81 112 113=head1 SYNOPSIS 114 115 my $parser = DateTime::Format::Builder->create_parser( 116 regex => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)$/, 117 params => [ qw( year month day hour minute second ) ], 118 ); 119 120=head1 SPECIFICATION 121 122In addition to the 123L<common keys|DateTime::Format::Builder/"SINGLE SPECIFICATIONS">, 124C<Regex> supports: 125 126=over 4 127 128=item * 129 130B<regex> is a regular expression that should capture 131elements of the datetime string. 132This is a required element. This is the key whose presence 133indicates it's a specification that belongs to this class. 134 135=item * 136 137B<params> is an arrayref of key names. The captures from the 138regex are mapped to these (C<$1> to the first element, C<$2> 139to the second, and so on) and handed to 140C<< DateTime->new() >>. 141This is a required element. 142 143=item * 144 145B<extra> is a hashref of extra arguments you wish to give to 146C<< DateTime->new() >>. For example, you could set the 147C<year> or C<time_zone> to defaults: 148 149 extra => { year => 2004, time_zone => "Australia/Sydney" }, 150 151=item * 152 153B<constructor> is either an arrayref or a coderef. If an arrayref 154then the first element is a class name or object, and the second 155element is a method name (or coderef since Perl allows that sort of 156thing). The arguments to the call are anything in C<$p> and 157anything given in the C<extra> option above. 158 159If only a coderef is supplied, then it is called with arguments of 160C<$self>, C<$p> and C<extra>. 161 162In short: 163 164 $self->$coderef( %$p, %{ $self->{extra} } ); 165 166The method is expected to return a valid L<DateTime> object, 167or undef in event of failure, but can conceivably return anything 168it likes. So long as it's 'true'. 169 170=back 171 172=head1 SUPPORT 173 174See L<DateTime::Format::Builder> for details. 175 176=head1 SEE ALSO 177 178C<datetime@perl.org> mailing list. 179 180http://datetime.perl.org/ 181 182L<perl>, L<DateTime>, 183L<DateTime::Format::Builder> 184 185=head1 AUTHORS 186 187=over 4 188 189=item * 190 191Dave Rolsky <autarch@urth.org> 192 193=item * 194 195Iain Truskett 196 197=back 198 199=head1 COPYRIGHT AND LICENSE 200 201This software is Copyright (c) 2013 by Dave Rolsky. 202 203This is free software, licensed under: 204 205 The Artistic License 2.0 (GPL Compatible) 206 207=cut 208