File Coverage

blib/lib/DateTime/Format/Builder/Parser/Regex.pm
Criterion Covered Total %
statement 41 41 100.0
branch 10 12 83.3
condition 2 2 100.0
subroutine 9 9 100.0
pod 3 4 75.0
total 65 68 95.5


line stmt bran cond sub pod time code
1             package DateTime::Format::Builder::Parser::Regex;
2             {
3             $DateTime::Format::Builder::Parser::Regex::VERSION = '0.81';
4             }
5              
6              
7 24     24   122 use strict;
  24         39  
  24         746  
8 24     24   111 use warnings;
  24         43  
  24         603  
9 24     24   110 use vars qw( @ISA );
  24         45  
  24         1066  
10 24     24   126 use Params::Validate qw( validate ARRAYREF SCALARREF HASHREF CODEREF );
  24         37  
  24         1665  
11              
12 24     24   15521 use DateTime::Format::Builder::Parser::generic;
  24         60  
  24         16120  
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              
44             sub do_match {
45 41     41 1 67 my $self = shift;
46 41         118 my $date = shift;
47 41         432 my @matches = $date =~ $self->{regex};
48 41 100       207 return @matches ? \@matches : undef;
49             }
50              
51             sub post_match {
52 30     30 1 55 my $self = shift;
53 30         57 my ( $date, $matches, $p ) = @_;
54              
55             # Fill %p from match
56 30         49 @{$p}{ @{ $self->{params} } } = @$matches;
  30         212  
  30         211  
57 30         137 return;
58             }
59              
60             sub make {
61 30     30 1 62 my $self = shift;
62 30         125 my ( $date, $dt, $p ) = @_;
63 30         84 my @args = ( %$p, %{ $self->{extra} } );
  30         185  
64 30 100       122 if ( my $cons = $self->{constructor} ) {
65 5 100       25 if ( ref $cons eq 'ARRAY' ) {
    50          
66 3         7 my ( $class, $method ) = @$cons;
67 3         20 return $class->$method(@args);
68             }
69             elsif ( ref $cons eq 'CODE' ) {
70 2         9 return $self->$cons(@args);
71             }
72             }
73             else {
74 25         147 return DateTime->new(@args);
75             }
76             }
77              
78             sub create_parser {
79 34     34 0 103 my ( $self, %args ) = @_;
80 34   100     208 $args{extra} ||= {};
81 34 50       91 unless ( ref $self ) {
82 34         305 $self = $self->new(%args);
83             }
84              
85             # Create our parser
86 136 100       459 return $self->generic_parser(
87             (
88 34         82 map { exists $args{$_} ? ( $_ => $args{$_} ) : () }
89             qw(
90             on_match on_fail preprocess postprocess
91             )
92             ),
93             label => $args{label},
94             );
95             }
96              
97             1;
98              
99             # ABSTRACT: Regex based date parsing
100              
101             __END__