Refactoring postfix transport script to allow pluggable commands.

lib/WebGUI/MailCommand.pm

@@ -0,0 +1,53 @@
+package WebGUI::MailCommand;
+
+use strict;
+use warnings;
+
+sub isValidCommand {
+    my $command = shift;
+
+    return defined resolveCommandClass( $command );
+}
+
+sub new {
+    my $class = shift;
+    my $session = shift || die "Need a session";
+
+    bless { _session => $session }, $class;
+}
+
+sub process {
+    WebGUI::Error::OverrideMe->throw;
+}
+
+sub processCommand {
+    my $session     = shift;
+    my $command     = shift;
+    my $parameter   = shift;
+
+    my $commandClass = resolveCommandClass( $command )
+        || return;
+
+    my $commandObject = WebGUI::Pluggable::instanciate( $commandClass, 'new', [ $session ] );
+
+    return $commandObject->process( $parameter );
+}
+
+sub session {
+    return (shift)->{ _session };
+}
+
+sub resolveCommandClass {
+    my $command = shift;
+
+    # TODO: Do not hard code.
+    my %commands = (
+        bounce  => 'WebGUI::MailCommand::Bounce',
+    );
+
+    return $commands{ $command } if exists $commands{ $command };
+    return;
+}
+
+1;
+

lib/WebGUI/MailCommand/Bounce.pm

@@ -0,0 +1,40 @@
+package WebGUI::MailCommand::Bounce;
+
+use strict;
+use warnings;
+
+use WebGUI::Mailing::Email;
+use Mail::DeliveryStatus::BounceParser;
+
+use base 'WebGUI::MailCommand';
+
+#-----------------------------------------------------------------------------
+sub process {
+    my $self    = shift;
+    my $hexId   = shift;
+    my $session = $self->session;
+    my $log     = $session->log;
+    my $id      = $session->id->fromHex( $hexId );
+
+    my $email   = WebGUI::Mailing::Email->new( $session, $id );
+    
+    if ($email) {
+        my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN );
+        
+        my $report  = ( $dsr->reports )[0];
+        my $reason  = $report->get( 'std_reason' );
+        my $message = $report->get( 'reason'     );
+        $message    =~ s{\s+}{ }g; 
+
+        $log->warn( "Registering email [$id] as bounced." );
+        $email->registerBounced( $reason, $message );
+    }
+    else {
+        $log->error( "Cannot process bounced email [$id] because it cannot be located in the db." );
+    }
+
+    return;
+}
+
+1;
+

lib/WebGUI/MailCommand/Subscribe.pm

@@ -0,0 +1,27 @@
+package WebGUI::MailCommand::Subscribe;
+
+use strict;
+use warnings;
+
+use WebGUI::AssetAspect::Subscriber;
+
+use base 'WebGUI::MailCommand';
+
+#-----------------------------------------------------------------------------
+sub process {
+    my $self    = shift;
+    my $listName= shift;
+    my $session = $self->session;
+    my $log     = $session->log;
+
+    my $asset = WebGUI::AssetAspect::Subscriber::findAssetByListName( $session, $listName );
+
+    die "Invalid list name [$listName]" unless $asset;
+
+    $asset->subscribeThroughEmail( $fromAddress );
+
+    return;
+}
+
+1;
+

sbin/newsletter-transport.pl

@@ -8,53 +8,82 @@ BEGIN {
 }
 
 use strict;
+use warnings;
 
-use Mail::DeliveryStatus::BounceParser;
+#use Mail::DeliveryStatus::BounceParser;
-use WebGUI::Mailing::Email;
+#use WebGUI::Mailing::Email;
+use WebGUI::MailCommand;
 use List::MoreUtils qw{ any };
+use WebGUI::Config;
+use Getopt::Long;
+
+use 5.010;
 
 my $NO_SUCH_USER    = 67;
 my $webguiRoot      = '/data/WebGUI';
-my %configs         = (
-    'lom.lom.st.unitedknowledge.org'   => 'www.lomcongres.nl.conf',
-);
-
 
 #---------------------------------------------------------------
-my ( $domain, $user )       = @ARGV;
+# Startup
-my ( $mailId, $command )    = $user =~ m{^(.+)-([^-]+)$}i;
+{
+    my ( $configFile, $command, $id ) = getCredentials();
 
-my $configFile      = $configs{ $domain };
+    if ( WebGUI::MailCommand::isValidCommand( $command ) ) {
-my $validCommand    = any { $command eq $_ } qw{ subscribe unsubscribe bounce confirm };
+        my $session = openSession( $webguiRoot, $configFile );
-
-unless ( $configFile && $validCommand ) {
-#    system "/usr/sbin/sendmail -G -i $user\@$domain";
-    exit(0);
-}
-else {
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->log->warn( 'valid bounce address' );
-    my $email   = WebGUI::Mailing::Email->new( $session, $session->id->fromHex( $mailId ) );
-    
-    if ($email) {
-        $session->log->warn( 'found email' );
-        my $dsr = Mail::DeliveryStatus::BounceParser->new( \*STDIN );
         
-        my $report  = ( $dsr->reports )[0];
+        WebGUI::MailCommand::processCommand( $session, $command, $id );
-        my $reason  = $report->get( 'std_reason' );
+    
-        my $message = $report->get( 'reason'     );
+        closeSession( $session );
-        $message    =~ s{\s+}{ }g; 
-
-        $session->log->warn( 'about to register as bounced' );
-        $email->registerBounced( $reason, $message );
     }
     else {
-        $session->log->error( "Cannot process bounced email because it cannot be located in the db [$mailId]" );
+        # TODO: log something
     }
 
+    exit(0);
+}
+
+#-----------------------------------------------------------------------------
+sub getCredentials {
+    my ( $domain, $user );
+
+    GetOptions(
+        'domain=s'  => \$domain,
+        'user=s'    => \$user,
+    );
+    die "--domain parameter is required" unless $domain;
+    die "--user paramere is required" unless $user;
+
+    my $dispatch = WebGUI::Config->new( $webguiRoot, 'mailing_dispatch.config' )
+        || die "Cannot open $webguiRoot/etc/mailing_dispatch.config";
+
+    my $configFile = $dispatch->get( $domain )
+        || die "Received mail for domain [$domain] which is not configured!";
+
+    # Format is mailId-command
+    my ( $id, $command ) = $user =~ m{ ^ (.+) - ([^-]+) $ }ix;
+
+    die "Received mail addressed to [$user\@$domain] which contains no id"      unless $id;
+    die "Received mail addressed to [$user\@$domain] which contains no command" unless $command;
+
+    return ( $configFile, $command, $id );
+}
+
+#-----------------------------------------------------------------------------
+sub openSession {
+    my $webguiRoot  = shift;
+    my $configFile  = shift;
+
+    # Require WebGUI:Session rather than use it to save compilation of it when invalid commands are passed.
+    require WebGUI::Session;
+
+    my $session = WebGUI::Session->open( $webguiRoot, $configFile );
+
+    return $session;
+}
+
+#-----------------------------------------------------------------------------
+sub closeSession {
+    my $session = shift;
+
     $session->close;
-    exit (0);
+}
-}    
-
-exit $NO_SUCH_USER unless any { $command eq $_ } qw{ subscribe unsubscribe bounces confirm };