[prev] [thread] [next] [lurker] [Date index for 2004/04/06]
--V0207lvV8h4k8FAm
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
On Mon, Apr 05, 2004 at 07:29:26PM +0100, Richard Clamp said:
> Asides from those comments, I'd say it looks pretty much there.
And good points they were too
Second patch ahoy.
--V0207lvV8h4k8FAm
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="siesta-digest-2004-04-06.patch"
Index: Config.pm.in
===================================================================
--- Config.pm.in (revision 1496)
+++ Config.pm.in (working copy)
@@ -1,7 +1,7 @@
# $Id$
package Siesta::Config;
use strict;
-use vars qw( $CONFIG_FILE $ROOT $MESSAGES @STORAGE $ARCHIVE $LOG_PATH $LOG_LEVEL $config );
+use vars qw( $CONFIG_FILE $ROOT $MESSAGES @STORAGE $ARCHIVE $DIGESTS $LOG_PATH $LOG_LEVEL $config );
use AppConfig qw(:expand :argcount);
use base 'Exporter';
our @EXPORT_OK = qw( $config );
@@ -16,18 +16,18 @@
Where to install everything to. Currently this is set to
- @@ROOT@@
+ @@ROOT@@
=head2 C<$CONFIG_FILE>
Where the config file is currently
- @@ROOT@@/siesta.conf
+ @@ROOT@@/siesta.conf
This can be overridden when using the command line tools by
using
- -f <new config file>
+ -f <new config file>
=head3 CONFIG OPTIONS
@@ -52,6 +52,12 @@
By default - @@ROOT@@/archive/<list name>/
+=item digests
+
+Where we save our digest spools
+
+By default = @@ROOT@@/digests/
+
=item log_path
Where we log things
@@ -104,6 +110,7 @@
$config->get('storage_pass')),
$MESSAGES = $config->get('messages');
$ARCHIVE = $config->get('archive');
+ $DIGESTS = $config->get('digests');
$LOG_PATH = $config->get('log_path');
$LOG_LEVEL = $config->get('log_level');
}
@@ -128,6 +135,9 @@
archive => {
DEFAULT => '@@ROOT@@/archive',
},
+ digests => {
+ DEFAULT => '@@ROOT@@/digests',
+ }
log_path => {
DEFAULT => '@@ROOT@@/error',
},
Index: lib/Siesta/Plugin/Digest.pm
===================================================================
--- lib/Siesta/Plugin/Digest.pm (working copy)
+++ lib/Siesta/Plugin/Digest.pm (working copy)
@@ -0,0 +1,130 @@
+package Siesta::Plugin::Digest;
+use strict;
+use base 'Siesta::Plugin';
+__PACKAGE__->columns( TEMP => qw( send_this ));
+
+use Email::LocalDelivery;
+use Email::Folder;
+use MIME::Lite;
+use DateTime;
+
+
+sub description { "handle the digest collating and sending" }
+sub personal { 1 }
+
+
+# TODO do this on a time basis?
+
+sub process {
+ my $self = shift;
+ my $mail = shift;
+
+ my $path = $self->pref('path');
+
+ unless ($self->user) { # first pass
+ $self->add_to_digest( $mail );
+
+ my @messages = $self->get_digest();
+
+ if ($#messages > $self->pref('messages')) { # spool is big enough
+
+ $self->send_this($self->make_digest(@messages));
+
+ # we should probably lock this
+ die "Archive is not an mbox\n" unless (-f $path);
+ unlink($path) || die "Couldn't unlink '$path'\n";
+ }
+ return; # carry on
+ }
+
+ # okay, this user isn't interested in digests, continue with the
+ # regular mail
+ return unless $self->pref( 'digest' );
+
+ return 1 unless $self->send_this; # the digest isn't ready yet, stop.
+ $mail = $self->send_this;
+ return;
+}
+
+# get the digest messages
+sub get_digest {
+ my $self = shift;
+ my $count = 0;
+
+ my $path = $self->pref('path');
+ my $folder = Email::Folder->new($self->pref('path'))
+ || die "Couldn't open email folder '$path'\n";
+
+
+ return $folder->messages();
+}
+
+# make the digest as a set of message/rfc-822 chunks
+# (hidden surprise toy - people with suitable MUAs
+# can reply to just the message they meant and appear
+# in the right place in the thread).
+sub make_digest {
+ my $self = shift;
+ my @messages = @_;
+
+ my $subject = "Digest for ", $self->list->name , " ( ", DateTime->now->ymd , ")";
+
+
+ # create the mime message
+ my $msg = MIME::Lite->new(
+ From => $self->list->post_address,
+ To => $self->list->post_address,
+ Subject => $subject,
+ Type =>'multipart/mixed'
+ );
+
+
+ # attach a header
+ $msg->attach( Type => 'TEXT',
+ Data => Siesta->bake('digest', list => $self->list, messages => \@messages),
+ );
+
+
+ foreach my $message (@messages) {
+ $msg->attach(Type => 'message/rfc-822', Data => $message->as_string );
+ }
+
+ return $msg->as_string();
+}
+
+
+# spool to disk
+sub add_to_digest {
+ my ($self, $mail) = @_;
+
+ my $path = $self->pref('path');
+ Email::LocalDelivery->deliver( $mail->as_string, $path )
+ or die "storage of digets mail into '$path' failed";
+}
+
+
+# TODO some preferences should be marked personal
+# that way the interface is simplified
+sub options {
+ my $self = shift;
+ my $name = $self->list->name;
+ +{
+ path => {
+ description => "where to spool the digest",
+ type => "string",
+ default => "$Siesta::Config::DIGEST/$name/",
+ },
+ messages => {
+ description => "how many messages to spool before sending the digest",
+ type => "number",
+ default => "20",
+ },
+ digest => {
+ description => "whether the user would like to receive list mail as a digest",
+ type => "boolean",
+ default => 0,
+ },
+ };
+}
+
+
Index: messages/digest
===================================================================
--- messages/digest (working copy)
+++ messages/digest (working copy)
@@ -0,0 +1,26 @@
+Send [% list.name %] mailing list submissions to
+ [% list.post_address -%]
+
+[%# TODO
+To subscribe or unsubscribe via the World Wide Web, visit
+ WEBADDRESS
+or, via email, send a message with subject or body 'help' to
+ LISTHELP
+-%]
+
+You can reach the person managing the list at
+ [% list.owner %]
+
+When replying, please edit your Subject line so it is more specific
+than "Re: Contents of [% list.name %] digest..."
+
+
+Today's Topics:
+
+[%- SET count = 0 -%]
+[%- FOREACH message = messages +%]
+ [%- count = count + 1 -%]
+ [%- count %]. [%- message.header('subject') %] ([% message.header('from') %])
+
+[%- END -%]
+
Index: Build.PL
===================================================================
--- Build.PL (revision 1496)
+++ Build.PL (working copy)
@@ -13,6 +13,7 @@
'Class::DBI' => '0.93', # older versions don't do TEMP properly
'Class::DBI::BaseDSN' => 0,
'Class::DBI::SQLite' => 0,
+ 'DateTime' => 0,
'Digest::MD5' => 0,
'Email::Folder' => 0,
'Email::Simple' => '1.4',
@@ -20,6 +21,7 @@
'File::Find::Rule' => '0.20', # appearance of the relative flag
'Mail::Address' => 0,
'Mail::DeliveryStatus::BounceParser' => 0,
+ 'MIME::Lite' => 0,
# Module::Build 0.18 is the first release with
# working scripts shebang rewriting
'Module::Build' => '0.18',
--V0207lvV8h4k8FAm--
There's stuff above here
Generated at 13:56 on 01 Jul 2004 by mariachi 0.52