| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Devel::Declare::Interface; |
|
2
|
5
|
|
|
5
|
|
18
|
use strict; |
|
|
5
|
|
|
|
|
7
|
|
|
|
5
|
|
|
|
|
166
|
|
|
3
|
5
|
|
|
5
|
|
24
|
use warnings; |
|
|
5
|
|
|
|
|
6
|
|
|
|
5
|
|
|
|
|
135
|
|
|
4
|
|
|
|
|
|
|
|
|
5
|
5
|
|
|
5
|
|
21
|
use base 'Exporter'; |
|
|
5
|
|
|
|
|
7
|
|
|
|
5
|
|
|
|
|
563
|
|
|
6
|
5
|
|
|
5
|
|
25
|
use Carp; |
|
|
5
|
|
|
|
|
6
|
|
|
|
5
|
|
|
|
|
2105
|
|
|
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
|
14
|
my ( $name, $rclass ) = @_; |
|
19
|
8
|
50
|
|
|
|
22
|
croak( "No name for registration" ) unless $name; |
|
20
|
8
|
|
33
|
|
|
36
|
$rclass ||= caller; |
|
21
|
8
|
50
|
66
|
|
|
46
|
croak( "Parser $name already registered" ) |
|
22
|
|
|
|
|
|
|
if $REGISTER{ $name } && $REGISTER{ $name }->[0] ne $rclass; |
|
23
|
8
|
|
|
|
|
26
|
$REGISTER{ $name } = [ $rclass, 0 ]; |
|
24
|
|
|
|
|
|
|
} |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub get_parser { |
|
27
|
32
|
|
|
32
|
1
|
40
|
my ( $name ) = @_; |
|
28
|
32
|
50
|
|
|
|
68
|
croak( "No name for parser" ) unless $name; |
|
29
|
32
|
50
|
|
|
|
77
|
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
|
|
|
|
71
|
unless( $REGISTER{$name}->[1] ) { |
|
37
|
6
|
50
|
|
|
|
552
|
eval "require " . $REGISTER{$name}->[0] . "; 1" || die($@); |
|
38
|
6
|
|
|
|
|
17
|
$REGISTER{$name}->[1]++; |
|
39
|
|
|
|
|
|
|
} |
|
40
|
32
|
|
|
|
|
63
|
return $REGISTER{ $name }->[0]; |
|
41
|
|
|
|
|
|
|
} |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub enhance { |
|
44
|
7
|
|
|
7
|
1
|
1432
|
my ( $for, $name, $parser, $type ) = @_; |
|
45
|
7
|
50
|
33
|
|
|
46
|
croak "You must specify a class, a function name, and a parser" |
|
|
|
|
33
|
|
|
|
|
|
46
|
|
|
|
|
|
|
unless $for && $name && $parser; |
|
47
|
7
|
|
50
|
|
|
26
|
$type ||= 'const'; |
|
48
|
|
|
|
|
|
|
|
|
49
|
7
|
100
|
|
|
|
14
|
if ( $parser eq 'begin' ) { |
|
50
|
1
|
|
|
|
|
408
|
require Devel::BeginLift; |
|
51
|
1
|
|
|
|
|
6522
|
return Devel::BeginLift->setup_for( $for => [$name] ) |
|
52
|
|
|
|
|
|
|
} |
|
53
|
|
|
|
|
|
|
|
|
54
|
6
|
|
|
|
|
23
|
require Devel::Declare; |
|
55
|
|
|
|
|
|
|
Devel::Declare->setup_for( |
|
56
|
|
|
|
|
|
|
$for, |
|
57
|
|
|
|
|
|
|
{ |
|
58
|
|
|
|
|
|
|
$name => { |
|
59
|
|
|
|
|
|
|
$type => sub { |
|
60
|
32
|
|
|
32
|
|
14611
|
my $pclass = get_parser( $parser ); |
|
61
|
32
|
|
|
|
|
156
|
my $parser = $pclass->new( $name, @_ ); |
|
62
|
32
|
|
|
|
|
88
|
$parser->process(); |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
} |
|
65
|
|
|
|
|
|
|
} |
|
66
|
6
|
|
|
|
|
55
|
); |
|
67
|
|
|
|
|
|
|
} |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
1; |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
__END__ |