#!/usr/bin/perl -s

use warnings;
use strict;
use IO::All;

use constant DEBUG => 0;

our $name;
our $keyword ||= 'sub';
my $code = join( '', <STDIN> );

print extract_method($code);

sub extract_method
{
    my $code = shift;
    write_file($code);
    my $err  = 1;
    my @args = ();
    while($err)
    {
        $err = 0;
        open( my $perl, "-|", 'perl -C /tmp/code.txt 2>&1' )
            || die $@;
        while( my $item = <$perl> )
        {
            if( $item =~ /Global symbol "(.*)" requires explicit package name/ )
            {
                $err = 1;
                push @args, $1 unless( grep { $1 eq $_ } @args );
                warn "args: $item, $1" if DEBUG;
            }
        }
        write_file( $code, @args );
    }
    return codegen( $code, 'final', @args );
}

sub write_file
{
    my $code = shift;
    my @args = (@_);
    codegen( $code, 'test', @args ) > io('/tmp/code.txt');

}

sub codegen
{
    my $code = shift;
    my $mode = shift;
    my @args = (@_);

    my $selforthis_signature = qr/^(\$self|\$this)$/;
    my ($class_obj) = grep { $_ =~ /$selforthis_signature/ } @args;
    $class_obj ||= '$self' if $keyword ne 'sub';
    my @params = grep { $_ !~ /$selforthis_signature/ } @args;
    my $subname = $name || 'mysub_' . int( rand(1000) );
    return generate_method( $class_obj, \@params, $code, $subname )
        if $class_obj and $mode eq 'final';
    my $method_body = generate_signature( $class_obj, \@params, $code );
    my $invocation;

    if($class_obj)
    {
        $invocation = $class_obj . "->" . $subname;
    }
    else
    {
        $invocation = $subname;
    }
    my $ret = "$invocation(" . join( ',', map { $_ =~ /^(\%|\@)/ ? '\\' . $_ : $_ } @params ) . ");\n";
    $ret .= "sub $subname\n{\n" . ( $mode eq 'test' ? "use strict;\n" : '' ) . $method_body . "\n}";
    return $ret;
}

sub generate_signature
{
    my $class_obj = shift;
    my @params    = @{ (shift) };
    my $code      = shift;

    my $ret = join(
        "\n",
        ( $class_obj ? '    my ' . $class_obj . " = shift;" : "" ),
        map {
            my $var = $_;
            if( $var =~ /^(\%|\@)(.*)$/ )
            {
                my $sigil = $1;
                my $name  = $2;
                "    my " . $var . " = " . $sigil . "{(shift)};";
            }
            else
            {
                "    my $var = shift;";
            }
            } @params
        )
        . "\n\n"
        . $code;
    return $ret;
}

sub generate_method
{
    my $class_obj = shift;
    my @params    = @{ (shift) };
    my $code      = shift;
    my $subname   = shift;
    my $decl      = $keyword;

    my $name_args = $subname . ( @params ? ' (' . join( ', ', map { $_ =~ /^(\%|\@)/ ? '\\' . $_ : $_ } @params ) . ')' : '' );
    my $invocation = $class_obj . "->" . $name_args . ";";
    my $body       = "$decl $name_args\n{\n" . $code . "\n}";

    my $ret = ( $decl eq 'sub' ? 'use strict;' : '' ) . $invocation . "\n\n" . $body . "\n";
    warn $ret if DEBUG;
    $ret;
}