1 package Devel::Declare::Context::Simple;
6 use B::Hooks::EndOfScope;
16 @{$self}{ qw(Declarator Offset) } = @_;
22 return $self->{Offset}
27 $self->{Offset} += shift;
32 return $self->{Declarator}
37 my $decl = $self->declarator;
38 my $len = Devel::Declare::toke_scan_word($self->offset, 0);
39 confess "Couldn't find declarator '$decl'"
42 my $linestr = $self->get_linestr;
43 my $name = substr($linestr, $self->offset, $len);
44 confess "Expected declarator '$decl', got '${name}'"
45 unless $name eq $decl;
47 $self->inc_offset($len);
52 $self->inc_offset(Devel::Declare::toke_skipspace($self->offset));
57 my $line = Devel::Declare::get_linestr();
64 Devel::Declare::set_linestr($line);
70 if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) {
71 my $linestr = $self->get_linestr();
72 my $name = substr( $linestr, $self->offset, $len );
73 substr( $linestr, $self->offset, $len ) = '';
74 $self->set_linestr($linestr);
85 if (my $len = Devel::Declare::toke_scan_ident( $self->offset )) {
86 my $linestr = $self->get_linestr();
87 my $ident = substr( $linestr, $self->offset, $len );
88 substr( $linestr, $self->offset, $len ) = '';
89 $self->set_linestr($linestr);
101 my $linestr = $self->get_linestr();
102 if (substr($linestr, $self->offset, 1) eq '(') {
103 my $length = Devel::Declare::toke_scan_str($self->offset);
104 my $proto = Devel::Declare::get_lex_stuff();
105 Devel::Declare::clear_lex_stuff();
106 $linestr = $self->get_linestr();
108 substr($linestr, $self->offset, $length) = '';
109 $self->set_linestr($linestr);
116 sub strip_names_and_args {
122 my $linestr = $self->get_linestr;
123 if (substr($linestr, $self->offset, 1) eq '(') {
124 # We had a leading paren, so we will now expect comma separated
126 substr($linestr, $self->offset, 1) = '';
127 $self->set_linestr($linestr);
130 # At this point we expect to have a comma-separated list of
131 # barewords with optional protos afterward, so loop until we
132 # run out of comma-separated values
135 my $thing = $self->strip_name;
136 # If there's no bareword here, bail
137 confess "failed to parse bareword. found ${linestr}"
138 unless defined $thing;
140 $linestr = $self->get_linestr;
141 if (substr($linestr, $self->offset, 1) eq '(') {
142 # This one had a proto, pull it out
143 push(@args, [ $thing, $self->strip_proto ]);
145 # This had no proto, so store it with an undef
146 push(@args, [ $thing, undef ]);
149 $linestr = $self->get_linestr;
151 if (substr($linestr, $self->offset, 1) eq ',') {
152 # We found a comma, strip it out and set things up for
154 substr($linestr, $self->offset, 1) = '';
155 $self->set_linestr($linestr);
158 # No comma, get outta here
163 # look for the final closing paren of the list
164 if (substr($linestr, $self->offset, 1) eq ')') {
165 substr($linestr, $self->offset, 1) = '';
166 $self->set_linestr($linestr);
170 # fail if it isn't there
171 confess "couldn't find closing paren for argument. found ${linestr}"
174 # No parens, so expect a single arg
175 my $thing = $self->strip_name;
176 # If there's no bareword here, bail
177 confess "failed to parse bareword. found ${linestr}"
178 unless defined $thing;
179 $linestr = $self->get_linestr;
180 if (substr($linestr, $self->offset, 1) eq '(') {
181 # This one had a proto, pull it out
182 push(@args, [ $thing, $self->strip_proto ]);
184 # This had no proto, so store it with an undef
185 push(@args, [ $thing, undef ]);
196 my $linestr = Devel::Declare::get_linestr;
199 if (substr($linestr, $self->offset, 1) eq ':') {
200 while (substr($linestr, $self->offset, 1) ne '{') {
201 if (substr($linestr, $self->offset, 1) eq ':') {
202 substr($linestr, $self->offset, 1) = '';
203 Devel::Declare::set_linestr($linestr);
209 $linestr = Devel::Declare::get_linestr();
211 if (my $len = Devel::Declare::toke_scan_word($self->offset, 0)) {
212 my $name = substr($linestr, $self->offset, $len);
213 substr($linestr, $self->offset, $len) = '';
214 Devel::Declare::set_linestr($linestr);
216 $attrs .= " ${name}";
218 if (substr($linestr, $self->offset, 1) eq '(') {
219 my $length = Devel::Declare::toke_scan_str($self->offset);
220 my $arg = Devel::Declare::get_lex_stuff();
221 Devel::Declare::clear_lex_stuff();
222 $linestr = Devel::Declare::get_linestr();
223 substr($linestr, $self->offset, $length) = '';
224 Devel::Declare::set_linestr($linestr);
226 $attrs .= "(${arg})";
231 $linestr = Devel::Declare::get_linestr();
238 sub get_curstash_name {
239 return Devel::Declare::get_curstash_name;
244 my $pack = $self->get_curstash_name;
245 Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
248 sub inject_if_block {
251 my $before = shift || '';
255 my $linestr = $self->get_linestr;
256 if (substr($linestr, $self->offset, 1) eq '{') {
257 substr($linestr, $self->offset + 1, 0) = $inject;
258 substr($linestr, $self->offset, 0) = $before;
259 $self->set_linestr($linestr);
265 sub scope_injector_call {
267 my $inject = shift || '';
268 return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; ";
275 my $linestr = Devel::Declare::get_linestr;
276 return unless defined $linestr;
277 my $offset = Devel::Declare::get_linestr_offset;
278 substr( $linestr, $offset, 0 ) = ';' . $inject;
279 Devel::Declare::set_linestr($linestr);