197 lines
6.0 KiB
Perl
197 lines
6.0 KiB
Perl
# ==================================================================
|
|
# Gossamer List - enhanced mailing list management system
|
|
#
|
|
# Website : http://gossamer-threads.com/
|
|
# Support : http://gossamer-threads.com/scripts/support/
|
|
# CVS Info :
|
|
# Revision : $Id: Config.pm,v 1.7 2004/10/05 22:02:27 bao Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# Redistribution in part or in whole strictly prohibited. Please
|
|
# see LICENSE file for full details.
|
|
# ==================================================================
|
|
#
|
|
|
|
package GList::Config;
|
|
# =============================================================================
|
|
# Sets up our config variables -- if you are looking to hand edit variables the
|
|
# data is in GList/Config/Data.pm, but you shouldn't have to do this, really!
|
|
#
|
|
use GT::Config();
|
|
use vars qw/@ISA/;
|
|
@ISA = 'GT::Config';
|
|
|
|
use strict;
|
|
|
|
sub new {
|
|
# -----------------------------------------------------------------------------
|
|
my $class = ref $_[0] ? ref shift : shift;
|
|
my $path = shift || '.';
|
|
|
|
my $file = "$path/GList/Config/Data.pm";
|
|
|
|
my $self = $class->load($file => {
|
|
debug => $GList::DEBUG,
|
|
header => <<'HEADER'
|
|
# ==================================================================
|
|
# Gossamer List - enhanced mailing list management system
|
|
#
|
|
# Website: http://gossamer-threads.com/
|
|
# Support: http://gossamer-threads.com/scripts/support/
|
|
# Updated: [localtime]
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# Redistribution in part or in whole strictly prohibited. Please
|
|
# see LICENSE file for full details.
|
|
# ==================================================================
|
|
|
|
HEADER
|
|
});
|
|
|
|
$self->debug_level($self->{debug});
|
|
|
|
return $self;
|
|
|
|
$self->{priv_path} ||= '.';
|
|
$self->{version} ||= $GList::VERSION;
|
|
$self->{setup} ||= 0;
|
|
|
|
return $self;
|
|
}
|
|
|
|
sub tpl_load {
|
|
# ------------------------------------------------------------------
|
|
# Returns a hash of config variables for use in tempaltes.
|
|
#
|
|
my $t = {};
|
|
while (my ($key, $val) = each %{$GList::CFG}) {
|
|
(ref $val eq 'ARRAY') and ($val = join ",", @$val);
|
|
(ref $val eq 'HASH') and do { my $tmp = ''; foreach (sort keys %$val) { $tmp .= "$_ = $val->{$_}, "; } chop $tmp; chop $tmp; $val = $tmp; };
|
|
$t->{"cfg_$key"} = $GList::IN->html_escape($val);
|
|
}
|
|
return $t;
|
|
}
|
|
|
|
sub defaults {
|
|
# ------------------------------------------------------------------
|
|
# Set sensible defaults for the config values, overwriting old values.
|
|
#
|
|
my $self = shift;
|
|
$self->{setup} = 1;
|
|
$self->default_path(1);
|
|
$self->default_misc(1);
|
|
}
|
|
|
|
sub create_defaults {
|
|
# ------------------------------------------------------------------
|
|
# Create defaults, does not overwrite old values.
|
|
#
|
|
my $self = shift;
|
|
$self->{setup} = 1;
|
|
$self->default_path(0);
|
|
$self->default_misc(0);
|
|
}
|
|
|
|
sub set {
|
|
# ------------------------------------------------------------------
|
|
# Sets a value.
|
|
#
|
|
my ($self, $key, $val, $overwrite) = @_;
|
|
if ($overwrite or ! exists $self->{$key}) { $self->{$key} = $val }
|
|
}
|
|
|
|
sub default_path {
|
|
# ------------------------------------------------------------------
|
|
# Set the path settings to default values.
|
|
#
|
|
my ($self, $overwrite) = @_;
|
|
$self->set('cgi_url', _find_cgi_url(), $overwrite);
|
|
$self->set('image_url', _find_image_url(), $overwrite);
|
|
$self->set('path_to_perl', _find_perl(), $overwrite);
|
|
$self->set('path_fileman', $self->{priv_path}, $overwrite);
|
|
}
|
|
|
|
sub default_misc {
|
|
# ------------------------------------------------------------------
|
|
# Set the misc settings to default values.
|
|
#
|
|
my ($self, $overwrite) = @_;
|
|
$self->set('reg_number', '', $overwrite);
|
|
$self->set('debug_level', 0, $overwrite);
|
|
$self->set('user_session', '', $overwrite);
|
|
$self->set('session_exp', 3, $overwrite);
|
|
$self->set('scheduled_mailing_minute', 5, $overwrite);
|
|
$self->set('admin_email', '', $overwrite);
|
|
$self->set('smtp_server', '', $overwrite);
|
|
$self->set('mail_path', _find_sendmail(), $overwrite);
|
|
$self->set('highlight_color', 1, $overwrite);
|
|
|
|
# for attachments
|
|
$self->set('max_attachments_size', 1024, $overwrite);
|
|
|
|
# for templates
|
|
my $html_code = <<'HTML';
|
|
<!-- CODE BEGINS-->
|
|
<form method="post" action="<%url%>">
|
|
Join <%name%>!<br>
|
|
Email Address: <input name=email width=40><br>
|
|
Name: <input name=name width=40><br>
|
|
<select name="do">
|
|
<option value="subscribe">Subscribe</option>
|
|
<option value="unsubscribe">Unsubscribe</option>
|
|
<input Type=submit value="Go">
|
|
<input type=hidden name="lid" value="<%id%>">
|
|
</form>
|
|
<!-- CODE ENDS -->
|
|
HTML
|
|
|
|
$self->set('html_code', $html_code, $overwrite);
|
|
}
|
|
|
|
sub _find_cgi_url {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns basedir of current url.
|
|
#
|
|
my $url = GT::CGI->url({ absolute => 1, query_string => 0 });
|
|
$url =~ s,/[^/]*$,,;
|
|
return $url;
|
|
}
|
|
|
|
sub _find_image_url {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns image directory basedir from cgi basedir, replacing cgi with images
|
|
#
|
|
my $url = _find_cgi_url();
|
|
$url =~ s,/cgi$,,;
|
|
$url .= '/images';
|
|
return $url;
|
|
}
|
|
|
|
sub _find_perl {
|
|
# -----------------------------------------------------------------------------
|
|
# Returns path to perl.
|
|
#
|
|
my @poss_perls = qw(
|
|
/usr/local/bin/perl /usr/bin/perl /bin/perl
|
|
/usr/local/bin/perl5 /usr/bin/perl5 /bin/perl5
|
|
/perl/bin/perl.exe c:/perl/bin/perl.exe d:/perl/bin/perl.exe
|
|
);
|
|
foreach my $perl_path (@poss_perls) {
|
|
return $perl_path if -f $perl_path and -x _;
|
|
}
|
|
return '';
|
|
}
|
|
|
|
sub _find_sendmail {
|
|
# ------------------------------------------------------------------
|
|
# Looks for sendmail.
|
|
#
|
|
for (qw(/usr/sbin/sendmail /usr/lib/sendmail /usr/bin/sendmail /sbin/sendmail /bin/sendmail)) {
|
|
return $_ if -f and -x _;
|
|
}
|
|
return '';
|
|
}
|
|
|
|
1;
|
|
|