1 package Devel::Declare::Context::Simple;
6 use B::Hooks::EndOfScope;
9 our $VERSION = '0.006_021';
19 @{$self}{ qw(Declarator Offset WarningOnRedefined) } = @_;
25 return $self->{Offset}
30 $self->{Offset} += shift;
35 return $self->{Declarator}
38 sub warning_on_redefine {
40 return $self->{WarningOnRedefined}
45 my $decl = $self->declarator;
46 my $len = Devel::Declare::toke_scan_word($self->offset, 0);
47 confess "Couldn't find declarator '$decl'"
50 my $linestr = $self->get_linestr;
51 my $name = substr($linestr, $self->offset, $len);
52 confess "Expected declarator '$decl', got '${name}'"
53 unless $name eq $decl;
55 $self->inc_offset($len);
60 $self->inc_offset(Devel::Declare::toke_skipspace($self->offset));
65 my $line = Devel::Declare::get_linestr();
72 Devel::Declare::set_linestr($line);
78 if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) {
79 my $linestr = $self->get_linestr();
80 my $name = substr( $linestr, $self->offset, $len );
81 substr( $linestr, $self->offset, $len ) = '';
82 $self->set_linestr($linestr);
93 if (my $len = Devel::Declare::toke_scan_ident( $self->offset )) {
94 my $linestr = $self->get_linestr();
95 my $ident = substr( $linestr, $self->offset, $len );
96 substr( $linestr, $self->offset, $len ) = '';
97 $self->set_linestr($linestr);
109 my $linestr = $self->get_linestr();
110 if (substr($linestr, $self->offset, 1) eq '(') {
111 my $length = Devel::Declare::toke_scan_str($self->offset);
112 my $proto = Devel::Declare::get_lex_stuff();
113 Devel::Declare::clear_lex_stuff();
114 $linestr = $self->get_linestr();
116 substr($linestr, $self->offset,
117 defined($length) ? $length : length($linestr)) = '';
118 $self->set_linestr($linestr);
125 sub strip_names_and_args {
131 my $linestr = $self->get_linestr;
132 if (substr($linestr, $self->offset, 1) eq '(') {
133 # We had a leading paren, so we will now expect comma separated
135 substr($linestr, $self->offset, 1) = '';
136 $self->set_linestr($linestr);
139 # At this point we expect to have a comma-separated list of
140 # barewords with optional protos afterward, so loop until we
141 # run out of comma-separated values
144 my $thing = $self->strip_name;
145 # If there's no bareword here, bail
146 confess "failed to parse bareword. found ${linestr}"
147 unless defined $thing;
149 $linestr = $self->get_linestr;
150 if (substr($linestr, $self->offset, 1) eq '(') {
151 # This one had a proto, pull it out
152 push(@args, [ $thing, $self->strip_proto ]);
154 # This had no proto, so store it with an undef
155 push(@args, [ $thing, undef ]);
158 $linestr = $self->get_linestr;
160 if (substr($linestr, $self->offset, 1) eq ',') {
161 # We found a comma, strip it out and set things up for
163 substr($linestr, $self->offset, 1) = '';
164 $self->set_linestr($linestr);
167 # No comma, get outta here
172 # look for the final closing paren of the list
173 if (substr($linestr, $self->offset, 1) eq ')') {
174 substr($linestr, $self->offset, 1) = '';
175 $self->set_linestr($linestr);
179 # fail if it isn't there
180 confess "couldn't find closing paren for argument. found ${linestr}"
183 # No parens, so expect a single arg
184 my $thing = $self->strip_name;
185 # If there's no bareword here, bail
186 confess "failed to parse bareword. found ${linestr}"
187 unless defined $thing;
188 $linestr = $self->get_linestr;
189 if (substr($linestr, $self->offset, 1) eq '(') {
190 # This one had a proto, pull it out
191 push(@args, [ $thing, $self->strip_proto ]);
193 # This had no proto, so store it with an undef
194 push(@args, [ $thing, undef ]);
205 my $linestr = Devel::Declare::get_linestr;
208 if (substr($linestr, $self->offset, 1) eq ':') {
209 while (substr($linestr, $self->offset, 1) ne '{') {
210 if (substr($linestr, $self->offset, 1) eq ':') {
211 substr($linestr, $self->offset, 1) = '';
212 Devel::Declare::set_linestr($linestr);
218 $linestr = Devel::Declare::get_linestr();
220 if (my $len = Devel::Declare::toke_scan_word($self->offset, 0)) {
221 my $name = substr($linestr, $self->offset, $len);
222 substr($linestr, $self->offset, $len) = '';
223 Devel::Declare::set_linestr($linestr);
225 $attrs .= " ${name}";
227 if (substr($linestr, $self->offset, 1) eq '(') {
228 my $length = Devel::Declare::toke_scan_str($self->offset);
229 my $arg = Devel::Declare::get_lex_stuff();
230 Devel::Declare::clear_lex_stuff();
231 $linestr = Devel::Declare::get_linestr();
232 substr($linestr, $self->offset, $length) = '';
233 Devel::Declare::set_linestr($linestr);
235 $attrs .= "(${arg})";
240 $linestr = Devel::Declare::get_linestr();
247 sub get_curstash_name {
248 return Devel::Declare::get_curstash_name;
253 my $pack = $self->get_curstash_name;
254 Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
257 sub inject_if_block {
260 my $before = shift || '';
264 my $linestr = $self->get_linestr;
265 if (substr($linestr, $self->offset, 1) eq '{') {
266 substr($linestr, $self->offset + 1, 0) = $inject;
267 substr($linestr, $self->offset, 0) = $before;
268 $self->set_linestr($linestr);
274 sub scope_injector_call {
276 my $inject = shift || '';
277 return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; ";
284 my $linestr = Devel::Declare::get_linestr;
285 return unless defined $linestr;
286 my $offset = Devel::Declare::get_linestr_offset;
287 substr( $linestr, $offset, 0 ) = ';' . $inject;
288 Devel::Declare::set_linestr($linestr);