#!/usr/bin/env perl

# Combined Disassemble and Reassemble


use if (-d 'C:/Users/clueless_newbie'),lib=>'C:/Users/clueless_newbie/lib';
use if (-d 'C:/Users/clueless_newbie'),lib=>'C:/Users/clueless_newbie/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 Params::Validate(':all');
use Pod::Usage;
use PPI;
use PPI::Dumper;
use strict;
use warnings;
use 5.10.0;

{ # INTERNALS

    # Given a file name and a list of directories returns the content of the file in the "right most" directory
    sub read_file {
        my ($filename_S)=Params::Validate::validate_pos(@_,{ type=>SCALAR });

        open my $FILE,'<',$ARGV[0]
            or die "Could not open '$filename_S for reading! $OS_ERROR";
        local $INPUT_RECORD_SEPARATOR;
        return \<$FILE>;
        }; # read_file:

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

        my ($name,$directory,$extension)=File::Basename::fileparse($filename_S, qr/\.[^.]*/);
        #=# DEBUG [ name=>\$name,$directory=>\$directory,extension=>\$extension,directories=>\@directories_A ];
        for (my $i=$#directories_A; $i >= 0; $i--) {
            #=# TRACE [ trying=>\"$directories_A[$i]/$name$extension" ];
            return "$directories_A[$i]/$name$extension"
                if (-r "$directories_A[$i]/$name$extension");
            };
        # No such file -- return a reference to a string containing a stub.
        return \qq{sub $name {\n # NOT FOUND!!! \n}};
        }; # which_file:

    }; # 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 ($option_href->{to} && $option_href->{from}) { # WTF: Can't have both!
    pod2usage( '-verbose' => 2 )
    }
elsif ($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
        #=# TRACE "deleting files:",
        unlink glob "$option_href->{to}/*.*";
        }
    elsif (mkdir $option_href->{to}) { # Made the directory
        }
    else { # Maybe $option_href->{to} is a file?
        Carp::confess "We do not have the requisite directory '$option_href->{to}'! $OS_ERROR";
        };

    my $source_sref=read_file($ARGV[0]);
    # Tidy it?

    # Disassmble it
    my $document=PPI::Document->new($source_sref)
        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 AND won't have Adam Kennedy shaking his head in disgust! Thanks to haukex
            $sub->insert_after(PPI::Document::Fragment->new(\(q{sub }.$sub->name.q{ {...}}))->find_first(q{PPI::Statement::Sub})->remove)
                or warn q{Could not ...->insert_after(...->remove)!};
            my $subdoc=PPI::Document::Fragment->new()
                or die q{Oops! Could not PPI::Document::Fragment->new!};
            $subdoc->add_element($sub->remove);
            # Won't need to stub by removing sub's block's children
            $subdoc->save($option_href->{to}.q{/}.$sub->name.q{.sub});
            };
        };
    # Save the stubbed out "main/package" under MAIN.
    #=# DEBUG 'MAIN';
    $document->save("$option_href->{to}/MAIN");
    } # Appears to work: Check MAIN & subs against ARGV[0]
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(which_file('MAIN',@{$option_href->{from}}));
    #=# TRACE ''.PPI::Dumper->new($document)->string;

    # Buffer to hold subs required by the updated document
    my @sub_a;

    # Find and flesh out the stubs
    for my $stub (@{$document->find('PPI::Statement::Sub') || []}) {
        #=# DEBUG $stub->name;
    	unless ($stub->forward) {
            push @sub_a,PPI::Document->new(which_file($stub->name.q{.sub},@{$option_href->{from}}));
            if ($stub->insert_before($sub_a[-1]->find_first('PPI::Statement::Sub'))) {
                $stub->delete();
                }
            else {
                warn q{... ->insert_before failed!};
                };
            };
        };
    #=# 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__