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