From: Chris Nehren <apeiron@cpan.org>
Date: Sun, 14 Mar 2010 01:31:58 +0000 (-0500)
Subject: Just about ready to go live
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=21baaef0e40fb1f234a9cf27432d67e73a4e9b92;p=p5sagit%2FPromulger.git

Just about ready to go live
---

diff --git a/lib/App/Promulger/Command.pm b/lib/App/Promulger/Command.pm
index a46961a..c667539 100644
--- a/lib/App/Promulger/Command.pm
+++ b/lib/App/Promulger/Command.pm
@@ -2,5 +2,32 @@ package App::Promulger::Command;
 use strict;
 use warnings;
 
+use App::Cmd::Setup -command;
+
+use Promulger::Config;
+
+sub opt_spec {
+  return (
+    [ "config|c=s", "configuration file", { required => 1 } ],
+  );
+}
+
+sub validate_args {
+  my ($self, $opt, $args) = @_;
+  my $cf = $opt->{config};
+
+  unless(-e $cf) {
+    die "Config file $cf doesn't exist\n";
+  }
+  unless(-f $cf) {
+    die "Config file $cf not a file\n";
+  }
+  unless(-r $cf) {
+    die "Config file $cf not readable\n";
+  }
+
+  Promulger::Config->config({ Config::General->new($cf)->getall });
+  Promulger::Config->config->{config}{config_file} = $cf;
+}
 
 1;
diff --git a/lib/App/Promulger/Command/msg.pm b/lib/App/Promulger/Command/msg.pm
index f946e63..08a81bd 100644
--- a/lib/App/Promulger/Command/msg.pm
+++ b/lib/App/Promulger/Command/msg.pm
@@ -16,7 +16,7 @@ sub run {
     local $/;
     <STDIN>
   };
-  Promulger::Dispatch::dispatch($message, $self->{config});
+  Promulger::Dispatch::dispatch($message);
 }
 
 1;
diff --git a/lib/App/Promulger/Command/newlist.pm b/lib/App/Promulger/Command/newlist.pm
index 3ca908c..d4a386e 100644
--- a/lib/App/Promulger/Command/newlist.pm
+++ b/lib/App/Promulger/Command/newlist.pm
@@ -4,44 +4,18 @@ use warnings;
 
 use App::Promulger -command;
 use Promulger::List;
-use Config::General;
 
 sub abstract {
   return "creates a new list";
 }
 
-sub opt_spec {
-  return (
-    [ "config|c=s", "configuration file", { required => 1 } ],
-  );
-}
-
-sub validate_args {
-  my ($self, $opt, $args) = @_;
-  my $cf = $opt->{config};
-
-  unless(-e $cf) {
-    die "Config file $cf doesn't exist\n";
-  }
-  unless(-f $cf) {
-    die "Config file $cf not a file\n";
-  }
-  unless(-r $cf) {
-    die "Config file $cf not readable\n";
-  }
-
-  $self->{config} = { Config::General->new($cf)->getall };
-  $self->{config}{config_file} = $cf;
-}
-
-
 sub run {
   my ($self, $opt, $args) = @_;
   @$args == 1 or die "pmg newlist needs a list name\n";
   my $list = Promulger::List->new(
     listname  => $args->[0],
   );
-  $list->setup($self->{config});
+  $list->setup;
 }
 
 1;
diff --git a/lib/Promulger/Config.pm b/lib/Promulger/Config.pm
new file mode 100644
index 0000000..6c4d73b
--- /dev/null
+++ b/lib/Promulger/Config.pm
@@ -0,0 +1,12 @@
+package Promulger::Config;
+
+my $config;
+sub config {
+  my $class = shift;
+  if(my $new = shift) {
+    $config = $new;
+  }
+  return $config;
+};
+
+'http://reductivelabs.com/products/puppet/';
diff --git a/lib/Promulger/Dispatch.pm b/lib/Promulger/Dispatch.pm
index ba04393..36fc651 100644
--- a/lib/Promulger/Dispatch.pm
+++ b/lib/Promulger/Dispatch.pm
@@ -8,8 +8,12 @@ use Email::Simple;
 use Email::Sender::Simple qw(sendmail);
 use Mail::Verp;
 
+use Promulger::Config;
+
+# XXX no bounce parsing yet -- apeiron, 2010-03-13 
 sub dispatch {
-  my($message, $config) = @_;
+  my($message) = @_;
+  my $config = Promulger::Config->config;
 
   my $email = Email::Simple->new($message);
   my $recipient = $email->header('To');
@@ -30,14 +34,14 @@ sub dispatch {
 }
 
 sub handle_request {
-  my ($list, $sender, $recipient, $subject, $config) = @_;
+  my ($list, $sender, $recipient, $subject) = @_;
 
   if($subject =~ /^subscribe/i) {
-    $list->subscribe($sender, $config) 
-      or already_subscribed($list, $sender, $config);
+    $list->subscribe($sender) 
+      or already_subscribed($list, $sender);
   } elsif($subject =~ /^unsubscribe/i) {
-    $list->unsubscribe($sender, $config) 
-      or not_subscribed($list, $sender, $config);
+    $list->unsubscribe($sender) 
+      or not_subscribed($list, $sender);
   }
 }
 
@@ -73,8 +77,52 @@ sub post_message {
   }
 }
 
-sub reject {}
-sub not_subscribed {}
-sub already_subscribed {}
+# XXX make this actually not suck -- apeiron, 2010-03-13 
+sub reject {
+  my($recipient, $sender) = @_;
+  my $email = Email::Simple->create(
+    header => [
+      From => $recipient,
+      To   => $sender,
+      Subject => 'Rejected',
+    ],
+    body => <<BODY,
+Sorry, your message to $recipient has been denied.
+BODY
+  );
+  sendmail($email);
+}
+
+sub not_subscribed {
+  my($list, $sender) = @_;
+  my $list_address = $list->address;
+  my $email = Email::Simple->create(
+    header => [
+      From => $list->admin_address,
+      To   => $sender,
+      Subject => 'Not subscribed',
+    ],
+    body => <<BODY,
+Sorry, you are not subscribed to $list_address;
+BODY
+  );
+  sendmail($email);
+}
+
+sub already_subscribed {
+  my($list, $sender) = @_;
+  my $list_address = $list->address;
+  my $email = Email::Simple->create(
+    header => [
+      From => $list->admin_address,
+      To   => $sender,
+      Subject => 'Already subscribed',
+    ],
+    body => <<BODY,
+Sorry, you are already subscribed to $list_address;
+BODY
+  );
+  sendmail($email);
+}
 
 'http://www.shadowcat.co.uk/blog/matt-s-trout/oh-subdispatch-oh-subdispatch/';
diff --git a/lib/Promulger/List.pm b/lib/Promulger/List.pm
index c595525..7c4a96f 100644
--- a/lib/Promulger/List.pm
+++ b/lib/Promulger/List.pm
@@ -7,6 +7,8 @@ use Carp;
 use Path::Class;
 use Fcntl ':flock';
 
+use Promulger::Config;
+
 has listname => (
   is       => 'ro',
   isa      => 'Str',
@@ -20,32 +22,61 @@ has active => (
   default  => 1,
 );
 
+has subscribers => (
+  is       => 'rw',
+  isa      => 'HashRef',
+  required => 1,
+  default  => sub { {} },
+);
+
 with Storage (
   format => 'JSON',
   io     => 'File',
 );
 
-sub resolve {}
+sub resolve {
+  my($proto) = @_;
+  $proto =~ s/-request$//;
+  my $path = find_path_for($proto);
+  my $maybe_list;
+  eval {
+    $maybe_list = __PACKAGE__->load($path->stringify);
+  };
+  return $maybe_list;
+}
 
-sub subscribe {}
+sub subscribe {
+  my($self, $new) = @_;
+  return if $self->subscribers->at($new);
+  $self->subscribers->put($new, 1);
+  $self->store(find_path_for($self->name));
+}
 
-sub unsubscribe {}
+sub unsubscribe {
+  my($self, $ex) = @_;
+  return unless $self->subscribers->at($ex);
+  $self->subscribers->delete($ex);
+  $self->store(find_path_for($self->name));
+}
 
-sub accept_posts_from {}
+# XXX implement ACLs and other shinies -- apeiron, 2010-03-13 
+sub accept_posts_from {
+  my($self, $sender) = @_;
+  return grep { $sender eq $_ } @{$self->subscribers};
+}
 
 sub setup {
-  my($self, $config) = @_;
+  my($self) = @_;
+  my $config = Promulger::Config->config;
   my $name = $self->listname;
-  my $path = file($config->{list_home}, $name . ".list");
-  eval {
-    __PACKAGE__->load($path->stringify);
-  };
-  croak "${name} already a known list" unless $@;
+  croak "${name} already a known list" if resolve($name);
+  my $path = find_path_for($name);
 
   open my $fh, '+<', $config->{aliases};
   flock $fh, LOCK_EX;
   my @current_contents = <$fh>;
   my @aliases = ($name, "${name}-request");
+
   for my $alias (@aliases) {
     if(grep { /^${alias}:/ } @current_contents) {
       croak "${alias} already in $config->{aliases}";
@@ -53,9 +84,15 @@ sub setup {
     push @current_contents, 
       qq(${alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
   }
+
   $self->store($path->stringify);
   print $fh @current_contents;
   flock $fh, LOCK_UN;
 }
 
-1;
+sub find_path_for {
+  my ($proto) = @_;
+  my $path = file(Promulger::Config->config->{list_home}, $proto . ".list");
+}
+
+'http://mitpress.mit.edu/sicp/';