--- 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"
- ),
- " © 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($) {