From: Chris Nehren Date: Sun, 4 Sep 2011 05:30:33 +0000 (-0400) Subject: bring Moo to the Dispatcher for more flexibility and easier testing X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9e4ca6377faec49b4bd806f6fccdb907e279f8e9;p=p5sagit%2FPromulger.git bring Moo to the Dispatcher for more flexibility and easier testing --- diff --git a/lib/App/Promulger/Command/msg.pm b/lib/App/Promulger/Command/msg.pm index 968a71b..28a2131 100644 --- a/lib/App/Promulger/Command/msg.pm +++ b/lib/App/Promulger/Command/msg.pm @@ -16,7 +16,7 @@ sub run { local $/; }; - Promulger::Dispatch::dispatch($message); + Promulger::Dispatch->new->dispatch($message); } 'Engage'; diff --git a/lib/Promulger/Dispatch.pm b/lib/Promulger/Dispatch.pm index 991798f..2892cff 100644 --- a/lib/Promulger/Dispatch.pm +++ b/lib/Promulger/Dispatch.pm @@ -1,73 +1,77 @@ package Promulger::Dispatch; -use strict; -use warnings; +use Moo; +use Method::Signatures::Simple; +use autodie ':all'; use Email::Address; use Email::MIME; -# XXX allow the user to specify their own Email::Sender::Transport -- apeiron, -# 2010-03-13 -use Email::Sender::Simple qw(sendmail); +use Email::Sender::Simple (); # XXX not yet -- apeiron, 2010-06-25 #use Mail::Verp; use Promulger::Config; +has transport => ( + is => 'rw', + isa => sub { + my $proto = $_[0]; + blessed $proto and + $proto->can('does') and + $proto->does('Email::Sender::Transport') + or die "transport must do Email::Sender::Transport role"; + }, + default => sub { + Email::Sender::Transport::Sendmail->new + }, +); + # XXX no bounce parsing yet -- apeiron, 2010-03-13 -sub dispatch { - my ($message) = @_; +method dispatch ($message) { my $config = Promulger::Config->config; my $email = Email::MIME->new($message); my $recipient = $email->header('To'); - my $local_user = user_for_address($recipient); + my $local_user = $self->user_for_address($recipient); my $sender = $email->header('From'); my $subject = $email->header('Subject'); my $list = Promulger::List->resolve($local_user); unless($list) { - reject($recipient, $sender); + $self->reject($recipient, $sender); return; } if($local_user =~ /-request$/) { - handle_request($list, $sender, $local_user, $subject, $config); + $self->handle_request($list, $sender, $local_user, $subject, $config); return; } # they don't have a request for us, so they want to post a message - post_message($list, $email, $config); + $self->post_message($list, $email, $config); return; } -sub handle_request { - my ($list, $sender, $recipient, $subject) = @_; - - my $sender_address = bare_address($sender); +method handle_request ($list, $sender, $recipient, $subject) { + my $sender_address = $self->bare_address($sender); if($subject =~ /^\s*subscribe/i) { - print "going to subscribe $sender to " . $list->listname . "\n"; $list->subscribe($sender_address) - or already_subscribed($list, $recipient, $sender_address); + or $self->already_subscribed($list, $recipient, $sender_address); } elsif($subject =~ /^\s*unsubscribe/i) { $list->unsubscribe($sender_address) - or not_subscribed($list, $recipient, $sender_address); + or $self->not_subscribed($list, $recipient, $sender_address); } } -sub post_message { - my ($list, $email, $config) = @_; - +method post_message ($list, $email, $config) { my $sender = $email->header('From'); - my $sender_address = bare_address($sender); + my $sender_address = $self->bare_address($sender); my $recipient = $email->header('To'); unless($list->accept_posts_from($sender_address) && $list->active) { - reject($recipient, $sender); + $self->reject($recipient, $sender); return; } - # 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_str; for my $subscriber (keys %{$list->subscribers}) { @@ -86,12 +90,11 @@ sub post_message { ); # XXX no queuing or job distribution for now beyond what the MTA provides # -- apeiron, 2010-03-13 - send_message($new_message); + $self->send_message($new_message); } } -sub send_message { - my ($message) = @_; +method send_message ($message) { my $config = Promulger::Config->config; my ($class, $transport); if($class = $config->{mailer}) { @@ -103,17 +106,16 @@ sub send_message { } Class::MOP::load_class($class); $transport = $class->new; - sendmail( + Email::Sender::Simple::sendmail( $message, { - transport => $transport, + transport => $self->transport, } ); } # XXX make this actually not suck -- apeiron, 2010-03-13 -sub reject { - my ($recipient, $sender) = @_; +method reject ($recipient, $sender) { my $email = Email::MIME->create( header => [ From => $recipient, @@ -124,11 +126,10 @@ sub reject { Sorry, your message to $recipient has been denied. BODY ); - send_message($email); + $self->send_message($email); } -sub not_subscribed { - my ($list, $recipient, $sender) = @_; +method not_subscribed ($list, $recipient, $sender) { my $email = Email::MIME->create( # XXX need admin address header => [ @@ -140,11 +141,10 @@ sub not_subscribed { Sorry, you are not subscribed to $list. BODY ); - send_message($email); + $self->send_message($email); } -sub already_subscribed { - my ($list, $recipient, $sender) = @_; +method already_subscribed ($list, $recipient, $sender) { my $email = Email::MIME->create( header => [ From => $recipient, @@ -155,17 +155,15 @@ sub already_subscribed { Sorry, you are already subscribed to $list. BODY ); - send_message($email); + $self->send_message($email); } -sub bare_address { - my ($full_addr) = @_; +method bare_address ($full_addr) { my ($addr_obj) = Email::Address->parse($full_addr); return $addr_obj->address; } -sub user_for_address { - my ($full_addr) = @_; +method user_for_address ($full_addr) { my ($addr_obj) = Email::Address->parse($full_addr); return $addr_obj->user; }