equal
deleted
inserted
replaced
53 sub md5_base62 { ... } |
53 sub md5_base62 { ... } |
54 |
54 |
55 my $rxVIEW = qr/[a-z\d]{6}-[a-z\d]+/i; # date-userhash |
55 my $rxVIEW = qr/[a-z\d]{6}-[a-z\d]+/i; # date-userhash |
56 my $rxFILE = qr/[a-z\d]{6}-[a-z\d]+-./i; # date-filehash-deletemode |
56 my $rxFILE = qr/[a-z\d]{6}-[a-z\d]+-./i; # date-filehash-deletemode |
57 |
57 |
58 my $TT_CONFIG = { |
58 my $TT_CONFIG = |
59 INCLUDE_PATH => [ map { catfile($RealBin, $_) } |
59 { INCLUDE_PATH => |
60 qw(var templates.override templates) ] |
60 [map { catfile($RealBin, $_) } qw(var templates.override templates)] }; |
61 }; |
|
62 |
61 |
63 umask 077; |
62 umask 077; |
64 |
63 |
65 # The working (var) directory gets passed to us via ONCE_VAR environment |
64 # The working (var) directory gets passed to us via ONCE_VAR environment |
66 # FIXME: Should we allow the current directory as an alternative? |
65 # FIXME: Should we allow the current directory as an alternative? |
69 $ENV{ONCE_VAR} =~ /^(\/\S+)/; |
68 $ENV{ONCE_VAR} =~ /^(\/\S+)/; |
70 die "Please define (correct) env ONCE_VAR\n" |
69 die "Please define (correct) env ONCE_VAR\n" |
71 if not defined $1; |
70 if not defined $1; |
72 $1; |
71 $1; |
73 }; |
72 }; |
74 |
|
75 my @footer = (hr, |
|
76 div( |
|
77 { -align => "right" }, |
|
78 a( |
|
79 { |
|
80 -href => |
|
81 "https://ssl.schlittermann.de/hg/anon-upload/file/once/" |
|
82 } => "Scripting" |
|
83 ), |
|
84 " © 2010,2011,2015 ", |
|
85 a({ -href => "http://www.schlittermann.de/" } => "Heiko Schlittermann"), |
|
86 " © 2014 ", |
|
87 a({ -href => "http://www.schlittermann.de/" } => "Matthias Förste") |
|
88 ) |
|
89 ); |
|
90 |
73 |
91 exit main() if not caller; |
74 exit main() if not caller; |
92 |
75 |
93 sub main { |
76 sub main { |
94 |
77 |
230 } |
213 } |
231 |
214 |
232 # create the view |
215 # create the view |
233 my %tt = (view => $view); |
216 my %tt = (view => $view); |
234 my $tt = Template->new($TT_CONFIG) |
217 my $tt = Template->new($TT_CONFIG) |
235 or die $Template::ERROR; |
218 or die $Template::ERROR; |
236 |
219 |
237 # List the current content |
220 # List the current content |
238 if (my @files = map { deslash $_ } glob "$user_dir/*-*/*") { |
221 if (my @files = map { deslash $_ } glob "$user_dir/*-*/*") { |
239 |
222 |
240 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } @files) { |
223 foreach (map { /(.*)/ } sort { -M $a <=> -M $b } @files) { |
303 sub deslash { $_[0] =~ s{/+}{/}gr } |
286 sub deslash { $_[0] =~ s{/+}{/}gr } |
304 |
287 |
305 sub confirm { |
288 sub confirm { |
306 my ($base, $mimetype) = @_; |
289 my ($base, $mimetype) = @_; |
307 my %tt = ( |
290 my %tt = ( |
308 file => { name => $base, |
291 file => { |
|
292 name => $base, |
309 mimetype => $mimetype |
293 mimetype => $mimetype |
310 } |
294 } |
311 ); |
295 ); |
312 my $tt = Template->new($TT_CONFIG) |
296 my $tt = Template->new($TT_CONFIG) |
313 or die $Template::ERROR; |
297 or die $Template::ERROR; |
314 $tt->process('confirm.html' => \%tt); |
298 $tt->process('confirm.html' => \%tt); |
315 exit 0; |
299 exit 0; |
316 } |
300 } |
317 |
301 |
318 sub unbase62 { |
302 sub unbase62 { |