X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDevel%2FDeclare%2FContext%2FSimple.pm;h=1a47a7ff831c7016666f92260568218383a1063e;hb=86964fb3f9ba6afc359b1ecb231fe44dae3665ef;hp=268514cef18bd9bfd69ee671f9c8b2681e2b1f88;hpb=e7be1784afaeb943f278a4249d5000bd2b706f11;p=p5sagit%2FDevel-Declare.git diff --git a/lib/Devel/Declare/Context/Simple.pm b/lib/Devel/Declare/Context/Simple.pm index 268514c..1a47a7f 100644 --- a/lib/Devel/Declare/Context/Simple.pm +++ b/lib/Devel/Declare/Context/Simple.pm @@ -1,101 +1,151 @@ package Devel::Declare::Context::Simple; use Devel::Declare (); -use Scope::Guard; +use B::Hooks::EndOfScope; use strict; use warnings; sub new { - my $class = shift; - bless {@_}, $class; + my $class = shift; + bless {@_}, $class; } sub init { - my $ctx = shift; - @{$ctx}{ qw(Declarator Offset) } = @_; - $ctx; + my $self = shift; + @{$self}{ qw(Declarator Offset) } = @_; + return $self; } -sub offset : lvalue { shift->{Offset}; } -sub declarator { shift->{Declarator} } +sub offset { + my $self = shift; + return $self->{Offset} +} + +sub inc_offset { + my $self = shift; + $self->{Offset} += shift; +} + +sub declarator { + my $self = shift; + return $self->{Declarator} +} sub skip_declarator { - my $ctx = shift; - $ctx->offset += Devel::Declare::toke_move_past_token( $ctx->offset ); + my $self = shift; + $self->inc_offset(Devel::Declare::toke_move_past_token($self->offset)); } sub skipspace { - my $ctx = shift; - $ctx->offset += Devel::Declare::toke_skipspace( $ctx->offset ); + my $self = shift; + $self->inc_offset(Devel::Declare::toke_skipspace($self->offset)); +} + +sub get_linestr { + my $self = shift; + my $line = Devel::Declare::get_linestr(); + return $line; +} + +sub set_linestr { + my $self = shift; + my ($line) = @_; + Devel::Declare::set_linestr($line); } sub strip_name { - my $ctx = shift; - $ctx->skipspace; - if( my $len = Devel::Declare::toke_scan_word( $ctx->offset, 1 ) ) { - my $linestr = Devel::Declare::get_linestr(); - my $name = substr( $linestr, $ctx->offset, $len ); - substr( $linestr, $ctx->offset, $len ) = ''; - Devel::Declare::set_linestr($linestr); - return $name; - } - return; + my $self = shift; + $self->skipspace; + if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) { + my $linestr = $self->get_linestr(); + my $name = substr( $linestr, $self->offset, $len ); + substr( $linestr, $self->offset, $len ) = ''; + $self->set_linestr($linestr); + return $name; + } + + $self->skipspace; + return; +} + +sub strip_ident { + my $self = shift; + $self->skipspace; + if (my $len = Devel::Declare::toke_scan_ident( $self->offset )) { + my $linestr = $self->get_linestr(); + my $ident = substr( $linestr, $self->offset, $len ); + substr( $linestr, $self->offset, $len ) = ''; + $self->set_linestr($linestr); + return $ident; + } + + $self->skipspace; + return; } sub strip_proto { - my $ctx = shift; - $ctx->skipspace; - - my $linestr = Devel::Declare::get_linestr(); - if( substr( $linestr, $ctx->offset, 1 ) eq '(' ) { - my $length = Devel::Declare::toke_scan_str( $ctx->offset ); - my $proto = Devel::Declare::get_lex_stuff(); - Devel::Declare::clear_lex_stuff(); - $linestr = Devel::Declare::get_linestr(); - substr( $linestr, $ctx->offset, $length ) = ''; - Devel::Declare::set_linestr($linestr); - return $proto; - } - return; + my $self = shift; + $self->skipspace; + + my $linestr = $self->get_linestr(); + if (substr($linestr, $self->offset, 1) eq '(') { + my $length = Devel::Declare::toke_scan_str($self->offset); + my $proto = Devel::Declare::get_lex_stuff(); + Devel::Declare::clear_lex_stuff(); + $linestr = $self->get_linestr(); + + substr($linestr, $self->offset, $length) = ''; + $self->set_linestr($linestr); + + return $proto; + } + return; } sub get_curstash_name { - return Devel::Declare::get_curstash_name; + return Devel::Declare::get_curstash_name; } sub shadow { - my $ctx = shift; - my $pack = $ctx->get_curstash_name; - Devel::Declare::shadow_sub( $pack . '::' . $ctx->declarator, $_[0] ); + my $self = shift; + my $pack = $self->get_curstash_name; + Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] ); } sub inject_if_block { - my $ctx = shift; - my $inject = shift; - $ctx->skipspace; - my $linestr = Devel::Declare::get_linestr; - if( substr( $linestr, $ctx->offset, 1 ) eq '{' ) { - substr( $linestr, $ctx->offset + 1, 0 ) = $inject; - Devel::Declare::set_linestr($linestr); - } + my $self = shift; + my $inject = shift; + my $before = shift || ''; + + $self->skipspace; + + my $linestr = $self->get_linestr; + if (substr($linestr, $self->offset, 1) eq '{') { + substr($linestr, $self->offset + 1, 0) = $inject; + substr($linestr, $self->offset, 0) = $before; + $self->set_linestr($linestr); + return 1; + } + return 0; } sub scope_injector_call { - return ' BEGIN { ' . __PACKAGE__ . '::inject_scope }; '; + my $self = shift; + my $inject = shift || ''; + return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; "; } sub inject_scope { - my $ctx = shift; - $^H |= 0x120000; - $^H{DD_METHODHANDLERS} = Scope::Guard->new( - sub { - my $linestr = Devel::Declare::get_linestr; - my $offset = Devel::Declare::get_linestr_offset; - substr( $linestr, $offset, 0 ) = ';'; - Devel::Declare::set_linestr($linestr); - } - ); + my $class = shift; + my $inject = shift; + on_scope_end { + my $linestr = Devel::Declare::get_linestr; + return unless defined $linestr; + my $offset = Devel::Declare::get_linestr_offset; + substr( $linestr, $offset, 0 ) = ';' . $inject; + Devel::Declare::set_linestr($linestr); + }; } 1; - +# vi:sw=2 ts=2