rev 1501 - in trunk/siesta: . lib/Siesta/Plugin messages

[prev] [thread] [next] [lurker] [Date index for 2004/04/06]

From: simon
Subject: rev 1501 - in trunk/siesta: . lib/Siesta/Plugin messages
Date: 13:06 on 06 Apr 2004
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