#!/usr/bin/perl
#
# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements.  See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership.  The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License.  You may obtain a copy of the License at
#
#   http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing,
# software distributed under the License is distributed on an
# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
# KIND, either express or implied.  See the License for the
# specific language governing permissions and limitations
# under the License.
#
use POSIX;
use Pod::Usage;
use Getopt::Long;
use Data::Dumper;
use JSON;
use strict;
use warnings;

=head1 NAME

B<pablopcatso.pl> - generate graphs of catalog entries

=head1 SYNOPSIS

B<pablopcatso.pl> [options] <json file> 

Options:

    -help            brief help message
    -man             full documentation
	-direction       direction of graph
	-nocolor         black and white graph
	-nocluster       do not cluster tables from same header file
	-showfiles       if clustered, label each cluster with header file name
	-showcolumns     print column definitions for tables
    -filemap         a json file mapping files to catalog tables
	-filterunused    filter out unreferenced columns or tables
	-table           only graph the specified tables

=head1 OPTIONS

=over 8

=item B<-help>

    Print a brief help message and exits.

=item B<-man>
    
    Prints the manual page and exits.

=item B<-direction>

   Direction of graph.  Valid entries are:

=over 12

=item LR (default): left to right

=item RL: right to left

=item BT: bottom to top

=item TB: top to bottom

    
=back

=item B<-nocolor>

	Print graph in black and white only if set.

    Colors from www.ColorBrewer.org by Cynthia A. Brewer, 
	Geography, Pennsylvania State University.

=item B<-nocluster>

	Normally, each set of tables from the same parent header 
	file is clustered together (with an invisible boundary) 
	in the graph.  Setting this parameter removes clustering.


=item B<-showfiles>

	If clustering is enabled, label and outline each cluster 
	with the parent filename.

=item B<-showcolumns>

	Print each table as a record node that lists the columns

=item B<-filemap> <filename>

    use a json file mapping source files to catalog tables referenced in cql statements (generated by calico.pl)

=item B<-filterunused>

	Filter the graph to only show the tables and columns 
	that shared a primary key/foreign key relationship.

=item B<-table>

Specify a table or set of tables to limit the size of the graph.  To
specify multiple tables, use multiple table arguments, eg:

  -table pg_class -table pg_operator


=back


=head1 DESCRIPTION

Some people try to plot out graphs and find it a hassle --
this does not happen with pablo p catso...

pablopcatso generates .dot file output on stdout.

=head1 CAVEATS

	Well the girls would turn the color
	of the avocado when he would drive
	Down their street in his El Dorado

=head1 AUTHORS

Apache HAWQ

Address bug reports and comments to: dev@hawq.apache.org

=cut

my $glob_id = "";

my $glob_dir;
my $glob_dosubgraph;
my $glob_doclusterfilename;
my $glob_filemap;
my $glob_filterunused;
my $glob_nocolumns;
my $glob_docolor;

my $glob_tabs;

my $glob_tmpdir = "/tmp";

my $GV_formats; # graphviz output formats

my %glob_coltab = (set312 => [
                              '#8DD3C7',
                              '#FFFFB3',
                              '#BEBADA',
                              '#FB8072',
                              '#80B1D3',
                              '#FDB462',
                              '#B3DE69',
                              '#FCCDE5',
                              '#D9D9D9',
                              '#BC80BD',
                              '#CCEBC5',
                              '#FFED6F'
                              ],
                   paired12 => [
                                '#a6cee3',
                                '#1f78b4',
                                '#b2df8a',
                                '#33a02c',
                                '#fb9a99',
                                '#e31a1c',
                                '#fdbf6f',
                                '#ff7f00',
                                '#cab2d6',
                                '#6a3d9a',
                                '#ffff99',
                                '#b15928'
                                ],
                   pastel19 => [
                                '#fbb4ae',
                                '#b3cde3',
                                '#ccebc5',
                                '#decbe4',
                                '#fed9a6',
                                '#ffffcc',
                                '#e5d8bd',
                                '#fddaec',
                                '#f2f2f2'
                                ],
                   pastel24 => [
                                '#b3e2cd',
                                '#fdcdac',
                                '#cbd5e8',
                                '#f4cae4',
                                '#e6f5c9',
                                '#fff2ae',
                                '#f1e2cc',
                                '#cccccc'
                                ],
                   set19 => [
                             '#e41a1c',
                             '#377eb8',
                             '#4daf4a',
                             '#984ea3',
                             '#ff7f00',
                             '#ffff33',
                             '#a65628',
                             '#f781bf',
                             '#999999'
                             ],
                   set28 => [
                             '#66c2a5',
                             '#fc8d62',
                             '#8da0cb',
                             '#e78ac3',
                             '#a6d854',
                             '#ffd92f',
                             '#e5c494',
                             '#b3b3b3'
                             ]
                   );


BEGIN {
    my $man				  = 0;
    my $help			  = 0;
	my $dir				  = "LR";
	my $nosubgraph		  = 0;
	my $doclusterfilename = 0;
	my $s_filemap;              # json file mapping files to catalog tables
	my $filterunused	  = 0;
	my $showcolumns		  = 0;
	my $nocolor			  = 0;
	my @tabs;

    $GV_formats = '^(jpg|bmp|ps|pdf|png)$';

    GetOptions(
               'help|?' => \$help, man => \$man, 
		'direction=s',
		'nocluster|nosubgraph' => \$nosubgraph,
		'showfiles' => \$doclusterfilename,
		'filemap:s'          =>     \$s_filemap,
		'filterunused' => \$filterunused,
		'showcols|showcolumns' => \$showcolumns,
		'nocolor' => \$nocolor,
		'table:s' => \@tabs
               )
        or pod2usage(2);

    pod2usage(-msg => $glob_id, -exitstatus => 1) if $help;
    pod2usage(-msg => $glob_id, -exitstatus => 0, -verbose => 2) if $man;

	if ($dir !~ m/^(TB|BT|LR|RL)$/i)
    {
        $glob_dir = "LR";
    }
    else
    {
        $glob_dir = uc($dir);
    }

	$glob_dosubgraph = !($nosubgraph);
	$glob_doclusterfilename = $doclusterfilename;
	$glob_filterunused = $filterunused;
	$glob_nocolumns = !($showcolumns);
	$glob_docolor = !($nocolor);

	$glob_filemap =  $s_filemap      if (defined($s_filemap));
	if (defined($s_filemap))
	{
	    die ("invalid argument for 'filemap': file $s_filemap does not exist")
			unless (-e $s_filemap);
	}

	if (scalar(@tabs))
	{
		$glob_filterunused = 1;
		$glob_tabs = {};
		for my $t1 (@tabs)
		{
			$glob_tabs->{$t1} = 1;
		}

	}

#    print "loading...\n" ;
}

# add mapping of c source files to catalog tables that they reference
sub do_filemap
{ 
	my ($glob_filemap, $tabhue) = @_;

	my $whole_file;

	{
        # $$$ $$$ undefine input record separator (\n")
        # and slurp entire file into variable

        local $/;
        undef $/;

		my $fmi;

		open $fmi, "< $glob_filemap" or die "cannot open $glob_filemap: $!";

		$whole_file = <$fmi>;

		close $fmi;
	}

	my $fmh = JSON::from_json($whole_file);

	for my $kk (keys(%{$fmh}))
	{
		print "\n\"$kk\" [style=filled,color=grey,shape=diamond];\n";

		for my $jj (@{$fmh->{$kk}})
		{
			print "\"$kk\" -> \"$jj\" [style=dashed";

			# check for special table color
			if (exists($tabhue->{$jj}))
			{
				my $hue = $tabhue->{$jj};

				print ", $hue";
			}

			print "];\n";

		}
	}
} # end do_filemap

sub dograph
{
	my ($tabh, $dir) = @_;

	print "digraph g {\n\noverlap=false;rankdir=\"$dir\";\n";

	my $filh = {};

	my $refcols = {};
	my $reftabs = {};
	my $revreftabs = {};

	my @alledges;

	for my $kk (sort (keys (%{$tabh})))
	{
		next if ($kk =~ m/^\_\_/);

		my $vv = $tabh->{$kk};

		if (exists($vv->{filename}))
		{
			$filh->{$vv->{filename}} = []
				unless (exists($filh->{$vv->{filename}}));

			push @{$filh->{$vv->{filename}}}, $kk;
		}

		next unless (exists($vv->{fk_list}));

		for my $fkdef (@{$vv->{fk_list}})
		{
			my $fk1	  = $fkdef->{fkcols};
			my $t1	  = $fkdef->{pktable};
			my $pk1	  = $fkdef->{pkcols};
			my $fktyp = $fkdef->{type}; # vector or scalar

			# save the fk
			$refcols->{$kk} = {} unless (exists($refcols->{$kk}));

			my $fkcols = $fk1->[0];

			if (exists($refcols->{$kk}->{$fkcols}))
			{
				$refcols->{$kk}->{$fkcols} = 
					$refcols->{$kk}->{$fkcols} & 
					(($fktyp =~ m/scalar/i) ? 1 : 2);
			}
			else
			{
				$refcols->{$kk}->{$fkcols} = 
					(($fktyp =~ m/scalar/i) ? 1 : 2);				
			}

			my $fktnum = $refcols->{$kk}->{$fkcols};
			
			# save the pk
			$refcols->{$t1} = {} unless (exists($refcols->{$t1}));

			my $pkcols = $pk1->[0];

			if (exists($refcols->{$t1}->{$pkcols}))
			{
				$refcols->{$t1}->{$pkcols} = 
					$refcols->{$t1}->{$pkcols} & 
					(($fktyp =~ m/scalar/i) ? 1 : 2);
			}
			else
			{
				$refcols->{$t1}->{$pkcols} = 
					(($fktyp =~ m/scalar/i) ? 1 : 2);				
			}

			my $pktnum = $refcols->{$t1}->{$pkcols};

			# save the table reference
			$reftabs->{$kk} = {} unless (exists($reftabs->{$kk}));
			$reftabs->{$kk}->{$t1} = $fktnum;

			$revreftabs->{$t1} = {} unless (exists($revreftabs->{$t1}));
			$revreftabs->{$t1}->{$kk} = $pktnum;
		}

	} # end for my kk

#	print Data::Dumper->Dump([$refcols]);

	my $clusternum = 0;

	my $dosubgraph = $glob_dosubgraph;
	my $doclusterfilename = $glob_doclusterfilename;
	my $filterunused = $glob_filterunused;
	my $nocolumns = $glob_nocolumns;
	my $docolor = $glob_docolor;

	my @tablist = qw(
pg_class
pg_type
pg_proc
pg_operator
pg_authid
pg_namespace
pg_tablespace
);

	my $tabhue = {};

	my $tcount = 0;

	if ($docolor)
	{
		for my $t1 (@tablist)
		{
			$tabhue->{$t1} = "color=\"" . 
				$glob_coltab{set28}->[$tcount] . '"';
			$tcount++;
		}
	}

	for my $filnam (sort (keys (%{$filh})))
	{
		my $fildef = $filh->{$filnam};

		$clusternum++;

		if ($dosubgraph)
		{
			print "subgraph cluster_" . "$clusternum { \n ";

			if (!$doclusterfilename)
			{
				print "style=invis; \n";
			}
			else
			{
				print "style=filled;\n color=lightgrey;\n";
				print "node [style=filled,color=white];\n label = \"" . 
				$filnam . "\";\n";
			}
		}

		my %tab_only; # only print these tables if in glob_tab references

		for my $kk (@{$fildef})
		{
			my $vv = $tabh->{$kk};

			my @allcols;

			# check table filtering
			if ($glob_tabs)
			{
				my @checko;

				# find all tables referencing and referenced by this table
				push @checko, keys(%{$reftabs->{$kk}})
					if (exists($reftabs->{$kk}));
				push @checko, keys(%{$revreftabs->{$kk}})
					if (exists($revreftabs->{$kk}));

				push @checko, $kk;

				my $gotone = 0;

				# check for match in table filter
				for my $c1 (@checko)
				{
					if (exists($glob_tabs->{$c1}))
					{
						$gotone = 1;
						$tab_only{$kk} = 1;
						$tab_only{$c1} = 1;
						last;
					}
				}
				next unless ($gotone);
			}


			# put the name of the table as the first label
#			push @allcols, $kk . '\\n\\n';
			push @allcols, $kk;

			if (exists($vv->{with}) && 
				exists($vv->{with}->{oid}) &&
				$vv->{with}->{oid})
			{
				my $colstr = "<oid> oid Oid" . '\l';
				push @allcols, $colstr
					if (!$filterunused ||
						# check if column is a pk or fk
						(exists($refcols->{$kk}) &&
						 exists($refcols->{$kk}->{oid})));
			}

			for my $col (@{$vv->{cols}})
			{
				my $colstr =  "<" . $col->{colname} . ">" . $col->{colname}
				. " " . $col->{sqltype} . '\l';

				push @allcols, $colstr
					if (!$filterunused ||
						(exists($refcols->{$kk}) &&
						 exists($refcols->{$kk}->{$col->{colname}})));
			}

			# check if have any columns to print 
			if (scalar(@allcols) > 1)
			{
				my $colspec;

				$colspec = "";
				$colspec = $tabhue->{$kk} . " style=filled "
					if (exists($tabhue->{$kk}));

				if ($nocolumns)
				{
					$colspec = "[ " . $colspec . " ] "
						if (length($colspec));

					print "\n" . '"' . $kk . '" ' . $colspec .  " ;\n";
 
				}
				else
				{
					print "\n" . '"' . $kk . '" [' . 
#				"\nnodelabel = \"" . $kk . "\";\n" .
						"\nlabel = \"";

					print  join(" | ", @allcols)  . '"' . 
						"\nshape= \"record\"\n  $colspec ];\n";
				}
			} # end scalar allcols
		} # end for my kk fildef

		for my $kk (@{$fildef})
		{
			my $vv = $tabh->{$kk};

			next unless (exists($vv->{fk_list}));

			if ($glob_tabs)
			{
				# filter by tablename
				next unless (exists($tab_only{$kk}));
			}

			if ($nocolumns)
			{
				if (exists($reftabs->{$kk}))
				{
					for my $t1 (keys(%{$reftabs->{$kk}}))
					{
						my $colspec = "";
						my @csa;

						if (exists($tabhue->{$t1}))
						{
							push @csa, $tabhue->{$t1} ;
						}

						if ($reftabs->{$kk}->{$t1} > 1)
						{
							if ($reftabs->{$kk}->{$t1} == 3)
							{
								push @csa, "arrowhead=normalodiamondnormal";
								push @csa, "arrowtail=odiamondnormal";
							}
							else
							{
								push @csa, "arrowhead=normalodiamond";
								push @csa, "arrowtail=odiamond";
							}
						}

						$colspec = "[ " . join(" ", @csa) . " ] "
							if (scalar(@csa));

						push @alledges,  '"' . $kk . '" -> "' . 
							$t1 . '"' . " $colspec ;\n";
					}
				}				
			}
			else
			{
				for my $fkdef (@{$vv->{fk_list}})
				{
					my $fk1	  = $fkdef->{fkcols};
					my $t1	  = $fkdef->{pktable};
					my $pk1	  = $fkdef->{pkcols};
					my $fktyp = $fkdef->{type}; # vector or scalar

					my $colspec = "";
					my @csa;

					if (exists($tabhue->{$t1}))
					{
						push @csa, $tabhue->{$t1} ;
					}

					if ($fktyp !~ m/scalar/i)
					{
						push @csa, "arrowhead=normalodiamond";
						push @csa, "arrowtail=odiamond";
					}

					$colspec = "[ " . join(" ", @csa) . " ] "
						if (scalar(@csa));

					push @alledges, '"' . $kk . '":' . $fk1->[0] . ' -> "' . 
						$t1 . '":' . $pk1->[0] . " $colspec ;\n";
				}
			}
		} # end for my $kk

		if ($dosubgraph)
		{
			print "\n};\n\n" ; # end subgraph
		}
		push @alledges, "\n";

	} # end for filname

	print join("", @alledges);

	do_filemap($glob_filemap, $tabhue)
		if (defined($glob_filemap) && length($glob_filemap));

	print "\n};\n\n" ; # end digraph

}

if (1)
{
	my $whole_file;

	{
        # $$$ $$$ undefine input record separator (\n")
        # and slurp entire file into variable

        local $/;
        undef $/;

		$whole_file = <>;
	}


	my $tabdefh = JSON::from_json($whole_file);

#	print Data::Dumper->Dump([$tabdefh]);

	dograph($tabdefh, $glob_dir);

}

exit();