git.sesse.net Git - pr0n/blob - perl/Sesse/pr0n/Upload.pm

   1 # Shows the upload dialog.
   2
   3 package Sesse::pr0n::Upload;
   4 use strict;
   5 use warnings;
   6
   7 use Sesse::pr0n::Common qw(error dberror);
   8
   9 sub handler {
  10         my $r = shift;
  11         my $dbh = Sesse::pr0n::Common::get_dbh();
  12
  13         # Fix common error: pr0n.sesse.net/upload/event -> pr0n.sesse.net/upload/event/
  14         if ($r->path_info !~ /\/$/) {
  15                 my $res = Plack::Response->new(301);
  16                 $res->header('Location' => $r->path_info . "/");
  17                 return $res;
  18         }
  19         $r->path_info =~ /^\/upload\/([a-zA-Z0-9-]+)\/?$/
  20                 or return error($r, "Could not extract event");
  21         my $event = $1;
  22
  23         my $res = Plack::Response->new(200);
  24         $res->content_type("text/html; charset=utf-8");
  25         my $io = IO::String->new;
  26
  27         chomp (my $title = Sesse::pr0n::Templates::fetch_template($r, 'upload-title'));
  28         Sesse::pr0n::Common::header($r, $io, $title);
  29         Sesse::pr0n::Templates::print_template($r, $io, 'upload', {
  30                 event => $event
  31         });
  32         Sesse::pr0n::Common::footer($r, $io);
  33
  34         $io->setpos(0);
  35         $res->body($io);
  36         return $res;
  37 }
  38
  39 1;
  40