lib/Devel/Declare/Context/Simple.pm

   1 package Devel::Declare::Context::Simple;
   2
   3 use strict;
   4 use warnings;
   5 use Devel::Declare ();
   6 use B::Hooks::EndOfScope;
   7 use Carp qw/confess/;
   8
   9 sub new {
  10   my $class = shift;
  11   bless {@_}, $class;
  12 }
  13
  14 sub init {
  15   my $self = shift;
  16   @{$self}{ qw(Declarator Offset) } = @_;
  17   return $self;
  18 }
  19
  20 sub offset {
  21   my $self = shift;
  22   return $self->{Offset}
  23 }
  24
  25 sub inc_offset {
  26   my $self = shift;
  27   $self->{Offset} += shift;
  28 }
  29
  30 sub declarator {
  31   my $self = shift;
  32   return $self->{Declarator}
  33 }
  34
  35 sub skip_declarator {
  36   my $self = shift;
  37   my $decl = $self->declarator;
  38   my $len = Devel::Declare::toke_scan_word($self->offset, 0);
  39   confess "Couldn't find declarator '$decl'"
  40     unless $len;
  41
  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;
  46
  47   $self->inc_offset($len);
  48 }
  49
  50 sub skipspace {
  51   my $self = shift;
  52   $self->inc_offset(Devel::Declare::toke_skipspace($self->offset));
  53 }
  54
  55 sub get_linestr {
  56   my $self = shift;
  57   my $line = Devel::Declare::get_linestr();
  58   return $line;
  59 }
  60
  61 sub set_linestr {
  62   my $self = shift;
  63   my ($line) = @_;
  64   Devel::Declare::set_linestr($line);
  65 }
  66
  67 sub strip_name {
  68   my $self = shift;
  69   $self->skipspace;
  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);
  75     return $name;
  76   }
  77
  78   $self->skipspace;
  79   return;
  80 }
  81
  82 sub strip_ident {
  83   my $self = shift;
  84   $self->skipspace;
  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);
  90     return $ident;
  91   }
  92
  93   $self->skipspace;
  94   return;
  95 }
  96
  97 sub strip_proto {
  98   my $self = shift;
  99   $self->skipspace;
 100
 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();
 107
 108     substr($linestr, $self->offset, $length) = '';
 109     $self->set_linestr($linestr);
 110
 111     return $proto;
 112   }
 113   return;
 114 }
 115
 116 sub get_curstash_name {
 117   return Devel::Declare::get_curstash_name;
 118 }
 119
 120 sub shadow {
 121   my $self = shift;
 122   my $pack = $self->get_curstash_name;
 123   Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
 124 }
 125
 126 sub inject_if_block {
 127   my $self   = shift;
 128   my $inject = shift;
 129   my $before = shift || '';
 130
 131   $self->skipspace;
 132
 133   my $linestr = $self->get_linestr;
 134   if (substr($linestr, $self->offset, 1) eq '{') {
 135     substr($linestr, $self->offset + 1, 0) = $inject;
 136     substr($linestr, $self->offset, 0) = $before;
 137     $self->set_linestr($linestr);
 138     return 1;
 139   }
 140   return 0;
 141 }
 142
 143 sub scope_injector_call {
 144   my $self = shift;
 145   my $inject = shift || '';
 146   return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; ";
 147 }
 148
 149 sub inject_scope {
 150   my $class = shift;
 151   my $inject = shift;
 152   on_scope_end {
 153       my $linestr = Devel::Declare::get_linestr;
 154       return unless defined $linestr;
 155       my $offset  = Devel::Declare::get_linestr_offset;
 156       substr( $linestr, $offset, 0 ) = ';' . $inject;
 157       Devel::Declare::set_linestr($linestr);
 158   };
 159 }
 160
 161 1;
 162 # vi:sw=2 ts=2