File Coverage

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

Criterion	Covered	Total	%
statement	42	42	100.0
branch	23	30	76.6
condition	2	3	66.6
subroutine	8	8	100.0
pod	2	2	100.0
total	77	85	90.5

package DateTime::Format::Builder::Parser::generic;
{
  $DateTime::Format::Builder::Parser::generic::VERSION = '0.81';
}
use strict;
use warnings;
use Carp;
use Params::Validate qw(
    validate SCALAR CODEREF UNDEF
);



sub new {
    my $class = shift;
    bless {@_}, $class;
}


sub generic_parser {
    my $class = shift;
    my %args  = validate(
        @_,
        {
            (
                map { $_ => { type => CODEREF, optional => 1 } }
                    qw(
                    on_match on_fail preprocess postprocess
                    )
            ),
            label => { type => SCALAR | UNDEF, optional => 1 },
        }
    );
    my $label = $args{label};

    my $callback
        = ( exists $args{on_match} or exists $args{on_fail} ) ? 1 : undef;

    return sub {
        my ( $self, $date, $p, @args ) = @_;
        return unless defined $date;
        my %p;
        %p = %$p if $p;    # Look! A Copy!

        my %param = (
            self => $self,
            ( defined $label ? ( label => $label ) : () ),
            ( @args          ? ( args  => \@args ) : () ),
        );

        # Preprocess - can modify $date and fill %p
        if ( $args{preprocess} ) {
            $date = $args{preprocess}
                ->( input => $date, parsed => \%p, %param );
        }

        my $rv = $class->do_match( $date, @args ) if $class->can('do_match');

        # Funky callback thing
        if ($callback) {
            my $type = defined $rv ? "on_match" : "on_fail";
            $args{$type}->( input => $date, %param ) if $args{$type};
        }
        return unless defined $rv;

        my $dt;
        $dt = $class->post_match( $date, $rv, \%p )
            if $class->can('post_match');

        # Allow post processing. Return undef if regarded as failure
        if ( $args{postprocess} ) {
            my $rv = $args{postprocess}->(
                parsed => \%p,
                input  => $date,
                post   => $dt,
                %param,
            );
            return unless $rv;
        }

        # A successful match!
        $dt = $class->make( $date, $dt, \%p ) if $class->can('make');
        return $dt;
    };
}


{
    no strict 'refs';
    for (qw( valid_params params )) {
        *$_ = *{"DateTime::Format::Builder::Parser::$_"};
    }
}

1;

# ABSTRACT: Useful routines

__END__