first sketch of Devel::Declare code

[gitmo/MooseX-Antlers.git] / lib / MooseX / Antlers / DevelDeclareHandler.pm

package MooseX::Antlers::DevelDeclareHandler;

use Method::Signatures::Simple ();
use B::Compiling;
use B::Hooks::EndOfScope;

my %fix;
my %names;

my $orig_block = Devel::Declare::Context::Simple->can('inject_if_block');

*Devel::Declare::Context::Simple::inject_if_block = sub {
  $orig_block->(@_);
  my $line = $_[0]->get_linestr;
  $line =~ s/BEGIN {.*?};//;
  push(@{$fix{PL_compiling->file}}, [ PL_compiling->line, $line ]);
};

my $orig_scope = Devel::Declare::Context::Simple->can('inject_scope');

*Devel::Declare::Context::Simple::inject_scope = sub {
  my $self = $_[0];
  $orig_scope->(@_);
  on_scope_end {
    push(@{$fix{PL_compiling->file}}, [ PL_compiling->line, $self->get_linestr ]);
  };
};

my $orig_install = Devel::Declare::MethodInstaller::Simple->can('install');

*Devel::Declare::MethodInstaller::Simple::install = sub {
  push(@{$names{PL_compiling->file}}, $_[1]);
  $orig_install->(@_);
};

sub emit_result {
  my ($file) = @_;
  use IO::All qw(io);
  my @self = io($file)->getlines;
  my @methods = @{$names{$file}};
  my $method_section = q!
use Sub::Name ();
my ($meth, @methods);
BEGIN {
  my @methods = qw(!.join(' ', @methods).q!);
  $meth = sub (&) {
    my $name = shift(@methods);
    *$name = Sub::Name::subname $name => $_[0];
  };
}
use MooseX::Antlers::StealImport
  'Method::Signatures::Simple' => {
    method => $meth
  };
!;
  foreach my $f (@{$fix{$file}}) {
    my ($line, $linestr) = @$f;
    $self[$line-1] = $linestr;
  }
  return join("", $method_section, @self);
}

1;