#!/usr/bin/perl

use strict;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser);   # NUR FUER DEN TEST!

$CGI::POST_MAX = 1024 * 100;  # maximum upload filesize is 100K

# Uploadverzeichnis auf dem Webserver
# muss dem Webserver-User gehoeren, z.B. www-data
my $uploaddir = '/opt/www/uploads/';

my $cgi = new CGI;

# Vorspann
print $cgi->header;
print $cgi->start_html(-title => 'Upload-Formular');

# Formular ausgeben
ShowForm();

# pruefen, ob die Datei zu gross ist
if (! $cgi->param('filename') && $cgi->cgi_error())
  {
  print $cgi->cgi_error();
  print qq~
  <p>
  Die Datei, die Sie hochladen wollen, ist leider zu groß.
  </p>
  ~;
  print $cgi->end_html;
  exit 0;
  }

# Upload-Datei speichern
SaveFile($cgi) if ($cgi->param());

# Nachspann
print $cgi->end_form;

sub SaveFile
  # Datei abspeichern
  {
  my ($q) = @_;
  my ($bytesread, $buffer);
  my $num_bytes = 1024;
  my $totalbytes;
  my $file;
  my $filename = $q->param('Uploaddatei');
  my $beschreibung = $q->param('Beschreibung');

  if (!$filename)
    {
    print $q->p('Bitte einen Dateinamen angeben');
    return;
    }

  # Uploaddateinamen erzeugen
  $file = 'upload_' . time() . $$; # Timestamp + Prozessnummer
  # Verzeichnis dazu
  $file = $uploaddir . $file;

  print "<h4>Upload-Info:</h4>";
  my $info = $q->uploadInfo($filename);
  for my $key (keys(%$info))
   {
   print "$key:  $$info{$key}<br />\n";
   }
 # Jetzt kommt das Mysterium: $filename ist gleichzeitig filehandle
  open (OUTFILE, ">", "$file") or die "Couldn't open $file for writing: $!";
  binmode $filename;
  binmode OUTFILE;
  while ($bytesread = read($filename, $buffer, $num_bytes))
    {
    $totalbytes += $bytesread;
    print OUTFILE $buffer;
    }
  die "Read failure" unless defined($bytesread);
  print "<p>Datei $filename uploaded to $file ($totalbytes Bytes)</p>";
  close OUTFILE;
  # Beschreibung etc. speichern
  open (OUTFILE, '>>', $uploaddir . 'katalog.dat');
  flock (OUTFILE, 2);
  # Daten schreiben, zuerst den umgewandelten Dateinamen
  # dann der Beschreibungstext, am Ende steht der Orginaldateiname
  print OUTFILE "$file||$beschreibung||$filename\n";
  close OUTFILE;
  flock (OUTFILE, 8);
  }


sub ShowForm
  {
  # Uploadformular
  # Formular muss als ENCTYPE 'multipart/form-data' haben
  print $cgi->start_form(-enctype => 'multipart/form-data');

  # Dateifeld
  print '<p>Dateinamen eingeben oder auf "browse" klicken,
         um eine Datei auszuw&auml;hlen<br />';
  print $cgi->filefield(-name      => 'Uploaddatei',
                        -size      => 50,
                        -maxlength => 80);
  print '</p><p>';
  # Texteingabefeld
  print 'Geben Sie noch eine kurze Beschreibung ein:<br />';
  print $cgi->textfield(-name      => 'Beschreibung',
                        -default   => 'Beschreibung',
                        -size      => 50,
                        -maxlength => 80);

  print '</p><p>', $cgi->submit(-value => 'Hochladen'),'</p>';
  }