lib/Devel/Declare/Context/Simple.pm

   1 package Devel::Declare::Context::Simple;
   2
   3 use Devel::Declare ();
   4 use B::Hooks::EndOfScope;
   5 use strict;
   6 use warnings;
   7
   8 sub new {
   9   my $class = shift;
  10   bless {@_}, $class;
  11 }
  12
  13 sub init {
  14   my $self = shift;
  15   @{$self}{ qw(Declarator Offset) } = @_;
  16   $self;
  17 }
  18
  19 sub offset : lvalue { shift->{Offset}; }
  20 sub declarator { shift->{Declarator} }
  21
  22 sub skip_declarator {
  23   my $self = shift;
  24   $self->offset += Devel::Declare::toke_move_past_token( $self->offset );
  25 }
  26
  27 sub skipspace {
  28   my $self = shift;
  29   $self->offset += Devel::Declare::toke_skipspace( $self->offset );
  30 }
  31
  32 sub get_linestr {
  33   my $self = shift;
  34   my $line = Devel::Declare::get_linestr();
  35   return $line;
  36 }
  37
  38 sub set_linestr {
  39   my $self = shift;
  40   my ($line) = @_;
  41   Devel::Declare::set_linestr($line);
  42 }
  43
  44 sub strip_name {
  45   my $self = shift;
  46   $self->skipspace;
  47   if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) {
  48     my $linestr = $self->get_linestr();
  49     my $name = substr( $linestr, $self->offset, $len );
  50     substr( $linestr, $self->offset, $len ) = '';
  51     $self->set_linestr($linestr);
  52     return $name;
  53   }
  54
  55   $self->skipspace;
  56   return;
  57 }
  58
  59 sub strip_proto {
  60   my $self = shift;
  61   $self->skipspace;
  62
  63   my $linestr = $self->get_linestr();
  64   if (substr($linestr, $self->offset, 1) eq '(') {
  65     my $length = Devel::Declare::toke_scan_str($self->offset);
  66     my $proto = Devel::Declare::get_lex_stuff();
  67     Devel::Declare::clear_lex_stuff();
  68     if( $length < 0 ) {
  69       # Need to scan ahead more
  70       $linestr .= $self->get_linestr();
  71       $length = rindex($linestr, ")") - $self->offset + 1;
  72     }
  73     else {
  74       $linestr = $self->get_linestr();
  75     }
  76
  77     substr($linestr, $self->offset, $length) = '';
  78     $self->set_linestr($linestr);
  79
  80     return $proto;
  81   }
  82   return;
  83 }
  84
  85 sub get_curstash_name {
  86   return Devel::Declare::get_curstash_name;
  87 }
  88
  89 sub shadow {
  90   my $self  = shift;
  91   my $pack = $self->get_curstash_name;
  92   Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
  93 }
  94
  95 sub inject_if_block {
  96   my $self   = shift;
  97   my $inject = shift;
  98   my $before = shift || '';
  99
 100   $self->skipspace;
 101
 102   my $linestr = $self->get_linestr;
 103   if (substr($linestr, $self->offset, 1) eq '{') {
 104     substr($linestr, $self->offset + 1, 0) = $inject;
 105     substr($linestr, $self->offset, 0) = $before;
 106     $self->set_linestr($linestr);
 107   }
 108 }
 109
 110 sub scope_injector_call {
 111   my $self = shift;
 112   my $inject = shift || '';
 113   return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; ";
 114 }
 115
 116 sub inject_scope {
 117   my $class = shift;
 118   my $inject = shift;
 119   on_scope_end {
 120       my $linestr = Devel::Declare::get_linestr;
 121       return unless defined $linestr;
 122       my $offset  = Devel::Declare::get_linestr_offset;
 123       substr( $linestr, $offset, 0 ) = ';' . $inject;
 124       Devel::Declare::set_linestr($linestr);
 125   };
 126 }
 127
 128 1;
 129 # vi:sw=2 ts=2