#!/usr/bin/perl

use strict;
use warnings;

#Check command line arguments
die "Incorrect number of arguments\n\tFormat : generalize_setup <file>\n\n" if ( $#ARGV != 0 );

my $file = $ARGV[0];
my ($file_noext, $ext) = split '\.', $file;

#load in the code to hooked
print "Loading file \'$file\' for processing\n";
open "IN", "<$file" or die "Could not open file for read : $!\n";
my @old_code = <IN>;
close(IN);

#Back up the old code
print "Backing up file \'$file\' to \'$file.bak\'\n";
open "BACKUP", ">$file.bak" or die "Could not open file for write : $!\n";
print BACKUP @old_code;
close (BACKUP);

my @new_code;
my $linenum = 1;
my $subcount = 0;
my @subroutines;
my $packageline;
my $package;

my $dir = "";
my $new_package = "";

#do the subroutines
foreach (@old_code) {
	if ( $linenum == 2) {
		my $pl = $packageline;
		$pl = s/package/use/;
		push @new_code, "$pl;\n";
	}
	if ( /^package/ ) {
		$packageline = $_;
		$packageline =~ /\w+\s+(.+)\;/;
		$package = $1;
		my @bits = split "::", $package;
		for ( 0 .. scalar @bits - 2 ) {
			$dir .= $bits[$_] . "/"; 
			$new_package .= $bits[$_] . "::"; 
		}
		$new_package .= "_" . $bits[scalar @bits - 1];
		chop $dir;
		push @new_code, "package $new_package;\n";
	} elsif ( /^sub/ ) {
		my ($pre, $subroutine, $post) = split ' ', $_;
		push @new_code, "$pre __$subroutine $post\n";
		$subcount++;
		push @subroutines, $subroutine;
	} else {
		push @new_code, $_;
	}
	$linenum++;
}


#set the data directory
my $datadir = "$dir\\/data";

#do the calls
foreach (@new_code) {
	
	#s/add_input\s*\(/$package\:\:add_input\(/;
	foreach my $s ( @subroutines ) {
		if ( /$s\s*\(/ ) {
			if ( !/>$s/ ) { 
				s/$s\s*\(/$package\:\:$s\(/;
			}
		}
		#fix up &func's 
		if ( /\&$s/ ) {
			s/$s/__$s/;
		}
	}
}

#Write the modified old code 
open "OUT", ">$dir/_Neural.pm" or die "Could not open file for write : $!\n";
print OUT $_ foreach ( @new_code );
close(OUT);

#Create the hooks
print "Replacing \'$file\' code with hooked version\n"; 
open "HOOK", ">$file" or die "Could not open file for write : $!\n";
print HOOK "$packageline\n\n";
print HOOK "use $new_package;\n\n";
print HOOK "use attributes;\n\n";
foreach my $sub ( @subroutines ) {
	print HOOK <<__END__;

#Hook from __$sub to $sub
sub $sub {
	my \$string;
	open "SUB_TYPE", ">>$datadir\\/$sub.type" or die "Could not open file for write : \$!\\n";
	open "SUB_DATA", ">>$datadir\\/$sub.data" or die "Could not open file for write : \$!\\n";

	my \$args;
	foreach my \$arg ( \@_ ) {
		\$args .= \$arg . ","; 
	}
	chop \$args;
	\$args .= "\n";
	print SUB_DATA \$args;
	close (SUB_DATA);

	foreach \$attr ( \@_ ) {
		if ( ref(\$attr) ) {
			\$string .= "REF:" . ref(\$attr) . ",";
		} else {
			\$string .= attributes::reftype(\\\$attr) . ",";
		}
	}
	chop \$string;
	\$string .= "\\n";
	print SUB_TYPE \$string;
	close (SUB_TYPE);
	return $new_package\:\:__$sub(\@_);
}

__END__
}
print HOOK "1;\n";
close (HOOK);

#Create a directory and blank file(s) for data
system ("mkdir $datadir");
foreach my $sub ( @subroutines ) {
	open "SUB", ">$datadir/$sub.type" or die "Could not open file for write : $!\n";
	close (SUB);
}

print "Hooked $subcount subroutines\n\nNow exercise code...\n\n";