Commit | Line | Data |
e7be1784 |
1 | package Devel::Declare::Context::Simple; |
2 | |
3 | use Devel::Declare (); |
b0a89632 |
4 | use B::Hooks::EndOfScope; |
e7be1784 |
5 | use strict; |
6 | use warnings; |
7 | |
b0a89632 |
8 | sub DEBUG { warn "@_" } |
e7be1784 |
9 | sub new { |
5b27c9b2 |
10 | my $class = shift; |
11 | bless {@_}, $class; |
e7be1784 |
12 | } |
13 | |
14 | sub init { |
5b27c9b2 |
15 | my $self = shift; |
16 | @{$self}{ qw(Declarator Offset) } = @_; |
17 | $self; |
e7be1784 |
18 | } |
19 | |
20 | sub offset : lvalue { shift->{Offset}; } |
21 | sub declarator { shift->{Declarator} } |
22 | |
23 | sub skip_declarator { |
5b27c9b2 |
24 | my $self = shift; |
25 | $self->offset += Devel::Declare::toke_move_past_token( $self->offset ); |
e7be1784 |
26 | } |
27 | |
28 | sub skipspace { |
5b27c9b2 |
29 | my $self = shift; |
30 | $self->offset += Devel::Declare::toke_skipspace( $self->offset ); |
e7be1784 |
31 | } |
32 | |
33 | sub strip_name { |
5b27c9b2 |
34 | my $self = shift; |
35 | $self->skipspace; |
36 | if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) { |
37 | my $linestr = Devel::Declare::get_linestr(); |
38 | my $name = substr( $linestr, $self->offset, $len ); |
39 | substr( $linestr, $self->offset, $len ) = ''; |
40 | Devel::Declare::set_linestr($linestr); |
41 | return $name; |
42 | } |
b0a89632 |
43 | |
44 | $self->skipspace; |
5b27c9b2 |
45 | return; |
e7be1784 |
46 | } |
47 | |
48 | sub strip_proto { |
5b27c9b2 |
49 | my $self = shift; |
50 | $self->skipspace; |
51 | |
52 | my $linestr = Devel::Declare::get_linestr(); |
b0a89632 |
53 | if (substr($linestr, $self->offset, 1) eq '(') { |
54 | my $length = Devel::Declare::toke_scan_str($self->offset); |
5b27c9b2 |
55 | my $proto = Devel::Declare::get_lex_stuff(); |
56 | Devel::Declare::clear_lex_stuff(); |
57 | $linestr = Devel::Declare::get_linestr(); |
b0a89632 |
58 | substr($linestr, $self->offset, $length) = ''; |
5b27c9b2 |
59 | Devel::Declare::set_linestr($linestr); |
60 | return $proto; |
61 | } |
b0a89632 |
62 | |
5b27c9b2 |
63 | return; |
e7be1784 |
64 | } |
65 | |
66 | sub get_curstash_name { |
5b27c9b2 |
67 | return Devel::Declare::get_curstash_name; |
e7be1784 |
68 | } |
69 | |
70 | sub shadow { |
5b27c9b2 |
71 | my $self = shift; |
72 | my $pack = $self->get_curstash_name; |
73 | Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] ); |
e7be1784 |
74 | } |
75 | |
76 | sub inject_if_block { |
b0a89632 |
77 | my $self = shift; |
5b27c9b2 |
78 | my $inject = shift; |
b0a89632 |
79 | my $before = shift || ''; |
80 | |
5b27c9b2 |
81 | $self->skipspace; |
b0a89632 |
82 | |
5b27c9b2 |
83 | my $linestr = Devel::Declare::get_linestr; |
b0a89632 |
84 | if (substr($linestr, $self->offset, 1) eq '{') { |
85 | substr($linestr, $self->offset + 1, 0) = $inject; |
86 | substr($linestr, $self->offset, 0) = $before; |
5b27c9b2 |
87 | Devel::Declare::set_linestr($linestr); |
88 | } |
e7be1784 |
89 | } |
90 | |
91 | sub scope_injector_call { |
b0a89632 |
92 | my $self = shift; |
93 | my $inject = shift || ''; |
94 | return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; "; |
e7be1784 |
95 | } |
96 | |
97 | sub inject_scope { |
b0a89632 |
98 | my $class = shift; |
99 | my $inject = shift; |
100 | on_scope_end { |
5b27c9b2 |
101 | my $linestr = Devel::Declare::get_linestr; |
b0a89632 |
102 | return unless defined $linestr; |
5b27c9b2 |
103 | my $offset = Devel::Declare::get_linestr_offset; |
b0a89632 |
104 | substr( $linestr, $offset, 0 ) = ';' . $inject; |
5b27c9b2 |
105 | Devel::Declare::set_linestr($linestr); |
b0a89632 |
106 | }; |
e7be1784 |
107 | } |
108 | |
109 | 1; |
b0a89632 |
110 | # vi:sw=2 ts=2 |