upload.pl
branchtesting
changeset 17 dc78008e8c97
parent 16 a4a87929803f
child 22 35e487d91ad9
--- a/upload.pl	Fri May 13 17:01:33 2011 +0200
+++ b/upload.pl	Wed May 25 09:52:07 2011 +0200
@@ -23,15 +23,18 @@
 use 5.010;
 use strict;
 use warnings;
+use Cwd qw(abs_path);
 use CGI qw(:all *table);
 use CGI::Carp qw(fatalsToBrowser);
 use CGI::Pretty;
 use File::Basename;
+use FindBin qw($Bin);
 use Digest::MD5 qw(md5_hex);
 use OSSP::uuid;
+use Template;
 
 my $DIR     = "d/{view}";
-my $DIR_URI = "/$DIR";
+my $DIR_URI = "./$DIR";
 
 sub human($);
 
@@ -42,6 +45,18 @@
 -d or mkdir $_ => 0750
   or die "Can't mkdir $_: $!\n";
 
+
+my %TT2_CONFIG = (
+    INCLUDE_PATH => ["$Bin/tt2", dirname(abs_path($0)) . "/tt2"],
+    CONSTANTS => {
+	source => "https://ssl.schlittermann.de/hg/anon-upload/",
+	author => { name => "Heiko Schlittermann",
+	            link => "mailto:hs\@schlittermann.de" },
+
+    },
+    CONSTANTS_NAMESPACE => "const",
+);
+
 MAIN: {
 
     # per view we have an own directory
@@ -54,7 +69,12 @@
       or mkdir $DIR => 0750
       or die "Can't mkdir $DIR: $!\n";
 
-    if (param("delete") =~ /([-a-z\d]+-\d+)/i) {
+    #
+    # delete is simple
+    #
+
+    if (param("op") eq "rm") {
+	param("id") =~ /([-a-z\d]+-\d+)/i;
         my $dir = $1;
         if (-d "$DIR/$dir") {
             unlink map { /(.*)/ && $1 } glob("$DIR/$dir/*")
@@ -65,11 +85,21 @@
         exit 0;
     }
 
-    print header(-charset => "UTF-8"),
-      start_html(-title => "Up&Down"),
-      h1 "Ansicht: $ENV{REMOTE_USER}";
+    #
+    # admin request
+    #
+    if (param("op") eq "admin") {
+	my $tt = Template->new(%TT2_CONFIG)
+	    or die Template->error();
+	print header(-charset => "UTF-8");
+	$tt->process("admin" => {
+	}) or die $tt->error;
+	exit 0;
+    }
 
-    # print Dump;
+    #
+    # it is an upload
+    # 
 
     if (length(my $file = param("upload"))) {
         my $days = param("expires");
@@ -97,76 +127,52 @@
               "rm -f \"$dir/$filename\"\n",
               "rmdir \"$dir\"\n";
             close $atfh;
-            system("cat /tmp/log");
         }
+    }
+
+    # 
+    # now check for existing files
+    #
+    my @files;
+    foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") {
+	my ($file, $dir) = fileparse($_);
+	$dir = basename $dir;
+
+	# $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next;
+	$dir =~ /(\S+)-(\d+)$/ or next;
+	my $hash    = $1;
+	my $expires = $2;
+	if ($expires <= time) {
+	    /(.*)/;
+	    unlink $_  or die "Can't unlik $_: $!\n";
+	    rmdir $dir or die "Can't rmdir $dir: $!\n";
+	    next;
+	}
+
+	push @files, {
+	    link => "$DIR_URI/$dir/$file",
+	    name => $file,
+	    size => human((stat $_)[7]),
+	    mtime => (stat $_)[9],
+	    dtime => $expires,
+	    dlink => "?op=rm&id=$dir",
+	}
 
     }
-    print hr;
 
-    if (my @files = glob "$DIR/*-*/*") {
-
-        #print "<pre>",
-        #(map { "$_: $ENV{$_}\n" } sort keys %ENV),
-        #"</pre>";
-
-        print p <<__;
-			Der gültige Download-Link ist die Link-Adresse, die sich hinter
-			dem Datei-Namen verbirgt. (Firefox: Rechte Maustaste, Link-Location).
-			Nach Ablauf des <a href="http://de.wikipedia.org/wiki/Mindesthaltbarkeitsdatum">MHD</a>
-			wird die Datei automatisch gelöscht.
-__
-
-        print start_table,
-          Tr(th { align => "left" }, [qw/Name Größe Hochgeladen Löschung/]);
-
-        foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") {
-            my ($file, $dir) = fileparse($_);
-            $dir = basename $dir;
-
-            # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next;
-            $dir =~ /(\S+)-(\d+)$/ or next;
-            my $hash    = $1;
-            my $expires = $2;
-            if (${expires} <= time) {
-                /(.*)/;
-                unlink $_  or die "Can't unlik $_: $!\n";
-                rmdir $dir or die "Can't rmdir $dir: $!\n";
-                next;
-            }
-
-            print Tr(
-                td(a { href => "$DIR_URI/$dir/$file" }, $file),
-                td({ align => "right" }, human((stat $_)[7])),
-                td(scalar localtime +(stat $_)[9]),
-                td(scalar localtime ${expires}),
-                td(a({ href => "?delete=$dir" }, "remove"))
-            );
-        }
-
-        print end_table, hr;
-    }
-
-    print start_multipart_form, start_table,
-      Tr(td("Dateiname: "),
-        td(filefield(-name => "upload", -default => "nothing")),
-      ),
-      Tr(td("Löschen in: "), td(textfield(-name => "expires", -default => 10)),
-        td("Tagen")),
-      Tr(td(), td(submit(-value => "Hochladen")),),
-      end_table,
-      end_multipart_form;
-
-    print hr,
-      div(
-        { -align => "right" },
-        a(
-            { -href => "https://keller.schlittermann.de/hg/anon-upload/" } =>
-              "Scripting"
-        ),
-        " &copy; 2010,2011 ",
-        a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann")
-      ),
-      end_html;
+    #
+    # the rest uses some templates
+    #
+    my $tt = Template->new(%TT2_CONFIG) or die Template->error();
+    print header(-charset => "UTF-8");
+    $tt->process("overview" => {
+	    alink => "?op=admin",
+	    view => $ENV{REMOTE_USER},
+	    directory => $DIR,
+	    sel => { 7 => "selected" },
+	    files => \@files,
+    }) or die $tt->error;
+    exit 0;
 }
 
 sub human($) {