diff -r a4a87929803f -r dc78008e8c97 upload.pl --- 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 =~ /(?\S+)-(?\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 "
",
-        #(map { "$_: $ENV{$_}\n" } sort keys %ENV),
-        #"
"; - - 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 MHD - 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 =~ /(?\S+)-(?\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($) {