1package DateTime::Format::Builder::Parser::Dispatch; 2use strict; 3use vars qw( $VERSION %dispatch_data ); 4use Params::Validate qw( CODEREF validate ); 5use DateTime::Format::Builder::Parser; 6 7=head1 NAME 8 9DateTime::Format::Builder::Parser::Dispatch - Dispatch parsers by group 10 11=head1 SYNOPSIS 12 13 package SampleDispatch; 14 use DateTime::Format::Builder 15 ( 16 parsers => { 17 parse_datetime => [ 18 { 19 Dispatch => sub { 20 return 'fnerk'; 21 } 22 } 23 ] 24 }, 25 groups => { 26 fnerk => [ 27 { 28 regex => qr/^(\d{4})(\d\d)(\d\d)$/, 29 params => [qw( year month day )], 30 }, 31 ] 32 } 33 ); 34 35=head1 DESCRIPTION 36 37C<Dispatch> adds another parser type to C<Builder> permitting 38dispatch of parsing according to group names. 39 40=head1 SPECIFICATION 41 42C<Dispatch> has just one key: C<Dispatch>. The value should be a 43reference to a subroutine that returns one of: 44 45=over 4 46 47=item * 48 49C<undef>, meaning no groups could be found. 50 51=item * 52 53An empty list, meaning no groups could be found. 54 55=item * 56 57A single string, meaning: use this group 58 59=item * 60 61A list of strings, meaning: use these groups in this order. 62 63=back 64 65Groups are specified much like the example in the L<SYNOPSIS>. 66They follow the same format as when you specify them for methods. 67 68=head1 SIDEEFFECTS 69 70Your group parser can also be a Dispatch parser. Thus you could 71potentially end up with an infinitely recursive parser. 72 73=cut 74 75$VERSION = '0.78'; 76 77{ 78 no strict 'refs'; 79 *dispatch_data = *DateTime::Format::Builder::dispatch_data; 80 *params = *DateTime::Format::Builder::Parser::params; 81} 82 83DateTime::Format::Builder::Parser->valid_params( 84 Dispatch => { 85 type => CODEREF, 86 } 87); 88 89sub create_parser 90{ 91 my ($self, %args) = @_; 92 my $coderef = $args{Dispatch}; 93 94 return sub { 95 my ($self, $date, $p, @args) = @_; 96 return unless defined $date; 97 my $class = ref($self)||$self; 98 99 my @results = $coderef->( $date ); 100 return unless @results; 101 return unless defined $results[0]; 102 103 for my $group (@results) 104 { 105 my $parser = $dispatch_data{$class}{$group}; 106 die "Unknown parsing group: $class\n" unless defined $parser; 107 my $rv = eval { $parser->parse( $self, $date, $p, @args ) }; 108 return $rv unless $@ or not defined $rv; 109 } 110 return; 111 }; 112} 113 1141; 115 116__END__ 117 118=head1 THANKS 119 120See L<the main module's section|DateTime::Format::Builder/"THANKS">. 121 122=head1 SUPPORT 123 124Support for this module is provided via the datetime@perl.org email 125list. See http://lists.perl.org/ for more details. 126 127Alternatively, log them via the CPAN RT system via the web or email: 128 129 http://perl.dellah.org/rt/dtbuilder 130 bug-datetime-format-builder@rt.cpan.org 131 132This makes it much easier for me to track things and thus means 133your problem is less likely to be neglected. 134 135=head1 LICENCE AND COPYRIGHT 136 137Copyright E<copy> Iain Truskett, 2003. All rights reserved. 138 139This library is free software; you can redistribute it and/or modify 140it under the same terms as Perl itself, either Perl version 5.000 or, 141at your option, any later version of Perl 5 you may have available. 142 143The full text of the licences can be found in the F<Artistic> and 144F<COPYING> files included with this module, or in L<perlartistic> and 145L<perlgpl> as supplied with Perl 5.8.1 and later. 146 147=head1 AUTHOR 148 149Iain Truskett <spoon@cpan.org> 150 151=head1 SEE ALSO 152 153C<datetime@perl.org> mailing list. 154 155http://datetime.perl.org/ 156 157L<perl>, L<DateTime>, 158L<DateTime::Format::Builder> 159 160=cut 161 162 163