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, $length) = '';
114 $self->set_linestr($linestr);
121 sub strip_names_and_args {
127 my $linestr = $self->get_linestr;
128 if (substr($linestr, $self->offset, 1) eq '(') {
129 # We had a leading paren, so we will now expect comma separated
131 substr($linestr, $self->offset, 1) = '';
132 $self->set_linestr($linestr);
135 # At this point we expect to have a comma-separated list of
136 # barewords with optional protos afterward, so loop until we
137 # run out of comma-separated values
140 my $thing = $self->strip_name;
141 # If there's no bareword here, bail
142 confess "failed to parse bareword. found ${linestr}"
143 unless defined $thing;
145 $linestr = $self->get_linestr;
146 if (substr($linestr, $self->offset, 1) eq '(') {
147 # This one had a proto, pull it out
148 push(@args, [ $thing, $self->strip_proto ]);
150 # This had no proto, so store it with an undef
151 push(@args, [ $thing, undef ]);
154 $linestr = $self->get_linestr;
156 if (substr($linestr, $self->offset, 1) eq ',') {
157 # We found a comma, strip it out and set things up for
159 substr($linestr, $self->offset, 1) = '';
160 $self->set_linestr($linestr);
163 # No comma, get outta here
168 # look for the final closing paren of the list
169 if (substr($linestr, $self->offset, 1) eq ')') {
170 substr($linestr, $self->offset, 1) = '';
171 $self->set_linestr($linestr);
175 # fail if it isn't there
176 confess "couldn't find closing paren for argument. found ${linestr}"
179 # No parens, so expect a single arg
180 my $thing = $self->strip_name;
181 # If there's no bareword here, bail
182 confess "failed to parse bareword. found ${linestr}"
183 unless defined $thing;
184 $linestr = $self->get_linestr;
185 if (substr($linestr, $self->offset, 1) eq '(') {
186 # This one had a proto, pull it out
187 push(@args, [ $thing, $self->strip_proto ]);
189 # This had no proto, so store it with an undef
190 push(@args, [ $thing, undef ]);
201 my $linestr = Devel::Declare::get_linestr;
204 if (substr($linestr, $self->offset, 1) eq ':') {
205 while (substr($linestr, $self->offset, 1) ne '{') {
206 if (substr($linestr, $self->offset, 1) eq ':') {
207 substr($linestr, $self->offset, 1) = '';
208 Devel::Declare::set_linestr($linestr);
214 $linestr = Devel::Declare::get_linestr();
216 if (my $len = Devel::Declare::toke_scan_word($self->offset, 0)) {
217 my $name = substr($linestr, $self->offset, $len);
218 substr($linestr, $self->offset, $len) = '';
219 Devel::Declare::set_linestr($linestr);
221 $attrs .= " ${name}";
223 if (substr($linestr, $self->offset, 1) eq '(') {
224 my $length = Devel::Declare::toke_scan_str($self->offset);
225 my $arg = Devel::Declare::get_lex_stuff();
226 Devel::Declare::clear_lex_stuff();
227 $linestr = Devel::Declare::get_linestr();
228 substr($linestr, $self->offset, $length) = '';
229 Devel::Declare::set_linestr($linestr);
231 $attrs .= "(${arg})";
236 $linestr = Devel::Declare::get_linestr();
243 sub get_curstash_name {
244 return Devel::Declare::get_curstash_name;
249 my $pack = $self->get_curstash_name;
250 Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
253 sub inject_if_block {
256 my $before = shift || '';
260 my $linestr = $self->get_linestr;
261 if (substr($linestr, $self->offset, 1) eq '{') {
262 substr($linestr, $self->offset + 1, 0) = $inject;
263 substr($linestr, $self->offset, 0) = $before;
264 $self->set_linestr($linestr);
270 sub scope_injector_call {
272 my $inject = shift || '';
273 return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; ";
280 my $linestr = Devel::Declare::get_linestr;
281 return unless defined $linestr;
282 my $offset = Devel::Declare::get_linestr_offset;
283 substr( $linestr, $offset, 0 ) = ';' . $inject;
284 Devel::Declare::set_linestr($linestr);