File Coverage

blib/lib/Devel/Declare/Interface.pm

Criterion	Covered	Total	%
statement	32	36	88.8
branch	8	18	44.4
condition	6	14	42.8
subroutine	8	8	100.0
pod	3	3	100.0
total	57	79	72.1

package Devel::Declare::Interface;
use strict;
use warnings;

use base 'Exporter';
use Carp;

our @EXPORT = qw/register_parser get_parser enhance/;

our %REGISTER = (
    codeblock => [ 'Devel::Declare::Parser::Codeblock', 0 ],
    method    => [ 'Devel::Declare::Parser::Method',    0 ],
    sublike   => [ 'Devel::Declare::Parser::Sublike',   0 ],
    codelast  => [ 'Devel::Declare::Parser',            0 ],
);

sub register_parser {
    my ( $name, $rclass ) = @_;
    croak( "No name for registration" ) unless $name;
    $rclass ||= caller;
    croak( "Parser $name already registered" )
        if $REGISTER{ $name } && $REGISTER{ $name }->[0] ne $rclass;
    $REGISTER{ $name } = [ $rclass, 0 ];
}

sub get_parser {
    my ( $name ) = @_;
    croak( "No name for parser" ) unless $name;
    unless ( $REGISTER{$name} ) {
        if ( $name =~ m/::/g ) {
            return $name if eval "require $name; 1";
            warn @_;
        }
        croak( "No parser found for $name" );
    }
    unless( $REGISTER{$name}->[1] ) {
        eval "require " . $REGISTER{$name}->[0] . "; 1" || die($@);
        $REGISTER{$name}->[1]++;
    }
    return $REGISTER{ $name }->[0];
}

sub enhance {
    my ( $for, $name, $parser, $type ) = @_;
    croak "You must specify a class, a function name, and a parser"
        unless $for && $name && $parser;
    $type ||= 'const';

    require Devel::Declare;
    Devel::Declare->setup_for(
        $for,
        {
            $name => {
                $type => sub {
                    my $pclass = get_parser( $parser );
                    my $parser = $pclass->new( $name, @_ );
                    $parser->process();
                }
            }
        }
    );
}

1;

__END__