#!/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;