#!/usr/um/bin/perl
################################################################################
#
# SURVEY
#
################################################################################
# Authors:
#     David A Winkel <dwinkel@umich.edu>
#     Kevin B McGowan <clunis@umich.edu>
#
################################################################################
## Copyright (C) 1996 by the Regents of the University of Michigan.
##
## User agrees to reproduce said copyright notice on all copies of the software
## made by the recipient.
##
## All Rights Reserved. Permission is hereby granted for the recipient to make
## copies and use this software for its own internal purposes only. Recipient of
## this software may not re-distribute this software outside of their own
## institution. Permission to market this software commercially, to include this
## product as part of a commercial product, or to make a derivative work for
## commercial purposes, is explicitly prohibited.  All other uses are also
## prohibited unless authorized in writing by the Regents of the University of
## Michigan.
##
## This software is offered without warranty. The Regents of the University of
## Michigan disclaim all warranties, express or implied, including but not
## limited to the implied warranties of merchantability and fitness for any
## particular purpose. In no event shall the Regents of the University of
## Michigan be liable for loss or damage of any kind, including but not limited
## to incidental, indirect, consequential, or special damages.
################################################################################

require 'ssi-template.lib';

# Global variables

$CGI_URL      = "http://$ENV{'REMOTE_HOST'}/cgi-bin/survey";

$VERSION      = "1.0";
$LAST_UPDATE  = "11/11/98";

# HTML code for webmaster information
$WEBMASTER    =  "<em>webmaster\@umich.edu</em>\n";

# HTML code for version information
$VERSION_MESG =  "\n<hr><i>Survey v$VERSION</i><br>\n" .
                 "Report problems with this gateway to\n" . $WEBMASTER .
                 "Online <a href=\"$CGI_URL/HELP\">help</a> \nis available.\n";

# Typical file system location where data is kept (in user's home directory)
$CGI_DIR      =  "/survey-data";

# Date -- prettily
chop($DATE = `/bin/date +"%A, %B %d, %Y -- %T (%Z)"`);

######################################################################
# MAIN
######################################################################

# determine if data was posted
if ($ENV{'REQUEST_METHOD'} eq 'GET')  { $buffer = $ENV{'QUERY_STRING'}; }
if ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); }

# get USER ...
$USER = $1 if $ENV{'PATH_INFO'} =~ m@/(.*)@;
# and if the browser, for some ungodly reason, adds a trailing slash...
$USER =~ s/\///g;

&Help if (!$USER || $USER eq 'HELP');    # Display Help if no USER or USER=HELP

# Grab home directory out of passwd file...
$SURVEY_DIR = (getpwnam($USER))[7] || &Error("Unable to get user/group information for $USER...");
$SURVEY_DIR .= $CGI_DIR;
$SURVEY_FILE = $SURVEY_DIR . "/survey.data";

&Form unless $buffer;                    # if no data, create and display form

$FORM{'filename'} = "survey.data";
# Parse input
@pairs = split(/&/, $buffer);                # Break down buffer into key=value
foreach $pair (@pairs) {
    ($name, $value) = split(/=/, $pair);     # Break out key and value
    $value =~ tr/+/ /;                       # Get rid of pluses and hex codes
    $name =~ tr/+/ /;                        # Get rid of pluses and hex codes
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $FORM{$name} = $value;                   # Set the key and value hash
}

# A little security check...
$FORM{'filename'} =~ s/\///g;
 
$SURVEY_FILE = $SURVEY_DIR . "/" . $FORM{'filename'};

&SanityChecking;

# Get database field names from file
($field_line = <F>, close F) if open (F, $SURVEY_FILE);
$field_line =~ s/\n//eg;                     # Get rid of the pesky return
@fields = split(/\t/, $field_line);

if ( !$FORM{'nextFORM'} ) {
    # if they didn't give us another form to parse then post the data.
    open(F, ">>$SURVEY_FILE");
    foreach (@fields) {
        # if they haven't asked us not to, clean up the data before saving.
        if ( !$FORM{'rawDATA'} ) {
            # remove tabs, returns, and newlines
            $FORM{$_} =~ tr/\t/ /;              # Get rid of tabs
            $FORM{$_} =~ tr/\r/ /;              # Get rid of returns
            $FORM{$_} =~ tr/\n/ /;              # Get rid of newline
        }
    
        print F "$FORM{$_}\t";
    }
    print F "\n";
    close F;

    # redirect to the success page if everything posted correctly
    if ($FORM{'successURL'}) {
        print "Location:  $FORM{'successURL'}\n\n";
    } else {
        &Success;
    }
} else {
    # parse the next form and print it to the browser.
    
    # eine kleine security check
    $FORM{'nextFORM'} =~ s/\///g;

    # template files have to be in the survey-data directory
    $TEMPLATE_PATH = $SURVEY_DIR;
    my $TEMPLATE_FILE = $SURVEY_DIR . "/" . $FORM{'nextFORM'};
    my $content = &ssi_do_template($TEMPLATE_FILE, \%FORM);
    print "Content-Type:  text/html\n\n";
    print $content;
}

exit;

sub SanityChecking {
    # Make sure the container directory exists
    &Error("$USER is not configured for the Survey services...")
        if (!-d $SURVEY_DIR);

    # Make sure we can write to the file
    &Error("$USER is not allowing entries into a Survey...")
        if (!open(F, ">$SURVEY_DIR/write-check"));
    unlink("$SURVEY_DIR/write-check");

    # Make sure file exists
    &Error("$USER hasn't set up database file properly...")
        if (!-f $SURVEY_FILE);
}

######################################################################
# Error
######################################################################
sub Error {
    print "Content-Type:  text/html\n\n";
    print "<html><head><title>Survey Error</title></head><body>";
    print "<h1>Error!</h1>@_<p>$VERSION_MESG</body></html>";
    exit 1;
}

######################################################################
# Success
######################################################################
sub Success {
    print "Content-Type:  text/html\n\n";
    print "<html><head><title>Survey Entry</title></head><body>";
    print "<h2>Entry Made!</h2>";
    print "Your survey entry has been successfully entered in the database ";
    print "of <b>$USER</b>.<br>";
    print "Thank you for your participation.<BR>\n";
    print "$VERSION_MESG </body></html>\n";
}

######################################################################
# Form
######################################################################
sub Form {
    print "Content-Type:  text/html\n\n";
    print "<html>\n";
    print "<head><title>Survey Entry Form for $USER</title></head>\n\n";
    print "<h2>Thank you for visiting!</h2>\n\n";
    print "Fill in the form below to fill out the survey of <b>$USER</b>.\n";
    print "<hr><form method=POST action=\"$CGI_URL/$USER\">\n";
    print "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0>\n";

    # Get database field names from file
    ($field_line = <F>, close F) if open (F, $SURVEY_FILE);
    $field_line =~ s/\n//eg;                     # Get rid of the pesky return
    @fields = split(/\t/, $field_line);

    foreach (@fields) {
        print "<TR><TD>$_: <TD><input type=\"text\" name=\"$_\" size=30><BR>\n";
    }

    print "</table>\n";
    print "<input type=submit value=\"Submit\"> <input type=reset>\n";
    print "</form>\n\n";
    print "<p>$VERSION_MESG</html>\n";
    exit;
}

######################################################################
# Help
######################################################################
sub Help {
    # Print redirect to documentation
    print "Location: http://www.umich.edu/~websvcs/resources/wwwcgi.html\n\n\r";
    exit;
}