Transports may optionally be enabled or disabled on a per-user basis

Message.pm

@@ -118,16 +118,16 @@ sub load_transport_module {
         return $self -> self_error("Incorrect arguments to load_transport_module: id or name not provided");
     }
 
-    my $modh = $self -> {"dbh"} -> prepare("SELECT perl_module
+    my $modh = $self -> {"dbh"} -> prepare("SELECT id, perl_module
                                             FROM `".$self -> {"settings"} -> {"database"} -> {"message_transports"}."`
                                             WHERE $field = ?");
     $modh -> execute($args -> {$field})
         or return $self -> self_error("Unable to execute transport module lookup: ".$self -> {"dbh"} -> errstr);
 
-    my $modname = $modh -> fetchrow_arrayref()
+    my $transport = $modh -> fetchrow_hashref()
         or return $self -> self_error("Unable to fetch module name for transport module: entry does not exist");
 
-    return $self -> {"module"} -> load_module($modname -> [0]);
+    return $self -> {"module"} -> load_module($transport -> {"perl_module"}, {"transport_id" => $transport -> {"id"}});
 }
 
 

Message/Queue.pm

@@ -311,6 +311,8 @@ sub get_sendable_messages {
     my $transportid    = shift;
     my $include_failed = shift;
 
+    my $transport
+
     # Sendable messages are messsages that have a send_after field value less than the current
     # time, and a status of "pending" (or "failed") for the specified transport....
     my $sendh = $self -> {"dbh"} -> prepare("SELECT m.id

Message/Transport.pm

@@ -41,4 +41,47 @@ sub deliver {
     return $self -> self_error("Attempt to send message '".$message -> {"id"}."' through transport ".ref($self)." with no deliver() mechanism.");
 }
 
+
+## @method $ allow_disable()
+# If this transport can be disabled for users, this returns true. Otherwise it
+# will return false - the default is false, and subclasses must override this
+# function if they want to allow users to disable delivery.
+#
+# @return true if the transport supports being disabled per-user, false otherwise.
+sub allow_disable {
+    my $self = shift;
+
+    return 0;
+}
+
+
+## @method $ use_transport($userid)
+# Determine whether the user wants to use the current transport. By default, all
+# transports are set to be used for all users.
+#
+# @param userid The ID of the user to check.
+# @return true if the user wants to receive messages through this transport, false
+#         if they don't, undef on error.
+sub use_transport {
+    my $self   = shift;
+    my $userid = shift;
+
+    # If there is no transport user control table, all transports work
+    return 1 unless($self -> {"settings"} -> {"database"} -> {"message_userctrl"});
+
+    my $enableh = $self -> {"dbh"} -> prepare("SELECT enabled
+                                               FROM `".$self -> {"settings"} -> {"database"} -> {"message_userctrl"}."`
+                                               WHERE transport_id = ?
+                                               AND user_id = ?");
+    $enableh -> execute($self -> {"trasport_id"}, $userid)
+        or return $self -> self_error("Unable to execute user transport control lookup: ".$self -> {"dbh"} -> errstr);
+
+    # If there's no entry for this user for this transport, assume the user should get messages
+    my $enabled = $enableh -> fetchrow_arrayref()
+        or return 1;
+
+    return $enabled -> [0];
+}
+
+
 1;

Message/Transport/Email.pm

@@ -86,6 +86,21 @@ sub DESTROY {
 # ============================================================================
 #  Delivery
 
+## @method $ allow_disable()
+# If this transport can be disabled for users, this returns true. Otherwise it
+# will return false - the default is false, and subclasses must override this
+# function if they want to allow users to disable delivery.
+#
+# @return true if the transport supports being disabled per-user, false otherwise.
+sub allow_disable {
+    my $self = shift;
+
+    # If there is no transport usercontrol table, disabling can't be supported
+    return 0 unless($self -> {"settings"} -> {"database"} -> {"message_userctrl"});
+    return 1;
+}
+
+
 ## @method $ deliver($message)
 # Attempt to deliver the specified message to its recipients.
 #
@@ -111,12 +126,16 @@ sub deliver {
 
     # And the recipients
     foreach my $recipient (@{$message -> {"recipients"}}) {
+        # Skip users who shouldn't get emails
+        next unless($self -> use_transport($recipient -> {"recipient_id"}));
+
         my $recip = $self -> _get_user_email($recipient -> {"recipient_id"})
             or return undef;
 
         $to .= "," if($to);
         $to .= $recip;
     }
+    return 1 if(!$to); # Nothing to do if there are no recipients.
 
     my $email = Email::MIME -> create(header_str => [ From => $from,
                                                       To   => $to,
@@ -168,7 +187,8 @@ sub _build_smtp_args {
 # to obtain the address.
 #
 # @param userid The ID of the user to fetch the email address for.
-# @return The user's email address on success, undef on error.
+# @return The user's email address or the empty string if the user has opted not to be notified
+#         via their email, undef on error.
 sub _get_user_email {
     my $self   = shift;
     my $userid = shift;