lib/Promulger/Dispatch.pm

   1 package Promulger::Dispatch;
   2 use strict;
   3 use warnings;
   4
   5 use Email::Simple;
   6 # XXX allow the user to specify their own Email::Sender::Transport -- apeiron,
   7 # 2010-03-13
   8 use Email::Sender::Simple qw(sendmail);
   9 use Mail::Verp;
  10
  11 sub dispatch {
  12   my($message, $config) = @_;
  13
  14   my $email = Email::Simple->new($message);
  15   my $recipient = $email->header('To');
  16   my $sender = $email->header('From');
  17   my $subject = $email->header('Subject');
  18
  19   my $list = Promulger::List->resolve($recipient);
  20   unless($list) {
  21     reject($recipient, $sender);
  22   }
  23
  24   if($recipient =~ /-request$/) {
  25     handle_request($list, $sender, $recipient, $subject, $config);
  26   }
  27
  28   # they don't have a request for us, so they want to post a message
  29   post_message($list, $email, $config);
  30 }
  31
  32 sub handle_request {
  33   my ($list, $sender, $recipient, $subject, $config) = @_;
  34
  35   if($subject =~ /^subscribe/i) {
  36     $list->subscribe($sender, $config)
  37       or already_subscribed($list, $sender, $config);
  38   } elsif($subject =~ /^unsubscribe/i) {
  39     $list->unsubscribe($sender, $config)
  40       or not_subscribed($list, $sender, $config);
  41   }
  42 }
  43
  44 sub post_message {
  45   my($list, $email, $config) = @_;
  46
  47   my $sender = $email->header('From');
  48   my $recipient = $email->header('To');
  49
  50   reject($recipient, $sender) unless $list->accept_posts_from($sender);
  51   reject($recipient, $sender) unless $list->active;
  52
  53   # they're allowed to post (subscribed or not), the list is active. let's do
  54   # this thing.
  55
  56   # XXX no MIME or other fancy handling for now -- apeiron, 2010-03-13
  57   my $body = $email->body;
  58   for my $subscriber ($list->subscribers) {
  59     my $verped_from = Mail::Verp->encode($list->address, $subscriber);
  60     # XXX we let the MTA create the message-id for us for now -- apeiron,
  61     # 2010-03-13
  62     my $new_message = Email::Simple->create(
  63       header => [
  64         From => $verped_from,
  65         To   => $subscriber,
  66         Subject => $email->subject,
  67       ],
  68       body => $body,
  69     );
  70     # XXX no queuing or job distribution for now beyond what the MTA provides
  71     # -- apeiron, 2010-03-13
  72     sendmail($new_message);
  73   }
  74 }
  75
  76 sub reject {}
  77 sub not_subscribed {}
  78 sub already_subscribed {}
  79
  80 'http://www.shadowcat.co.uk/blog/matt-s-trout/oh-subdispatch-oh-subdispatch/';