#!/usr/bin/perl
##
## File Upload
##
##
## Copyright(c) 2000 Leo Fellermayr <leosmail@mac.com>

use strict;

### GET

if ($ENV{'REQUEST_METHOD'} eq "GET") {
 
    ## Uploadformular und Liste aktuell vorhandener Uploads
    print "Content-type: text/html\n\n";
    print<<"...";
	<h3>File-Upload</h3>
	<form action="$ENV{SCRIPT_NAME}" method="post"
	enctype="multipart/form-data">
	<table border="0" cellspacing="20" cellpadding="0">
	<tbody>
	<tr>
	  <td width="70" align="right"><b>Datei</b></td>
	  <td><input type="file" name="upload" size="40" /></td>
	</tr>
	<tr>
	<td>&nbsp;</td>
        <td align="right"><br>
        <input type="submit" value="Hochladen" />
        </td>
        </tr>
	</tbody>
	</table>
	</form>
	<table border="0" cellspacing="0" cellpadding="5" align="center">
	<tr><td align="center"><b>Derzeitige Uploads</b></td></tr>
	<tr><td><img src="/images/blackpix.gif" width="300"
	height="1"></img></td></tr>
...
    open (PIPE, "/bin/ls -l1 /wwwroot/prinzess.dyndns.org/html/intra/uploads |");
    my ($addr,$line);
    my $i = 0;
    foreach $line (<PIPE>) {
    $i++;
    if ($i % 2) { print "<tr><td bgcolor=\"#f6f6f6\">\n"; }
    else { print "<tr><td bgcolor=\"#e5e5e5\">\n"; }
      chop $line;
      $addr = $line;
      $addr =~ s/\ /%20/g;
      print "<b><a href=\"/intra/uploads/$addr\">$line</a></b></td></tr>\n";
    }
    print "</table>\n";
    close (PIPE);

} # GET

### POST

else {

  ## File-Upload
  use CGI;
  my $cgi = new CGI;
  my $file = $cgi->param('upload');
  if (!$file) {
    print "Content-type: text/html\n\n";
    print "Keine Datei ausgew&auml;hlt!\n\n";
  }
  my $filename = $file;
  # nur alphanumerische Zeichen, Ziffern und der Punkt (.)
  $filename =~ s/[^A-Za-z0-9\.]//g;
  # Punkt am Anfang entfernen (.ht*-Dateien)
  $filename =~ s/(^[\.])(.*)/$2/g;
  open (PIPE, ">>/wwwroot/prinzess.dyndns.org/html/intra/uploads/$filename");
  while (<$file>) {
    print PIPE $_;
  }
  close (PIPE);
  print "Location: http://prinzess.dyndns.org/intra/upload.php\n\n";

} # POST