#! /usr/bin/perl
use Win32::API;

# Will found out the appropiate length to pack integers in this machine
#const optimize
BEGIN {
    use Config;
    eval ' sub pointer_pack_type () { "'
    .($Config{ptrsize} == 8 ? 'Q' : 'L').
    '" }';
}
# Control vars
$pass = 1;
$printOutValues = 1;
if($printOutValues)
{
	use Data::Dumper;
	$Data::Dumper::Useqq = 1;
}

# Create a table using the dll.
# Some info about the API function:
# __declspec(dllimport) myTable myTableCreate();
# Some info about the type myTable:
# typedef
# struct myTable{ 
# void* opaque;  ///< Opaque pointer to storage
# } myTable;
$CreateTable = new Win32::API("myDll.dll","myTableCreate", 'V','N');
 if(not defined $CreateTable) {
        die "Can't import API myTableCreate(): $!\n";
}
#Create an empty tables.
if($pass)
{
	$LeftTable = $CreateTable->Call('');
	$RightTable = $CreateTable->Call('');
	$outputTable = $CreateTable->Call('');
	# Make sure that the function does return a memory position, and not a 0.
	$pass = $pass && ($LeftTable>0 && $RightTable>0 && $outputTable>0);
	if($pass){print("Empty Tables Succesfully Created. Pass code: ".$pass.".\n");};
	if($pass && $printOutValues)
	{	print "...\n";
		print "These are the empty tables HANDLEs:\nLeft Table:\t".$LeftTable."\nRight Table:\t".$RightTable."\nOutput Table:\t".$outputTable."\n";
		print "...\n";
	}
}

# pack the table.
if($pass)
{	
	$packedOption = pointer_pack_type();
	$packedLeftTable = pack($packedOption,$LeftTable);
	$packedRightTable = pack($packedOption,$RightTable);
	$packedOutputTable = pack($packedOption,$outputTable);
	$pass = $pass && (unpack($packedOption,$packedLeftTable) == $LeftTable && unpack($packedOption,$packedRightTable) == $RightTable && unpack($packedOption,$packedOutputTable) == $outputTable);
	if($pass){ print("Table communication between perl and dll is correct. Pass code: ".$pass."\n");}
	if($pass && $printOutValues)
	{	print "...\n";
		print "These are the empty tables LPHANDLEs (Pack Option: ".$packedOption."):\nLeft Table:\t";
		print Dumper($packedLeftTable);
		print "Right Table:\t";
		print Dumper($packedRightTable);
		print "Output Table:\t";
		print Dumper($packedOutputTable);
		print "...\n";
	}
}
# Path definition.
$pathTableLeft = 'C:/Temp/Requests/TableTest1.TBL';
$pathTableRight = 'C:/Temp/Requests/TableTest2.TBL';
#$pathTableRight = 'C:/Temp/Requests/TableTest1.TBL';

# Load the function.
# Load the table file loader from the dll.
# Some info about the API function:
# __declspec(dllimport) enum cStatus myTableLoadFromFile(char const* filename, myTable* raw_result);
# enum cStatus will treated as an int and interpreted using the array @DllTableStatus.
$LoadTableFromFile = new Win32::API("myDll.dll","myTableLoadFromFile", 'PP', 'I','_cdecl');
if(not defined $LoadTableFromFile) {
        die "Can't import API myTableLoadFromFile(): $!\n";
 }
if($pass)
{
	my @DllTblStatus = ("OK Status, no errors", "Failed to allocate memory", "Unable to open or save file", "Unable to convert value to requested type", "Unknown error", "Validation Failed", "Cell could not be found");
	my $isLoadedLeft = 1;
	my $isLoadedRight = 1;
	$isLoadedLeft = $LoadTableFromFile->Call($pathTableLeft,$packedLeftTable);
	$isLoadedRight = $LoadTableFromFile->Call($pathTableRight, $packedRightTable);
	$pass = $pass && ($isLoadedLeft==0 && $isLoadedRight==0);
	if($pass)
		{	$LeftTable = unpack($packedOption,$packedLeftTable);
			$RightTable = unpack($packedOption, $packedRightTable);
			print("Tables: ".$pathTableLeft." and ".$pathTableRight." loaded correctly. Pass code: ".$pass."\n");
			if($pass && $printOutValues)
			{
				print "...\n";
				print "After loading the tables with the files, the tables LPHANDLEs (Pack Option: ".$packedOption."):\nLeft Table:\t";
				print Dumper($packedLeftTable);
				print "Right Table:\t";
				print Dumper($packedRightTable);
				print "Output Table:\t";
				print Dumper($packedOutputTable);
				print "...\n";
				print "After laoding the tables with the files, the tables HANDLEs (Unpack Option: ".$packedOption."):\nLeft Table:\t".$LeftTable."\nRight Table:\t".$RightTable."\nOutput Table:\t".$outputTable."\n";
				print "...\n";
			}
		}
	else
	{
		if($isLoadedLeft>0){print("Loading table error on ".$pathTableLeft.": ".@DllTblStatus[$isLoadedLeft]."\n");}
		if($isLoadedRight>0){print("Loading table error on ".$pathTableRight.": ".@DllTblStatus[$isLoadedRight]."\n");}
	}
}
# Load the table comparer from the dll.
# Some info about the API function:
# __declspec(dllimport) bool myTableCompare(myTable lhs, myTable rhs, myTable* output, unsigned int *count, double relative_tolerance, double absolute_tolerance);
# bool is not an acceptable type. So the result of the function is stored in an int.

$TableComparer = new Win32::API("myDll.dll","myTableCompare", 'NNPPDD','N','_cdecl');
if(not defined $TableComparer) {
        die "Can't import API myTableCompare(): $!\n";
 }

if($pass)
{	my $count = 0;
	my $pointerToCount = pack('L',$count);
	my $RelativeTol=0.001;
	my $AbsTol=1.0;
	if($pass)
	{
		$areTheSame=$TableComparer->Call($LeftTable, $RightTable, $packedOutputTable, $pointerToCount, $RelativeTol, $AbsTol);
		$outputTable = unpack($packedOption,$packedOutputTable);
		if($areTheSame==1)
		{
			print $pathTableLeft." and ".$pathTableRight." are equal.\nThe returned value of myTableCompare was: ".$areTheSame."\n";
		}
		else
		{
			print $pathTableLeft." and ".$pathTableRight." are NOT equal.\nThe returned value of myTableCompare was: ".$areTheSame."\n";
		}
		if($pass && $printOutValues)
		{
			print "...\n";
			print "After comparing both tables, the tables LPHANDLEs (Pack Option: ".$packedOption."):\nLeft Table:\t";
			print Dumper($packedLeftTable);
			print "Right Table:\t";
			print Dumper($packedRightTable);
			print "Output Table:\t";
			print Dumper($packedOutputTable);
			print "...\n";
			print "After comparing both tables, the tables HANDLEs (Unpack Option: ".$packedOption."):\nLeft Table:\t".$LeftTable."\nRight Table:\t".$RightTable."\nOutput Table:\t".$outputTable."\n";
			print "...\n";
		}
	}
}

##</code><code>##

Empty Tables Succesfully Created. Pass code: 1.
...
These are the empty tables HANDLEs:
Left Table:	48120353
Right Table:	48120401
Output Table:	48120449
...
Table communication between perl and dll is correct. Pass code: 1
...
These are the empty tables LPHANDLEs (Pack Option: L):
Left Table:	$VAR1 = "!B\336\2";
Right Table:	$VAR1 = "QB\336\2";
Output Table:	$VAR1 = "\201B\336\2";
...
Tables: C:/Temp/Requests/TableTest1.TBL and C:/Temp/Requests/TableTest1.TBL loaded correctly. Pass code: 1
...
After loading the tables with the files, the tables LPHANDLEs (Pack Option: L):
Left Table:	$VAR1 = "\31\261\337\2";
Right Table:	$VAR1 = "y\333\340\2";
Output Table:	$VAR1 = "\201B\336\2";
...
After laoding the tables with the files, the tables HANDLEs (Unpack Option: L):
Left Table:	48214297
Right Table:	48290681
Output Table:	48120449
...
C:/Temp/Requests/TableTest1.TBL and C:/Temp/Requests/TableTest1.TBL are equal.
The returned value of myTableCompare was: 1
...
After comparing both tables, the tables LPHANDLEs (Pack Option: L):
Left Table:	$VAR1 = "\31\261\337\2";
Right Table:	$VAR1 = "y\333\340\2";
Output Table:	$VAR1 = "q\335\340\2";
...
After comparing both tables, the tables HANDLEs (Unpack Option: L):
Left Table:	48214297
Right Table:	48290681
Output Table:	48291185
...

##</code><code>##

$TableComparer = new Win32::API("myDll.dll","myTableCompare", 'NNPPDD','N','_cdecl');

##</code><code>##

Empty Tables Succesfully Created. Pass code: 1.
...
These are the empty tables HANDLEs:
Left Table:	48120353
Right Table:	48120401
Output Table:	48120449
...
Table communication between perl and dll is correct. Pass code: 1
...
These are the empty tables LPHANDLEs (Pack Option: L):
Left Table:	$VAR1 = "!B\336\2";
Right Table:	$VAR1 = "QB\336\2";
Output Table:	$VAR1 = "\201B\336\2";
...
Tables: C:/Temp/Requests/TableTest1.TBL and C:/Temp/Requests/TableTest2.TBL loaded correctly. Pass code: 1
...
After loading the tables with the files, the tables LPHANDLEs (Pack Option: L):
Left Table:	$VAR1 = "\31\261\337\2";
Right Table:	$VAR1 = "a:\342\2";
Output Table:	$VAR1 = "\201B\336\2";
...
After laoding the tables with the files, the tables HANDLEs (Unpack Option: L):
Left Table:	48214297
Right Table:	48380513
Output Table:	48120449
...
C:/Temp/Requests/TableTest1.TBL and C:/Temp/Requests/TableTest2.TBL are NOT equal.
The returned value of myTableCompare was: 48168704
...
After comparing both tables, the tables LPHANDLEs (Pack Option: L):
Left Table:	$VAR1 = "\31\261\337\2";
Right Table:	$VAR1 = "a:\342\2";
Output Table:	$VAR1 = "1%\342\2";
...
After comparing both tables, the tables HANDLEs (Unpack Option: L):
Left Table:	48214297
Right Table:	48380513
Output Table:	48375089
...