lib/Devel/Declare/Context/Simple.pm

   1 package Devel::Declare::Context::Simple;
   2
   3 use Devel::Declare ();
   4 use Scope::Guard;
   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 strip_name {
  33   my $self = shift;
  34   $self->skipspace;
  35   if (my $len = Devel::Declare::toke_scan_word( $self->offset, 1 )) {
  36     my $linestr = Devel::Declare::get_linestr();
  37     my $name = substr( $linestr, $self->offset, $len );
  38     substr( $linestr, $self->offset, $len ) = '';
  39     Devel::Declare::set_linestr($linestr);
  40     return $name;
  41   }
  42   return;
  43 }
  44
  45 sub strip_proto {
  46   my $self = shift;
  47   $self->skipspace;
  48
  49   my $linestr = Devel::Declare::get_linestr();
  50   if (substr( $linestr, $self->offset, 1 ) eq '(') {
  51     my $length = Devel::Declare::toke_scan_str( $self->offset );
  52     my $proto  = Devel::Declare::get_lex_stuff();
  53     Devel::Declare::clear_lex_stuff();
  54     $linestr = Devel::Declare::get_linestr();
  55     substr( $linestr, $self->offset, $length ) = '';
  56     Devel::Declare::set_linestr($linestr);
  57     return $proto;
  58   }
  59   return;
  60 }
  61
  62 sub get_curstash_name {
  63   return Devel::Declare::get_curstash_name;
  64 }
  65
  66 sub shadow {
  67   my $self  = shift;
  68   my $pack = $self->get_curstash_name;
  69   Devel::Declare::shadow_sub( $pack . '::' . $self->declarator, $_[0] );
  70 }
  71
  72 sub inject_if_block {
  73   my $self    = shift;
  74   my $inject = shift;
  75   $self->skipspace;
  76   my $linestr = Devel::Declare::get_linestr;
  77   if (substr( $linestr, $self->offset, 1 ) eq '{') {
  78     substr( $linestr, $self->offset + 1, 0 ) = $inject;
  79     Devel::Declare::set_linestr($linestr);
  80   }
  81 }
  82
  83 sub scope_injector_call {
  84   return ' BEGIN { ' . __PACKAGE__ . '::inject_scope }; ';
  85 }
  86
  87 sub inject_scope {
  88   my $self = shift;
  89   $^H |= 0x120000;
  90   $^H{DD_METHODHANDLERS} = Scope::Guard->new(sub {
  91       my $linestr = Devel::Declare::get_linestr;
  92       my $offset  = Devel::Declare::get_linestr_offset;
  93       substr( $linestr, $offset, 0 ) = ';';
  94       Devel::Declare::set_linestr($linestr);
  95   });
  96 }
  97
  98 1;
  99