Commit | Line | Data |
e7be1784 |
1 | package Devel::Declare::MethodInstaller::Simple; |
2 | |
3 | use base 'Devel::Declare::Context::Simple'; |
4 | |
5 | use Devel::Declare (); |
6 | use Sub::Name; |
7 | use strict; |
8 | use warnings; |
9 | |
10 | sub install_methodhandler { |
5b27c9b2 |
11 | my $class = shift; |
12 | my %args = @_; |
13 | { |
14 | no strict 'refs'; |
15 | *{$args{into}.'::'.$args{name}} = sub (&) {}; |
16 | } |
17 | |
18 | my $ctx = $class->new(%args); |
19 | Devel::Declare->setup_for( |
20 | $args{into}, |
21 | { $args{name} => { const => sub { $ctx->parser(@_) } } } |
22 | ); |
e7be1784 |
23 | } |
24 | |
25 | sub parser { |
5b27c9b2 |
26 | my $self = shift; |
27 | $self->init(@_); |
28 | |
29 | $self->skip_declarator; |
30 | my $name = $self->strip_name; |
31 | my $proto = $self->strip_proto; |
32 | my @decl = $self->parse_proto($proto); |
33 | my $inject = $self->inject_parsed_proto(@decl); |
34 | if (defined $name) { |
35 | $inject = $self->scope_injector_call() . $inject; |
36 | } |
37 | $self->inject_if_block($inject); |
38 | if (defined $name) { |
39 | my $pkg = $self->get_curstash_name; |
40 | $name = join( '::', $pkg, $name ) |
41 | unless( $name =~ /::/ ); |
42 | $self->shadow( sub (&) { |
43 | my $code = shift; |
44 | # So caller() gets the subroutine name |
45 | no strict 'refs'; |
46 | *{$name} = subname $name => $code; |
47 | }); |
48 | } else { |
49 | $self->shadow(sub (&) { shift }); |
50 | } |
e7be1784 |
51 | } |
5b27c9b2 |
52 | |
e7be1784 |
53 | sub parse_proto { } |
5b27c9b2 |
54 | |
e7be1784 |
55 | sub inject_parsed_proto { |
5b27c9b2 |
56 | return $_[1]; |
e7be1784 |
57 | } |
58 | |
e7be1784 |
59 | 1; |
60 | |