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     $linestr = $self->get_linestr();
  96
  97     substr($linestr, $self->offset, $length) = '';
  98     $self->set_linestr($linestr);
  99
 100     return $proto;
 101   }
 102   return;
 103 }
 104
 105 sub get_curstash_name {
 106   return Devel::Declare::get_curstash_name;
 107 }
 108
 109 sub shadow {
 110   my $self = shift;
 111   my $pack = $self->get_curstash_name;
 112   Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
 113 }
 114
 115 sub inject_if_block {
 116   my $self   = shift;
 117   my $inject = shift;
 118   my $before = shift || '';
 119
 120   $self->skipspace;
 121
 122   my $linestr = $self->get_linestr;
 123   if (substr($linestr, $self->offset, 1) eq '{') {
 124     substr($linestr, $self->offset + 1, 0) = $inject;
 125     substr($linestr, $self->offset, 0) = $before;
 126     $self->set_linestr($linestr);
 127     return 1;
 128   }
 129   return 0;
 130 }
 131
 132 sub scope_injector_call {
 133   my $self = shift;
 134   my $inject = shift || '';
 135   return ' BEGIN { ' . ref($self) . "->inject_scope('${inject}') }; ";
 136 }
 137
 138 sub inject_scope {
 139   my $class = shift;
 140   my $inject = shift;
 141   on_scope_end {
 142       my $linestr = Devel::Declare::get_linestr;
 143       return unless defined $linestr;
 144       my $offset  = Devel::Declare::get_linestr_offset;
 145       substr( $linestr, $offset, 0 ) = ';' . $inject;
 146       Devel::Declare::set_linestr($linestr);
 147   };
 148 }
 149
 150 1;
 151 # vi:sw=2 ts=2