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.
3 Commits
1 Branch
0 Tags
244 MiB
 
 
 
 
 
 
Tree: 729333d4f5
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '729333d4f5'
${ noResults }
survey-manager/survey-nginx/cgi-bin/dbreport.pl

445 lines
13 KiB
Raw Blame History

#!/usr/bin/perl
#
# $Id: dbreport.pl,v 1.3 2004/01/29 07:57:04 jeffo Exp $
#
# Generic report generation code. See schema description at
# http://.../cgi-bin/db.pl for details.
print "Content-Type: text/html\n\n";
# Get config
use POSIX qw(iscntrl);
use Data::Dumper;
use logger;
use dm;
use toolbox;
my $debug = 1;
my $dbopts = {
dbhost => $ENV{PGPORT} || `hostname`,
dbport => $ENV{PGPORT} || 5432,
dbname => $ENV{PGDATABASE} || 'tmdb',
dbuser => $ENV{PGUSER} || 'wwwrun',
loadme => 1,
cache => 1,
};
chomp $dbopts->{dbhost};
my $dbversion;
my $cgi = "/cgi-bin/db.pl";
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 TextElement {
my ($form, $dbopts, $value) = @_;
return $value;
}
#############################################################################
sub SQLElement {
my ($form, $dbopts, $value) = @_;
my ($out, $results);
my $sql = $value;
my $qopts = { %$dbopts };
$qopts->{want_array_refs} = 1;
if ( $sql =~ /^\s*SELECT\s+/i && $sql !~ /\s+INTO\s+/i ) {
$results = dm::SelectData($sql, undef, $qopts);
} else {
$results = dm::ModifyData($sql, undef, $qopts);
}
foreach my $row ( @$results ) {
foreach my $col ( @$row ) {
$out .= $col;
}
}
return $out;
}
#############################################################################
sub CodeElement {
my ($form, $dbopts, $value) = @_;
my ($out, $results);
my $results = eval $value;
if ( $@ ) {
logger::logerr("Evaluation failed for [$value]: $@");
} else {
$out = $results;
}
return $out;
}
#############################################################################
sub FileElement {
my ($form, $dbopts, $value) = @_;
my $out;
if ( open(INFILE, "< $value") ) {
while ( <INFILE> ) {
$out .= $_;
}
close INFILE;
} else {
logger::logerr("Could not open $value: $!");
}
return $out;
}
#############################################################################
sub SQLFileElement {
my ($form, $dbopts, $value) = @_;
return SQLElement($form, $dbopts, FileElement($form, $dbopts, $value));
}
#############################################################################
sub CodeFileElement {
my ($form, $dbopts, $value) = @_;
return CodeElement($form, $dbopts, FileElement($form, $dbopts, $value));
}
#############################################################################
sub showreport {
my ($form, $dbopts) = @_;
my $sql = qq{
SELECT e.value, t.name AS "type", c.inclusion_order AS "order",
e.id AS "element_id", c.id AS "component_id",
r.id AS "report_id"
FROM report_element e, report_component c, report_element_type t,
report r
WHERE r.name = ?
AND c.report_id = r.id
AND c.element_id = e.id
AND e.type_id = t.id
AND c.active = 't'
ORDER BY c.inclusion_order ASC;
};
my $params = [ $form->{id} ];
my $data = dm::SelectData($sql, $params, $dbopts);
my ($html, $pval, $order, $eid, $cid);
foreach my $e ( @$data ) {
$order = $e->{order};
($eid, $cid) = ($e->{element_id}, $e->{component_id});
if ( $form->{dbg} && $form->{dbg} == 2 ) {
$html .= qq{<br><pre>$e->{type}: };
$html .= escape_special_chars($e->{value});
$html .= qq{</pre><br>};
}
if ( $e->{type} eq 'Text' ) {
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n\n<!-- Element #$order: $e->{type} -->\n};
$html .= qq{<!-- element_id $eid, component_id $cid -->\n\n};
}
$html .= TextElement($form, $dbopts, $e->{value});
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n<!-- END - Element #$order: $e->{type} -->\n};
}
} elsif ( $e->{type} eq 'SQL' ) {
$pval = $e->{value};
$pval =~ s/\n/ /g;
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n\n<!-- Element #$order: $e->{type} : $pval -->\n};
$html .= qq{<!-- element_id $eid, component_id $cid -->\n\n};
}
$html .= SQLElement($form, $dbopts, $e->{value});
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n<!-- END - Element #$order: $e->{type} -->\n};
}
} elsif ( $e->{type} eq 'Code' ) {
$pval = $e->{value};
$pval =~ s/\n/ /g;
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n\n<!-- Element #$order: $e->{type} : $pval -->\n};
$html .= qq{<!-- element_id $eid, component_id $cid -->\n\n};
}
$html .= CodeElement($form, $dbopts, $e->{value});
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n<!-- END - Element #$order: $e->{type} -->\n};
}
} elsif ( $e->{type} eq 'TextFile' ) {
$pval = $e->{value};
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n\n<!-- Element #$order: $e->{type} : $pval -->\n};
$html .= qq{<!-- element_id $eid, component_id $cid -->\n\n};
}
$html .= FileElement($form, $dbopts, $e->{value});
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n<!-- END - Element #$order: $e->{type} -->\n};
}
} elsif ( $e->{type} eq 'SQLFile' ) {
$pval = $e->{value};
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n\n<!-- Element #$order: $e->{type} : $pval -->\n};
$html .= qq{<!-- element_id $eid, component_id $cid -->\n\n};
}
$html .= SQLFileElement($form, $dbopts, $e->{value});
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n<!-- END - Element #$order: $e->{type} -->\n};
}
} elsif ( $e->{type} eq 'CodeFile' ) {
$pval = $e->{value};
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n\n<!-- Element #$order: $e->{type} : $pval -->\n};
$html .= qq{<!-- element_id $eid, component_id $cid -->\n\n};
}
$html .= CodeFileElement($form, $dbopts, $e->{value});
if ( $form->{dbg} || $form->{debug} ) {
$html .= qq{\n<!-- END - Element #$order: $e->{type} -->\n};
}
} else {
logger::logerr("Unrecognized element type [$e->{type}]");
}
}
return $html;
}
#############################################################################
sub showreportlist {
my ($form, $dbopts) = @_;
my $sql = qq{
SELECT r.id, r.name, r.description
FROM report r;
};
my $data = dm::SelectData($sql, undef, $dbopts);
my $html = qq{<table border="1">};
# $html .= qq{<tr><th>Client</th><th>Report Name</th><th>Description</th></tr>};
$html .= qq{<tr><th>Report Name</th><th>Description</th></tr>};
foreach my $rep ( @$data ) {
my $link .= qq{<a href="dbreport.pl?id=$rep->{name}};
$link .= qq{&dbg=1} if ( $debug );
$link .= qq{">};
my $row = qq{<tr>};
$row .= qq{<td>$link$rep->{name}</a></td>};
$row .= qq{<td>$link$rep->{description}</a></td>};
$html .= qq{<tr>$row</tr>};
}
$html .= qq{</table>};
return $html;
}
#############################################################################
sub go {
my %FORM;
initialize(\%FORM);
foreach my $key ( keys %FORM ) {
$dbopts->{$key} = $FORM{$key} if ( defined($dbopts->{$key}) );
}
$dbversion = dm::SelectDataValue("select version();", undef, $dbopts);
my $html;
my $t0 = toolbox::NowAsScalar();
if ( defined($FORM{id}) ) {
$html = &showreport(\%FORM, $dbopts);
} else {
$html = &showreportlist(\%FORM, $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;