#!/usr/local/bin/perl

# filename to store results
$results = "results.txt";  

# response page
$response = "response.html";

# field delimiter in results file
$delimiter = "\t";

# replacement if delimiter found in data
$replace = " ";

# use module designed for CGI
use CGI;
$data = new CGI;

# split "_order" field on commas
@order = split(/,/,$data->param('_order'));

# stop if no order defined
&cry("no defined field order") unless defined(@order);

# start with a blank line of data
$line = "";

# add field values to line of data according to order
foreach $field (@order){

    # get and clean a field value
    $value = $data->param($field);
    $value =~ s/[\r\t\n\f]/ /g;          # convert whitespace
    $value =~ s/$delimiter/$replace/g;   # replace delimiter

    # add field to line
    $line .= $value . $delimiter;
}

# chop trailing delimiter
chop($line);

# locking mechanism
$flock = "/usr/local/bin/flock";
$lock_cmd   = "exec $flock -q -t $results >/dev/null 2>/dev/null";
$unlock_cmd = "$flock";  

# lock results file (could check return code)
system $lock_cmd;

# open results file to append new data 
open(OUT,">>$results") || &cry("error openning $results file");

# add line to results file
print OUT $line . "\n";

# close results file
close(OUT);

# unlock results file (could check return code)
system $unlock_cmd;

# redirect to response page
$uri = $ENV{SCRIPT_NAME};
$uri =~ s|[^/]*$||;
$url = "http://" . $ENV{SERVER_NAME} . $uri . $response;
print $data->redirect($url);

# done
exit;

# a little subroutine to handle errors
sub cry {
    my($message) = @_;

    # print initial response header
    print $data->header;

    print "This CGI program failed to process your submission.\n";
    print "The problem seems to be: $message.\n";
    print "Please contact the owner.";
    exit;
}