#!perl

use strict;

printf qq(/*** %-67s ***/\n), "Please do not edit this file!";
printf qq(/*** %-67s ***/\n), "It was generated with 'perl tds_willconvert.pl > tds_willconvert.h'";
printf qq(/*** %-67s ***/\n), "It is much easier to edit the __DATA__ table than this file.  ";
printf qq(/*** %-67s ***/\n), " ";
printf qq(/*** %67s ***/\n\n), "Thank you.";

# read types values from tdsproto.h
my %typesNum = ();
my @typeNames = ('') x 256;
open(IN, '<', $ARGV[0]) or die $ARGV[0];
while (<IN>) {
	if (/\s+(X?SYB[A-Z0-9]+)\s+=\s+([1-9]\d+)/) {
		my ($name, $val) = ($1, $2);
		$typesNum{$name} = $val;\
		die "out of range" if $val <= 0 || $val >= 256;
		$typeNames[$val] = $name;
	}

}
close(IN);

my %yn = 	( T => 1
	, t => 0	# should be true, but not yet implemented.
	, F => 0
	);

sub category($) {
	$_ = shift;
	return qw(INT1 UINT1 INT2 UINT2 INT4 UINT4 INT8 UINT8) if $_ eq 'INTx';
	return qw(MONEY MONEY4) if $_ eq 'MONEYx';
	return qw(FLT8 REAL) if $_ eq 'FLTx';
	return qw(DATETIME DATETIME4 DATE TIME MSDATE MSTIME MSDATETIME2 MSDATETIMEOFFSET 5BIGDATETIME 5BIGTIME) if $_ eq 'DATETIMEx';
	return qw(BIT BITN) if $_ eq 'BITx';
	return qw(BINARY VARBINARY IMAGE LONGBINARY XBINARY XVARBINARY) if $_ eq 'BINARYx';
        return qw(CHAR VARCHAR XCHAR XNCHAR XNVARCHAR XVARCHAR) if $_ eq 'CHARx';
        return qw(TEXT NTEXT) if $_ eq 'TEXT';
	return ($_);
}

sub to_type($) {
	$_ = shift;
	return 'XSYB'.substr($_, 1) if (substr($_, 0, 1) eq 'X');
	return "SYB$_";
}

my @to;
my %allTypes;
my %fromTo;
my %toFrom;
while(<DATA>) {
	next if /^\s+To\s*$/;
	next if /^From/;
	if( /^\s+CHARx/ ) {
		@to = split;
		next;
	}
	last if /^\s*$/;

	my @yn = split;
	my $from = shift @yn;
	foreach $from (category($from)) {
		my $i = 0;
		foreach my $to (@to) {
			foreach my $to (category($to)) {
				die if !exists($yn{$yn[$i]});
				my $yn = $yn{$yn[$i]};
				my $from = to_type($from);
				next if $from eq 'SYBBOUNDARY';
				die if !exists($typesNum{$from});
				$allTypes{$from} = 1;
				my $to = to_type($to);
				next if $to eq 'SYBBOUNDARY';
				die $to if !exists($typesNum{$to});
				$allTypes{$to} = 1;
				$fromTo{$from}{$to} = $yn;
				$toFrom{$to}{$from} = $yn;
			}
			++$i;
		}
	}
}
my @types = sort { $typesNum{$a} <=> $typesNum{$b} } keys %allTypes;
undef %allTypes;

# collapse types with same conversions
my %cats;
for my $type (@types) {
	my $id = join('x', @{$fromTo{$type}}{@types}).join('x', @{$toFrom{$type}}{@types});
	push @{$cats{$id}}, $type;
}
undef %toFrom;

# assign category a number
my %typeCategory;
my $n = 0; # category 0 is invalid
my @catsNum = (0) x 256;
my @converts;
for my $types (values %cats) {
	++$n;
	push @converts, @{$types}[0];
	for my $type (@{$types}) {
		$catsNum[$typesNum{$type}] = $n;
		$typeCategory{$type} = $n;
	}
}
die if $n >= 32;

# output array to translate type to category
print "static const TDS_TINYINT type2category[256] = {\n";
for my $n (0..255) {
	my $comment = $typeNames[$n] ? $typeNames[$n] : "$n";
	print "\t$catsNum[$n], /* $comment */\n";
}
print "};\n\n";

# compute category conversions
print "static const TDS_UINT category_conversion[] = {\n\t0,\n";
for my $catFrom (@converts) {
	my $conv = 0;
	my $n = 1;
	for my $catTo (@converts) {
		$n *= 2;
		$conv |= $n if $fromTo{$catFrom}{$catTo} != 0;
	}
	print "\t$conv,\t/* $catFrom */\n";
}
print "};\n";

# NB: SYBSENSITIVITY (Sybase) == 103 (0x67) == SYBNVARCHAR (MS)

__DATA__
          To
From
            CHARx TEXT BINARYx INTx FLTx NUMERIC DECIMAL BITx MONEYx DATETIMEx BOUNDARY UNIQUE SENSITIVITY
CHARx       T     T    T       T    T    T       T       T    T      T         T        T      T
TEXT        T     T    T       T    T    T       T       T    T      T         T        T      T
BINARYx     T     T    T       T    T    F       F       F    T      F         F        F      T
INTx        T     T    T       T    T    T       T       T    T      F         F        F      T
FLTx        T     T    T       T    T    T       T       T    T      F         F        F      T
NUMERIC     T     T    T       T    T    T       T       T    T      F         F        F      T
DECIMAL     T     T    T       T    T    T       T       T    T      F         F        F      T
BITx        T     T    T       T    T    T       T       T    T      F         F        F      T
MONEYx      T     T    T       T    T    T       T       T    T      F         F        F      T
DATETIMEx   T     T    T       F    F    F       F       F    F      T         F        F      T
BOUNDARY    T     T    F       F    F    F       F       F    F      F         T        F      T
UNIQUE      T     T    T       F    F    F       F       F    F      F         F        T      T
SENSITIVITY T     T    T       T    T    T       T       T    T      T         T        T      T
