diff --git a/Message.pm b/Message.pm
index b31b717..f50887a 100644
--- a/Message.pm
+++ b/Message.pm
@@ -126,4 +126,5 @@ sub load_transport_module {
return $self -> {"module"} -> load_module($modname -> [0]);
}
+
1;
diff --git a/Message/Queue.pm b/Message/Queue.pm
index d2dcb75..73a6c68 100644
--- a/Message/Queue.pm
+++ b/Message/Queue.pm
@@ -337,6 +337,47 @@ sub get_sendable_messages {
}
+# ============================================================================
+# Delivery
+
+## @method $ deliver_queue($try_failed)
+# Attempt to deliver queued messages that have not yet been sent. This will invoke
+# the transport modules in turn, fetching sendable messages and trying to send them
+#
+# @param try_failed If this is set to true, transport modules will try to resend
+# messages that previously failed to send.
+sub deliver_queue {
+ my $self = shift;
+ my $try_failed = shift;
+
+ # Go through the list of transports, fetching the messages that can be sent by
+ # that transport and try to send them.
+ my $transports = $self -> get_transports();
+ foreach my $transport (@{$transports}) {
+ my $messages = $self -> get_sendable_messages($transport -> {"id"}, $try_failed)
+ or return undef;
+
+ if(scalar(@{$messages})) {
+ # Load the transport...
+ $transport -> {"module"} = $self -> load_transport_module($transport -> {"id"})
+ or return $self -> self_error("Transport loading failed: ".$transport -> {"module"} -> {"errstr"});
+
+ # Try to deliver each sendable message
+ foreach my $message (@{$messages}) {
+ my $sent = $transport -> {"module"} -> deliver($message);
+
+ # Store the send status for this transport
+ $self -> update_status($message -> {"id"},
+ $transport -> {"id"},
+ $sent ? "sent" : "failed",
+ $sent ? undef : $transport -> {"errstr"})
+ or return undef;
+ }
+ }
+ }
+}
+
+
# ============================================================================
# Marking of various sorts
diff --git a/Message/Transport.pm b/Message/Transport.pm
new file mode 100644
index 0000000..b6101a3
--- /dev/null
+++ b/Message/Transport.pm
@@ -0,0 +1,44 @@
+## @file
+# This file contains the implementation of the base Message Transport class.
+#
+# @author Chris Page <chris@starforge.co.uk>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+
+## @class Message::Transport
+# This is the 'base' class for the Message::Transport modules. It provides
+# any functionality that needs to be shared between the Message::Transport::*
+# modules.
+package Message::Transport;
+use strict;
+use base qw(Message);
+
+# ============================================================================
+# Delivery
+
+## @method $ deliver($message)
+# Attempt to deliver the specified message to its recipients. This function
+# does not actually do anything in the Message::Transport class - it must
+# be overridden in subclasses to actually perform message delivery.
+#
+# @param message A reference to hash containing the message data.
+# @return true if the message is sent successfully, undef if not.
+sub deliver {
+ my $self = shift;
+ my $message = shift;
+
+ return $self -> self_error("Attempt to send message '".$message -> {"id"}."' through transport ".ref($self)." with no deliver() mechanism.");
+}
+
+1;
diff --git a/Message/Transport/Email.pm b/Message/Transport/Email.pm
new file mode 100644
index 0000000..a583b60
--- /dev/null
+++ b/Message/Transport/Email.pm
@@ -0,0 +1,177 @@
+## @file
+# This file contains the implementation of the EMail Message Transport class.
+#
+# @author Chris Page <chris@starforge.co.uk>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+
+## @class Message::Transport::Email
+# This class implements the email transport system; lasciate ogne speranza, voi ch'intrate.
+#
+package Message::Transport::Email;
+use strict;
+use base qw(Message);
+use Encode;
+use Email::MIME;
+use Email::Sender::Simple qw(sendmail);
+use Email::Sender::Transport::SMTP;
+use Email::Sender::Transport::SMTP::Persistent;
+use Try::Tiny;
+
+# ============================================================================
+# Constructor
+
+## @cmethod Message::Transport::Email new(%args)
+# Create a new Message::Transport::Email object. This will create an object
+# that may be used to send messages to recipients over SMTP.
+#
+# @param args A hash of arguments to initialise the Message::Transport::Email
+# object with.
+# @return A new Message::Transport::Email object.
+sub new {
+ my $invocant = shift;
+ my $class = ref($invocant) || $invocant;
+ my $self = $class -> SUPER::new(@_)
+ or return undef;
+
+ # Make local copies of the config for readability
+ # Arguments for Email::Sender::Transport::SMTP(::Persistent)
+ $self -> {"host"} = $self -> {"settings"} -> {"config"} -> {"Message::Transport::Email::smtp_host"};
+ $self -> {"port"} = $self -> {"settings"} -> {"config"} -> {"Message::Transport::Email::smtp_port"};
+ $self -> {"ssl"} = $self -> {"settings"} -> {"config"} -> {"Message::Transport::Email::smtp_secure"};
+ $self -> {"username"} = $self -> {"settings"} -> {"config"} -> {"Message::Transport::Email::username"};
+ $self -> {"password"} = $self -> {"settings"} -> {"config"} -> {"Message::Transport::Email::password"};
+
+ # Should persistent SMTP be used?
+ $self -> {"persist"} = $self -> {"settings"} -> {"config"} -> {"Message::Transport::Email::persist"};
+
+ # Should the sender be forced (ie: always use the system-specified sender, even if the message has
+ # an explicit sender. This should be the address to set as the sender.
+ $self -> {"force_sender"} = $self -> {"settings"} -> {"config"} -> {"Message::Transport::Email::force_sender"};
+
+ # The address to use as the envelope sender.
+ $self -> {"env_sender"} = $self -> {"settings"} -> {"config"} -> {"Core:envelope_address"};
+
+ # set up persistent STMP if needed
+ if($self -> {"persist"}) {
+ eval { $self -> {"smtp"} = Email::Sender::Transport::SMTP::Persistent -> new(host => $self -> {"host"},
+ port => $self -> {"port"},
+ ssl => $self -> {"ssl"},
+ sasl_username => $self -> {"username"},
+ sasl_password => $self -> {"password"});
+ };
+ return SystemModule::set_error("SMTP Initialisation failed: $@") if($@);
+ }
+
+ return $self;
+}
+
+
+## @method void DESTROY()
+# Destructor method to clean up persistent SMTP if it is in use.
+sub DESTROY {
+ my $self = shift;
+
+ $self -> {"smtp"} -> disconnect()
+ if($self -> {"persist"} && $self -> {"smtp"});
+}
+
+
+# ============================================================================
+# Delivery
+
+## @method $ deliver($message)
+# Attempt to deliver the specified message to its recipients.
+#
+# @param message A reference to hash containing the message data.
+# @return True on success, undef on failure/error.
+sub deliver {
+ my $self = shift;
+ my $message = shift;
+
+ if(!$self -> {"persist"}) {
+ eval { $self -> {"smtp"} = Email::Sender::Transport::SMTP -> new(host => $self -> {"host"},
+ port => $self -> {"port"},
+ ssl => $self -> {"ssl"},
+ sasl_username => $self -> {"username"},
+ sasl_password => $self -> {"password"});
+ };
+ return $self -> self_error("SMTP Initialisation failed: $@") if($@);
+ }
+
+ my ($from, $to) = ($self -> {"env_sender"}, "");
+
+ # Work out the the sender if needed...
+ if(!$self -> {"force_sender"} && $message -> {"sender"}) {
+ $from = $self -> _get_user_email($message -> {"sender"} -> {"sender_id"})
+ or return undef;
+ }
+
+ # And the recipients
+ foreach my $recipient (@{$message -> {"recipients"}}) {
+ my $recip = $self -> _get_user_email($recipient -> {"recipient_id"})
+ or return undef;
+
+ $to .= "," if($to);
+ $to .= $recip;
+ }
+
+ my $email = Email::MIME -> create(header_str => [ From => $from,
+ To => $to,
+ Subject => $message -> {"subject"}
+ ],
+ body_str => Encode::encode_utf8($message -> {"body"}),
+ attributes => { charset => 'utf8',
+ content_type => "text/plain",
+ encoding => 'base64' });
+
+ try {
+ sendmail($email, { from => $self -> {"env_sender"},
+ transport => $self -> {"smtp"}});
+ } catch {
+ return $self -> self_error("Delivery of message ".$message -> {"id"}." failed: $_");
+ };
+
+ return 1;
+}
+
+
+# ============================================================================
+# Support code
+
+## @method private $ _get_user_email($userid)
+# Obtain the email address set for the specified user. This class may be called outside
+# the normal application environment, so it might not have access to the AppUser or Session
+# classes - but it still needs email addresses! This looks directly into the user table
+# 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.
+sub _get_user_email {
+ my $self = shift;
+ my $userid = shift;
+
+ my $userh = $self -> {"dbh"} -> prepare("SELECT email
+ FROM ".$self -> {"settings"} -> {"database"} -> {"users"}."
+ WHERE user_id = ?");
+ $userh -> execute($userid)
+ or return $self -> self_error("Unable to perform user email lookup: ". $self -> {"dbh"} -> errstr);
+
+ my $user = $userh -> fetchrow_arrayref()
+ or return $self -> self_error("User email lookup failed: user $userid does not exist");
+
+ return $user -> [0];
+}
+
+1;
diff --git a/Message/Transport/Local.pm b/Message/Transport/Local.pm
new file mode 100644
index 0000000..6b68a71
--- /dev/null
+++ b/Message/Transport/Local.pm
@@ -0,0 +1,44 @@
+## @file
+# This file contains the implementation of the Local Message Transport class.
+#
+# @author Chris Page <chris@starforge.co.uk>
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see .
+
+## @class Message::Transport::Local
+# This class implements the local delivery transport. Local delivery actually involves
+# no work whatsoever - any messages that are queued for local deliver can always be
+# delivered.
+package Message::Transport::Local;
+use strict;
+use base qw(Message);
+
+# ============================================================================
+# Delivery
+
+## @method $ deliver($message)
+# Attempt to deliver the specified message to its recipients. This function
+# is always successful - it is impossible for local delivery to fail, as the
+# message is already there!
+#
+# @param message A reference to hash containing the message data.
+# @return Always returns true.
+sub deliver {
+ my $self = shift;
+ my $message = shift;
+
+ return 1;
+}
+
+1;