once.pl
changeset 60 e3d6e4095a2c
parent 59 ade26fe6ecbb
child 61 81fc1e7ce91b
equal deleted inserted replaced
59:ade26fe6ecbb 60:e3d6e4095a2c
    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 = {
       
    59     INCLUDE_PATH => [ map { catfile($RealBin, $_) }
       
    60         qw(var templates.override templates) ]
       
    61         };
       
    62 
    58 umask 077;
    63 umask 077;
    59 
    64 
    60 # The working (var) directory gets passed to us via ONCE_VAR environment
    65 # The working (var) directory gets passed to us via ONCE_VAR environment
    61 # FIXME: Should we allow the current directory as an alternative?
    66 # FIXME: Should we allow the current directory as an alternative?
    62 
    67 
   223         }
   228         }
   224 
   229 
   225     }
   230     }
   226 
   231 
   227     # create the view
   232     # create the view
   228     print header(-charset => "UTF-8");
       
   229 
       
   230     my %tt = (view => $view);
   233     my %tt = (view => $view);
   231     my $tt = Template->new(
   234     my $tt = Template->new($TT_CONFIG)
   232         {
   235         or die $Template::ERROR;
   233             INCLUDE_PATH => =>
       
   234               [map { catfile($RealBin, $_) } 'var', 'templates.override', 'templates']
       
   235         }
       
   236     ) or die $Template::ERROR;
       
   237 
   236 
   238     # List the current content
   237     # List the current content
   239     if (my @files = map { deslash $_ } glob "$user_dir/*-*/*") {
   238     if (my @files = map { deslash $_ } glob "$user_dir/*-*/*") {
   240 
   239 
   241         foreach (map { /(.*)/ } sort { -M $a <=> -M $b } @files) {
   240         foreach (map { /(.*)/ } sort { -M $a <=> -M $b } @files) {
   321 
   320 
   322 sub deslash { $_[0] =~ s{/+}{/}gr }
   321 sub deslash { $_[0] =~ s{/+}{/}gr }
   323 
   322 
   324 sub confirm {
   323 sub confirm {
   325     my ($base, $mimetype) = @_;
   324     my ($base, $mimetype) = @_;
   326     print header(-charset => "UTF-8"),
   325     my %tt = (
   327       start_html(-title => "once"),
   326         file => { name => $base,
   328       h1 "Download bestätigen";
   327             mimetype => $mimetype
   329     print hr, p <<__;
   328             }
   330         Die Datei `$base' ($mimetype), die Sie herunterladen möchten, wird nach Abschluß des
   329     );
   331         Downloads gelöscht. Virenscanner oder andere Programme, die den Link
   330     my $tt = Template->new($TT_CONFIG)
   332         möglicherweise automatisiert aufrufen, könnten eine versehentliche
   331         or die $Template::ERROR;
   333         Löschung der Datei auslösen. Bestätigen Sie deshalb bitte den Download
   332     $tt->process('confirm.html' => \%tt);
   334         per Knopfdruck.
       
   335 __
       
   336     print start_form,
       
   337       hidden('confirmed', 'yes'),
       
   338       submit(-value => 'Bestätigung'),
       
   339       end_form,
       
   340       @footer,
       
   341       end_html;
       
   342     exit 0;
   333     exit 0;
   343 }
   334 }
   344 
   335 
   345 sub unbase62 {
   336 sub unbase62 {
   346     my @digits = reverse split '', shift;
   337     my @digits = reverse split '', shift;