1 package Devel::Declare::Context::Simple;
6 use B::Hooks::EndOfScope;
16 @{$self}{ qw(Declarator Offset WarningOnRedefined) } = @_;
22 return $self->{Offset}
27 $self->{Offset} += shift;
32 return $self->{Declarator}
35 sub warning_on_redefine {
37 return $self->{WarningOnRedefined}
42 my $decl = $self->declarator;
43 my $len = Devel::Declare::toke_scan_word($self->offset, 0);
44 confess "Couldn't find declarator '$decl'"
47 my $linestr = $self->get_linestr;
48 my $name = substr($linestr, $self->offset, $len);
49 confess "Expected declarator '$decl', got '${name}'"
50 unless $name eq $decl;
52 $self->inc_offset($len);
57 $self->inc_offset(Devel::Declare::toke_skipspace($self->offset));
62 my $line = Devel::Declare::get_linestr();
69 Devel::Declare::set_linestr($line);
75 if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) {
76 my $linestr = $self->get_linestr();
77 my $name = substr( $linestr, $self->offset, $len );
78 substr( $linestr, $self->offset, $len ) = '';
79 $self->set_linestr($linestr);
90 if (my $len = Devel::Declare::toke_scan_ident( $self->offset )) {
91 my $linestr = $self->get_linestr();
92 my $ident = substr( $linestr, $self->offset, $len );
93 substr( $linestr, $self->offset, $len ) = '';
94 $self->set_linestr($linestr);
106 my $linestr = $self->get_linestr();
107 if (substr($linestr, $self->offset, 1) eq '(') {
108 my $length = Devel::Declare::toke_scan_str($self->offset);
109 my $proto = Devel::Declare::get_lex_stuff();
110 Devel::Declare::clear_lex_stuff();
111 $linestr = $self->get_linestr();
113 substr($linestr, $self->offset,
114 defined($length) ? $length : length($linestr)) = '';
115 $self->set_linestr($linestr);
122 sub strip_names_and_args {
128 my $linestr = $self->get_linestr;
129 if (substr($linestr, $self->offset, 1) eq '(') {
130 # We had a leading paren, so we will now expect comma separated
132 substr($linestr, $self->offset, 1) = '';
133 $self->set_linestr($linestr);
136 # At this point we expect to have a comma-separated list of
137 # barewords with optional protos afterward, so loop until we
138 # run out of comma-separated values
141 my $thing = $self->strip_name;
142 # If there's no bareword here, bail
143 confess "failed to parse bareword. found ${linestr}"
144 unless defined $thing;
146 $linestr = $self->get_linestr;
147 if (substr($linestr, $self->offset, 1) eq '(') {
148 # This one had a proto, pull it out
149 push(@args, [ $thing, $self->strip_proto ]);
151 # This had no proto, so store it with an undef
152 push(@args, [ $thing, undef ]);
155 $linestr = $self->get_linestr;
157 if (substr($linestr, $self->offset, 1) eq ',') {
158 # We found a comma, strip it out and set things up for
160 substr($linestr, $self->offset, 1) = '';
161 $self->set_linestr($linestr);
164 # No comma, get outta here
169 # look for the final closing paren of the list
170 if (substr($linestr, $self->offset, 1) eq ')') {
171 substr($linestr, $self->offset, 1) = '';
172 $self->set_linestr($linestr);
176 # fail if it isn't there
177 confess "couldn't find closing paren for argument. found ${linestr}"
180 # No parens, so expect a single arg
181 my $thing = $self->strip_name;
182 # If there's no bareword here, bail
183 confess "failed to parse bareword. found ${linestr}"
184 unless defined $thing;
185 $linestr = $self->get_linestr;
186 if (substr($linestr, $self->offset, 1) eq '(') {
187 # This one had a proto, pull it out
188 push(@args, [ $thing, $self->strip_proto ]);
190 # This had no proto, so store it with an undef
191 push(@args, [ $thing, undef ]);
202 my $linestr = Devel::Declare::get_linestr;
205 if (substr($linestr, $self->offset, 1) eq ':') {
206 while (substr($linestr, $self->offset, 1) ne '{') {
207 if (substr($linestr, $self->offset, 1) eq ':') {
208 substr($linestr, $self->offset, 1) = '';
209 Devel::Declare::set_linestr($linestr);
215 $linestr = Devel::Declare::get_linestr();
217 if (my $len = Devel::Declare::toke_scan_word($self->offset, 0)) {
218 my $name = substr($linestr, $self->offset, $len);
219 substr($linestr, $self->offset, $len) = '';
220 Devel::Declare::set_linestr($linestr);
222 $attrs .= " ${name}";
224 if (substr($linestr, $self->offset, 1) eq '(') {
225 my $length = Devel::Declare::toke_scan_str($self->offset);
226 my $arg = Devel::Declare::get_lex_stuff();
227 Devel::Declare::clear_lex_stuff();
228 $linestr = Devel::Declare::get_linestr();
229 substr($linestr, $self->offset, $length) = '';
230 Devel::Declare::set_linestr($linestr);
232 $attrs .= "(${arg})";
237 $linestr = Devel::Declare::get_linestr();
244 sub get_curstash_name {
245 return Devel::Declare::get_curstash_name;
250 my $pack = $self->get_curstash_name;
251 Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
254 sub inject_if_block {
257 my $before = shift || '';
261 my $linestr = $self->get_linestr;
262 if (substr($linestr, $self->offset, 1) eq '{') {
263 substr($linestr, $self->offset + 1, 0) = $inject;
264 substr($linestr, $self->offset, 0) = $before;
265 $self->set_linestr($linestr);
271 sub scope_injector_call {
273 my $inject = shift || '';
274 return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; ";
281 my $linestr = Devel::Declare::get_linestr;
282 return unless defined $linestr;
283 my $offset = Devel::Declare::get_linestr_offset;
284 substr( $linestr, $offset, 0 ) = ';' . $inject;
285 Devel::Declare::set_linestr($linestr);