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   return $self;
  17 }
  18
  19 sub offset {
  20   my $self = shift;
  21   return $self->{Offset}
  22 }
  23
  24 sub inc_offset {
  25   my $self = shift;
  26   $self->{Offset} += shift;
  27 }
  28
  29 sub declarator {
  30   my $self = shift;
  31   return $self->{Declarator}
  32 }
  33
  34 sub skip_declarator {
  35   my $self = shift;
  36   $self->inc_offset(Devel::Declare::toke_move_past_token($self->offset));
  37 }
  38
  39 sub skipspace {
  40   my $self = shift;
  41   $self->inc_offset(Devel::Declare::toke_skipspace($self->offset));
  42 }
  43
  44 sub get_linestr {
  45   my $self = shift;
  46   my $line = Devel::Declare::get_linestr();
  47   return $line;
  48 }
  49
  50 sub set_linestr {
  51   my $self = shift;
  52   my ($line) = @_;
  53   Devel::Declare::set_linestr($line);
  54 }
  55
  56 sub strip_name {
  57   my $self = shift;
  58   $self->skipspace;
  59   if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) {
  60     my $linestr = $self->get_linestr();
  61     my $name = substr( $linestr, $self->offset, $len );
  62     substr( $linestr, $self->offset, $len ) = '';
  63     $self->set_linestr($linestr);
  64     return $name;
  65   }
  66
  67   $self->skipspace;
  68   return;
  69 }
  70
  71 sub strip_ident {
  72   my $self = shift;
  73   $self->skipspace;
  74   if (my $len = Devel::Declare::toke_scan_ident( $self->offset )) {
  75     my $linestr = $self->get_linestr();
  76     my $ident = substr( $linestr, $self->offset, $len );
  77     substr( $linestr, $self->offset, $len ) = '';
  78     $self->set_linestr($linestr);
  79     return $ident;
  80   }
  81
  82   $self->skipspace;
  83   return;
  84 }
  85
  86 sub strip_proto {
  87   my $self = shift;
  88   $self->skipspace;
  89
  90   my $linestr = $self->get_linestr();
  91   if (substr($linestr, $self->offset, 1) eq '(') {
  92     my $length = Devel::Declare::toke_scan_str($self->offset);
  93     my $proto = Devel::Declare::get_lex_stuff();
  94     Devel::Declare::clear_lex_stuff();
  95     if( $length < 0 ) {
  96       # Need to scan ahead more
  97       $linestr .= $self->get_linestr();
  98       $length = rindex($linestr, ")") - $self->offset + 1;
  99     }
 100     else {
 101       $linestr = $self->get_linestr();
 102     }
 103
 104     substr($linestr, $self->offset, $length) = '';
 105     $self->set_linestr($linestr);
 106
 107     return $proto;
 108   }
 109   return;
 110 }
 111
 112 sub get_curstash_name {
 113   return Devel::Declare::get_curstash_name;
 114 }
 115
 116 sub shadow {
 117   my $self = shift;
 118   my $pack = $self->get_curstash_name;
 119   Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
 120 }
 121
 122 sub inject_if_block {
 123   my $self   = shift;
 124   my $inject = shift;
 125   my $before = shift || '';
 126
 127   $self->skipspace;
 128
 129   my $linestr = $self->get_linestr;
 130   if (substr($linestr, $self->offset, 1) eq '{') {
 131     substr($linestr, $self->offset + 1, 0) = $inject;
 132     substr($linestr, $self->offset, 0) = $before;
 133     $self->set_linestr($linestr);
 134     return 1;
 135   }
 136   return 0;
 137 }
 138
 139 sub scope_injector_call {
 140   my $self = shift;
 141   my $inject = shift || '';
 142   return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; ";
 143 }
 144
 145 sub inject_scope {
 146   my $class = shift;
 147   my $inject = shift;
 148   on_scope_end {
 149       my $linestr = Devel::Declare::get_linestr;
 150       return unless defined $linestr;
 151       my $offset  = Devel::Declare::get_linestr_offset;
 152       substr( $linestr, $offset, 0 ) = ';' . $inject;
 153       Devel::Declare::set_linestr($linestr);
 154   };
 155 }
 156
 157 1;
 158 # vi:sw=2 ts=2