anomalist
/
survey-manager
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
6 Commits
1 Branch
0 Tags
244 MiB
Branch: master
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'master'
${ noResults }
survey-manager/survey-nginx/cgi-bin/db.pl

1092 lines
32 KiB
Raw Permalink Normal View History

Updates to get nginx working
4 months ago
#!/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;