From: Chris Nehren <apeiron@cpan.org>
Date: Sat, 3 Sep 2011 22:25:13 +0000 (-0400)
Subject: very basic web frontend
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cefad1542ab54c130a8a0c341e6cb71bb368283f;p=p5sagit%2FPromulger.git

very basic web frontend
---

diff --git a/lib/Promulger/Web.pm b/lib/Promulger/Web.pm
new file mode 100644
index 0000000..4698cb5
--- /dev/null
+++ b/lib/Promulger/Web.pm
@@ -0,0 +1,123 @@
+package Promulger::Web;
+use Web::Simple 'Promulger::Web';
+use autodie;
+
+use Promulger::List;
+
+use Method::Signatures::Simple;
+
+has list_home => (
+  is => 'ro',
+  default => sub { 'etc/lists' },
+  lazy => 1,
+);
+
+sub dispatch_request {
+  my ($self) = shift;
+  sub (GET + /list/) {
+    redispatch_to '/index';
+  },
+  sub (GET + /list) {
+    redispatch_to '/index';
+  },
+  sub (GET + /) {
+    redispatch_to '/index';
+  },
+  sub (GET + /index) {
+    my ($self) = @_;
+    [ 200, [ 'Content-type', 'text/html' ], [ $self->render_index(@_) ] ]
+  },
+  sub (GET + /list/*/) {
+    my ($self, $list) = @_;
+    redispatch_to "/list/${list}";
+  },
+  sub (GET + /list/*) {
+    my ($self, $list) = @_;
+    [ 200, [ 'Content-type', 'text/html' ], [ $self->show_list($list) ] ]
+  },
+  sub (GET + /list/*/subscriber/*) {
+    my ($self, $list, $subscriber) = @_;
+    [ 
+      200, 
+      [ 'Content-type', 'text/html' ], 
+      [ $self->show_subscriber($list, $subscriber) ] 
+    ]
+  },
+  sub (GET + /list/*/subscriber/*/unsubscribe) {
+    my ($self, $list, $subscriber) = @_;
+    [ 
+      200, 
+      [ 'Content-type', 'text/html' ], 
+      [ $self->unsubscribe($list, $subscriber) ] 
+    ]
+  },
+  sub (POST + /list/*/subscribe + %email=) {
+    my ($self, $list, $email) = @_;
+    [ 
+      200, 
+      [ 'Content-type', 'text/html' ], 
+      [ $self->subscribe($list, $email) ],
+    ]
+  },
+  sub () {
+    [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ]
+  }
+}
+
+method render_index {
+  my ($self) = @_;
+  my @lists = Promulger::List->get_lists;
+  my $html = <<HTML;
+<p>Promulger</p>
+
+<p>Lists:</p>
+<ul>
+HTML
+  for my $list (@lists) {
+    $html .= qq{<li><a href="/list/${list}">${list}</a></li>};
+  }
+  $html .= "</ul>";
+  return $html;
+}
+
+method show_list($list_name) {
+  my $list = Promulger::List->resolve($list_name);
+  my $name = $list->listname;
+  my $active = $list->active;
+  my @subscribers = keys %{ $list->subscribers };
+  my $html = <<"HTML";
+<p>List: ${name}</p>
+<p>Active: ${active}</p>
+<form method="POST" action="/list/${list_name}/subscribe">
+<input type="text" name="email">
+</form>
+<p>Subscribers:</p>
+<ul>
+HTML
+  for my $sub (@subscribers) {
+    $html .= qq{<li><a href="/list/${name}/subscriber/${sub}">${sub}</a></li>};
+  }
+  $html .= "</ul>";
+  return $html;
+}
+
+method subscribe($list_name, $email) {
+  my $list = Promulger::List->resolve($list_name);
+  $list->subscribe($email);
+  return "<p>Subscribed ${email} to ${list_name}.</p>";
+}
+
+method unsubscribe($list_name, $email) {
+  my $list = Promulger::List->resolve($list_name);
+  $list->unsubscribe($email);
+  return "<p>Unsubscribed ${email} from ${list_name}.</p>";
+}
+
+method show_subscriber($list_name, $subscriber) {
+  my $html = <<"HTML";
+<p>Subscriber ${subscriber}</p>
+<a href="/list/${list_name}/subscriber/${subscriber}/unsubscribe">unsubscribe</a>
+HTML
+}
+
+1;
diff --git a/script/pmg-web b/script/pmg-web
new file mode 100644
index 0000000..ba29cfd
--- /dev/null
+++ b/script/pmg-web
@@ -0,0 +1,9 @@
+#!/usr/bin/env perl
+use strictures 1;
+use autodie;
+
+use Promulger::Web;
+use Promulger::Config;
+Promulger::Config->load_config('etc/pmg.conf');
+
+Promulger::Web->run_if_script;