#!/usr/bin/perl
use warnings;
use strict;
use FindBin '$Bin';

use Test::More tests => 1 + 22 + (8+1146+14+715+495+8) + (13+13+13);

BEGIN {
	use_ok('Mac::AppleEvents');
	require "$Bin/helper.pl";
}

use Mac::Types;
use MacPerl 'MakePath';

my $fourcharcode = ['abcd', '1   ', "\0\0\0\0"];
my $stringdata   = ['a', 'ab', 'abc', @$fourcharcode, 'abcde', 'abcdef', "this is some random text I am just gonna add here OK?"];

# 15
my %types = (
	# 3 * 5 = 15
	typeEnumerated()	=> $fourcharcode,
 	typeType()		=> $fourcharcode,
 	typeKeyword()		=> $fourcharcode,
 	typeApplSignature()	=> $fourcharcode,
 	typeProperty()		=> $fourcharcode,

	# 9
 	typeChar()		=> $stringdata,

	# 2, 3 * 5 = 17
 	typeBoolean()		=> [0, 1],
 	typeShortInteger()	=> [0, 123, -1234],
 	typeInteger()		=> [0, -2**24, 2**31-1],
 	typeShortFloat()	=> [0, 123.45, -1234.56],
 	typeFloat()		=> [0, 12345678.91, (-2**24 + .234234)],
 	typeMagnitude()		=> [0, 2**32-1, 2**31],

	# 1
	typeFSS()		=> ['/System/Library/CoreServices/Finder.app'],
	typeQDRectangle()	=> [ [1, 240, 320, 2000] ],
	typeRGBColor()		=> [ [65535, 0, 0] ],

	# qdrt, cRGB, STR, STR#
); # = 44

SKIP: {
#	skip "Basic AEDesc tests", 22;

	my $desc = AEDesc->new(typeChar);
	is(ref($desc), 'AEDesc',				'Create AEDesc');
	is($desc->type, typeChar,				'Check type');
	ok(!defined($desc->get),				'No data');

	my $hand = Handle->new('something');
	is($desc->type(typeType), typeType,			'Change type');
	ok(!defined($desc->get),				'No data');
	is(ref($hand), 'Handle',				'Create handle');
	ok($desc->data($hand),					'Add handle');
	is($desc->get, 'some',					'Check value'); # truncated due to typeType

	is($desc->type(typeChar), typeChar,			'Change type');
	# 6 * 2 = 12
	for my $i (0, 1, 10, 100, 1000, 10000) {
		ok($desc->data(Handle->new($i)),		'Add handle');
		is($desc->get, $i,				'Check value');
	}

	ok(AEDisposeDesc($desc),				'Dispose');
}

SKIP: {
#	skip "AEDesc and AEList tests", 8+1146+14+715+495+8;

	# 8
	my $list = AECreateList('', 0);
	is($list->type, typeAEList,					'Create AEList');
	my $reco = AECreateList('', 1);
	is($reco->type, typeAERecord,					'Create AERecord');

	my $list2 = AECreateList('', 0);
	is($list2->type, typeAEList,					'Create AEList');
	my $reco2 = AECreateList('', 1);
	is($reco2->type, typeAERecord,					'Create AERecord');

	my $lists = AEStream->new;
	is(ref $lists, 'AEStream',					'Create AEStream list');
	ok($lists->OpenList,						'OpenList');
	my $recos = AEStream->new;
	is(ref $recos, 'AEStream',					'Create AEStream list');
	ok($recos->OpenRecord,						'OpenRecord');

	my($listg_fmt, $recog_fmt, @g_param) = ('', '');

	# 44 * 4 * 5 = 880, + 44, + 33 * 4 = 132, + 15 * 6 = 90 = 1146
	for my $type (sort keys %types) {
		my $data = $types{$type};
		for my $datum (@$data) {
			my $packed = exists($MacPack{$type}) ? MacPack($type, (ref $datum ? @$datum : $datum)) : $datum;

			my $desc1 = AEDesc->new($type, $packed);
			my $desc2 = AEKeyDesc->new($type, $type, $packed);
			my $desc3 = AECreateDesc($type, $packed);
			my $desc4 = AEDuplicateDesc($desc1);

			# http://developer.apple.com/technotes/tn/tn2045.html
			my $builddata = $datum;
			my $lit = 0;
			my $skip = 0;
			my $hand = 0;
			if ($type eq typeFSS) {
				$builddata = $packed;
			} elsif ($datum =~ /\0/) {
				$builddata = MakeHex($datum);
				$lit = 1;
			} elsif ($type eq typeType) {
				$builddata = Handle->new(MakeFourChar($datum));
				$hand = 1;
			} elsif ($type eq typeKeyword) {
				$builddata = MakeFourChar($datum);
			} elsif ($type eq typeApplSignature || $type eq typeProperty || $type eq typeEnumerated) {
				$builddata = "'$datum'";
				$lit = 1;
			} elsif ($type eq typeBoolean) {
				$builddata = MakeNumHex($datum);
				$lit = 1;
			} elsif ($type eq typeShortInteger || $type eq typeInteger) {
				$lit = 1;
			} elsif (SkipType($type)) {
				# no idea why this doesn't work, oh well
				$skip = 1;
			}

			my $desc5 = $skip ? '' :
				$lit  ? AEBuild("$type($builddata)") :
				$hand ? AEBuild("$type(\@@)", $builddata) :
				        AEBuild("$type(\@)",  $builddata);

			# http://developer.apple.com/technotes/tn/tn2046.html
			my $stream = AEStream->new;
			$stream->WriteDesc($type, $packed);
			my $desc6 = $stream->Close;

			#diag("$type: $datum");

			if ($datum eq $data->[-1]) {
				ok(AEPut($list, AECountItems($list)+1, $type, $packed),	'AEPut');
				ok(AEPutKey($reco, $type, $type, $packed), 		'AEPutKey');

				ok(AEPutDesc($list2, AECountItems($list2)+1, $desc4),	'AEPutDesc');
				ok(AEPutKeyDesc($reco2, $type, $desc4), 		'AEPutKeyDesc');

				ok($lists->WriteDesc($type, $packed),			'WriteDesc list');
				ok($recos->WriteKeyDesc($type, $type, $packed),		'WriteKeyDesc record');

				unless ($skip) {
					if ($lit) {
						$listg_fmt .= "$type($builddata), ";
						$recog_fmt .= "$type : $type($builddata), ";
					} else {
						my $at = $hand ? '@@' : '@';
						$listg_fmt .= "$type($at), ";
						$recog_fmt .= "$type : $type($at), ";
						push @g_param, $builddata;
					}
				}
			}

			#diag("$type($builddata)");
			#diag(AEPrint($desc4));
			#diag(AEPrint($desc5)) if $desc5;
			for my $desc ($desc1, $desc2, $desc3, $desc4, $desc5, $desc6) {
				next unless $desc;
				CheckDesc($desc, $type, $datum);
			}
		}
	}

	# 14
	s/, $// for ($listg_fmt, $recog_fmt);
	my $listg = AEBuild("[$listg_fmt]", @g_param);
	is($listg->type, typeAEList,			'Create AEList');
	my $recog = AEBuild("{$recog_fmt}", @g_param);
	is($recog->type, typeAERecord,			'Create AERecord');

	ok($lists->CloseList,				'CloseList');
	ok($recos->CloseRecord,				'CloseRecord');

	ok(my $list3 = $lists->Close,			'Close list');
	ok(my $reco3 = $recos->Close,			'Close record');

	my $count = scalar keys %types;
	for my $L ($list, $list2, $list3, $reco, $reco2, $reco3) {
		is(AECountItems($L), $count,		'Count list items');
	}

	my $countg = $count - 5;
	for my $L ($listg, $recog) {
		is(AECountItems($L), $countg,		'Count list items');
	}

	# 15 * 13 * 3 = 585, + 13 * 10 = 715
	my $i = 0;
	my $g = 0;
	for my $type (sort keys %types) {
		$i++; $g++;
		my $datum = $types{$type}[-1];
		#diag("AEList: $type: $datum");

		my $j = 0;
		for my $L ($list, $list2, $list3, $listg) {
			my $k = $i;
			if (++$j == 4) {
				#diag("ok!: $type: $g");
				if (SkipType($type)) {
					$g--;
					next;
				}
				$k = $g;
			}
			my $desc = AEGetNthDesc($L, $k);
			CheckDesc($desc, $type, $datum);
		}

		$j = 0;
		for my $L ($reco, $reco2, $reco3, $recog) {
			my $k = $i;
			if (++$j == 4) {
				#diag("ok!!: $type: $g");
				if (SkipType($type)) {
					next;
				}
				$k = $g;
			}
			my $desc = AEGetKeyDesc($L, $type);
			CheckDesc($desc, $type, $datum);

			# same as above, but fetch by index
			($desc, my($key)) = AEGetNthDesc($L, $k);
			is($key, $type,			'Check key');
			CheckDesc($desc, $type, $datum);
		}
	}

	# 15 * 11 * 3 = 495
	$i = 0;
	for my $type (sort keys %types) {
		$i++;
		my $datum = $types{$type}[-1];
		#diag("AEDelete: $type: $datum");

		for my $L ($list, $list2, $list3) {
			my $desc = AEGetNthDesc($L, 1);
			CheckDesc($desc, $type, $datum);
			AEDeleteItem($L, 1);
			my $tab = AECountItems($L);
			cmp_ok($tab, '==', $count-$i,	'Count items remaining');
		}

		for my $L ($reco, $reco2, $reco3) {
			my($desc, $key) = AEGetNthDesc($L, 1);
			is($key, $type,			'Check key');
			CheckDesc($desc, $type, $datum);
			AEDeleteItem($L, 1);
			my $tab = AECountItems($L);
			$tab =~ s/\D+//;
			is($tab, $count-$i,		'Count items remaining');
		}
	}

	# 8
	for my $L ($list, $list2, $list3, $listg, $reco, $reco2, $reco3, $recog) {
		ok(AEDisposeDesc($L), 			'Dispose list');
	}
}

SKIP: {
#	skip "AECoerce tests", 13+13+13;

	my $string = "abcdef";
	my $desc = AEDesc->new(typeChar, $string);
	my $desc2 = AECoerceDesc($desc, typeUnicodeText);
	my $desc3 = AECoerce(typeChar, $string, typeUnicodeText);

	# 13
	CheckDesc($desc, typeChar, $string);

	CheckRef($desc2, typeUnicodeText);
	CheckType($desc2, typeUnicodeText);
	is(length($desc2->get), 2*length($string),		'Length check');

	CheckRef($desc3, typeUnicodeText);
	CheckType($desc3, typeUnicodeText);
	is(length($desc3->get), 2*length($string),		'Length check');

	is($desc2->get, $desc3->get,				'Value check');

	CheckDispose($desc2);
	CheckDispose($desc3);


	my $keyw = "abcd";
	$desc = AEDesc->new(typeKeyword, $keyw);
	$desc2 = AECoerceDesc($desc, typeChar);
	$desc3 = AECoerce(typeKeyword, $keyw, typeChar);

	# 13
	CheckDesc($desc, typeKeyword, $keyw);
	is($desc2->get, $desc3->get,				'Value check');
	CheckDesc($desc2, typeChar, $keyw);
	CheckDesc($desc3, typeChar, $keyw);



	my $num = 2**18;
	my $num2 = $num + .45;
	$desc = AEDesc->new(typeFloat, MacPack(typeFloat, $num2));
	$desc2 = AECoerceDesc($desc, typeInteger);
	$desc3 = AECoerce(typeFloat, MacPack(typeFloat, $num2), typeInteger);

	# 13
	CheckDesc($desc, typeFloat, $num2);

	CheckRef($desc2, typeInteger);
	CheckType($desc2, typeInteger);
	is($desc2->get, $num,					'Value check');

	CheckRef($desc3, typeInteger);
	CheckType($desc3, typeInteger);
	is($desc3->get, $num,					'Value check');

	is($desc2->get, $desc3->get,				'Value check');

	CheckDispose($desc2);
	CheckDispose($desc3);
}

sub MakeFourChar {
	pack "N", unpack "L", $_[0];
}

sub MakeHex {
	'$' . join('', map { sprintf("%02X", ord) } split //, MakeFourChar($_[0])) . '$';
}

sub MakeNumHex {
	my $hex = '$' . sprintf("%02X", $_[0]) . '$';
	if (length($hex) % 2) {
		$hex =~ s/^\$/\$0/;
	}
	return $hex;
}

sub SkipType {
	my($type) = @_;
	return 1 if $type eq typeShortFloat || $type eq typeFloat || $type eq typeMagnitude || $type eq typeQDRectangle || $type eq typeRGBColor;
	return 0;
}

=pod

=head1 TODO

=over 4

* location/range/comparison/logical?

* AEBuild doesn't work with unsigned 32-bit or floats?

* AEBuild doesn't automatically handle byteswapping of OSTypes

* AEStream WriteData, same problem

=back



__END__