#!/usr/local/bin/perl

use CGI ':standard';

# Scritto da Luca Cabibbo basandosi sullo script WebMonitor mail
# ======================================================================
# Upload:
#
#     Script CGI per salvare su un file del server Web
#     informazioni immesse in un form
#
#     La documentazione e' inesistente
# ======================================================================
# Users may want to include a:
#    <INPUT TYPE="hidden" NAME="next-url" VALUE="/~user/received.html">
# If this is present in the FORM input, the client will be redirected
# to this HTML file as a confirmation message instead of the default.
# In addition, the user can also define any of the following input names
# in their form to better customize the output mailed back to them.
#    <INPUT TYPE="hidden" NAME="subject" VALUE="My survey results">
#    <INPUT TYPE="hidden" NAME="from-name" VALUE="Average Web user">
#    <INPUT TYPE="hidden" NAME="from-email" VALUE="jdoe@domain.com">
# These values will then be used in the header of the email message.
# Otherwise, default values will be substituted.
# ======================================================================


########################################################################
########## Configurable variables ######################################

$SAVEDIR = 'C:\\Home\\Apache\\';
##                     Cartella dove salvare il file generato

## Also, make sure the first line of this script points
## to your PERL binary

########## Nothing else to change ######################################
########################################################################


$ENV{'SCRIPT_NAME'} =~ m#(/.*/)(.*)$#;
$SCRIPTDIR = $1;
$SCRIPT = $2;

#### Do standard HTTP stuff ####
&cgi_receive;
&cgi_decode;
&cgi_header;

#### Check whether to save
if ($ENV{'QUERY_STRING'}) {
    #### User specified an option ####
    $tobesaved = $ENV{'QUERY_STRING'};
} else {
    $tobesaved = 'no';
}

#### Check for require fields
foreach $field (@requirefields) {
    &error_blank_field($field) unless ($FORM{$field});
}

#### Fill in missing fields for forwarding FORM results ####
($FORM{'traccia'}) || die ("$SCRIPT: Traccia mancante!\n");
($FORM{'cognome'}) || die ("$SCRIPT: Cognome mancante!\n");
($FORM{'nome'}) || die ("$SCRIPT: Nome mancante!\n");
($FORM{'matricola'}) || ($FORM{'matricola'} = "00000");
($FORM{'estensione'}) || ($FORM{'estensione'} = "txt");

### Calcola il nome del file
$TRACCIA = $FORM{'traccia'};
$COGNOME = $FORM{'cognome'};
$NOME = $FORM{'nome'};
$ESTENSIONE = $FORM{'estensione'};
$TRACCIA =~ s/\W//g;
$COGNOME =~ s/\W//g;
$NOME =~ s/\W//g;
$ESTENSIONE =~ s/\W//g;
$SAVEFILE = $SAVEDIR . $TRACCIA . '\\' . $COGNOME . $NOME . '.' . $ESTENSIONE;

($tobesaved eq 'yes') && (&write_file);
&write_stdout;

#### Now, redirect if "next-url" is included
if ($FORM{'next-url'}) {
    print "Location: $FORM{'next-url'}\n";
    print "\n";
    exit;
}

#### Prevent HTML output
foreach $key (keys %FORM) {
    $FORM{$key} =~ s/</\&lt;/g;
    $FORM{$key} =~ s/>/\&gt;/g;
}

exit;

#####################################################################
#### SUBROUTINES ####################################################

sub write_file {
    open (FILE, "> $SAVEFILE") || die ("$SCRIPT: Impossibile aprire il file!\n");
    binmode FILE;

    print FILE "// Nome file:  $SAVEFILE\n";
    print FILE "\n";
    &dump_values(FORM, FILE);
    print FILE "\n";
    close (FILE);
}

#### Output confirmation message ####
sub write_stdout {
    print qq|<HTML><HEAD><TITLE>Upload Notification</TITLE></HEAD><BODY>\n|;
    print qq|<H1>$ENV{'SERVER_NAME'} Upload notification</H1>\n|;
    print qq|The following file has been successfully saved on remote server.\n|;
    print qq|<HR>\n|;
    print "<PRE>\n";
    print "// Nome file:  $SAVEFILE\n";
    print "\n";
    &dump_values(FORM, STDOUT);
    print "\n";
    print "</PRE>\n";
    print "</BODY></HTML>\n";
}

sub error_blank_field {
    local($variable) = @_;
    print "\n" if ($FORM{'next-url'});
    print "<HTML><HEAD><TITLE>Upload Error</TITLE></HEAD><BODY>\n";
    print "<H1>Error!</H1>\n";
    print "You did not fill in $variable.\n";
    print "</BODY></HTML>\n";
    exit;
}

sub cgi_header {
    print "Content-type: text/html\n";
    print "\n" unless ($FORM{'next-url'});
}

sub cgi_receive {
    if ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $incoming, $ENV{'CONTENT_LENGTH'});
    }
    else {
        $incoming = $ENV{'QUERY_STRING'};
    }
}

sub cgi_decode {
    @pairs = split(/&/, $incoming);

    foreach (@pairs) {
        ($name, $value) = split(/=/, $_);

        $name  =~ tr/+/ /;
        $value =~ tr/+/ /;
        $name  =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
        $value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;

        #### Strip out semicolons unless for special character
        # $value =~ s/;/$$/g;
        # $value =~ s/&(\S{1,6})$$/&\1;/g;
        # $value =~ s/$$/ /g;

        # $value =~ s/\|/ /g;
        # $value =~ s/^!/ /g; ## Allow exclamation points in sentences

    #### Split apart any directive prefixes
    #### NOTE: colons are reserved to delimit these prefixes
    @parts = split(/:/, $name);
    $name = $parts[$#parts];
    if (grep(/^require$/, @parts)) {
        push (@requirefields, $name);
    }
    if (grep(/^ignore$/, @parts)) {
        push (@ignorefields, $name);
    }
    if (grep(/^dynamic$/, @parts)) {
        #### For simulating a checkbox
        #### It may be dynamic, but useless if nothing entered
            next if ($value eq "");
            $name = $value;
            $value = "on";
    }

        #### Skip generally blank fields
        next if ($value eq "");

    #### Allow for multiple values of a single name
        $FORM{$name} .= ", " if ($FORM{$name});

        $FORM{$name} .= $value;
    #### Add to ordered list if not on list already
        push (@fields, $name) unless (grep(/^$name$/, @fields));
    }
}

sub dump_values {
    local($env, $handle) = @_;
    ($handle eq "STDOUT") && (print $handle "<PRE>\n");
    foreach $field (@fields) {
    next if (grep(/^$field$/, @ignorefields));
    if ($FORM{$field} =~ /[\cM\n]/) {
        $this_field = $FORM{$field};
        $this_field =~ s/\r//;
        print $handle "/* ", "-" x 15, "  $field begins here  ", "-" x 15, " */\n";
        print $handle $this_field;
        print $handle "\n/* ", "-" x 15, "  $field ends here  ", "-" x 15, " */\n";
    }
    else {
        print $handle "// $field:  $FORM{$field}\n";
    }
    }
    ($handle eq "STDOUT") && (print $handle "</PRE>\n");
}
