#!/usr/bin/env perl

# Combined Disassemble and Reassemble


use if (-d 'C:/Users/Clueless'),lib=>'C:/Users/Clueless/lib';
use if (-d 'C:/Users/Clueless'),lib=>'C:/Users/Clueless/devlib';

# $ENV{DBG} -> compile time; $ENV{DEBUG} -> run time.
use if ($ENV{DBG} || $ENV{DEBUG}),"Devel::UnComment","#[=]#","Keep";

use Data::Dumper;
use English '-no_match_vars';
use File::Basename;
use Getopt::Long;
#use Getopt::Euclid;
use Params::Validate(':all');
use Perl::Tidy;
use Pod::Usage;
use PPI;
use PPI::Dumper;
use Text::Diff;
use Try::Tiny;
use strict;
use warnings;
use 5.10.0;

{ # INTERNALS

    # Given a file name and a list of directories returns the path of the file in the "right most" directory
    sub use_file {
        my ($filename_S,@directories_A)=Params::Validate::validate_pos(@_,{ type=>SCALAR },({ type=>SCALAR,callbacks=>{ "Directory not found"=> sub { -d shift() } } }) x $#_);

        for (my $i=$#directories_A; $i >= 0; $i--) {
            return "$directories_A[$i]/$filename_S"
                if (-r "$directories_A[$i]/$filename_S");
            };
        Carp::cluck "File '$filename_S' was never found!";
        my ($name)=File::Basename::fileparse($filename_S, qr/\.[^.]*/);
        return \q{sub $name { ...; }};
        }; # use_file;

    # Given a reference to a string and a string of perltidy options
    # Returns a reference to the tidied string.
    sub tidy {
        my ($source_SREF,$argv_S)=Params::Validate::validate_pos(@_,{ type=>SCALARREF },{ type=>SCALAR });

        my $error=Perl::Tidy::perltidy(
                argv        => $argv_S,
                source      => $source_SREF,
                destination => \my $destination,
                stderr      => \my $stderr,
                errorfile   => \my $errorfile,    # ignored when -se flag is set
                );

        # Handle errors
        if ($error) {
            # serious error in input parameters, no tidied output
            print {*STDERR} "\n$stderr\n";
            Carp::croak "Exiting because of serious errors!";
            };
        print {*STDERR} "<<STDERR>>\n$stderr\n"
            if ($stderr);
        print {*STDERR} "<<.ERR file>>\n$errorfile\n"
            if ($errorfile);

        return \$destination;
        }; #tidy:

    # Given a reference to a scalar and a file name writes the scalar to the designated file:
    sub write_to_file {
        my ($string_SREF,$filename_S)=Params::Validate::validate_pos(@_,{ type=>SCALARREF },{ type=>SCALAR });

        try {
            open my $file,'>',$filename_S
               or die "Can NOT open '$filename_S' for write";
            print {$file} $$string_SREF;
            close $file
               or die "Can NOT close '$filename_S' after write";
            }
        catch {
            #=# WARN Carp::longmess $_;
            Carp::confess $_;
            };
        }; # write_to_file; done.

    }; # INTERNALS

# Get options
my $option_href={};
Getopt::Long::GetOptions($option_href,
        'help'
        ,'man'
        ,'from=s@'
        ,'to=s'
        )
    or pod2usage(2);
#=# DEBUG [ option_href=>\$option_href];

pod2usage(1)
    if $option_href->{help};
pod2usage( '-verbose' => 2 )
    if $option_href->{man};

if ($ARGV[0] && -r $ARGV[0] && $option_href->{to}) { # Disassmble $ARGV[0] saving its "MAIN" and its subs into $option_href->[to} as files
    # Either empty the directory or create it
    if (-d $option_href->{to}) { # Directory exists - flush it
        #=# DEBUG 
        unlink glob "$option_href->{to}/*.*";
        }
    elsif (mkdir $option_href->{to}) { # Made the directory
        }
    else { # Maybe $option_href->{to} is a file?
        Carp::confess "We don't have the requisite directory '$option_href->{to}'! $!";
        };

    # Load the source    
    my $source_s=do {
        open my $FILE,'<',$ARGV[0]
            or die "Could not open '$ARGV[0]' for reading! $!";
        local $/;
        <$FILE>;
        };
    # Tidy it?

    # Disassmble it
    my $document=PPI::Document->new(\$source_s)
        or die "Oops! Could not PPI::Document '$ARGV[0]'!";

    # Decompose
    for my $sub (@{$document->find('PPI::Statement::Sub') || []}) {
        unless ($sub->forward) {
            #=# DEBUG $sub->name;
            # save the sub and its content
            # THIS WORKS (as I can't get $sub->save(...) to work) BUT IS IT KOSHER?
            write_to_file(\$sub->PPI::Document::serialize(),$option_href->{to}.'/'.$sub->name.'.sub');
            # Create a stub by removing sub's block's children
            my @elements=$sub->block->children;
            for (my $i=0; $i < @elements; $i++) {
                $elements[$i]->remove;
                };
            };
        };
    # Save the stubbed out "main/package" under MAIN.
    $document->save("$option_href->{to}/MAIN");
    }
elsif ($ARGV[0] && $option_href->{from}) { # Reassemble $ARGV[0] from MAIN and the subs in @$option_href->{from} (scanning $# .. 0)
    # Load "MAIN"
    my $document=PPI::Document->new(use_file('MAIN',@{$option_href->{from}}));
    #=# DEBUG ''.PPI::Dumper->new($document)->string;

    # Find and flesh out the stubs
    for my $stub (@{$document->find('PPI::Statement::Sub') || []}) {
    	  unless ($stub->forward) {

            # Thanks to haukex
            # http://www.perlmonks.org/bare/?node_id=1199996
            ## 1. store the document in its own variable
            #my $doc=PPI::Document->new(\$sub_h{$stub->name}{content});
            #my $sub=$doc->find_first('PPI::Statement::Sub');
            #
            ## 2. remove the sub element from its document
            #$stub->insert_after($sub->remove)
            #    or warn "Could not insert_after!";
            ## 3. remove the stub
            #$stub->remove
            #    or warn "Could not ->remove!";

            # ... or equivalently
            $stub->insert_after(PPI::Document->new(use_file($stub->name.q{.sub},@{$option_href->{from}}))->find_first('PPI::Statement::Sub')->remove)
                or warn "Could not ...->insert_after(...->remove)!";
            #=# TRACE '',PPI::Dumper->new($document,whitespace=>0)->string;
            $stub->remove
                or warn "Could not ...->remove!";
            #=# DEBUG '',PPI::Dumper->new($document,whitespace=>0)->string;

    	      };
        };
    #=# DEBUG '',PPI::Dumper->new($document,whitespace=>0)->string;

    # Write out the results (should we tidy it?)
    $document->save($ARGV[0]);
    }
else {
    pod2usage( '-verbose' => 2 )
    };
exit;
__END__