#!/usr/bin/perl

# If anyone feels the aching need to do some Perl, please feel free to
# rewrite this *mess*.
#
# Also, I'm not sure the crow's feet are correct, or at least the code
# might be making unsafe assumptions.
#
# Tom Gidden, 17-Oct-05

use DBI;
use Data::Dumper;
use Carp qw|verbose|;
use Getopt::Std;



our %opts;
getopts('D:H:U:P:LChamgsl:c:t:w:', \%opts);

our $dbname_default = 'Database';
our $dbhost_default = 'localhost';
our $dbuser_default = 'ro';
our $dbpass_default = 'ro';

if($opts{'h'}) {
	print <<EOF;
 mysql2graffle

 Usage:
    -C                 No columns
    -L                 No labels
    -c <fontsize>      Column font size (10)
    -t <fontsize>      Table name font size (12)
    -l <fontsize>      Label font size (8)
    -m                 Include magnets for tables
    -g                 Include magnets for columns
    -s                 Include shadows
    -w <width>         Table width (100)
    -a                 Include all tables in database
    -D <database>      Database name (default: $dbname_default)
    -H <host>          Database host (default: $dbhost_default)
    -U <database_user> Database user (default: $dbuser_default)
    -P <database_pass> Database password (default: $dbpass_default)

 Example:
    mysql2graffle -c 10 -t 20 -l 8 -d Database table1 table2 ... tableN
EOF
exit;
}

our $dbname = $opts{'D'} ? $opts{'D'} : $dbname_default;
our $dbhost = $opts{'H'} ? $opts{'H'} : $dbhost_default;
our $dbuser = $opts{'U'} ? $opts{'U'} : $dbuser_default;
our $dbpass = $opts{'P'} ? $opts{'P'} : $dbpass_default;
our $cs = $opts{'c'} || 10;
our $ts = $opts{'t'} || 12;
our $ls = $opts{'l'} || 8;
our $shadows = $opts{'s'};
our $nolabels = $opts{'L'};
our $nocolumns = $opts{'C'};
our $magnets = $opts{'m'};
our $colmags = $opts{'g'};
our $tw = $opts{'w'} || 100;
our $rh = $nocolumns ? $ts : $cs;
our $alltables = $opts{'a'};


$dbh = DBI->connect("DBI:mysql:database=$dbname;host=$dbhost", $dbuser, $dbpass);
die "Can't Connect to MySQL: $!" unless($dbh);
$dbh->do('SET SESSION wait_timeout=3600');

our %unique;
our %indexes;
our %part_of_primkey;
our %tids;
our %table_columns;
our @tables;

our $x=0;
our $column_links = 0;

if($alltables) {
	@tables = (map { s/\`//gso; s/^.+?\.//gso; $_; } $dbh->tables);
} else {
	@tables = @ARGV;
	shift @tables;
}


# Load lookup tables
{
	my $id = 1;
	foreach my $table (@tables) {
		my $q = $dbh->prepare('show columns from '.$table);
		$q->execute or die $dbh->errstr;
#		$tabs{$id} = $table;
		$tids{$table} = ++$id;
		while($row = $q->fetchrow_hashref) {
			$tids{$table.'.'.$$row{Field}} = ++$id;
			$table_columns{$table}{$$row{Field}} = 1;
			push @{$table_column_list{$table}}, $$row{Field};
			$isnullable{$table}{$$row{Field}} = $$row{Null} eq 'YES' ? 1 : 0;
		}
		$q->finish;

		$q = $dbh->prepare('show indexes from '.$table);
		$q->execute or die $dbh->errstr;
		my $ind = '';
		my $lastrow;
		my @cols;
		if($row = $q->fetchrow_hashref) {
			do {
				if($ind ne $$row{Key_name}) {
					if($ind) {
						my $key = join(',', sort @cols);
						foreach $col (@cols) {
							$part_of_primkey{$table}{$col} = 1 if($ind eq 'PRIMARY');
						}
						$unique{$table}{$key} = 1 if($$row{Non_unique}==0);
						$indexes{$table}{$key} = $$row{Null}eq'YES' ? 1 : 2;
					}
					@cols = ();
					$lastrow = $row;
					$ind = $$row{Key_name};
				}
				my $col = $$row{Column_name};
				$col =~ s/\`//gso;
				push @cols, $col;
			} while($row = $q->fetchrow_hashref);

			if($ind) {
				my $key = join(',', sort @cols);
				foreach $col (@cols) {
					$part_of_primkey{$table}{$col} = 1 if($ind eq 'PRIMARY');
				}
				$unique{$table}{$key} = 1 if($$lastrow{Non_unique}==0);
				$indexes{$table}{$key} = $$lastrow{Null}eq'YES' ? 1 : 2;
			}
		}

		@cols = keys %{$part_of_primkey{$table}};
		if(scalar @cols == 1) {
			$unique{$table}{$cols[0]} = 1;
		}
	}
}

print '<?xml version="1.0" encoding="UTF-8"?>',"\n";
print '<plist version="1.0">',"\n";
print "<dict>\n<key>GraphicsList</key>\n<array>\n";

# Iterate tables
{
	foreach my $table (@tables) {
		print table_xml($table);
	}
}

print "</array>\n</dict>\n</plist>\n";




sub table_xml($) {
	my ($table) = @_;
	my $ret = '';

	$ret .= "<dict>\n";
	$ret .= "<key>Class</key><string>Group</string>\n";
	$ret .= "<key>ID</key><integer>".$tids{$table}."</integer>\n";

	$ret .= "<key>Magnets</key>\n<array>\n<string>{0,-1}</string>\n<string>{0,1}</string>\n</array>\n"
	  if($magnets);

	$ret .= "<key>Graphics</key>\n<array>\n";

	$x += $tw*1.5;
	my $y = 0;

	# Draw table header
	$ret .= "<dict>\n";
	$ret .= "<key>Class</key><string>ShapedGraphic</string>\n";
	$ret .= "<key>Bounds</key><string>{{$x, $y}, {$tw, $rh}}</string>\n";
	$ret .= "<key>Shape</key><string>Rectangle</string>\n";
	$ret .= "<key>Style</key>\n<dict>\n<key>shadow</key>\n<dict>\n<key>Draws</key><string>NO</string>\n</dict>\n</dict>\n";
	$ret .= "<key>Text</key>\n<dict>\n<key>Text</key><string>{\\rtf1\\f0\\fs$ts $table}</string>\n</dict>\n";
	$ret .= "</dict>\n";
	$y += $rh;

	unless($nocolumns) {
		# Draw columns
		foreach my $col (@{$table_column_list{$table}})  {
			my $fnt = '\\rtf1\\f0\\fs'.$cs;
			$fnt .= '\\b' if($unique{$table}{$col});
			$fnt .= '\\ul' if($part_of_primkey{$table}{$col});
			$fnt .= '\\i' if($isnullable{$table}{$col});

			$ret .= "<dict>\n";

			if($colmags) {
				$ret .= "<key>ID</key><integer>".$tids{$table.'.'.$col}."</integer>\n";
				$ret .= "<key>AllowConnections</key><string>YES</string>\n";
				$ret .= "<key>Magnets</key>\n<array>\n<string>{-1,0}</string>\n<string>{1,0}</string>\n</array>\n";
			} else {
				$ret .= "<key>AllowConnections</key><string>NO</string>\n";
			}

			$ret .= "<key>Class</key><string>ShapedGraphic</string>\n";
			$ret .= "<key>Bounds</key><string>{{$x, $y}, {$tw, $rh}}</string>\n";
			$ret .= "<key>Style</key>\n<dict>\n<key>shadow</key>\n<dict>\n<key>Draws</key><string>NO</string>\n</dict>\n<key>stroke</key>\n<dict>\n<key>Draws</key><string>NO</string>\n</dict>\n</dict>\n";

			$ret .= "<key>Text</key>\n<dict>\n<key>Text</key><string>{$fnt $col}</string>\n</dict>\n";
			$ret .= "</dict>\n";
			$y += $rh;
		}
	}

	$ret .= "<dict>\n";
	$ret .= "<key>Class</key><string>ShapedGraphic</string>\n";
	$ret .= "<key>Bounds</key><string>{{$x, 0}, {$tw, $y}}</string>\n";
	$ret .= "<key>Shape</key><string>Rectangle</string>\n";
	$ret .= "<key>Style</key>\n<dict>\n<key>shadow</key>\n<dict>\n<key>Draws</key><string>".($shadows?'YES':'NO')."</string>\n</dict>\n</dict>\n";
	$ret .= "</dict>\n";

	$ret .= "</array>\n</dict>\n";



#	# Do keys
#	{
#		foreach my $from_col (@{$table_column_list{$table}}) {
#			next unless($from_col =~ m/^(.+)_id$/);
#			my $to_table;
#			my $to_table_id;
#			my $to_col = $from_col;

#			next unless($to_table_id = $tids{$to_table = $1});

#			next if($to_table eq $table);

#			next unless($table_columns{$to_table}{$to_col});

# This stuff is for MySQL databases with foreign key constraints.
	{
		my $ct;
		my $q = $dbh->prepare('SHOW CREATE TABLE '.$table) or die $dbh->errstr;
		$q->execute;
		my @row = $q->fetchrow_array;
		die $dbh->errstr unless($ct = pop @row);

		while($ct =~ s/CONSTRAINT \`[^\`]+\` FOREIGN KEY \(\s*([^\)]+)\s*\) REFERENCES `([^\`]+)` \(\s*([^\)]+)\s*\)//osi) {
			my ($from_col, $to_table, $to_col) = ($1,$2,$3);
			$from_col =~ s/\s*\`\s*//gso;
			$to_col =~ s/\s*\`\s*//gso;
			$to_table =~ s/\s*\`\s*//gso;

			$from_col = join(',', sort (split(/\s*\,\s*/, $from_col)));
			$to_col = join(',', sort (split(/\s*\,\s*/, $to_col)));

			my $head;
			my $tail;
			if(!$column_links or $from_col =~ m/\,/so) {
				$tail = $tids{$table};
			} else {
				$tail = $tids{"$table.$from_col"};
			}

			if(!$column_links or $to_col =~ m/\,/so) {
				$head = $tids{$to_table};
			} else {
				$head = $tids{"$to_table.$to_col"};
			}

			my $col;
			if($from_col eq $to_col) {
				$col = $from_col;
			} else {
				$col = "$from_col = $to_col";
			}

			my $headtype = 0;
			my $tailtype = 0;

			if($unique{$to_table}{$to_col}) {
				$headtype = 'Bar';
			} else {
				$headtype = 'Crow';
			}


			# Work out if to can be zeroed (if from can be null) XXX
			my $fromnull = 0;
			foreach my $fc (split(/\,/, $from_col)) {
				$fromnull = 1 if($isnullable{$table}{$fc});
			}

			$tailtype = 'CrowBall';

			if($fromnull) {
				if($headtype eq 'Crow') {
					$headtype = 'CrowBall';
				} else {
					$headtype = 'BarBall';
				}
			} else {
				if($headtype eq 'Crow') {
					$headtype = 'CrowsFeet';
				} else {
					$headtype = 'DoubleBar';
				}
			}

#			#DoubleBar
#			#BarBall
#			#CrowBall
#			#CrowBar
#			#CrowsFeet

			$ret .= "<dict>\n";
			$ret .= "<key>Class</key><string>LineGraphic</string>\n";
			$ret .= "<key>Head</key>\n<dict>\n<key>ID</key><integer>$head</integer>\n</dict>\n";
			$ret .= "<key>Tail</key>\n<dict>\n<key>ID</key><integer>$tail</integer>\n</dict>\n";
			$ret .= "<key>Labels</key>\n<array>\n<dict>\n<key>Orientation</key><integer>2</integer>\n<key>Label</key>\n<dict>\n<key>Align</key><integer>0</integer>\n<key>Text</key><string>{\\rtf1\\f0\\fs$ls $col}</string>\n</dict>\n<key>LabelVisible</key><string>YES</string>\n</dict>\n</array>\n"
			  unless($nolabels);
			$ret .= "<key>OrthogonalBarAutomatic</key><true/>\n";
			$ret .= "<key>Style</key>\n<dict>\n<key>stroke</key>\n<dict>\n<key>Cap</key><integer>0</integer>\n<key>HeadArrow</key><string>$headtype</string>\n<key>HopLines</key><true/>\n<key>Join</key><integer>0</integer>\n<key>LineType</key><integer>2</integer>\n<key>TailArrow</key><string>$tailtype</string>\n</dict>\n</dict>\n";
			$ret .= "</dict>\n";
		}
	}

	return $ret;
}