#!/pro/bin/perl

use strict;
use warnings;

use DBI;
use Term::ANSIColor qw(:constants);

# CHAGE THIS TO CONNECT TO THE DATABASE
my $DSN   = $ENV{DBI_DSN}  || "dbi:Pg:";
my $user  = $ENV{DBI_USER} || undef;
my $pass  = $ENV{DBI_PASS} || undef;

sub usage
{
    my $err = shift and select STDERR;
    print "usage: $0 [ --html=DBD | --no-color ]\n";
    exit $err;
    } # usage

use Getopt::Long;
my $opt_h = undef;
my $opt_c = 1;
GetOptions (
    "help|?"	=> sub { usage (0); },
    "h|html:s"	=> \$opt_h,
    "c|color!"	=> \$opt_c,
    ) or usage (1);

my $dbh = DBI->connect ($DSN, $user, $pass, {
    AutoCommit		=> 0,
    RaiseError		=> 1,
    PrintError		=> 1,
    ShowErrorStatement	=> 1,
    FetchHashKeyName	=> "NAME_lc",
    });

if (defined $opt_h && !$opt_h) {
    my @db = grep m/\b DBD \b/x => keys %INC;
    if (@db == 1) {
	$opt_h = $db[0];
	$opt_h =~ s{\.pm$}{}i;
	$opt_h =~ s{.* DBD (?: / | :: | \\ )+ }{DBD::}ix;
	}
    else {
	$opt_h = "DBD";
	}
    }

{   local $dbh->{RaiseError} = 0;
    local $dbh->{PrintError} = 0;
    $dbh->do ("drop table if exists b_test_null");
    $dbh->commit;
    }

$dbh->do (q;
    create table b_test_null (
	c_foo numeric,
	chr   char (4),
	vch   varchar (4)
	););
$dbh->commit;

my @v = (
    undef,
    undef,
    "",
    " ",
    pack ("C",  13),
    pack ("CC", 32, 13),
    );
{   my $sth = $dbh->prepare ("insert into b_test_null values (?, ?, ?)");
    $sth->execute ($_, $v[$_], $v[$_]) for 1 .. 5;

    $dbh->commit;
    }

my %v;
foreach my $cb (0, 1) {
    $dbh->{ChopBlanks} = $cb;
    my $sth = $dbh->prepare ("select chr, vch from b_test_null where c_foo = ?");
    for (1 .. 5) {
	$sth->execute ($_);
	my ($chr, $vch) = $sth->fetchrow_array;
	($v{c}{$cb}{$_} = defined $chr ? "'$chr'" : "NULL") =~ s/\r/\\r/g;
	($v{v}{$cb}{$_} = defined $vch ? "'$vch'" : "NULL") =~ s/\r/\\r/g;
	}
    }

$dbh->do ("drop table b_test_null");
$dbh->commit;

my %e = (
    c => {
	0 => { 1, "NULL", 2, "'    '", 3, "'    '", 4, "'\\r   '", 5, "' \\r  '", },
	1 => { 1, "NULL", 2, "''",     3, "''",     4, "'\\r'",    5, "' \\r'",   },
	},
    v => {
	0 => { 1, "NULL", 2, "''",     3, "' '",    4, "'\\r'",    5, "' \\r'",   },
	1 => { 1, "NULL", 2, "''",     3, "''",     4, "'\\r'",    5, "' \\r'",   },
	},
    );

my ($correct, $wrong, $reset) = $opt_c ? (GREEN, RED.ON_WHITE, RESET) : ("", "", "");
foreach my $t ("c", "v") {
    if ($opt_h) {
	print qq{\n <tr>\n  <td class="d">$opt_h</td>\n};
	}
    else {
	print "$t\t{ChopBlanks} = 0\t{ChopBlanks} = 1\n";
	}
    foreach my $cb (0, 1) {
	for (1 .. 5) {
	    my $ok = $v{$t}{$cb}{$_} eq $e{$t}{$cb}{$_} ? 1 : 0;
	    if ($opt_h) {
		print qq{  <td class="f">};
		$ok or print qq{<span class="orange">};
		(my $h = $v{$t}{$cb}{$_}) =~ s/ /&nbsp;/g;
		$h =~ tr/'/"/;
		print $h;
		$ok or print qq{</span>};
		print qq{</td>\n};
		next;
		}
	    printf "\t%s%s%s", $ok ? $correct : $wrong, "$v{$t}{$cb}{$_}", $reset;
	    }
	}
    $opt_h and print "  </tr>\n";
    print "\n";
    }
