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__ |