upload.pl
changeset 3 8b499dbf38ca
parent 1 2f299c7ef0c9
child 4 16a0b84fe7fb
equal deleted inserted replaced
2:0bd7075603d9 3:8b499dbf38ca
    14 use CGI::Pretty;
    14 use CGI::Pretty;
    15 use IO::File;
    15 use IO::File;
    16 use File::Basename;
    16 use File::Basename;
    17 use Digest::SHA1 qw(sha1_hex);
    17 use Digest::SHA1 qw(sha1_hex);
    18 
    18 
    19 my $DIR = "upload.d";
    19 my $DIR      = "upload.d";
    20 my $LINK_DIR = dirname($ENV{SCRIPT_NAME}) . "$DIR";
    20 my $LINK_DIR = dirname($ENV{SCRIPT_NAME}) . "$DIR";
    21 
    21 
    22 -d $DIR
    22 -d $DIR
    23   or mkdir $DIR => 0750
    23   or mkdir $DIR => 0750
    24   or die "Can't mkdir $DIR: $!\n";
    24   or die "Can't mkdir $DIR: $!\n";
    25 
    25 
    26 MAIN: {
    26 MAIN: {
    27     print header(-charset => "UTF-8"), start_html,
    27     print header(-charset => "UTF-8"), start_html, h1 "View: $ENV{REMOTE_USER}";
    28       h1 "View: $ENV{REMOTE_USER}";
       
    29 
    28 
    30     # print Dump;
    29     # print Dump;
    31 
    30 
    32     if (param("delete") =~ /([a-z\d]+-\d+)/i) {
    31     if (param("delete") =~ /([a-z\d]+-\d+)/i) {
    33         my $dir = $1;
    32         my $dir = $1;
    66     print start_table, Tr(th { align => "left" }, [qw/name size date expires/]);
    65     print start_table, Tr(th { align => "left" }, [qw/name size date expires/]);
    67 
    66 
    68     foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") {
    67     foreach (map { /(.*)/ } sort { -M $a <=> -M $b } glob "$DIR/*-*/*") {
    69         my ($file, $dir) = fileparse($_);
    68         my ($file, $dir) = fileparse($_);
    70         $dir = basename $dir;
    69         $dir = basename $dir;
       
    70 
    71         # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next;
    71         # $dir =~ /(?<hash>\S+)-(?<expires>\d+)$/ or next;
    72         $dir =~ /(\S+)-(\d+)$/ or next;
    72         $dir =~ /(\S+)-(\d+)$/ or next;
    73 	my $hash = $1;
    73         my $hash    = $1;
    74 	my $expires = $2;
    74         my $expires = $2;
    75         if (${expires} <= time) {
    75         if (${expires} <= time) {
    76             /(.*)/;
    76             /(.*)/;
    77             unlink $_  or die "Can't unlik $_: $!\n";
    77             unlink $_  or die "Can't unlik $_: $!\n";
    78             rmdir $dir or die "Can't rmdir $dir: $!\n";
    78             rmdir $dir or die "Can't rmdir $dir: $!\n";
    79             next;
    79             next;