1package DateTime::Format::Builder::Parser::generic; 2use strict; 3use vars qw( $VERSION ); 4use Carp; 5use Params::Validate qw( 6 validate SCALAR CODEREF UNDEF 7); 8 9$VERSION = '0.77'; 10 11=head1 NAME 12 13DateTime::Format::Builder::Parser::generic - Useful routines 14 15=head1 METHODS 16 17=head2 Useful 18 19=head3 new 20 21Standard constructor. Returns a blessed hash; any arguments are placed 22in the hash. This is useful for storing information between methods. 23 24=cut 25 26sub new 27{ 28 my $class = shift; 29 bless { @_ }, $class; 30} 31 32=head3 generic_parser 33 34This is a method provided solely for the benefit of 35C<Parser> implementations. It semi-neatly abstracts 36a lot of the work involved. 37 38Basically, it takes parameters matching the assorted 39callbacks from the parser declarations and makes a coderef 40out of it all. 41 42Currently recognized callbacks are: 43 44=over 4 45 46=item * 47 48on_match 49 50=item * 51 52on_fail 53 54=item * 55 56preprocess 57 58=item * 59 60postprocess 61 62=back 63 64=cut 65 66sub generic_parser { 67 my $class = shift; 68 my %args = validate( @_, { 69 ( map { $_ => { type => CODEREF, optional => 1 } } qw( 70 on_match on_fail preprocess postprocess 71 ) ), 72 label => { type => SCALAR|UNDEF, optional => 1 }, 73 }); 74 my $label = $args{label}; 75 76 my $callback = (exists $args{on_match} or exists $args{on_fail}) ? 1 : undef; 77 78 return sub 79 { 80 my ($self, $date, $p, @args) = @_; 81 return unless defined $date; 82 my %p; 83 %p = %$p if $p; # Look! A Copy! 84 85 my %param = ( 86 self => $self, 87 ( defined $label ? ( label => $label ) : ()), 88 (@args ? (args => \@args) : ()), 89 ); 90 91 # Preprocess - can modify $date and fill %p 92 if ($args{preprocess}) 93 { 94 $date = $args{preprocess}->( input => $date, parsed => \%p, %param ); 95 } 96 97 my $rv = $class->do_match( $date, @args ) if $class->can('do_match'); 98 99 # Funky callback thing 100 if ($callback) 101 { 102 my $type = defined $rv ? "on_match" : "on_fail"; 103 $args{$type}->( input => $date, %param ) if $args{$type}; 104 } 105 return unless defined $rv; 106 107 my $dt; 108 $dt = $class->post_match( $date, $rv, \%p ) if $class->can('post_match'); 109 110 # Allow post processing. Return undef if regarded as failure 111 if ($args{postprocess}) 112 { 113 my $rv = $args{postprocess}->( 114 parsed => \%p, 115 input => $date, 116 post => $dt, 117 %param, 118 ); 119 return unless $rv; 120 } 121 122 # A successful match! 123 $dt = $class->make( $date, $dt, \%p ) if $class->can('make'); 124 return $dt; 125 }; 126} 127 128=head2 Methods for subclassing 129 130These are methods you should define when writing your own subclass. 131 132B<Note>: these methods do not exist in this class. There is no point 133trying to call C<< $self->SUPER::do_match( ... ) >>. 134 135=head3 do_match 136 137C<do_match> is the first phase. Arguments are the date and @args. 138C<self>, C<label>, C<args>. Return value must be defined if you match 139successfully. 140 141=head3 post_match 142 143C<post_match> is called after the appropriate callback out of 144C<on_match>/C<on_fail> is done. It's passed the date, the return 145value from C<do_match> and the parsing hash. 146 147Its return value is used as the C<post> argument to the C<postprocess> 148callback, and as the second argument to C<make>. 149 150=head3 make 151 152C<make> takes the original input, the return value from C<post_match> 153and the parsing hash and should return a C<DateTime> object or 154undefined. 155 156=head2 Delegations 157 158For use of C<Parser>, this module also delegates C<valid_params> and 159C<params>. This is just convenience to save typing the following: 160 161 DateTime::Format::Builder::Parser->valid_params( blah ) 162 163Instead we get to type: 164 165 $self->valid_params( blah ); 166 __PACKAGE__->valid_params( blah ); 167 168=cut 169 170{ 171 no strict 'refs'; 172 for (qw( valid_params params )) 173 { 174 *$_ = *{"DateTime::Format::Builder::Parser::$_"}; 175 } 176} 177 1781; 179 180__END__ 181 182=head1 WRITING A SUBCLASS 183 184Rather than attempt to explain how it all works, I think it's best if 185you take a look at F<Regex.pm> and F<Strptime.pm> as examples and 186work from there. 187 188=head1 THANKS 189 190See L<DateTime::Format::Builder>. 191 192=head1 SUPPORT 193 194Support for this module is provided via the datetime@perl.org email 195list. See http://lists.perl.org/ for more details. 196 197Alternatively, log them via the CPAN RT system via the web or email: 198 199 http://perl.dellah.org/rt/dtbuilder 200 bug-datetime-format-builder@rt.cpan.org 201 202This makes it much easier for me to track things and thus means 203your problem is less likely to be neglected. 204 205=head1 LICENCE AND COPYRIGHT 206 207Copyright E<copy> Iain Truskett, 2003. All rights reserved. 208 209This library is free software; you can redistribute it and/or modify 210it under the same terms as Perl itself, either Perl version 5.000 or, 211at your option, any later version of Perl 5 you may have available. 212 213The full text of the licences can be found in the F<Artistic> and 214F<COPYING> files included with this module, or in L<perlartistic> and 215L<perlgpl> as supplied with Perl 5.8.1 and later. 216 217=head1 AUTHOR 218 219Iain Truskett <spoon@cpan.org> 220 221=head1 SEE ALSO 222 223C<datetime@perl.org> mailing list. 224 225http://datetime.perl.org/ 226 227L<perl>, L<DateTime>, L<DateTime::Format::Builder>, 228L<DateTime::Format::Builder::Parser>. 229 230=cut 231 232