#!/usr/bin/perl
#
# $Id: db.pl,v 1.3 2004/01/29 07:57:04 jeffo Exp $
#
# Source File: db.pl

print "Content-Type: text/html\n\n";

# Get config
use POSIX qw(iscntrl);
use Data::Dumper;
use logger;
use dm;
use toolbox;

my $dbopts = {
    dbhost => $ENV{PGPORT} || `hostname`,
    dbport => $ENV{PGPORT} || 5432,
    dbname => $ENV{PGDATABASE} || 'template1',
    dbuser => $ENV{PGUSER} || 'tmdba',
    loadme => 1,
    cache => 1,
};
chomp $dbopts->{dbhost};

my $dbversion;
my $cgi = "/cgi-bin/db.pl";

my %ri_cache;

sub numeric_type {
    my ($table, $attname) = @_;

    if ( $attname eq 'attnum' ||
         $attname eq 'attnotnull' ||
         $attname eq 'id' ||
         $attname =~ /_id$/ ) {
        return 1;
    }

    return 0;
}


sub get_ri_info {
    my ($table, $column, $keyval, $opts) = @_;

    my $sql = qq{
        SELECT t.tgargs 
        FROM pg_trigger t, pg_class c 
        WHERE c.relname= ? 
          AND c.oid = t.tgrelid
          AND t.tgname like 'RI_ConstraintTrigger_%';
    };
    my $params;
    push( @$params, $table );

    my $cachekey = $column.$keyval.$sql.join('',@$params).join('',$opts);

    my $data = ($ri_cache{$cachekey} ?  $ri_cache{$cachekey} :
            dm::SelectData($sql, $params, $opts) );

    $ri_cache{$cachekey} = $data;

    my $info = undef;

    foreach my $href ( @$data ) {
        ($nm,$thistable,$ftable,$x,$fkey,$fcol) = split('\0',$href->{tgargs});
        if ( $thistable eq $table && $column eq $fkey ) {
            my $mkeyval = munge($keyval);
            $info->{fcol} = $fcol;
            $info->{ftable} = $ftable;
            return { %$info };
        }
    }

    return undef;
}


sub get_pkey_cols {
    my ($table, $opts) = @_;


    $depth = (defined($depth) ? $depth : 1);

    my $sql = qq{
        SELECT a.attname
        FROM pg_class c, pg_attribute a
        WHERE a.attnum > 0 AND a.attrelid = c.oid
          AND c.relname = (
            SELECT pkidx.relname
            FROM pg_class c, pg_class pkidx, pg_index i 
            WHERE c.relname = ?
              AND c.oid = i.indrelid 
              AND i.indexrelid = pkidx.oid 
              AND i.indisprimary 
              AND i.indisunique 
            ORDER BY pkidx.relname);
    };

    my $params = [ $table ];
    my $pkeycols = &dm::SelectData($sql, $params, $opts);

    return $pkeycols;
}





sub get_pkey_value {
    my ($table, $fkeycol, $fkeyval, $opts, $depth) = @_;


    $depth = (defined($depth) ? $depth : 1);

    my $sql = qq{
        SELECT a.attname
        FROM pg_class c, pg_attribute a
        WHERE a.attnum > 0 AND a.attrelid = c.oid
          AND c.relname = (
            SELECT pkidx.relname
            FROM pg_class c, pg_class pkidx, pg_index i 
            WHERE c.relname = ?
              AND c.oid = i.indrelid 
              AND i.indexrelid = pkidx.oid 
              AND i.indisprimary 
              AND i.indisunique 
            ORDER BY pkidx.relname);
    };

    my $params = [ $table ];
    my $pkeycols = &dm::SelectData($sql, $params, $opts);


    my $pkeyval;
    my $info;
    my $selectclause;

    if ( ! $pkeycols ) {
        return "";
    }

    foreach my $rec ( @$pkeycols ) {

        $selectclause .= ", " if length($selectclause);
        $selectclause .= $rec->{attname};
    }

    $sql = qq{
        SELECT $selectclause
        FROM $table
        WHERE $fkeycol = ?;
    };
    $params = [ $fkeyval ];
    $pkeyvals = &dm::SelectData($sql, $params, $opts);

    foreach my $rec ( @$pkeyvals ) {

        while ( my ($col, $val) = each %$rec ) {
            $info = get_ri_info( $table, $col, $val, $opts );
            $pkeyval .= ", " if length($pkeyval);
            if ( $info ) {
                $pkeyval .= get_pkey_value($info->{ftable}, $info->{fcol}, $val, $opts, $depth + 1);
            } else {
                $pkeyval .= $val;
            }
        }
    }

    return $pkeyval;
}



sub tabledescription {
    my ($table, $opts) = @_;

    my $sql = qq{
        select obj_description(c.oid) as "Table Description"
        from pg_class c 
        where c.relname = '$table';};

    return dm::SelectDataValue($sql,undef,$opts);
}



sub dataview {
    my ($opts) = @_;

    &logger::logdbg("Entering dataview...");
    my $sortdir = ($opts->{sd} eq 'dn' ? 'up' : 'dn');
    my $sortbyidx;
    my $offset = $opts->{off} ||= 0;
    my $limit = $opts->{rc} || 10;
    my $lastrec = $offset + $limit;
    my $nextoffset;
    my $extent = $limit;
    my $table = $opts->{t};
    my $pkeycols = get_pkey_cols($table, $opts);
    my $sortby = $opts->{sb} || $pkeycols->[0]->{attname};

    my $orderbyclause = $sortby;
    $orderbyclause .= ($orderbyclause ? ($sortdir eq 'up' ? ' ASC' : ' DESC'):"");

    for my $kcol ( @$pkeycols ) {
        $orderbyclause .= ', ' if ($orderbyclause);
        $orderbyclause .= "$kcol->{attname} ASC";
    }

    #  gather pre-existing filters...
    my $filters;
    my $filterhash;
    my $filternote;
    my $whereclause;
    my (@params, $col, $fop, $fopkey);
    while ( my($key,$val) = each %$opts ) {
        if ( $key =~ /^(_f)-(\S+)$/ ) {
            $col = $2;
            $fopkey = "${1}op-$col";
            $fop = (defined($opts->{$fopkey}) ? $opts->{$fopkey} : '=');
            $filters .= "&" if length($filters);
            $filters .= "$key=$val";
            $filters .= "&$fopkey=".munge($opts->{$fopkey});
            $whereclause .= qq{
          and } if ( length($whereclause) );
            $whereclause .= qq{$col $fop ?};
            push( @params, $val );
            $filternote .= qq{<tr><th>Column</th><th>Op</th><th>Value</th></tr>\n} if ( ! length($filternote) );
            $filternote .= qq{<tr><td>$col</td><td align="center">$fop</td><td>$val</td></tr>\n};
            $filterhash->{$col}{fop} = $fop;
            $filterhash->{$col}{val} = $val;
        }
    }

    $opts->{pk} = (defined($opts->{pk}) ? $opts->{pk} : 1);
    $opts->{sys} = (defined($opts->{sys}) ? $opts->{sys} : 0);

    $filters .= "&ff=$opts->{ff}";
    $filters .= "&sys=$opts->{sys}";

    my $desc = tabledescription($table,$opts);
    # Make sure these column headers don't have spaces for URI sorting...
    my $sql = qq{
        select * 
        from $table};
    $sql .= qq{
        where $whereclause} if ( length($whereclause) );
    $sql .= qq{
        order by $orderbyclause} if ( length($orderbyclause) );
    $sql .= qq{
        limit $limit
        offset $offset;};

    logger::logdbg($sql);

    my $tmpopts = { %$opts };
    $tmpopts->{want_array_refs} = 1;
    my $data = dm::SelectData($sql, \@params, $tmpopts);
    my $reccnt = scalar(@$data) - 1;
    &logger::logdbg("Got $reccnt rows from DB...");
    $sortby ||= $data->[0][0];
    my $totreccnt = dm::SelectDataValue("select count(id) from $table",undef,$opts);

    my ($html, $otherlabel, $labellink);

    $html .= qq{<html>};
    $html .= qq{<head>};
    $html .= qq{</head>};
    $html .= qq{<title>};
    $html .= breadcrumb_label($opts);
    $html .= qq{</title>};
    $html .= qq{<body>};
    $html .= breadcrumb($opts);
    $html .= qq{<h1>Table:  $table (Data)</h1>};
    $html .= qq{<table border="1"><caption><b>Data Filters</b></caption>$filternote</table>\n} if ( length($filternote) );
    $html .= "<table border=1>";


    my $hdrrow;
    my (@hdrs, $i);
    foreach my $rowaref ( @$data ) {
        $hdrrow = "<tr>";
        foreach my $hdr ( @$rowaref ) {
            my $thattrs = ($sortby eq $hdr ? qq{ bgcolor="#CCCCCC"} : "");
            my $arrow = ($sortby eq $hdr ? ($sortdir eq 'up' ? '&nbsp;&darr;' : '&nbsp;&uarr;') : "");
            $arrow = qq{<font size="-3">$arrow</font>};
            my $hdrlink = qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&sb=$hdr&sd=$sortdir&off=$nextoffset&rc=$extent&pk=$opts->{pk}};
            $hdrlink .= qq{&$filters} if ( length($filters) );
            $hdrlink .= qq{">$hdr</a>$arrow};
            $hdrrow .= qq{<th$thattrs>$hdrlink</th>};
            if ( $hdr eq $sortby ) {
                $sortbyidx = $i;
            }
            push(@hdrs, $hdr);
            $i++;
        }
        $hdrrow .= "</tr>\n";
        last;
    }

    my $span = scalar(@hdrs);
    $html .= qq{<tr><td colspan="$span"><b>Description:</b><i>&nbsp;&nbsp;$desc</i></td><tr>};
    $html .= qq{<tr>};
    $html .= qq{<td colspan="$span">};
    $html .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=schema">View Schema</a>...};
    $html .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&pk=$opts->{pk}">Reset Filters</a>...};
    $html .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&$filters&sb=$opts->{sb}&sd=$opts->{sd}&off=$opts->{off}&rc=$opts->{rc}};
    if ( $opts->{pk} ) {
        $html .= qq{&pk=0">Hide Primary Keys</a>...};
    } else {
        $html .= qq{&pk=1">Show Primary Keys</a>...};
    }
    $html .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&pk=$opts->{pk}&$filters&sb=$opts->{sb}&sd=$opts->{sd}&off=$opts->{off}&rc=$opts->{rc}};
    if ( $opts->{ff} ) {
        $html .= qq{&ff=0">Hide Full Filters</a>...};
    } else {
        $html .= qq{&ff=1">Show Full Filters</a>...};
    }
    $opts->{fs} ||= 0;
    my $bfs = $opts->{fs} + 1;
    my $sfs = $opts->{fs} - 1;

    $opts->{fs} = ($opts->{fs} >= 0 ? "+".$opts->{fs} : $opts->{fs});
    $bfs = ($bfs >= 0 ? "+".$bfs : $bfs);
    $sfs = ($sfs >= 0 ? "+".$sfs : $sfs);

    $html .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&pk=$opts->{pk}&$filters&sb=$opts->{sb}&sd=$opts->{sd}&off=$opts->{off}&rc=$opts->{rc}};
    $html .= qq{&fs=$sfs">Smaller Font</a>...};
    $html .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&pk=$opts->{pk}&$filters&sb=$opts->{sb}&sd=$opts->{sd}&off=$opts->{off}&rc=$opts->{rc}};
    $html .= qq{&fs=$bfs">Bigger Font</a>...};

    $html .= qq{</td>} if ( length($filters) );
    $html .= qq{</tr>\n};

    $html .= $hdrrow;

    shift @$data;  # discard headers

    my $sortf;
    if ( $sortby ) {
        if ( numeric_type($table, $sortby) ) {
            if ( $sortdir eq 'dn' ) {
                $sortf = sub { return $a->[$sortbyidx] <=> $b->[$sortbyidx]; };
            } else {
                $sortf = sub { return $b->[$sortbyidx] <=> $a->[$sortbyidx]; };
            }
        } else {
            if ( $sortdir eq 'dn' ) {
                $sortf = sub { return $a->[$sortbyidx] cmp $b->[$sortbyidx]; };
            } else {
                $sortf = sub { return $b->[$sortbyidx] cmp $a->[$sortbyidx]; };
            }
        }
    } else {
        $sortf = sub { return $a->[$sortbyidx] cmp $b->[$sortbyidx]; };
    }

    $i = 0;
    my $fkeylink;
    foreach my $rowaref ( @$data ) {
        my $cellrow = "<tr>";
        my $hi = 0;
        foreach my $cell ( @$rowaref ) {
            $fkeylink = undef;
            my $info = get_ri_info( $table, $hdrs[$hi], $cell, $opts );
            my $mval = munge($cell);
            if ( $info && defined($cell) ) {
                if ( $opts->{pk} ) {
                    my $pkeyval = get_pkey_value($info->{ftable}, $info->{fcol}, $cell, $opts);
                    $cell = $pkeyval;
                }
                $fkeylink = qq{t=$info->{ftable}&_f-$info->{fcol}=$mval};
                $fkeylink = qq{<a href="$cgi?dbname=$opts->{dbname}&$fkeylink&v=data">$cell</a>};
            }
            $cellrow .= qq{<td>};
            $cellrow .= qq{<font size="$opts->{fs}">} if (defined($opts->{fs}));

            my ($filterlink, $op, $foplinks);

            if ( defined($fkeylink) ) {
                $cellrow .= qq{$fkeylink};
            } else {
                if ( ! $opts->{ff} ) {
                    $op = '=';
                    $fop = ($op);
                    $fopkey = "_fop-$hdrs[$hi]";
                    $filterlink = "";
                    $filterlink .= qq{$filters&} if $filters;
                    $filterlink .= qq{_f-$hdrs[$hi]=$mval&$fopkey=};
                    $filterlink .= munge($fop);
                    $cellrow .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&$filterlink&v=data&pk=$opts->{pk}">$cell</a>};
                } else {
                    $cellrow .= qq{$cell};
                }
            }


            $op = '<';
            $fop = ($op);
            $fopkey = "_fop-$hdrs[$hi]";
            $filterlink = "";
            $filterlink .= qq{$filters&} if $filters;
            $filterlink .= qq{_f-$hdrs[$hi]=$mval&$fopkey=};
            $filterlink .= munge($fop);
            $foplinks .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&$filterlink&v=data&pk=$opts->{pk}">};
            $foplinks .= escape_special_chars($op);
            $foplinks .= qq{</a>};
            $foplinks .= qq{...};

            $op = '<=';
            $fop = ($op);
            $fopkey = "_fop-$hdrs[$hi]";
            $filterlink = "";
            $filterlink .= qq{$filters&} if $filters;
            $filterlink .= qq{_f-$hdrs[$hi]=$mval&$fopkey=};
            $filterlink .= munge($fop);
            $foplinks .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&$filterlink&v=data&pk=$opts->{pk}">};
            $foplinks .= escape_special_chars($op);
            $foplinks .= qq{</a>};
            $foplinks .= qq{...};

            $op = '=';
            $fop = ($op);
            $fopkey = "_fop-$hdrs[$hi]";
            $filterlink = "";
            $filterlink .= qq{$filters&} if $filters;
            $filterlink .= qq{_f-$hdrs[$hi]=$mval&$fopkey=};
            $filterlink .= munge($fop);
            $foplinks .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&$filterlink&v=data&pk=$opts->{pk}">};
            $foplinks .= escape_special_chars($op);
            $foplinks .= qq{</a>};
            $foplinks .= qq{...};

            $op = '>=';
            $fop = ($op);
            $fopkey = "_fop-$hdrs[$hi]";
            $filterlink = "";
            $filterlink .= qq{$filters&} if $filters;
            $filterlink .= qq{_f-$hdrs[$hi]=$mval&$fopkey=};
            $filterlink .= munge($fop);
            $foplinks .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&$filterlink&v=data&pk=$opts->{pk}">};
            $foplinks .= escape_special_chars($op);
            $foplinks .= qq{</a>};
            $foplinks .= qq{...};

            $op = '>';
            $fop = ($op);
            $fopkey = "_fop-$hdrs[$hi]";
            $filterlink = "";
            $filterlink .= qq{$filters&} if $filters;
            $filterlink .= qq{_f-$hdrs[$hi]=$mval&$fopkey=};
            $filterlink .= munge($fop);
            $foplinks .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&$filterlink&v=data&pk=$opts->{pk}">};
            $foplinks .= escape_special_chars($op);
            $foplinks .= qq{</a>};


            if ( $opts->{ff} ) {
                $cellrow .= qq{&nbsp;&nbsp;&nbsp;<font size="-2"><br><nobr>(};
                $cellrow .= $foplinks;
                $cellrow .= qq{)</nobr</font>};
            }
            $cellrow .= qq{</font>} if ( defined($opts->{fs}) );
            $cellrow .= qq{</td>};

            $hi++;
        }
        $cellrow .= "</tr>\n";
        $html .= "$cellrow\n";
    }

    my $navlink;
    $html .= "<tr><td colspan=$span>";
    $html .= qq{<i>($reccnt of $totreccnt from $table table)</i>&nbsp;};
    logger::logdbg("offset = $offset, reccnt = $reccnt, lastrec = $lastrec");
    if ( $offset > 0 ) {
        $nextoffset = ($offset - $extent < 0 ? 0 : $offset - $extent);
        $navlink = qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&sb=$sortby&sd=$opts->{sd}&off=$nextoffset&rc=$extent">[Previous $extent...]</a>};
        $html .= "$navlink&nbsp;&nbsp;";

        $extent *= 2;
        $nextoffset = ($offset - $extent < 0 ? 0 : $offset - $extent);
        $navlink = qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&sb=$sortby&sd=$opts->{sd}&off=$nextoffset&rc=$extent">[Previous $extent...]</a>};
        $html .= "$navlink&nbsp;&nbsp;";
    }

    $extent = $limit;
    if ( $totreccnt > $lastrec ) {
        $nextoffset = $lastrec;
        $navlink = qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&sb=$sortby&sd=$opts->{sd}&off=$nextoffset&rc=$extent">[Next $extent...]</a>};
        $html .= "$navlink&nbsp;&nbsp;";

        $extent *= 2;
        $navlink = qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&sb=$sortby&sd=$opts->{sd}&off=$nextoffset&rc=$extent">[Next $extent...]</a>};
        $html .= "$navlink&nbsp;&nbsp;";
    }
    $html .= "</td></tr>\n";
    $html .= "</table>\n";

    &logger::logdbg("Exiting schemaview...");

    return $html;
}


sub schemaview {
    my ($opts) = @_;

    &logger::logdbg("Entering schemaview...");
    my $table = $opts->{t};
    my $desc = tabledescription($table,$opts);
    # Make sure these column headers don't have spaces for URI sorting...
    my $sql = qq{
        SELECT a.attnum, a.attname, format_type(a.atttypid, a.atttypmod), 
               a.attnotnull, a.atthasdef, 
               '<i>'||col_description(a.attrelid, a.attnum)||'</a>' as "description"
        FROM pg_class c, pg_attribute a
        WHERE c.relname = '$table'
          AND a.attnum > 0 AND a.attrelid = c.oid
          ORDER BY a.attnum;
    };
    my $tmpopts = { %$opts };
    $tmpopts->{want_array_refs} = 1;
    my $data = dm::SelectData($sql, undef, $tmpopts);

    my ($html, $otherlabel, $labellink);

    $html = qq{<html>};
    $html .= qq{<head>};
    $html .= qq{</head>};
    $html .= qq{<title>};
    $html .= breadcrumb_label($opts);
    $html .= qq{</title>};
    $html .= qq{<body>};
    $html .= breadcrumb($opts);
    $html .= qq{<h1>Table:  $table (Schema)</h1>};
    $html .= "<table border=1>";

    my $sortdir = ($opts->{sd} eq 'dn' ? 'up' : 'dn');
    my $sortby = $opts->{sb} ||= $data->[0][0];
    my $sortbyidx;


    my $hdrrow;
    my (@hdrs, $i);
    foreach my $rowaref ( @$data ) {
        $hdrrow = "<tr>";
        foreach my $hdr ( @$rowaref ) {
            my $thattrs = ($sortby eq $hdr ? qq{ bgcolor="#CCCCCC"} : "");
            my $arrow = ($sortby eq $hdr ? ($sortdir eq 'up' ? '&nbsp;&darr;' : '&nbsp;&uarr;') : "");
            $arrow = qq{<font size="-3">$arrow</font>};
            my $hdrlink = qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=schema&sb=$hdr&sd=$sortdir">$hdr</a>$arrow};
            $hdrrow .= qq{<th$thattrs>$hdrlink</th>};
            if ( $hdr eq $sortby ) {
                $sortbyidx = $i;
            }
            push(@hdrs, $hdr);
            $i++;
        }
        $hdrrow .= "</tr>\n";
        last;
    }

    my $span = scalar(@hdrs);
    $html .= qq{<tr><td colspan="$span"><b>Description:</b><i>&nbsp;&nbsp;$desc</i></td><tr>};
    $html .= qq{<tr>};
    $html .= qq{<td colspan="$span">};
    $html .= qq{<a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data">View Data</a>};
    $html .= qq{</td>};
    $html .= qq{</tr>\n};

    $html .= $hdrrow;

    shift @$data;  # discard headers

    my $sortf;
    if ( $sortby ) {
        if ( numeric_type($table, $sortby) ) {
            if ( $sortdir eq 'dn' ) {
                $sortf = sub { return $a->[$sortbyidx] <=> $b->[$sortbyidx]; };
            } else {
                $sortf = sub { return $b->[$sortbyidx] <=> $a->[$sortbyidx]; };
            }
        } else {
            if ( $sortdir eq 'dn' ) {
                $sortf = sub { return $a->[$sortbyidx] cmp $b->[$sortbyidx]; };
            } else {
                $sortf = sub { return $b->[$sortbyidx] cmp $a->[$sortbyidx]; };
            }
        }
    } else {
        $sortf = sub { return $a->[$sortbyidx] cmp $b->[$sortbyidx]; };
    }


    &logger::logdbg("There are ".scalar(@$data)." rows.");
    foreach my $rowaref ( sort $sortf @$data ) {
        my $cellrow = "<tr>";
        foreach my $cell ( @$rowaref ) {
            $cellrow .= qq{<td>$cell</td>};
        }
        $cellrow .= "</tr>\n";
        $html .= $cellrow;
    }

    $html .= "</table>\n";

    &logger::logdbg("Exiting schemaview...");

    return $html;
}


sub tableview {
    my ($opts) = @_;

    if ( $opts->{v} eq 'schema' ) {
        return schemaview($opts);
    } else {
        return dataview($opts);
    }
}


sub dbviewhome {
    my ($opts) = @_;

    my $sql = qq{
        select tablename as "Table" 
        from pg_tables};

    if ( ! $opts->{sys} ) {
        $sql .= qq{
        where tablename not like 'pg_%'};
    }

    $sql .= qq{
        order by tablename};
    $sql .= ';';

    my $tmpopts = { %$opts };
    $tmpopts->{want_array_refs} = 1;
    my $data = dm::SelectData($sql, undef, $tmpopts);

    my ($html, $otherlabel, $labellink);

    $html = qq{<html>};
    $html .= qq{<head>};
    $html .= qq{</head>};
    $html .= qq{<title>};
    $html .= breadcrumb_label($opts);
    $html .= qq{</title>};
    $html .= qq{<body>};
    $html .= breadcrumb($opts);
    $html .= "<table border=1>";
    my $sortdir = ($opts->{sd} eq 'dn' ? 'up' : 'dn');
    &logger::logdbg("sd = $opts->{sd} ===> sortdir = $sortdir");
    my $sortby = $opts->{sb} || 'name';
    my $tablehdr = qq{<a href="$cgi?dbname=$opts->{dbname}&sb=name&sd=$sortdir&sys=$opts->{sys}">Table</a>};
    my $cnthdr = qq{<a href="$cgi?dbname=$opts->{dbname}&sb=count&sd=$sortdir&sys=$opts->{sys}">Record Count</a>};
    my $tablehdrattrs = ($sortby eq 'name' ? qq{ bgcolor="#CCCCCC"} : "");
    my $cnthdrattrs = ($sortby eq 'count' ? qq{ bgcolor="#CCCCCC"} : "");
    $html .= "<tr><th$tablehdrattrs>$tablehdr</th><th$cnthdrattrs>$cnthdr</th><th>Description</th></tr>\n";

    my $i = 0;
    my $table;
    my @recs;

    $opts->{sys} = (defined($opts->{sys}) ? $opts->{sys} : 0);

    foreach my $aref ( @$data ) {
        next if ($i++ == 0);

        my $v = shift @$aref;
        my $table = (defined($v) ? $v : "");
        $sql = qq{select count(*) from $table;};
        my $count = dm::SelectDataValue($sql, undef, $opts);
        push( @recs, { table => $table, count => $count } );
    }

    my $sortf;

    if ( $sortby eq 'name' ) {
        if ( $sortdir eq 'dn' ) {
            $sortf = sub { return $a->{table} cmp $b->{table}; };
        } else {
            $sortf = sub { return $b->{table} cmp $a->{table}; };
        }
    } else {
        if ( $sortdir eq 'dn' ) {
            $sortf = sub { return $a->{count} <=> $b->{count}; };
        } else {
            $sortf = sub { return $b->{count} <=> $a->{count}; };
        }
    }


    foreach my $href ( sort $sortf @recs ) {
        my $row = "<tr>";
        my $j = 0;

        my $table = $href->{table};
        my $count = $href->{count};
        my $desc = tabledescription($table,$opts);
        $row .= qq{<td><a href="$cgi?dbname=$opts->{dbname}&t=$table&v=schema&sys=$opts->{sys}">$table</a></td>};
        $row .= qq{<td align="center"><a href="$cgi?dbname=$opts->{dbname}&t=$table&v=data&sys=$opts->{sys}">$count</a></td>};
        $row .= qq{<td align="left"><font size="-2">$desc</font></td>};
        $row .= "</tr>\n";

        $html .= $row;
    }
    $html .= "</table>\n";

    return $html;
}

sub serverview {
    my ($opts) = @_;

    my $sql = qq{
        select datname as "Database" 
        from pg_database};

    if ( ! $opts->{sys} ) {
        $sql .= qq{
        where datname !~ 'template[01]'};
    }

    $sql .= qq{
        order by datname;
    };

    my $tmpopts = { %$opts };
#    $tmpopts->{want_array_refs} = 1;
    my $data = dm::SelectData($sql, undef, $tmpopts);

    my ($html, $otherlabel, $labellink);

    $html = breadcrumb($opts);
    $html .= qq{<h1>$opts->{dbhost}:$opts->{dbport}</h1>};
    $html .= qq{<font size="-1"><b>Version:</b>&nbsp;&nbsp;<i>$dbversion</i></font>};
    $html .= "<table border=1>";
    my $sortdir = ($opts->{sd} eq 'dn' ? 'up' : 'dn');
    my $sortby = $opts->{sb} || 'datname';
    my $dbhdr = qq{<a href="$cgi?sb=name&sd=$sortdir&sys=$opts->{sys}">Database</a>};
    my $dbhdrattrs = ($sortby eq 'datname' ? qq{ bgcolor="#CCCCCC"} : "");
    $html .= "<tr><th$dbhdrattrs>$dbhdr</th></tr>\n";

    my $i = 0;
    my $table;
    my @recs;

    $opts->{sys} = (defined($opts->{sys}) ? $opts->{sys} : 0);

    my $sortf;

    if ( $sortdir eq 'dn' ) {
        $sortf = sub { return $a->{$sortby} cmp $b->{$sortby}; };
    } else {
        $sortf = sub { return $b->{$sortby} cmp $a->{$sortby}; };
    }

print STDERR Dumper($data);

    foreach my $href ( sort $sortf @$data ) {
        my $row = "<tr>";
        my $j = 0;

        my $db = $href->{Database};
        $row .= qq{<td><a href="$cgi?dbv=1&dbname=$db">$db</a></td>};
        $row .= "</tr>\n";

        $html .= $row;
    }
    $html .= "</table>\n";

    return $html;
}

sub dbview {
    my ($opts) = @_;

    if ( $opts->{t} ) {
        return tableview($opts);
    } else {
        return dbviewhome($opts);
    }
}

sub munge( $ ) {
	my ($string) = @_;
	$string =~ s/([\<\>\=\'\"\?\&\\!\$\#\@\*\;\:\r\n])/join('', '%', uc(unpack("H*",$1)))/eg;
	return $string;
}                                                                               

sub unmunge( $ ) {
	my ($string) = @_;
	$string =~ s/%([<>=a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
	return $string;
}                                                                               

my $escape_map = {
	'"'	=>	'&quot;',
	'&'	=>	'&amp;',
	'<'	=>	'&lt;',
	'>'	=>	'&gt;',
	'<='	=>	'&le;',
	'='	=>	'&#61;',
	'=>'	=>	'&ge;',
};

sub get_escape( $ ) {
	my ($char) = shift;
	if ( ! defined($escape_map->{$char}) ) {
		logger::logerr("WARNING:  undefined escape for '$char'");
	}
	return $escape_map->{$char};
}

sub escape_special_chars( $ ) {
    my ($string) = @_;
    $string =~ s/([\"&<>=])/get_escape($1)/eg;
    return $string;
}                                                                               

sub initialize {
    my  ($FORM) = @_;

    if ( ! $FORM ) {
        &logger::logerr("Missing FORM hashref");
        return undef;
    }

    my ($reqmeth,@cookies,$cookie,$nm,$vlu,$qstr);
    my ($contenttype,$srch,$trash,$boundary,$endboundary,$consep,@parts,);
    my ($contype,$content,%UI,%COOKIES,$part,@lines,$nme,$fname,$ftype,$line);
    my (@segs,$arraykey,%UPLOADED_FILES,@parameters,$pair);

    &logger::logdbg("Initializing...");

	$FORM->{servertime} = POSIX::strftime($UI{DATETIME_FMT}, localtime(time));
	# set variables from query parameters based on the request method
	$reqmeth = $ENV{'REQUEST_METHOD'};
	@cookies = split(/\;/,$ENV{'HTTP_COOKIE'});
	foreach $cookie (sort @cookies) {
		($nm, $vlu) = split(/=/, $cookie);
		$nm =~ s/ //g;
		$vlu =~ tr/+/ /;
		$vlu = unmunge($vlu);
		$COOKIES{$nm} = $vlu;
		&logger::logdbg("\$COOKIES{$nm} = $COOKIES{$nm}");
	}
	if ($reqmeth =~ /POST/i) {
        &logger::logdbg("Reading POST data...");
		read (STDIN, $qstr, $ENV{'CONTENT_LENGTH'});
	} else {
		if ($reqmeth =~ /GET/i) {
            &logger::logdbg("Reading GET data...");
			$qstr=$ENV{'QUERY_STRING'};
		} else {
            &logger::logdbg("Unrecognized request method:  [$reqmeth]");
        }
	}

    &logger::logdbg("qstr = $qstr");

	if ($qstr) { 
		$contenttype=$ENV{'CONTENT_TYPE'};
		if ($contenttype =~ 'multipart/form-data') {
			$srch="boundary\=";
			($trash,$boundary) = split(/$srch/, $contenttype);
			($boundary, $trash) = split(/ /, $boundary);
			$endboundary = join('', $boundary, "\-\-");
			$boundary = join('', $boundary, "\r\n");
			($qstr, $trash) = split(/$endboundary/, $qstr);
			@parts = split(/$boundary/, $qstr);
			$trash = shift @parts;
			$consep = "\r\n\r\n";
			foreach $part (@parts) {
				($contype, $content) = split(/$consep/, $part);
				if ($contype ne '') {
					$contype =~ s/\: /=/g;
					$contype =~ s/\r\n/; /g;
					@lines = split(/\; /, $contype);
					$nme = "";
					$fname = "";
					$ftype = "";
					foreach $line (@lines) {
						$line =~ s/\"//g;
						($nm,$vlu) = split(/=/, $line);
						$vlu =~ tr/+/ /;
						$vlu = unmunge($vlu);
						if ($nm eq 'filename') {
							@segs = split(/\./, $vlu);
							$ftype = $segs[$#segs];
						} else {
							if ($nm eq 'name') {
								$nme = $vlu;
							}
						}
					}
					chop($content);
					chop($content);
					if ($ftype eq '') {
						if ($content =~ /\<RAWHTML\>/ ) {
							$content =~ s/\<RAWHTML\>//g;
							chop($content);
							chop($content);
						} else {
							$content =~ s/\r\n//g;
						}
						$content =~ tr/+/ /;
						$content = unmunge($content);
						if ($FORM->{$nme} eq '') {
							$FORM->{$nme} = $content;
						} else {
							$FORM->{$nme} = join(',', $FORM->{$nme}, $content);
						}
					} else {
						if ($ftype eq 'csv') {
							$content =~ s/\r//g;
							$content =~ s/\n\n/\n/g;
						} else {
							$content =~ s/(.*)\r\n/$1/;
						}
						$arraykey="$nme.$ftype";
						$UPLOADED_FILES{$arraykey} = $content;
					}
				}
			}
		} else {
			# parse request parameters into variables
			@parameters = split(/&/, $qstr);
			foreach $pair (@parameters) {
				($nm, $vlu) = split(/=/, $pair);
				$vlu =~ tr/+/ /;
				$vlu = unmunge($vlu);
				$FORM->{$nm} = $vlu;
			}
		}
		foreach my $key ( sort keys %$FORM ) {
			&logger::logdbg("\$FORM{$key} = '$FORM->{$key}'");
		}
		return 1;
	} else {
		return 0;
	}
}

sub breadcrumb_label {
    my ($opts) = @_;

    my ($breadcrumb, $label);

    if ( $opts->{dbhost} ) {
        $label .= qq{$opts->{dbhost}};
    }

    if ( $opts->{dbport} ) {
        $label .= ":$opts->{dbport}";
    }

    $breadcrumb .= qq{$label};

    if ( $opts->{dbname} ) {
        $label = ":$opts->{dbname}";
    } else {
        return $breadcrumb;
    }

    if ( $opts->{t} ) {
        $label .= ":$opts->{t}";
    } else {
        return $breadcrumb;
    }

    if ( $opts->{v} ) {
        $label .= "&nbsp;($opts->{v})";
    }

    $breadcrumb .= qq{$label};

    return $breadcrumb;
}


sub breadcrumb {
    my ($opts) = @_;

    my ($hiddenargs, $fmtbegin, $fmtend);
    my ($breadcrumb, $args, $label, $fs);

    $fs = (defined($opts->{fs}) ? ($opts->{fs} - 1) : -1);
    $fs = "+$fs" if ( $fs >= 0 );

    $fmtbegin = qq{<font size="$fs" color="blue">};
    $fmtend = qq{</font>};
    $separator = qq{...};

    my @hiddenargs = qw( fs ff pk );
    foreach my $harg ( @hiddenargs ) {
        if ( $opts->{$harg} ) {
            $hiddenargs .= qq{&} if length($hiddenargs);
            $hiddenargs .= qq{$harg=$opts->{$harg}};
        }
    }

    if ( $opts->{dbhost} ) {
        $args .= qq{dbhost=$opts->{dbhost}};
        $label .= qq{$opts->{dbhost}};
    }

    if ( $opts->{dbport} ) {
        $args .= qq{&} if length($args);
        $args .= qq{dbport=$opts->{dbport}};
        $label .= ":$opts->{dbport}";
    }

    $breadcrumb .= qq{$fmtbegin<a href="$cgi?$args&$hiddenargs">$label</a>$fmtend};

    if ( $opts->{dbname} ) {
        $args = qq{&} if length($args);
        $args .= qq{dbname=$opts->{dbname}};
        $label = "$opts->{dbname}";
    } else {
        return $breadcrumb;
    }

    $breadcrumb .= qq{$separator$fmtbegin<a href="$cgi?$args&$hiddenargs">$label</a>$fmtend};

    if ( $opts->{t} ) {
        $args .= qq{&} if length($args);
        $args .= qq{t=$opts->{t}};
        $label = "$opts->{t}";
    } else {
        return $breadcrumb;
    }

    if ( $opts->{v} ) {
        $args .= qq{&} if length($args);
        $args .= qq{v=$opts->{v}};
        $label .= "&nbsp;($opts->{v})";
    }

    $breadcrumb .= qq{$separator$fmtbegin<a href="$cgi?$args&$hiddenargs">$label</a>$fmtend};

    return $breadcrumb;
}


sub go {
    my %FORM;
    initialize(\%FORM);
    foreach my $key ( keys %FORM ) {
        $dbopts->{$key} = $FORM{$key};
    }

    $dbversion = dm::SelectDataValue("select version();", undef, $dbopts);

    my $html;
    my $t0 = toolbox::NowAsScalar();
    if ( defined($dbopts->{dbname}) && $dbopts->{dbname} !~ /^template[01]$/ ) {
        $html = &dbview($dbopts);
    } else {
        $html = &serverview($dbopts);
    }

    $html .= qq{<hr><font color="blue" size="-2">};

    my $tf =  toolbox::NowAsScalar();
    my $size = length($html);
    $html .= sprintf("Generated %.1f KB in %.3f secs finishing %s<br>\n", 
                     ($size/1000), $tf - $t0, scalar(localtime(time)));

    $t0 = toolbox::NowAsScalar();
    print $html;
    $tf =  toolbox::NowAsScalar();

    $html = sprintf("Transmitted %.1f KB in %.3f secs finishing %s\n", 
                     ($size/1000), $tf - $t0, scalar(localtime(time)));
    $html .= qq{</body>};
    $html .= qq{</html>};
    print $html;
}

&go();

1;