File Coverage

blib/lib/Devel/Declare/Interface.pm
Criterion Covered Total %
statement 35 39 89.7
branch 10 20 50.0
condition 6 14 42.8
subroutine 8 8 100.0
pod 3 3 100.0
total 62 84 73.8


line stmt bran cond sub pod time code
1             package Devel::Declare::Interface;
2 5     5   24 use strict;
  5         9  
  5         212  
3 5     5   65 use warnings;
  5         9  
  5         187  
4              
5 5     5   25 use base 'Exporter';
  5         7  
  5         528  
6 5     5   33 use Carp;
  5         7  
  5         2718  
7              
8             our @EXPORT = qw/register_parser get_parser enhance/;
9              
10             our %REGISTER = (
11             codeblock => [ 'Devel::Declare::Parser::Codeblock', 0 ],
12             method => [ 'Devel::Declare::Parser::Method', 0 ],
13             sublike => [ 'Devel::Declare::Parser::Sublike', 0 ],
14             codelast => [ 'Devel::Declare::Parser', 0 ],
15             );
16              
17             sub register_parser {
18 8     8 1 19 my ( $name, $rclass ) = @_;
19 8 50       32 croak( "No name for registration" ) unless $name;
20 8   33     55 $rclass ||= caller;
21 8 50 66     69 croak( "Parser $name already registered" )
22             if $REGISTER{ $name } && $REGISTER{ $name }->[0] ne $rclass;
23 8         32 $REGISTER{ $name } = [ $rclass, 0 ];
24             }
25              
26             sub get_parser {
27 32     32 1 52 my ( $name ) = @_;
28 32 50       76 croak( "No name for parser" ) unless $name;
29 32 50       96 unless ( $REGISTER{$name} ) {
30 0 0       0 if ( $name =~ m/::/g ) {
31 0 0       0 return $name if eval "require $name; 1";
32 0         0 warn @_;
33             }
34 0         0 croak( "No parser found for $name" );
35             }
36 32 100       87 unless( $REGISTER{$name}->[1] ) {
37 6 50       411 eval "require " . $REGISTER{$name}->[0] . "; 1" || die($@);
38 6         23 $REGISTER{$name}->[1]++;
39             }
40 32         72 return $REGISTER{ $name }->[0];
41             }
42              
43             sub enhance {
44 7     7 1 2564 my ( $for, $name, $parser, $type ) = @_;
45 7 50 33     60 croak "You must specify a class, a function name, and a parser"
      33        
46             unless $for && $name && $parser;
47 7   50     38 $type ||= 'const';
48              
49 7 100       18 if ( $parser eq 'begin' ) {
50 1         688 require Devel::BeginLift;
51 1         7812 return Devel::BeginLift->setup_for( $for => [$name] )
52             }
53              
54 6         32 require Devel::Declare;
55             Devel::Declare->setup_for(
56             $for,
57             {
58             $name => {
59             $type => sub {
60 32     32   18442 my $pclass = get_parser( $parser );
61 32         183 my $parser = $pclass->new( $name, @_ );
62 32         105 $parser->process();
63             }
64             }
65             }
66 6         81 );
67             }
68              
69             1;
70              
71             __END__