#!/usr/bin/perl -wT

use strict;

use CGI qw(:standard -private_tempfiles);
use CGI::Carp qw(fatalsToBrowser);
use CGI::Pretty;

use File::Copy;
use FileHandle;

use POSIX qw(strftime);


########################################################################


my $query = new CGI;

exists $ENV{UNIQUE_ID} or die "\$UNIQUE_ID missing from environment\n";
$ENV{UNIQUE_ID} =~ /^([-0-9A-Za-z@]+)$/ or die "\$UNIQUE_ID looks suspicious: \"$ENV{UNIQUE_ID}\"\n";
my $uid = $1;
print($query->header({-sampler_unique_id => $uid}));

umask 0007;

my $dir = "/var/www/sampler-uploads/$uid";
mkdir $dir or die "cannot build upload directory $dir: $!\n";
END { rmdir $dir if $dir; }


sub stash_environ () {
    my $environment = new FileHandle "$dir/environment", 'w' or die $!;
    local ($,, $\) = ("\t", "\n");
    while (my ($key, $value) = each %ENV) {
	$environment->print($key, $value)
	    if $key =~ /^HTTP_SAMPLER_/;
    }
    $environment->print('DATE', strftime('%F %T', gmtime));
}


sub stash_file ($) {
    my $name = shift;
    $name =~ /^([-_0-9A-Za-z]+)$/ or die "uploaded file name looks suspicious: $name\n";
    my $filename = $1;
    my $in = $query->upload($name) or die "cannot read uploaded file: $!\n";
    my $out = new FileHandle "$dir/$filename.gz", 'w' or die "cannot stash uploaded file: $!\n";
    copy($in, $out);
}


stash_environ();
stash_file $_ foreach $query->param;

my $reply_demo = 0;
if ($reply_demo) {
    print($query->start_html('Server Reply Demo'),
	  $query->h1('Server Reply Demo'),
	  $query->p('This is a demonstration of presenting server reply messages to the client.  Ordinarily we would only use this if there was some important piece of information we needed to communicate to all clients.'),
	  $query->p('Replies can make full use of HTML features such as',
		    $query->a({href => 'http://www.cs.berkeley.edu/~liblit/sampler/'}, 'hyperlinks'),
		    'and inline images',
		    $query->img({src => 'http://www.cs.berkeley.edu/icons/balls/redball.gif'}),
		    '.'),
	  $query->end_html);
}
