From: Chris Nehren <apeiron@cpan.org>
Date: Sun, 14 Mar 2010 00:27:22 +0000 (-0500)
Subject: lots of refactoring
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f5baca2942c4be01fa044148d361268b505d6754;p=p5sagit%2FPromulger.git

lots of refactoring
---

diff --git a/bin/pmg b/bin/pmg
index f06884f..c340348 100755
--- a/bin/pmg
+++ b/bin/pmg
@@ -1,8 +1,4 @@
 #!/usr/bin/perl
-
-eval 'exec /usr/local/bin/perl -w -S $0 ${1+"$@"}'
-    if 0; # not running under some shell
-
 use strict;
 use warnings;
 
diff --git a/lib/App/Promulger/Command.pm b/lib/App/Promulger/Command.pm
new file mode 100644
index 0000000..a46961a
--- /dev/null
+++ b/lib/App/Promulger/Command.pm
@@ -0,0 +1,6 @@
+package App::Promulger::Command;
+use strict;
+use warnings;
+
+
+1;
diff --git a/lib/App/Promulger/Command/msg.pm b/lib/App/Promulger/Command/msg.pm
new file mode 100644
index 0000000..f946e63
--- /dev/null
+++ b/lib/App/Promulger/Command/msg.pm
@@ -0,0 +1,22 @@
+package App::Promulger::Command::msg;
+use strict;
+use warnings;
+
+use App::Promulger -command;
+use parent 'App::Promulger::Command';
+use Promulger::Dispatch;
+
+sub abstract {
+  return "interacts with a list";
+}
+
+sub run {
+  my ($self, $opt, $args) = @_;
+  my $message = do {
+    local $/;
+    <STDIN>
+  };
+  Promulger::Dispatch::dispatch($message, $self->{config});
+}
+
+1;
diff --git a/lib/App/Promulger/Command/newlist.pm b/lib/App/Promulger/Command/newlist.pm
index aa4393a..3ca908c 100644
--- a/lib/App/Promulger/Command/newlist.pm
+++ b/lib/App/Promulger/Command/newlist.pm
@@ -3,9 +3,7 @@ use strict;
 use warnings;
 
 use App::Promulger -command;
-use Promulger::Schema;
 use Promulger::List;
-
 use Config::General;
 
 sub abstract {
@@ -33,17 +31,17 @@ sub validate_args {
   }
 
   $self->{config} = { Config::General->new($cf)->getall };
-  @$args == 1 or die "pmg newlist needs a list name\n";
+  $self->{config}{config_file} = $cf;
 }
 
+
 sub run {
   my ($self, $opt, $args) = @_;
-  Promulger::Schema->connect($self->{config}{store});
+  @$args == 1 or die "pmg newlist needs a list name\n";
   my $list = Promulger::List->new(
     listname  => $args->[0],
   );
-  $list->setup_aliases_at($self->{config});
-  Promulger::Schema->store($list);
+  $list->setup($self->{config});
 }
 
 1;
diff --git a/lib/Promulger/Dispatch.pm b/lib/Promulger/Dispatch.pm
new file mode 100644
index 0000000..ba04393
--- /dev/null
+++ b/lib/Promulger/Dispatch.pm
@@ -0,0 +1,80 @@
+package Promulger::Dispatch;
+use strict;
+use warnings;
+
+use Email::Simple;
+# XXX allow the user to specify their own Email::Sender::Transport -- apeiron,
+# 2010-03-13 
+use Email::Sender::Simple qw(sendmail);
+use Mail::Verp;
+
+sub dispatch {
+  my($message, $config) = @_;
+
+  my $email = Email::Simple->new($message);
+  my $recipient = $email->header('To');
+  my $sender = $email->header('From');
+  my $subject = $email->header('Subject');
+
+  my $list = Promulger::List->resolve($recipient);
+  unless($list) {
+    reject($recipient, $sender);
+  }
+
+  if($recipient =~ /-request$/) {
+    handle_request($list, $sender, $recipient, $subject, $config);
+  }
+
+  # they don't have a request for us, so they want to post a message
+  post_message($list, $email, $config);
+}
+
+sub handle_request {
+  my ($list, $sender, $recipient, $subject, $config) = @_;
+
+  if($subject =~ /^subscribe/i) {
+    $list->subscribe($sender, $config) 
+      or already_subscribed($list, $sender, $config);
+  } elsif($subject =~ /^unsubscribe/i) {
+    $list->unsubscribe($sender, $config) 
+      or not_subscribed($list, $sender, $config);
+  }
+}
+
+sub post_message {
+  my($list, $email, $config) = @_;
+
+  my $sender = $email->header('From');
+  my $recipient = $email->header('To');
+
+  reject($recipient, $sender) unless $list->accept_posts_from($sender);
+  reject($recipient, $sender) unless $list->active;
+
+  # they're allowed to post (subscribed or not), the list is active. let's do
+  # this thing.
+
+  # XXX no MIME or other fancy handling for now -- apeiron, 2010-03-13 
+  my $body = $email->body;
+  for my $subscriber ($list->subscribers) {
+    my $verped_from = Mail::Verp->encode($list->address, $subscriber);
+    # XXX we let the MTA create the message-id for us for now -- apeiron,
+    # 2010-03-13 
+    my $new_message = Email::Simple->create(
+      header => [
+        From => $verped_from,
+        To   => $subscriber,
+        Subject => $email->subject,
+      ],
+      body => $body,
+    );
+    # XXX no queuing or job distribution for now beyond what the MTA provides
+    # -- apeiron, 2010-03-13 
+    sendmail($new_message);
+  }
+}
+
+sub reject {}
+sub not_subscribed {}
+sub already_subscribed {}
+
+'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 401b619..c595525 100644
--- a/lib/Promulger/List.pm
+++ b/lib/Promulger/List.pm
@@ -1,9 +1,11 @@
 package Promulger::List;
 use Moose;
+use MooseX::Storage;
 
+use autodie ':all';
 use Carp;
-use Dir::Self;
-use File::Slurp qw/read_file write_file/;
+use Path::Class;
+use Fcntl ':flock';
 
 has listname => (
   is       => 'ro',
@@ -18,18 +20,42 @@ has active => (
   default  => 1,
 );
 
-sub setup_aliases_at {
+with Storage (
+  format => 'JSON',
+  io     => 'File',
+);
+
+sub resolve {}
+
+sub subscribe {}
+
+sub unsubscribe {}
+
+sub accept_posts_from {}
+
+sub setup {
   my($self, $config) = @_;
   my $name = $self->listname;
-  my @current_contents = read_file $config->{aliases};
+  my $path = file($config->{list_home}, $name . ".list");
+  eval {
+    __PACKAGE__->load($path->stringify);
+  };
+  croak "${name} already a known list" unless $@;
+
+  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) {
+    if(grep { /^${alias}:/ } @current_contents) {
       croak "${alias} already in $config->{aliases}";
     }
-    push @current_contents, qq(${alias}: "|$config->{bin_root}/pmg msg"\n);
+    push @current_contents, 
+      qq(${alias}: "|$config->{bin_root}/pmg msg -c $config->{config_file}"\n);
   }
-  write_file $config->{aliases}, @current_contents;
+  $self->store($path->stringify);
+  print $fh @current_contents;
+  flock $fh, LOCK_UN;
 }
 
 1;
diff --git a/lib/Promulger/Schema.pm b/lib/Promulger/Schema.pm
deleted file mode 100644
index cd68c17..0000000
--- a/lib/Promulger/Schema.pm
+++ /dev/null
@@ -1,24 +0,0 @@
-package Promulger::Schema;
-use strict;
-use warnings;
-
-use KiokuDB;
-
-my $kdb;
-my $scope;
-
-sub connect {
-  my($self, $dsn) = @_;
-  $kdb = KiokuDB->connect(
-    $dsn,
-    create => 1,
-  );
-  $scope = $kdb->new_scope;
-}
-
-sub store {
-  my($self, $obj) = @_;
-  $kdb->store($obj);
-}
-
-1;