[prev] [thread] [next] [lurker] [Date index for 2004/04/06]
Author: richardc
Date: 2004-04-06 15:59:27 +0100 (Tue, 06 Apr 2004)
New Revision: 1505
Modified:
trunk/siesta/Config.pm.in
trunk/siesta/bin/nacho
trunk/siesta/lib/Siesta.pm
trunk/siesta/lib/Siesta/DBI.pm
trunk/siesta/lib/Siesta/Plugin/Archive.pm
trunk/siesta/lib/Siesta/Plugin/Digest.pm
trunk/siesta/lib/Siesta/Test.pm
trunk/siesta/lib/Siesta/Web.pm
trunk/siesta/t/30nacho.t
Log:
shave and a haircut, 2 bits. - remove the globals from Siesta::Config
Modified: trunk/siesta/Config.pm.in
===================================================================
--- trunk/siesta/Config.pm.in 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/Config.pm.in 2004-04-06 14:59:27 UTC (rev 1505)
@@ -1,57 +1,87 @@
+# -*- CPerl -*-
# $Id$
package Siesta::Config;
use strict;
-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 );
+use base qw( AppConfig Exporter );
+our @EXPORT = qw( $config );
-=head1 NAME
+our $config = Siesta::Config->new({
+ GLOBAL => {
+ ARGCOUNT => ARGCOUNT_ONE,
+ EXPAND => EXPAND_ALL,
+ },
+});
+
+=head1 NAME
+
Siesta::Config - organise the configuration of a Siesta install
-=head1 VARIABLES
+=head1 SYNOPSIS
-=head2 C<$ROOT>
+ use Siesta::Config;
+ print $config->root; # /usr/local/siesta
-Where to install everything to. Currently this is set to
+=cut
- @@ROOT@@
+our $CONFIG_FILE = '@@ROOT@@/siesta.conf'
+ unless defined $CONFIG_FILE;
-=head2 C<$CONFIG_FILE>
+=head1 Configuration file
-Where the config file is currently
+Where the config file is. Currently
- @@ROOT@@/siesta.conf
+ @@ROOT@@/siesta.conf
-This can be overridden when using the command line tools by
-using
+This can be overridden when using the command line tools by
+using
- -f <new config file>
+ -f <new config file>
+or by calling
-=head3 CONFIG OPTIONS
+ $config->file( 'new config file' );
-The following options are set within the config file :
-=over 4
+=head1 Configuration variables
+=over
+
=item root
-override the C<$ROOT> variable above
+Where to install - the default base of everything. The system default
+was set at install time to the value:
+ @@ROOT@@
+
+=cut
+
+$config->define( root => { DEFAULT => '@@ROOT@@' } );
+
+
=item messages
Where our message templates are stored.
By default - @@ROOT@@/messages/
+=cut
+
+$config->define( messages => { DEFAULT => '@@ROOT@@/messages' } );
+
+
=item archive
Where we archive list mails.
-By default - @@ROOT@@/archive/<list name>/
+By default - @@ROOT@@/archive
+=cut
+
+$config->define( archive => { DEFAULT => '@@ROOT@@/archive' } );
+
+
=item digests
Where we save our digest spools
@@ -64,34 +94,52 @@
By default - @@ROOT@@/error
+=cut
+$config->define( log_path => { DEFAULT => '@@ROOT@@/error' } );
+
+
=item log_level
By default - 3
+=cut
+
+$config->define( log_level => { DEFAULT => 3 } );
+
+
=item storage_dsn
The DSN for our local DB
By default - dbi:SQLite:@@ROOT@@/database
+=cut
+
+$config->define( storage_dsn => { DEFAULT => 'dbi:SQLite:@@ROOT@@/database' } );
+
+
=item storage_user
The user name for our DB
By default - root
+=cut
+
+$config->define( storage_user => { DEFAULT => 'root' } );
+
+
=item storage_pass
The password for our DB
By default - undef
-=back
+=cut
-=head2 C<@STORAGE>
+$config->define( storage_pass => { DEFAULT => undef } );
-A list containing the dsn, the user and password.
=head1 CREATION
@@ -99,62 +147,26 @@
=cut
-
sub load_from {
- shift;
+ my $self = shift;
my $file = shift;
- $config->file($file) if -e $file;
-
- @STORAGE = ($config->get('storage_dsn'),
- $config->get('storage_user'),
- $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');
+ $self->file($file) if -e $file;
}
-BEGIN {
- $ROOT = '@@ROOT@@';
- $CONFIG_FILE = '@@ROOT@@/siesta.conf' unless defined $CONFIG_FILE;
+sub storage {
+ my $self = shift;
+ if (@_) {
+ my ($dsn, $user, $pass) = @_;
+ $config->storage_dsn( $dsn );
+ $config->storage_user( $user );
+ $config->storage_pass( $pass );
+ }
+ return (
+ $config->storage_dsn, $config->storage_user, $config->storage_pass,
+ );
- $config = AppConfig->new({
- GLOBAL => { ARGCOUNT => ARGCOUNT_ONE,
- EXPAND => EXPAND_ALL,
- },
- },
-
- root => {
- DEFAULT => '@@ROOT@@',
- },
- messages => {
- DEFAULT => '@@ROOT@@/messages',
- },
- archive => {
- DEFAULT => '@@ROOT@@/archive',
- },
- digests => {
- DEFAULT => '@@ROOT@@/digests',
- },
- log_path => {
- DEFAULT => '@@ROOT@@/error',
- },
- log_level => {
- DEFAULT => 3,
- },
- storage_dsn => {
- DEFAULT => 'dbi:SQLite:@@ROOT@@/database',
- },
- storage_user => {
- DEFAULT => 'root',
- },
- storage_pass => {
- DEFAULT => undef,
- },
- );
- __PACKAGE__->load_from( $CONFIG_FILE );
}
+
1;
Modified: trunk/siesta/bin/nacho
===================================================================
--- trunk/siesta/bin/nacho 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/bin/nacho 2004-04-06 14:59:27 UTC (rev 1505)
@@ -14,13 +14,13 @@
while (@ARGV) {
if ($ARGV[0] eq '-d') {
shift;
- @Siesta::Config::STORAGE = split / /, shift;
+ $config->storage( split / /, shift );
next;
}
if ($ARGV[0] eq '-f') {
shift;
- Siesta::Config->load_from( shift );
+ $config->load_from( shift );
next;
}
@@ -690,7 +690,7 @@
=cut
$commands{'delete-deferred'} = sub {
-
+
foreach my $mess_id (@_) {
my $message = Siesta::Deferred->retrieve($mess_id)
@@ -722,7 +722,7 @@
$archive = $archive->promote;
my $input = $archive->pref('path');
my $name = $archive->list->name;
- my $output = $Siesta::Config::ROOT . "/mariachi-html/$name";
+ my $output = $config->root . "/mariachi-html/$name";
print "invoking mariachi for $name\n";
system 'mariachi', '-i', $input, '-o', $output, '-n', $name;
}
Modified: trunk/siesta/lib/Siesta/DBI.pm
===================================================================
--- trunk/siesta/lib/Siesta/DBI.pm 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/lib/Siesta/DBI.pm 2004-04-06 14:59:27 UTC (rev 1505)
@@ -2,7 +2,7 @@
package Siesta::DBI;
use Siesta::Config;
use base 'Class::DBI::BaseDSN';
-__PACKAGE__->set_db( 'Main', @Siesta::Config::STORAGE );
+__PACKAGE__->set_db( 'Main', $config->storage );
__PACKAGE__->mk_classdata('load_alias');
=head1 NAME
Modified: trunk/siesta/lib/Siesta/Plugin/Archive.pm
===================================================================
--- trunk/siesta/lib/Siesta/Plugin/Archive.pm 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/lib/Siesta/Plugin/Archive.pm 2004-04-06 14:59:27 UTC (rev 1505)
@@ -28,7 +28,7 @@
path => {
description => "where to drop the archives",
type => "string",
- default => "$Siesta::Config::ARCHIVE/$name/",
+ default => $config->archive. "/$name/",
},
};
}
Modified: trunk/siesta/lib/Siesta/Plugin/Digest.pm
===================================================================
--- trunk/siesta/lib/Siesta/Plugin/Digest.pm 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/lib/Siesta/Plugin/Digest.pm 2004-04-06 14:59:27 UTC (rev 1505)
@@ -1,5 +1,6 @@
package Siesta::Plugin::Digest;
use strict;
+use Siesta::Config;
use base 'Siesta::Plugin';
__PACKAGE__->columns( TEMP => qw( send_this ));
@@ -21,12 +22,12 @@
my $path = $self->pref('path');
- unless ($self->member) { # first pass
+ unless ($self->member) { # first pass
$self->add_to_digest( $mail );
my @messages = $self->get_digest();
- if ($#messages > $self->pref('messages')) { # spool is big enough
+ if ($#messages > $self->pref('messages')) { # spool is big enough
$self->send_this($self->make_digest(@messages));
@@ -34,14 +35,14 @@
die "Archive is not an mbox\n" unless (-f $path);
unlink($path) || die "Couldn't unlink '$path'\n";
}
- return; # carry on
+ return; # carry on
}
- # okay, this user isn't interested in digests, continue with the
- # regular mail
+ # 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.
+ return 1 unless $self->send_this; # the digest isn't ready yet, stop.
$mail = $self->send_this;
return;
}
@@ -52,41 +53,43 @@
my $count = 0;
my $path = $self->pref('path');
- my $folder = Email::Folder->new($self->pref('path'))
- || die "Couldn't open email folder '$path'\n";
+ my $folder = Email::Folder->new($self->pref('path'))
+ or 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
+# 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).
+# 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 , ")";
+ 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'
- );
+ 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),
- );
+ $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 );
+ $msg->attach( Type => 'message/rfc-822', Data => $message->as_string );
}
return $msg->as_string();
@@ -103,7 +106,7 @@
}
-# TODO some preferences should be marked personal
+# TODO some preferences should be marked personal
# that way the interface is simplified
sub options {
my $self = shift;
@@ -112,17 +115,17 @@
path => {
description => "where to spool the digest",
type => "string",
- default => "$Siesta::Config::DIGEST/$name/",
+ default => $config->digest_path."/$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,
+ default => 0,
},
};
}
Modified: trunk/siesta/lib/Siesta/Test.pm
===================================================================
--- trunk/siesta/lib/Siesta/Test.pm 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/lib/Siesta/Test.pm 2004-04-06 14:59:27 UTC (rev 1505)
@@ -1,16 +1,19 @@
+use strict;
package Siesta::Test;
# set up some stuff for testing
use Siesta::Config;
+
BEGIN {
my %dbs = (
pg => [ 'dbi:Pg:dbname=siesta', 'richardc', undef ],
mysql => [ 'dbi:mysql:siesta_test', 'root', undef ],
sqlite => [ 'dbi:SQLite:t/test.db', '', '' ],
);
- @Siesta::Config::STORAGE = @{ $dbs{ $ENV{SIESTA_TEST_DB} || 'sqlite' } };
- $Siesta::Config::MESSAGES = 'messages';
- $Siesta::Config::ARCHIVE = 't/root/archive';
- $Siesta::Config::LOG_PATH = 't/temp_error';
+ $config->storage( @{ $dbs{ $ENV{SIESTA_TEST_DB} || 'sqlite' } } );
+ $config->messages( 'messages' );
+ $config->archive( 't/root/archive' );
+ $config->root( 't/root' );
+ $config->log_path( 't/temp_error' );
}
use Siesta::DBI;
@@ -19,7 +22,7 @@
if (@_ && $_[0] eq 'init_db') {
print "# nuking test database\n";
- if ($Siesta::Config::STORAGE[0] =~ /^dbi:SQLite:(.*)/) {
+ if ($config->storage_dsn =~ /^dbi:SQLite:(.*)/) {
unlink $1;
}
else {
@@ -31,7 +34,6 @@
}
require Siesta;
Siesta->set_sender('Test');
-
}
1;
Modified: trunk/siesta/lib/Siesta/Web.pm
===================================================================
--- trunk/siesta/lib/Siesta/Web.pm 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/lib/Siesta/Web.pm 2004-04-06 14:59:27 UTC (rev 1505)
@@ -56,7 +56,7 @@
session => \%session,
};
- my $root = $Siesta::Config::config->root;
+ my $root = $config->root;
$tt ||= Template->new(
ABSOLUTE => 1,
INCLUDE_PATH => "$root/web-frontend/siesta:$root/web-frontend/lib" );
Modified: trunk/siesta/lib/Siesta.pm
===================================================================
--- trunk/siesta/lib/Siesta.pm 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/lib/Siesta.pm 2004-04-06 14:59:27 UTC (rev 1505)
@@ -6,6 +6,7 @@
use Template;
use Carp qw(croak);
+use Siesta::Config;
use Siesta::List;
use Siesta::Message;
@@ -97,7 +98,7 @@
=head2 ->log ($message, $level)
Log message as long as level is below the value set in
-I<$Siesta::Config::LOG_LEVEL>;
+I<$config->log_level>;
The lower the log level, the more important the error.
@@ -112,16 +113,17 @@
my $message = shift
or croak "need a message to log";
- my $level = shift || $Siesta::Config::LOG_LEVEL;
+ my $level = shift || $config->log_level;
unless ($logger) {
- open $logger, ">>$Siesta::Config::LOG_PATH"
- or die "Couldn't open file $Siesta::Config::LOG_PATH for appending\n";
+ my $file = $config->log_path;
+ open $logger, ">>$file"
+ or die "Couldn't open file $file for appending\n";
}
my $date = localtime;
print $logger "$date $message $level\n"
- if $level >= $Siesta::Config::LOG_LEVEL;
+ if $level >= $config->log_level;
}
@@ -153,12 +155,12 @@
my %opts = @_;
- $tt ||= Template->new({ INCLUDE_PATH => $Siesta::Config::MESSAGES });
+ $tt ||= Template->new({ INCLUDE_PATH => $config->messages });
my $body;
$tt->process($template, \%opts, \$body)
or die "Couldn't process message template '$template' because: "
- . $tt->error . "\nSearch path was: '$Siesta::Config::MESSAGES'";
+ . $tt->error . "\nSearch path was: '". $config->messages ."'";
return $body;
}
Modified: trunk/siesta/t/30nacho.t
===================================================================
--- trunk/siesta/t/30nacho.t 2004-04-06 12:10:47 UTC (rev 1504)
+++ trunk/siesta/t/30nacho.t 2004-04-06 14:59:27 UTC (rev 1505)
@@ -4,8 +4,9 @@
use lib qw(t/lib);
use Siesta::Test 'init_db';
use Siesta::List;
+use Siesta::Config;
-my $DB = join(' ', @Siesta::Config::STORAGE);
+my $DB = join(' ', $config->storage);
my $CF = "t/config";
my @NACHO = ($^X, qw( -Iblib/lib -Iblib/arch bin/nacho -f ), $CF, '-d', $DB );
Generated at 13:57 on 01 Jul 2004 by mariachi 0.52