File Coverage

blib/lib/DateTime/Format/Builder/Parser/Regex.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	10	12	83.3
condition	2	2	100.0
subroutine	8	8	100.0
pod	3	4	75.0
total	61	64	95.3

package DateTime::Format::Builder::Parser::Regex;

use strict;
use warnings;

our $VERSION = '0.83';

use Params::Validate qw( validate ARRAYREF SCALARREF HASHREF CODEREF );

use parent 'DateTime::Format::Builder::Parser::generic';

__PACKAGE__->valid_params(

    # How to match
    params => {
        type => ARRAYREF,    # mapping $1,$2,... to new args
    },
    regex => {
        type      => SCALARREF,
        callbacks => {
            'is a regex' => sub { ref(shift) eq 'Regexp' }
        }
    },

    # How to create
    extra => {
        type     => HASHREF,
        optional => 1,
    },
    constructor => {
        type      => CODEREF | ARRAYREF,
        optional  => 1,
        callbacks => {
            'array has 2 elements' => sub {
                ref( $_[0] ) eq 'ARRAY' ? ( @{ $_[0] } == 2 ) : 1;
            }
        }
    },
);

sub do_match {
    my $self    = shift;
    my $date    = shift;
    my @matches = $date =~ $self->{regex};
    return @matches ? \@matches : undef;
}

sub post_match {
    my $self = shift;
    my ( $date, $matches, $p ) = @_;

    # Fill %p from match
    @{$p}{ @{ $self->{params} } } = @$matches;
    return;
}

sub make {
    my $self = shift;
    my ( $date, $dt, $p ) = @_;
    my @args = ( %$p, %{ $self->{extra} } );
    if ( my $cons = $self->{constructor} ) {
        if ( ref $cons eq 'ARRAY' ) {
            my ( $class, $method ) = @$cons;
            return $class->$method(@args);
        }
        elsif ( ref $cons eq 'CODE' ) {
            return $self->$cons(@args);
        }
    }
    else {
        return DateTime->new(@args);
    }
}

sub create_parser {
    my ( $self, %args ) = @_;
    $args{extra} ||= {};
    unless ( ref $self ) {
        $self = $self->new(%args);
    }

    # Create our parser
    return $self->generic_parser(
        (
            map { exists $args{$_} ? ( $_ => $args{$_} ) : () }
                qw(
                on_match on_fail preprocess postprocess
                )
        ),
        label => $args{label},
    );
}

1;

# ABSTRACT: Regex based date parsing

__END__

=pod

=encoding UTF-8

=head1 NAME

DateTime::Format::Builder::Parser::Regex - Regex based date parsing

=head1 VERSION

version 0.83

=head1 SYNOPSIS

    my $parser = DateTime::Format::Builder->create_parser(
        regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)T(\d\d)(\d\d)(\d\d)$/,
        params => [qw( year month day hour minute second )],
    );

=head1 SPECIFICATION

In addition to the L<common keys|DateTime::Format::Builder/"SINGLE
SPECIFICATIONS">, C<Regex> supports:

=over 4

=item * regex

B<regex> is a regular expression that should capture elements of the datetime
string. This is a required element. This is the key whose presence indicates
it's a specification that belongs to this class.

=item * params

B<params> is an arrayref of key names. The captures from the regex are mapped
to these (C<$1> to the first element, C<$2> to the second, and so on) and
handed to C<< DateTime->new >>. This is a required element.

=item * extra

B<extra> is a hashref of extra arguments you wish to give to C<< DateTime->new
>>. For example, you could set the C<year> or C<time_zone> to defaults:

    extra => { year => 2004, time_zone => "Australia/Sydney" },

=item *

B<constructor> is either an arrayref or a coderef. If an arrayref then the
first element is a class name or object, and the second element is a method
name (or coderef since Perl allows that sort of thing). The arguments to the
call are anything in C<$p> and anything given in the C<extra> option above.

If only a coderef is supplied, then it is called with arguments of C<$self>,
C<$p> and C<extra>.

In short:

    $self->$coderef( %{$p}, %{ $self->{extra} } );

The method is expected to return a valid L<DateTime> object, or C<undef> in
event of failure, but can conceivably return anything it likes. So long as
it's 'true'.

=back

=head1 SEE ALSO

C<[e-mail]> mailing list.

http://datetime.perl.org/

L<perl>, L<DateTime>,
L<DateTime::Format::Builder>

=head1 SUPPORT

Bugs may be submitted at L<https://github.com/houseabsolute/DateTime-Format-Builder/issues>.

I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.

=head1 SOURCE

The source code repository for DateTime-Format-Builder can be found at L<https://github.com/houseabsolute/DateTime-Format-Builder>.

=head1 AUTHORS

=over 4

=item *

Dave Rolsky <[e-mail]>

=item *

Iain Truskett <[e-mail]>

=back

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2020 by Dave Rolsky.

This is free software, licensed under:

  The Artistic License 2.0 (GPL Compatible)

The full text of the license can be found in the
F<LICENSE> file included with this distribution.

=cut