#!/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";

##</code><code>##

package AI::Neural;


use AI::_Neural;

use attributes;


#Hook from __new to new
sub new {
	my $string;
	open "SUB_TYPE", ">>AI\/data\/new.type" or die "Could not open file for write : $!\n";
	open "SUB_DATA", ">>AI\/data\/new.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 AI::_Neural::__new(@_);
}

    .....

    .....


##</code><code>##

Loading file 'Neural.pm' for processing
Backing up file 'Neural.pm' to 'Neural.pm.bak'
Replacing 'Neural.pm' code with hooked version
Hooked 37 subroutines

Now exercise code...

##</code><code>##

total 21
drwxr-xr-x+ 2 paul matthews mkgroup-l-d   0 Apr  1 20:21 .
drwxr-xr-x+ 3 paul matthews mkgroup-l-d   0 Apr  1 20:28 ..
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 AddEdgeOverRandomVertex.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 AddRandomConnectedNeuron.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 AddRandomEdge.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 AddRandomNeuron.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 AddVertexOverRandomEdge.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 DeepCopy.type
-rw-r--r--  1 paul matthews mkgroup-l-d 144 Apr  1 20:21 GetNewVertexNumber.data
-rw-r--r--  1 paul matthews mkgroup-l-d  11 Apr  1 20:21 GetNewVertexNumber.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 RandomizeVertexActivationFunction.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 SaveNetwork.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 XMLout.type
-rw-r--r--  1 paul matthews mkgroup-l-d   6 Apr  1 20:21 __PACKAGE
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 activation_sigmoid.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 activation_tanh.type
-rw-r--r--  1 paul matthews mkgroup-l-d 287 Apr  1 20:21 add_edge.data
-rw-r--r--  1 paul matthews mkgroup-l-d  32 Apr  1 20:21 add_edge.type
-rw-r--r--  1 paul matthews mkgroup-l-d   0 Apr  1 20:21 add_graph.type
-rw-r--r--  1 paul matthews mkgroup-l-d  83 Apr  1 20:21 add_input.data
-rw-r--r--  1 paul matthews mkgroup-l-d  18 Apr  1 20:21 add_input.type
-rw-r--r--  1 paul matthews mkgroup-l-d  92 Apr  1 20:21 add_neuron.data
-rw-r--r--  1 paul matthews mkgroup-l-d  32 Apr  1 20:21 add_neuron.type

    .....

    ...l.

    .....

##</code><code>##

#!/usr/bin/perl

use strict;
use warnings;

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

my $package = $ARGV[0];
my @bits = split "/", $package;
my $datadir = "";
my $new_package = "";
for ( 0 .. scalar @bits - 2 ) {
	$datadir .= $bits[$_] . "/";
	$new_package .= $bits[$_] . "::";
} 
$new_package .= $bits[scalar @bits - 1];
$new_package =~ s/\.pm//;
print "NEW PACKAGE : $new_package\n";
chop $datadir;

#make a directory to store the tests
my $testdir = "t";
if ( ! -d "$datadir/$testdir" ) { system ("mkdir $datadir/$testdir"); }

#get the list of subroutines
my @files = glob("$datadir/data/*.type");

print "Creating tests for the following Subroutines\n\n";
my $f;
foreach $f ( sort @files ) {
	if ( -s $f ) {
		$f =~ /$datadir\/data\/(\w+).type/;
		my $subroutine = $1;
		print "$subroutine ";
		open SUB, "<$f" or die "Could not open file for read2 : $!\n";
		my @lines = <SUB>;
		close (SUB);
		
		my %hash;
		#Now create a hash of hashes of what each subroutine can take as inputs
		foreach my $l (@lines) {
			chomp $l;
			my @arr = split ',', $l;
			for ( 0 .. scalar @arr - 1) {
				${$hash{$_}}{$arr[$_]} = 1; 
			}

		}
		foreach my $h ( keys %hash ) {
			#print "[$h] : ";
			foreach my $k ( keys %{$hash{$h}} ) {
			#	print "$k ";
			}
			#print "\n";
		}

		#Now create tests based on the input parameters.
		$f =~ s/\/data\//\/t\//;
		$f =~ s/\.type/\.t/;
		open "TEST", ">$f" or die "Could not open file for write : $!\n";
		print TEST <<__END__;
use Test::More tests=> 1; 
use $new_package;

my \$self = $new_package->new();

ok(\$self->$subroutine(), "Testing $subroutine with no args");

__END__


		close (TEST);
	}
}
print "\n\n";


##</code><code>##

Creating tests for the following Subroutines

GetNewVertexNumber add_edge add_input add_neuron add_output new run_network run_node set_edge_weights set_input_value 


##</code><code>##

total 10
drwxr-xr-x+ 2 paul matthews mkgroup-l-d  0 Apr  1 16:32 .
drwxr-xr-x+ 4 paul matthews mkgroup-l-d  0 Apr  1 16:34 ..
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 GetNewVertexNumber.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 add_edge.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 add_input.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 add_neuron.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 add_output.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 new.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 run_network.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 run_node.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 set_edge_weights.t
-rw-r--r--  1 paul matthews mkgroup-l-d 37 Apr  1 16:34 set_input_value.t