my $user_id = "";
	foreach my $key (sort keys(%ENV)) {
	  if ($key =~ /QUERY_STRING/) {
		push(@ts_dir,$ENV{$key});
		#print "$ENV{$key}<p>";
	  }
	  elsif ($key =~ /IWUSER/) {
		$user_id = $ENV{$key};
		#print "$user_id<p>";
	  }
	}
##</code><code>##

my @ts_dir = $ENV{QUERY_STRING};
my $user_id = $ENV{IWUSER};

##</code><code>##

#!I:\Interwoven\TeamSite\iw-perl\bin\iwperl -T --
use strict;
use warnings;
use diagnostics;
use CGI;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser set_message);
use File::Copy qw/ copy /;
Main( @ARGV );
exit( 0 );
sub Main {
    set_message("It's not a bug, it's a feature!");
    local $CGI::POST_MAX = 1024 * 100;  # maximum upload filesize is 100K
    my $q = CGI->new;
    print $q->header;
    warningsToBrowser(1);
    
    print buildForm( $q );

    if (  !$q->param('filename') && $q->cgi_error() ) {
        ...
    } else {
        save_file($q);
    }
    print $q->end_html;
}


sub save_file {
    my( $q ) = @_;
    my $filename    = $query->param('uploaded_file');
    
    my $destination_filename = File::Spec->catfile( $hardcoded_destination_directory, WashFilename( $filename  ) );

    copy( $filename->handle, $destination_filename  ) or die "Copy to ( $destination_filename) failed: $!";
}

##</code><code>##

for my $testfn (
    "a/b/c",
    'a\b\c',
    'a:b:c',
    "a[!{(\205)}!].ext",
    "a.ext",
    ){
    printf "( %s )\n\t(%s)\n\n", $testfn , WashFilename( $testfn );
}

sub WashFilename {
    use File::Basename;
    my $basename = basename( shift );
#~     $basename =~ s/[^a-zA-Z0-9]//g; # remove everything except a-z A-Z 0-9
    $basename = join '', $basename =~ m/([.a-zA-Z0-9])/g; # untainted , only use a-z A-Z 0-9 and dot
    # basename is now, hopefully, file.ext
    ## so to ensure uniqueness, we adulterate it :)
    my $id = $$.'-'.time;
    my( $file, $ext ) = split /\./, $basename, 2 ;
    return join '.', grep defined, $file, $id, $ext;
}
__END__
( a/b/c )
        (c.1272-1316599567)

( a\b\c )
        (c.1272-1316599567)

( a:b:c )
        (c.1272-1316599567)

( a[!{(à)}!].ext )
        (a.1272-1316599567.ext)

( a.ext )
        (a.1272-1316599567.ext)

##</code><code>##

for my $testfn (
    "a/b/c",
    'a\b\c',
    'a:b:c',
    "a[!{(\205)}!].ext",
    "a.ext",
    ){
    printf "( %s )\n\t(%s)\n\n", $testfn , WashFilename( $testfn );
}

sub WashFilename {
    use File::Basename;
    my $basename = basename( shift );
    my $id = $$.'-'.time;
    my( $file, $ext ) = map { unpack 'h*',$_ } split /\./, $basename, 2 ;
    return join '.', grep defined, $file, $id, $ext;
}
__END__
( a/b/c )
        (36.3924-1316599650)

( a\b\c )
        (36.3924-1316599650)

( a:b:c )
        (36.3924-1316599650)

( a[!{(à)}!].ext )
        (16b512b7825892d712d5.3924-1316599650.568747)

( a.ext )
        (16.3924-1316599650.568747)