lib/Method/Inliner.pm

   1 package Method::Inliner;
   2
   3 use strictures 1;
   4 use Text::Balanced qw(extract_bracketed);
   5 use Sub::Quote ();
   6
   7 sub slurp { do { local (@ARGV, $/) = $_[0]; <> } }
   8 sub splat {
   9   open my $out, '>', $_[1] or die "can't open $_[1]: $!";
  10   print $out $_[0] or die "couldn't write to $_[1]: $!";
  11 }
  12
  13 sub inlinify {
  14   my $file = $_[0];
  15   my @chunks = split /(^sub.*?^}$)/sm, slurp $file;
  16   warn join "\n--\n", @chunks;
  17   my %code;
  18   foreach my $chunk (@chunks) {
  19     if (my ($name, $body) =
  20       $chunk =~ /^sub (\S+) {\n(.*)\n}$/s
  21     ) {
  22       $code{$name} = $body;
  23     }
  24   }
  25   foreach my $chunk (@chunks) {
  26     my ($me) = $chunk =~ /^sub.*{\n  my \((\$\w+).*\) = \@_;\n/ or next;
  27     my $meq = quotemeta $me;
  28     #warn $meq, $chunk;
  29     my $copy = $chunk;
  30     my ($fixed, $rest);
  31     while ($copy =~ s/^(.*?)${meq}->(\S+)(?=\()//s) {
  32       my ($front, $name) = ($1, $2);
  33       ((my $body), $rest) = extract_bracketed($copy, '()');
  34       warn "spotted ${name} - ${body}";
  35       if ($code{$name}) {
  36       warn "replacing";
  37         s/^\(//, s/\)$// for $body;
  38         $body = "${me}, ".$body;
  39         $fixed .= $front.Sub::Quote::inlinify($code{$name}, $body);
  40       } else {
  41         $fixed .= $front.$me.'->'.$name.$body;
  42       }
  43       #warn $fixed; warn $rest;
  44       $copy = $rest;
  45     }
  46     $fixed .= $rest if $fixed;
  47     warn $fixed if $fixed;
  48     $chunk = $fixed if $fixed;
  49   }
  50   print join '', @chunks;
  51 }
  52
  53 1;