[prev] [thread] [next] [lurker] [Date index for 2004/04/06]
Author: simon Date: 2004-04-06 13:06:39 +0100 (Tue, 06 Apr 2004) New Revision: 1501 Added: trunk/siesta/lib/Siesta/Plugin/Digest.pm trunk/siesta/messages/digest Modified: trunk/siesta/Build.PL trunk/siesta/Config.pm.in Log: Put in infrastructure for Digests Modified: trunk/siesta/Build.PL =================================================================== --- trunk/siesta/Build.PL 2004-04-06 12:01:31 UTC (rev 1500) +++ trunk/siesta/Build.PL 2004-04-06 12:06:39 UTC (rev 1501) @@ -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', Modified: trunk/siesta/Config.pm.in =================================================================== --- trunk/siesta/Config.pm.in 2004-04-06 12:01:31 UTC (rev 1500) +++ trunk/siesta/Config.pm.in 2004-04-06 12:06:39 UTC (rev 1501) @@ -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', }, Added: trunk/siesta/lib/Siesta/Plugin/Digest.pm =================================================================== --- trunk/siesta/lib/Siesta/Plugin/Digest.pm 2004-04-06 12:01:31 UTC (rev 1500) +++ trunk/siesta/lib/Siesta/Plugin/Digest.pm 2004-04-06 12:06:39 UTC (rev 1501) @@ -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, + }, + }; +} + + Added: trunk/siesta/messages/digest =================================================================== --- trunk/siesta/messages/digest 2004-04-06 12:01:31 UTC (rev 1500) +++ trunk/siesta/messages/digest 2004-04-06 12:06:39 UTC (rev 1501) @@ -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 -%] +
Generated at 13:57 on 01 Jul 2004 by mariachi 0.52