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;
+