lib/Promulger/Web.pm

   1 package Promulger::Web;
   2 use Web::Simple 'Promulger::Web';
   3 use autodie;
   4
   5 use Promulger::List;
   6
   7 has list_home => (
   8   is => 'ro',
   9   default => sub { 'etc/lists' },
  10   lazy => 1,
  11 );
  12
  13 sub dispatch_request {
  14   my ($self) = shift;
  15   sub (GET + /list/) {
  16     redispatch_to '/index';
  17   },
  18   sub (GET + /list) {
  19     redispatch_to '/index';
  20   },
  21   sub (GET + /) {
  22     redispatch_to '/index';
  23   },
  24   sub (GET + /index) {
  25     my ($self) = @_;
  26     [ 200, [ 'Content-type', 'text/html' ], [ $self->render_index(@_) ] ]
  27   },
  28   sub (GET + /list/*/) {
  29     my ($self, $list) = @_;
  30     redispatch_to "/list/${list}";
  31   },
  32   sub (GET + /list/*) {
  33     my ($self, $list) = @_;
  34     [ 200, [ 'Content-type', 'text/html' ], [ $self->show_list($list) ] ]
  35   },
  36   sub (GET + /list/*/subscriber/* + .*) {
  37     my ($self, $list, $subscriber, $extension) = @_;
  38     [
  39       200,
  40       [ 'Content-type', 'text/html' ],
  41       [ $self->show_subscriber($list, $subscriber, $extension) ]
  42     ]
  43   },
  44   sub (POST + /list/*/subscriber/*/unsubscribe) {
  45     my ($self, $list, $subscriber) = @_;
  46     [
  47       200,
  48       [ 'Content-type', 'text/html' ],
  49       [ $self->unsubscribe($list, $subscriber) ]
  50     ]
  51   },
  52   sub (POST + /list/*/subscribe + %email=) {
  53     my ($self, $list, $email) = @_;
  54     [
  55       200,
  56       [ 'Content-type', 'text/html' ],
  57       [ $self->subscribe($list, $email) ],
  58     ]
  59   },
  60   sub () {
  61     [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ]
  62   }
  63 }
  64
  65 sub render_index {
  66   my ($self) = @_;
  67   my @lists = Promulger::List->get_lists;
  68   my $html = <<HTML;
  69 <p>Promulger</p>
  70
  71 <p>Lists:</p>
  72 <ul>
  73 HTML
  74   for my $list (@lists) {
  75     $html .= qq{<li><a href="/list/${list}">${list}</a></li>};
  76   }
  77   $html .= "</ul>";
  78   return $html;
  79 }
  80
  81 sub show_list {
  82   my ($self, $list_name) = @_;
  83   my $list = Promulger::List->resolve($list_name);
  84   my $name = $list->listname;
  85   my $active = $list->active;
  86   my @subscribers = keys %{ $list->subscribers };
  87   my $html = <<"HTML";
  88 <p>List: ${name}</p>
  89 <p>Active: ${active}</p>
  90 <form method="POST" action="/list/${list_name}/subscribe">
  91 <input type="text" name="email">
  92 </form>
  93 <p>Subscribers:</p>
  94 <ul>
  95 HTML
  96   for my $sub (@subscribers) {
  97     $html .= qq{<li><a href="/list/${name}/subscriber/${sub}">${sub}</a></li>};
  98   }
  99   $html .= "</ul>";
 100   return $html;
 101 }
 102
 103 sub subscribe {
 104   my ($self, $list_name, $email) = @_;
 105   my $list = Promulger::List->resolve($list_name);
 106   $list->subscribe($email);
 107   return "<p>Subscribed ${email} to ${list_name}.</p>";
 108 }
 109
 110 sub unsubscribe {
 111   my ($self, $list_name, $email) = @_;
 112   my $list = Promulger::List->resolve($list_name);
 113   $list->unsubscribe($email);
 114   return "<p>Unsubscribed ${email} from ${list_name}.</p>";
 115 }
 116
 117 sub show_subscriber {
 118   my ($self, $list_name, $subscriber, $extension) = @_;
 119   my $address = "${subscriber}.${extension}";
 120   my $html = <<"HTML";
 121 <p>Subscriber ${address}</p>
 122 <form method="POST" action="/list/${list_name}/subscriber/${address}/unsubscribe">
 123 <input type="submit" value="Unsubscribe">
 124 </form>
 125 HTML
 126 }
 127
 128 1;