lib/MooseX/Antlers/DevelDeclareHandler.pm

   1 package MooseX::Antlers::DevelDeclareHandler;
   2
   3 use Method::Signatures::Simple ();
   4 use B::Compiling;
   5 use B::Hooks::EndOfScope;
   6
   7 my %fix;
   8 my %names;
   9
  10 my $orig_block = Devel::Declare::Context::Simple->can('inject_if_block');
  11
  12 *Devel::Declare::Context::Simple::inject_if_block = sub {
  13   $orig_block->(@_);
  14   my $line = $_[0]->get_linestr;
  15   $line =~ s/BEGIN {.*?};//;
  16   push(@{$fix{PL_compiling->file}}, [ PL_compiling->line, $line ]);
  17 };
  18
  19 my $orig_scope = Devel::Declare::Context::Simple->can('inject_scope');
  20
  21 *Devel::Declare::Context::Simple::inject_scope = sub {
  22   my $self = $_[0];
  23   $orig_scope->(@_);
  24   on_scope_end {
  25     push(@{$fix{PL_compiling->file}}, [ PL_compiling->line, $self->get_linestr ]);
  26   };
  27 };
  28
  29 my $orig_install = Devel::Declare::MethodInstaller::Simple->can('install');
  30
  31 *Devel::Declare::MethodInstaller::Simple::install = sub {
  32   push(@{$names{PL_compiling->file}}, $_[1]);
  33   $orig_install->(@_);
  34 };
  35
  36 sub emit_result {
  37   my ($file) = @_;
  38   use IO::All qw(io);
  39   my @self = io($file)->getlines;
  40   my @methods = @{$names{$file}};
  41   my $method_section = q!
  42 use Sub::Name ();
  43 my ($meth, @methods);
  44 BEGIN {
  45   my @methods = qw(!.join(' ', @methods).q!);
  46   $meth = sub (&) {
  47     my $name = shift(@methods);
  48     *$name = Sub::Name::subname $name => $_[0];
  49   };
  50 }
  51 use MooseX::Antlers::StealImport
  52   'Method::Signatures::Simple' => {
  53     method => $meth
  54   };
  55 !;
  56   foreach my $f (@{$fix{$file}}) {
  57     my ($line, $linestr) = @$f;
  58     $self[$line-1] = $linestr;
  59   }
  60   return join("", $method_section, @self);
  61 }
  62
  63 1;