ba04393c17ac25c3c566b87cd5855f007a9b2394
[p5sagit/Promulger.git] / 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/';