First pass at adding key files
This commit is contained in:
dsainty
1344
site/glist/lib/GList/Admin.pm
Normal file
1344
site/glist/lib/GList/Admin.pm
Normal file
File diff suppressed because it is too large
Load Diff
246
site/glist/lib/GList/Authenticate.pm
Normal file
246
site/glist/lib/GList/Authenticate.pm
Normal file
@ -0,0 +1,246 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: Authenticate.pm,v 1.15 2004/04/15 19:46:36 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::Authenticate;
|
||||
# ==================================================================
|
||||
|
||||
use strict;
|
||||
use GList qw/:objects/;
|
||||
use GT::Session::SQL;
|
||||
|
||||
sub auth {
|
||||
# -------------------------------------------------------------------
|
||||
# Runs the request auth function through the plugin system.
|
||||
#
|
||||
($_[0] eq 'GList::Authenticate') and shift;
|
||||
|
||||
my ($auth, $args) = @_;
|
||||
my $code = exists $GList::Authenticate::{"auth_$auth"} ? $GList::Authenticate::{"auth_$auth"} : die "Invalid Authenticate method: auth_$auth called.";
|
||||
GT::Plugins->dispatch("$CFG->{priv_path}/lib/GList/Plugins", "auth_$auth", $code, $args);
|
||||
}
|
||||
|
||||
sub auth_init {
|
||||
# -------------------------------------------------------------------
|
||||
# This function is guaranteed to be called before any other authentication
|
||||
# function, but may be called multiple times during one request.
|
||||
#
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub auth_get_user {
|
||||
# -------------------------------------------------------------------
|
||||
# This function returns user information for a given user, auto
|
||||
# creating if it doesn't exist.
|
||||
#
|
||||
my $args = shift;
|
||||
return $DB->table ('Users')->get({ usr_username => $args->{username}, usr_status => '1' });
|
||||
}
|
||||
|
||||
sub auth_valid_user {
|
||||
# -------------------------------------------------------------------
|
||||
# This function returns 1 if the user/pass combo is valid, 0/undef
|
||||
# otherwise.
|
||||
#
|
||||
my $args = shift;
|
||||
my $user = $DB->table('Users')->get($args->{username});
|
||||
return if ( !$user );
|
||||
|
||||
return ($user->{usr_password} eq GList::encrypt($args->{password}, $user->{usr_password})) ? 1 : 0;
|
||||
}
|
||||
|
||||
sub auth_create_session {
|
||||
# -------------------------------------------------------------------
|
||||
# This function creates a session, and prints the header and returns a
|
||||
# hash with session => $id, and redirect => 0/1.
|
||||
#
|
||||
my $args = shift;
|
||||
|
||||
my $uid = $args->{username};
|
||||
my $use_cookie = ( $CFG->{user_session} ) ? 0 : 1;
|
||||
my $session = GT::Session::SQL->new ({
|
||||
_debug => $CFG->{debug},
|
||||
tb => $DB->table('Users_Sessions'),
|
||||
session_user_id => $uid,
|
||||
session_data => { cookie => $use_cookie, do => scalar($IN->param('do')) },
|
||||
expires => $CFG->{session_exp},
|
||||
}
|
||||
);
|
||||
|
||||
if ( $GT::Session::SQL::error ) {
|
||||
return { error => $GT::Session::SQL::error };
|
||||
}
|
||||
# Delete all old sessions.
|
||||
$session->cleanup;
|
||||
if ($use_cookie) {
|
||||
print $IN->cookie(
|
||||
-name => 'sid',
|
||||
-value => $session->{info}->{session_id},
|
||||
)->cookie_header() . "\n";
|
||||
}
|
||||
return { session_id => $session->{info}->{session_id}, use_cookie => $use_cookie };
|
||||
}
|
||||
|
||||
sub auth_valid_session {
|
||||
# -------------------------------------------------------------------
|
||||
# This functions checks to see if the session is valid, and returns the
|
||||
# username.
|
||||
my $args = shift;
|
||||
my ($sid, $cookie);
|
||||
if ($IN->param ('sid')) {
|
||||
$sid = $IN->param ('sid');
|
||||
}
|
||||
elsif ( !$CFG->{user_session} and $IN->cookie ('sid') ) {
|
||||
$cookie = 1;
|
||||
$sid = $IN->cookie ('sid');
|
||||
}
|
||||
else { return }
|
||||
my $use_cookie = ( $CFG->{user_session} ) ? 0 : 1;
|
||||
|
||||
# Cookie authentication
|
||||
my $session = new GT::Session::SQL ({
|
||||
_debug => $CFG->{debug},
|
||||
tb => $DB->table('Users_Sessions'),
|
||||
session_id => $sid,
|
||||
expires => $CFG->{session_exp},
|
||||
session_data => { cookie => $use_cookie, do => scalar($IN->param('do')) },
|
||||
}) or return;
|
||||
|
||||
# Delete any of the user's expired sessions
|
||||
$sid = '' if ($session->{data}->{cookie});
|
||||
|
||||
# Must return the session id and the userid
|
||||
return { session_id => $session->{info}->{session_id}, use_cookie => $use_cookie, user_name => $session->{info}->{session_user_id} };
|
||||
}
|
||||
|
||||
sub auth_delete_session {
|
||||
# -------------------------------------------------------------------
|
||||
# This function removes a session, returns 1 on success, undef on
|
||||
# failure.
|
||||
#
|
||||
my $args = shift;
|
||||
my $sid;
|
||||
if ( $IN->param('sid') ) {
|
||||
$sid = $IN->param ('sid');
|
||||
}
|
||||
elsif ( !$CFG->{user_session} and $IN->cookie('sid') ) {
|
||||
$sid = $IN->cookie ('sid');
|
||||
}
|
||||
else { return }
|
||||
|
||||
my $session = new GT::Session::SQL (
|
||||
{
|
||||
_debug => $CFG->{debug},
|
||||
tb => $DB->table ('Users_Sessions'),
|
||||
session_id => $sid
|
||||
}
|
||||
) or return;
|
||||
|
||||
# Delete the cookie
|
||||
$session->delete or return;
|
||||
|
||||
# Print the cookie header
|
||||
if (!$CFG->{user_session}) {
|
||||
print $IN->cookie(
|
||||
-name => 'sid',
|
||||
-value => $sid,
|
||||
-expires => '-1h'
|
||||
)->cookie_header() . "\n";
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub auth_admin_valid_user {
|
||||
#---------------------------------------------------------
|
||||
#
|
||||
my $args = shift;
|
||||
|
||||
my $admins = $CFG->{admin};
|
||||
foreach my $u (keys % $admins) {
|
||||
my $pass = $admins->{$u}->[0];
|
||||
if ($u eq $args->{username} and GList::encrypt($args->{password}, $pass) eq $pass ) {
|
||||
return $args->{username};
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub auth_admin_create_session {
|
||||
#---------------------------------------------------------
|
||||
#
|
||||
my $args = shift;
|
||||
|
||||
# Clear out old sessions.
|
||||
require GT::Session::File;
|
||||
GT::Session::File->cleanup(1800, "$CFG->{priv_path}/tmp");
|
||||
|
||||
# Create a new session and save the information.
|
||||
my $session = new GT::Session::File ( directory => "$CFG->{priv_path}/tmp" );
|
||||
$session->{data}->{username} = $args->{username};
|
||||
my $session_id = $session->{id};
|
||||
$session->save;
|
||||
|
||||
# Now redirect to another URL and set cookies, or set URL string.
|
||||
my $redirect = 0;
|
||||
my $use_cookie = ( $CFG->{user_session} ) ? 0 : 1;
|
||||
if ($use_cookie) {
|
||||
print $IN->cookie (
|
||||
-name => 'session_id',
|
||||
-value => $session_id,
|
||||
-path => '/'
|
||||
)->cookie_header() . "\n";
|
||||
}
|
||||
return { session_id => $session_id, use_cookie => $use_cookie };
|
||||
}
|
||||
|
||||
sub auth_admin_valid_session {
|
||||
# -------------------------------------------------------------------
|
||||
# This functions checks to see if the session is valid, and returns the
|
||||
# username.
|
||||
#
|
||||
my $args = shift;
|
||||
|
||||
# Clear out old sessions.
|
||||
require GT::Session::File;
|
||||
GT::Session::File->cleanup(1800, "$CFG->{priv_path}/tmp");
|
||||
|
||||
my $session_id = $IN->param('session_id') || $IN->cookie('session_id') || return;
|
||||
my $session = new GT::Session::File (
|
||||
directory => "$CFG->{priv_path}/tmp",
|
||||
id => $session_id
|
||||
) || return;
|
||||
|
||||
my $use_cookie = ( $CFG->{user_session} ) ? 0 : 1;
|
||||
return { username => $session->{data}->{username}, session_id => $session_id, use_cookie => $use_cookie };
|
||||
}
|
||||
|
||||
sub auth_admin_delete_session {
|
||||
#--------------------------------------------------------
|
||||
#
|
||||
require GT::Session::File;
|
||||
my $session_id = $IN->cookie('session_id') || $IN->param('session_id') || return;
|
||||
my $session = new GT::Session::File(
|
||||
directory => "$CFG->{priv_path}/tmp",
|
||||
id => $session_id
|
||||
) || return;
|
||||
|
||||
print $IN->cookie(
|
||||
-name => 'session_id',
|
||||
-value => '',
|
||||
-path => '/'
|
||||
)->cookie_header() . "\n";
|
||||
|
||||
return $session->delete();
|
||||
}
|
||||
|
||||
1;
|
||||
196
site/glist/lib/GList/Config.pm
Normal file
196
site/glist/lib/GList/Config.pm
Normal file
@ -0,0 +1,196 @@
|
||||
# ==================================================================
|
||||
# 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;
|
||||
|
||||
73
site/glist/lib/GList/Config/Data.pm
Normal file
73
site/glist/lib/GList/Config/Data.pm
Normal file
@ -0,0 +1,73 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website: http://gossamer-threads.com/
|
||||
# Support: http://gossamer-threads.com/scripts/support/
|
||||
# Updated: Sat Feb 12 12:02:26 2022
|
||||
#
|
||||
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
||||
# Redistribution in part or in whole strictly prohibited. Please
|
||||
# see LICENSE file for full details.
|
||||
# ==================================================================
|
||||
|
||||
{
|
||||
'admin' => {
|
||||
'admin' => [
|
||||
'$GT$YJ4E9RP4$khwtQz/NC7ErNdHmPNOAE0',
|
||||
'slowman@slowtwitch.com'
|
||||
],
|
||||
'rappstar' => [
|
||||
'$GT$HQRmVMKU$qsarcJtu/9LHJtzyZBTJt.',
|
||||
'rappstar@slowtwitch.com'
|
||||
]
|
||||
},
|
||||
'admin_email' => '',
|
||||
'allowed_space' => '100000',
|
||||
'cgi_url' => 'https://secure.slowtwitch.com/cgi-bin',
|
||||
'command_time_out' => '10',
|
||||
'debug_level' => '0',
|
||||
'highlight_color' => '1',
|
||||
'html_code' => '<!-- 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="user_subscribe">Subscribe</option>
|
||||
<option value="user_unsubscribe">Unsubscribe</option>
|
||||
</select>
|
||||
<input Type=submit value="Go">
|
||||
<input type=hidden name="lid" value="<%id%>">
|
||||
</form>
|
||||
<!-- CODE ENDS -->
|
||||
',
|
||||
'iframe_tracking' => '1',
|
||||
'image_path' => '/home/slowtwitch/secure.slowtwitch.com/secure-www/glist',
|
||||
'image_url' => 'https://secure.slowtwitch.com/glist',
|
||||
'mail_path' => '/usr/sbin/sendmail',
|
||||
'max_attachments_size' => '1024',
|
||||
'max_bounced_emails' => '10000',
|
||||
'path_fileman' => '/home/slowtwitch/site/glist',
|
||||
'path_to_perl' => '/usr/bin/perl',
|
||||
'priv_path' => '/home/slowtwitch/site/glist',
|
||||
'reg_number' => '',
|
||||
'scheduled_mailing_minute' => '5',
|
||||
'session_exp' => '3',
|
||||
'setup' => '1',
|
||||
'signup_admin_validate' => '0',
|
||||
'signup_email_validate' => '1',
|
||||
'signup_enable' => '0',
|
||||
'signup_limit_email30' => '100',
|
||||
'signup_limit_list' => '10',
|
||||
'signup_limit_sublist' => '10',
|
||||
'signup_restricted_email' => [],
|
||||
'signup_username_regex' => '^[\w\-\.]{3,}$',
|
||||
'smtp_server' => '',
|
||||
'static_url' => 'https://secure.slowtwitch.com/glist',
|
||||
'template_backups' => '1',
|
||||
'template_set' => 'gossamer',
|
||||
'user_session' => '0',
|
||||
'version' => '1.1.1'
|
||||
};
|
||||
|
||||
# vim:syn=perl:ts=4:noet
|
||||
30
site/glist/lib/GList/Custom.pm
Normal file
30
site/glist/lib/GList/Custom.pm
Normal file
@ -0,0 +1,30 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: Custom.pm,v 1.1 2004/01/13 01:19:23 jagerman 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.
|
||||
# ==================================================================
|
||||
#
|
||||
# Description:
|
||||
# By default, this file is empty, however it is here to allow installations
|
||||
# to perform special operations required to make Gossamer Mail load.
|
||||
# For example, some installations might need a 'use lib' line to work
|
||||
# properly.
|
||||
#
|
||||
# This file will NOT be overwritten when upgrading your installation, so you
|
||||
# do not need to worry about additions made here being overwritten. This is
|
||||
# generally loaded after GMail.pm has started loading, but before any other
|
||||
# modules are loaded.
|
||||
#
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
1; # This must remain at the bottom of the file
|
||||
249
site/glist/lib/GList/GUI.pm
Normal file
249
site/glist/lib/GList/GUI.pm
Normal file
@ -0,0 +1,249 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: GUI.pm,v 1.5 2004/08/24 19:28:37 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::GUI;
|
||||
# ==================================================================
|
||||
|
||||
use strict;
|
||||
use GList qw/:objects/;
|
||||
|
||||
sub gui_profile_form {
|
||||
# -------------------------------------------------------------------
|
||||
require GT::SQL::Display::HTML;
|
||||
require GT::SQL::Display::HTML::Table;
|
||||
|
||||
my $opts = {@_};
|
||||
my $user_tb = $DB->table('Users');
|
||||
|
||||
$opts->{cols} ||= [ grep(/^pro_/, $user_tb->ordered_columns) ];
|
||||
$opts->{tr} ||= 'class="body"';
|
||||
$opts->{td_l} ||= 'class="body" width="40%" align="right"';
|
||||
$opts->{td_r} ||= 'class="body" align="left"';
|
||||
$opts->{cols} ||= [];
|
||||
$opts->{mode} ||= 'edit';
|
||||
$opts->{required} ||= ($opts->{mode} eq 'search') ? '' : '*';
|
||||
|
||||
my $tags = GT::Template->tags;
|
||||
my $cols = $user_tb->cols;
|
||||
my $disp = $DB->html($user_tb, GT::Template->tags);
|
||||
my $html = '';
|
||||
my $prefix = $opts->{prefix} || '';
|
||||
|
||||
if ( $opts->{mode} eq 'hidden' ) {
|
||||
|
||||
# Preserve all columns that relate to the Users database
|
||||
my $cols = $user_tb->cols;
|
||||
my $hidden_html = '';
|
||||
foreach my $col ( keys %$cols ) {
|
||||
foreach my $name ( map { "$col$_" } ( '', qw( -opt -gt -lt -le -ge -ne )) ) {
|
||||
my $v = $tags->{$name};
|
||||
next unless defined $v;
|
||||
my $input_html = gui_form_control({
|
||||
form_type => 'hidden',
|
||||
value => $v,
|
||||
name => $name
|
||||
});
|
||||
$html .= $$input_html;
|
||||
}
|
||||
}
|
||||
return \$html;
|
||||
}
|
||||
|
||||
my %search_defs = (
|
||||
string => { names => [qw( LIKE <> = )] },
|
||||
number => { names => [qw( = <> < <= > >= )] },
|
||||
date => { names => [ '', qw( = <> < <= > >= )] },
|
||||
radio => { names => [qw( = <> )] },
|
||||
minimal => { names => [qw( = )] }
|
||||
);
|
||||
|
||||
foreach my $col (@{$opts->{cols}}) {
|
||||
my $control_opts = {%{$cols->{$col}||{}}};
|
||||
$control_opts->{name} = $col;
|
||||
$control_opts->{value} = $tags->{$col};
|
||||
my $title = GList::language( $cols->{$col}{form_display} );
|
||||
my $input_html = gui_form_control({
|
||||
name => "$prefix$col",
|
||||
value=> ($opts->{mode} eq 'search') ? '' : $tags->{"$prefix$col"},
|
||||
def => $control_opts
|
||||
});
|
||||
$html .= ( $cols->{$col}->{not_null} ) ?
|
||||
"<tr $opts->{tr}><td $opts->{td_l}><ul/>$title</td><td $opts->{td_r}>$$input_html $opts->{required}</td></tr>" :
|
||||
"<tr $opts->{tr}><td $opts->{td_l}><ul/>$title</td><td $opts->{td_r}>$$input_html</td></tr>";
|
||||
}
|
||||
return \$html;
|
||||
}
|
||||
|
||||
sub gui_form_control {
|
||||
# -------------------------------------------------------------------
|
||||
require GT::SQL::Display::HTML;
|
||||
require GT::SQL::Display::HTML::Table;
|
||||
require GT::Template;
|
||||
|
||||
my $opts = ref $_[0] eq 'HASH' ? shift : {@_};
|
||||
|
||||
my $user_tb = $DB->table('Users');
|
||||
my $tags = GT::Template->tags || {};
|
||||
my $disp = $DB->html($user_tb, $tags);
|
||||
|
||||
my $form_type = lc $opts->{def}->{form_type};
|
||||
exists $opts->{blank} or $opts->{blank} = $form_type eq 'select' ? 1 : 0;
|
||||
|
||||
$opts->{def}->{class} = 'object' if ($form_type !~ /radio|checkbox/);
|
||||
my $input_html = 'radio' eq $form_type ? $disp->radio( $opts ) :
|
||||
'checkbox' eq $form_type ? $disp->checkbox( $opts ) :
|
||||
'select' eq $form_type ? $disp->select( $opts ) :
|
||||
'hidden' eq $form_type ? $disp->hidden( $opts ) :
|
||||
'multiple' eq $form_type ? $disp->multiple( $opts ) :
|
||||
'textarea' eq $form_type ? $disp->textarea( $opts ) :
|
||||
'file' eq $form_type ? "File type not supported." :
|
||||
'date' eq $form_type ? do {
|
||||
require GT::Date;
|
||||
my ($sel_year, $sel_mon, $sel_day) = split /\-/, GT::CGI::html_escape($opts->{value});
|
||||
$sel_year ||= 1970;
|
||||
$sel_mon ||= 1;
|
||||
$sel_day ||= 1;
|
||||
my $month_sel = $disp->select({
|
||||
name => "$opts->{name}-mon",
|
||||
value => $sel_mon,
|
||||
values => { map { sprintf("%02d", $_) => $GT::Date::LANGUAGE->{short_month_names}->[$_ - 1] } (1 .. 12) },
|
||||
sort => [ map { sprintf("%02d", $_) } (1 .. 12) ],
|
||||
blank => 0
|
||||
});
|
||||
my $day_sel = $disp->select({
|
||||
name => "$opts->{name}-day",
|
||||
value => $sel_day,
|
||||
values => { map { sprintf("%02d", $_) => $_ } (1 .. 31) },
|
||||
sort => [ map { sprintf("%02d", $_) } (1 .. 31) ],
|
||||
blank => 0
|
||||
});
|
||||
qq~
|
||||
$day_sel /
|
||||
$month_sel /
|
||||
<input type="text" name="$opts->{name}-year" value="$sel_year" size="4" maxlength="4">
|
||||
~;
|
||||
} :
|
||||
$disp->text($opts);
|
||||
|
||||
return \$input_html;
|
||||
}
|
||||
|
||||
sub gui_toolbar {
|
||||
my %input = @_;
|
||||
my $tags = GT::Template->tags;
|
||||
$input{first} ||= q|<img src="$image_url/icons/first.gif" border="0" width="17" height="11" alt="First page">|;
|
||||
$input{first_grey} ||= q|<img src="$image_url/icons/first_grey.gif" border="0" width="17" height="11" alt="First page">|;
|
||||
$input{prev} ||= q|<img src="$image_url/icons/prev.gif" border="0" width="10" height="11" alt="Previous page">|;
|
||||
$input{prev_grey} ||= q|<img src="$image_url/icons/prev_grey.gif" border="0" width="10" height="11" alt="Previous page">|;
|
||||
$input{next} ||= q|<img src="$image_url/icons/next.gif" border="0" width="10" height="11" alt="Next page">|;
|
||||
$input{next_grey} ||= q|<img src="$image_url/icons/next_grey.gif" border="0" width="10" height="11" alt="Next page">|;
|
||||
$input{last} ||= q|<img src="$image_url/icons/last.gif" border="0" width="17" height="11" alt="Last page">|;
|
||||
$input{last_grey} ||= q|<img src="$image_url/icons/last_grey.gif" border="0" width="17" height="11" alt="Last page">|;
|
||||
$input{view_all} ||= q|View All|;
|
||||
$input{pages} ||= 9;
|
||||
$input{'...'} ||= '...';
|
||||
$input{'first_...'} ||= 1;
|
||||
$input{'last_...'} ||= 1;
|
||||
$input{before_page} ||= q||;
|
||||
$input{after_page} ||= q||;
|
||||
$input{before_current} ||= q|<b>|;
|
||||
$input{after_current} ||= q|</b>|;
|
||||
$input{'glist.cgi'} ||= 'glist.cgi';
|
||||
|
||||
for (keys %input) {
|
||||
$input{$_} =~ s/\$image_url/$tags->{image_url}/g;
|
||||
}
|
||||
|
||||
my $hidden_query = ${$tags->{hidden_query} || \''};
|
||||
|
||||
my $num_page_items = ref $tags->{num_page_items} eq 'SCALAR' ? ${$tags->{num_page_items}} : $tags->{num_page_items};
|
||||
my $paging = GList::paging($num_page_items, @$tags{qw/mh nh/}, @input{qw/pages last_.../});
|
||||
($paging, my ($top_page, $ddd)) = @$paging{'paging', 'top_page', 'dotdotdot'};
|
||||
my $return = '';
|
||||
my $search = '';
|
||||
if ($tags->{toolbar_table}) {
|
||||
my $cols = $DB->table($tags->{toolbar_table})->cols;
|
||||
foreach my $c (keys %{$cols}) {
|
||||
next unless $tags->{$c};
|
||||
$search .= qq|$c=$tags->{$c};|;
|
||||
if ($tags->{"$c-opt"}) { $search .= qq|$c-opt=$tags->{"$c-opt"};|; }
|
||||
}
|
||||
}
|
||||
|
||||
my $link = sub {
|
||||
my ($page, $disp) = @_;
|
||||
$return .= qq|<a href="$input{'glist.cgi'}?do=$tags->{do};|;
|
||||
if ($tags->{toolbar_query}) {
|
||||
my $query = ref $tags->{toolbar_query} ? ${$tags->{toolbar_query}} : $tags->{toolbar_query};
|
||||
$return .= qq|$query;|;
|
||||
}
|
||||
if ($search) {
|
||||
$return .= qq|$search|;
|
||||
}
|
||||
$return .= qq|nh=$page;|;
|
||||
if ($tags->{users}) { $return .= qq|users=1;| }
|
||||
if ($tags->{show_user}) { $return .= qq|show_user=1;| }
|
||||
if ($tags->{fd}) { $return .= qq|fd=$tags->{fd};| }
|
||||
if ($tags->{sb}) { $return .= qq|sb=$tags->{sb};| }
|
||||
if ($tags->{so}) { $return .= qq|so=$tags->{so};| }
|
||||
if ($tags->{mh}) { $return .= qq|mh=$tags->{mh};| }
|
||||
if ($tags->{id}) { $return .= qq|id=$tags->{id};| }
|
||||
if ($tags->{cs}) { $return .= qq|cs=$tags->{cs};| }
|
||||
if ($tags->{first}) { $return .= qq|first=$tags->{first};| }
|
||||
if ($tags->{mn_disable}){ $return .= qq|mn_disable=1;| }
|
||||
|
||||
$return .= qq|$hidden_query">$disp</a>\n|;
|
||||
};
|
||||
|
||||
unless ($top_page == 1) {
|
||||
if ($tags->{nh} == 1) {
|
||||
$return .= $input{first_grey} . "\n";
|
||||
$return .= $input{prev_grey} . "\n";
|
||||
}
|
||||
else {
|
||||
my $prev = ($tags->{nh} == -1) ? 1 : ($tags->{nh} - 1);
|
||||
$link->(1, $input{first});
|
||||
$link->($prev, $input{prev});
|
||||
}
|
||||
|
||||
if (@$paging and $paging->[0]->{page_num} > 1 and $input{'first_...'}) {
|
||||
$link->(1, qq|$input{before_page}1$input{after_page}|);
|
||||
$return .= "$input{before_page}$input{'...'}" . ($input{after_page} || " ") if $paging->[0]->{page_num} > 2;
|
||||
}
|
||||
for (@$paging) {
|
||||
if ($_->{is_current_page}) {
|
||||
$return .= qq|$input{before_current}$_->{page_num}$input{after_current}\n|;
|
||||
}
|
||||
else {
|
||||
$link->($_->{page_num}, qq|$input{before_page}$_->{page_num}$input{after_page}|);
|
||||
}
|
||||
}
|
||||
if ($ddd) {
|
||||
$return .= "$input{before_page}$input{'...'}" . ($input{after_page} || " ");
|
||||
$link->($top_page, "$input{before_page}$top_page$input{after_page}");
|
||||
}
|
||||
|
||||
if ($tags->{nh} >= $top_page) {
|
||||
$return .= $input{next_grey} . "\n";
|
||||
$return .= $input{last_grey} . "\n";
|
||||
}
|
||||
else {
|
||||
my $next = ($tags->{nh} == -1) ? 1 : ($tags->{nh} + 1);
|
||||
$link->($next, $input{next});
|
||||
$link->($top_page, $input{last});
|
||||
}
|
||||
}
|
||||
return \$return;
|
||||
}
|
||||
1;
|
||||
88
site/glist/lib/GList/HTML.pm
Normal file
88
site/glist/lib/GList/HTML.pm
Normal file
@ -0,0 +1,88 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: HTML.pm,v 1.10 2004/03/01 21:38:38 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::HTML;
|
||||
|
||||
use strict;
|
||||
use GList q/:objects/;
|
||||
|
||||
sub date_get {
|
||||
#----------------------------------------------------------------------
|
||||
#
|
||||
my ($fld_name, $type) = @_;
|
||||
|
||||
my $tags = GT::Template->tags;
|
||||
my $format = $tags->{usr_date_format};
|
||||
$format =~ s/\#/\%/g;
|
||||
$format ||= '%mm%-%dd%-%yyyy%';
|
||||
$format .= ' %hh%:%MM%:%ss%' if ( $type );
|
||||
|
||||
require GT::Date;
|
||||
( $fld_name ) or return GT::Date::date_get(time, $format);
|
||||
|
||||
my $record = $tags->{results}[$tags->{row_num} - 1];
|
||||
return GT::Date::date_get($record->{$fld_name} || $tags->{$fld_name}, $format);
|
||||
}
|
||||
|
||||
sub html_unescape {
|
||||
#--------------------------------------------------------------------
|
||||
#
|
||||
my $content = shift;
|
||||
$content =~ s/\n/<br>/g;
|
||||
return $content;
|
||||
}
|
||||
|
||||
sub generate_attachments {
|
||||
#---------------------------------------------------------------------
|
||||
#
|
||||
my $col = shift || 'msg_id';
|
||||
|
||||
my $tags = GT::Template->tags;
|
||||
my $val = $tags->{results}[$tags->{row_num} - 1]->{$col};
|
||||
( $val ) or return;
|
||||
|
||||
my $sth;
|
||||
if ( $col eq 'msg_id' ) {
|
||||
$sth = $tags->{html}->{sql}->table('MessageAttachments')->select({ att_message_id_fk => $val });
|
||||
}
|
||||
else {
|
||||
$sth = $tags->{html}->{sql}->table('MailingAttachments')->select({ mat_mailing_id_fk => $val });
|
||||
}
|
||||
my $attachments;
|
||||
while ( my $rs = $sth->fetchrow_hashref ) {
|
||||
push @$attachments, $rs;
|
||||
}
|
||||
|
||||
return { attachments => ( !$attachments ) ? 0 : $attachments };
|
||||
}
|
||||
|
||||
sub generate_years {
|
||||
#-------------------------------------------------------------------
|
||||
#
|
||||
my $tags = GT::Template->tags;
|
||||
my $min = $tags->{html}->{sql}->table('MailingIndex')->select(['MIN(mli_done)'])->fetchrow_array || time;
|
||||
|
||||
require GT::Date;
|
||||
my $yy_min = GT::Date::date_get($min, '%yyyy%');
|
||||
my $yy_max = GT::Date::date_get(time, '%yyyy%');
|
||||
my @output;
|
||||
for my $i ( $yy_min .. $yy_max ) {
|
||||
push @output, { y => $i };
|
||||
}
|
||||
return { loop_years => \@output };
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
833
site/glist/lib/GList/List.pm
Normal file
833
site/glist/lib/GList/List.pm
Normal file
@ -0,0 +1,833 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: List.pm,v 1.50 2004/11/04 17:54:05 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::List;
|
||||
# ==================================================================
|
||||
|
||||
use strict;
|
||||
use GList qw/:objects :user_type $DEBUG/;
|
||||
use GT::AutoLoader;
|
||||
|
||||
sub process {
|
||||
#-------------------------------------------------------------------
|
||||
# Setermine what to do
|
||||
#
|
||||
my $do = shift;
|
||||
|
||||
my $action = _determine_action($do) or die "Error: Invalid Action! ($do)";
|
||||
my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
|
||||
|
||||
$tpl ||= 'lst_home.html';
|
||||
$MN_SELECTED = 2;
|
||||
|
||||
my $hidden = GList::hidden();
|
||||
$results->{hidden_query} = $hidden->{hidden_query};
|
||||
$results->{hidden_objects} = $hidden->{hidden_objects};
|
||||
GList::display($tpl, $results);
|
||||
}
|
||||
|
||||
$COMPILE{lst_home} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_home {
|
||||
#--------------------------------------------------------------------
|
||||
# Print home page
|
||||
#
|
||||
my $msg = shift;
|
||||
my $cgi = $IN->get_hash;
|
||||
if (defined $cgi->{do} and $cgi->{do} =~ /^lst_add|lst_modify|lst_html/) {
|
||||
foreach ( $DB->table('Lists')->cols ) { $cgi->{$_} = ''; }
|
||||
}
|
||||
my $search_check = ($IN->param('do') eq 'lst_search') ? 1 : 0;
|
||||
my $query = '';
|
||||
if ($cgi->{'lst_date_created-ge'} or $cgi->{'lst_date_created-le'}) {
|
||||
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
||||
my ($valid_from, $valid_to) = (1, 1);
|
||||
require GT::Date;
|
||||
if ($cgi->{'lst_date_created-ge'}) {
|
||||
$query .= "lst_date_created-ge=$cgi->{'lst_date_created-ge'};";
|
||||
$valid_from = GList::date_to_time($cgi->{'lst_date_created-ge'}, $format);
|
||||
$cgi->{'lst_date_created-ge'} = GT::Date::date_get($valid_from, $format);
|
||||
}
|
||||
if ($cgi->{'lst_date_created-le'}) {
|
||||
$query .= "lst_date_created-le=$cgi->{'lst_date_created-le'};";
|
||||
$valid_to = GList::date_to_time($cgi->{'lst_date_created-le'}, $format);
|
||||
$cgi->{'lst_date_created-le'} = GT::Date::date_get($valid_to, $format);
|
||||
}
|
||||
|
||||
if ($search_check and (!$valid_from or !$valid_to)) {
|
||||
$format =~ s/\%//g;
|
||||
return lst_search_form(GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')));
|
||||
}
|
||||
}
|
||||
my $results = GList::search(
|
||||
cgi => $cgi,
|
||||
db => $DB->table('Lists'),
|
||||
prefix => 'lst',
|
||||
sb => 'lst_title',
|
||||
so => 'ASC',
|
||||
search_check=> $search_check,
|
||||
select_all => $cgi->{select_all}
|
||||
);
|
||||
|
||||
if (ref $results ne 'HASH') {
|
||||
($IN->param('do') eq 'lst_search') ? return (lst_search_form($results))
|
||||
: return ('lst_home.html', { msg => $results });
|
||||
}
|
||||
elsif ($results->{error} and $search_check) {
|
||||
return lst_search_form($results->{error});
|
||||
}
|
||||
|
||||
require GT::SQL::Condition;
|
||||
my $subs = $DB->table('Subscribers');
|
||||
my $output = $results->{results};
|
||||
my @lists = map $_->{lst_id}, @$output;
|
||||
|
||||
$subs->select_options("GROUP BY sub_list_id_fk");
|
||||
my %subscribers = $subs->select(sub_list_id_fk => 'COUNT(*)', { sub_list_id_fk => \@lists })->fetchall_list;
|
||||
|
||||
$subs->select_options("GROUP BY sub_list_id_fk");
|
||||
my %validateds = $subs->select(sub_list_id_fk => 'COUNT(*)', { sub_list_id_fk => \@lists, sub_validated => 1 })->fetchall_list;
|
||||
|
||||
$subs->select_options("GROUP BY sub_list_id_fk");
|
||||
my %bounceds = $subs->select(sub_list_id_fk => 'COUNT(*)', GT::SQL::Condition->new(sub_list_id_fk => 'IN' => \@lists, sub_bounced => '>=' => 1))->fetchall_list;
|
||||
|
||||
foreach my $rs (@$output) {
|
||||
$rs->{subscribers} = $subscribers{$rs->{lst_id}};
|
||||
$rs->{validateds} = $validateds{$rs->{lst_id}};
|
||||
$rs->{bounceds} = $bounceds{$rs->{lst_id}};
|
||||
}
|
||||
|
||||
if ($cgi->{select_all}) {
|
||||
my $sorted = _qsort($results->{results}, $cgi->{sb}, ($cgi->{so} eq 'ASC') ? 1 : 0);
|
||||
my @sorted;
|
||||
my $mh = $results->{mh};
|
||||
my $nh = $results->{nh} || 1;
|
||||
my $bg = ( $nh == 1 ) ? 0 : ( $nh - 1 ) * $mh;
|
||||
my $count = 0;
|
||||
if ( $bg < $results->{hits} ) {
|
||||
foreach my $i (0..($results->{hits} - 1)) {
|
||||
if ($i >= $bg) {
|
||||
push @sorted, $sorted->[$i];
|
||||
last if ($#sorted == $mh - 1);
|
||||
}
|
||||
}
|
||||
$results->{results} = \@sorted;
|
||||
}
|
||||
else {
|
||||
$results->{results} = [];
|
||||
}
|
||||
}
|
||||
$results->{msg} = $msg if ($msg);
|
||||
return ('lst_home.html', { %$results, toolbar_query => $query });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_add} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_add {
|
||||
#--------------------------------------------------------------------
|
||||
#
|
||||
return ('lst_add_form.html') if ($IN->param('form'));
|
||||
|
||||
# Check account limit if it's a limited user
|
||||
if ($USER->{usr_type} == LIMITED_USER and GList::check_limit('list')) {
|
||||
return lst_home($GList::error);
|
||||
}
|
||||
|
||||
my $ret = GList::add('Lists', 'lst');
|
||||
return ('lst_add_form.html', { msg => "<font color=red>$GList::error</font>", help => 'lists_add.html' }) if ( $GList::error );
|
||||
|
||||
my $name = $IN->param('lst_title');
|
||||
return lst_home(GList::language('LST_ADD_SUCCESS', $name));
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_modify_form} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_modify_form {
|
||||
#--------------------------------------------------------------------
|
||||
# Print modify form
|
||||
#
|
||||
my $msg = shift;
|
||||
|
||||
return lst_home(GList::language('LST_INVALID')) unless ($IN->param('lst_id'));
|
||||
|
||||
my $info = GList::check_owner('Lists', 'lst', $IN->param('lst_id'));
|
||||
return home($info) if (ref $info ne 'HASH');
|
||||
|
||||
return ('lst_modify_form.html', { msg => $msg, %$info, help => 'lists_add.html' });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_modify} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_modify {
|
||||
#--------------------------------------------------------------------
|
||||
#
|
||||
GList::modify('Lists', 'lst');
|
||||
return lst_modify_form("<font color=red>$GList::error</font>") if ( $GList::error );
|
||||
|
||||
my $title = $IN->param('lst_title');
|
||||
lst_home(GList::language('LST_MOD_SUCCESS', $title));
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_search_form} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_search_form {
|
||||
#--------------------------------------------------------------------
|
||||
# Print add form
|
||||
#
|
||||
my $msg = shift;
|
||||
return ('lst_search_form.html', { msg => $msg });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_delete} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_delete {
|
||||
#--------------------------------------------------------------------
|
||||
# Delete lists
|
||||
#
|
||||
return lst_home(GList::delete('Lists', 'lst'));
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_html} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_html {
|
||||
#-----------------------------------------------------------------
|
||||
#
|
||||
return lst_home(GList::language('LST_INVALID')) unless ($IN->param('lst_id'));
|
||||
|
||||
my $info = GList::check_owner('Lists', 'lst', $IN->param('lst_id'));
|
||||
return lst_home($info) if (ref $info ne 'HASH');
|
||||
|
||||
my $msg = $CFG->{html_code};
|
||||
$msg =~ s/<%name%>/$info->{lst_title}/;
|
||||
$msg =~ s/<%id%>/$info->{lst_id}/;
|
||||
$msg =~ s/<%url%>/$CFG->{cgi_url}\/glist.cgi/;
|
||||
return ('lst_html.html', { msg => $msg, lst_title => $info->{lst_title} });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_import} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_import {
|
||||
#-----------------------------------------------------------------
|
||||
# Import data into subcribers table
|
||||
#
|
||||
return ('lst_import_form.html', { help => 'lists_import.html' }) if ($IN->param('form'));
|
||||
|
||||
my $data = $IN->param('sub_file') || $IN->param('sub_data');
|
||||
return ('lst_import_form.html', { msg => GList::language('LST_IPT_INVALID'), help => 'lists_import.html' }) unless ($data);
|
||||
return ('lst_import_form.html', { msg => GList::language('LST_IPT_LIST_EMPTY'), help => 'lists_import.html' }) unless ($IN->param('import_to'));
|
||||
|
||||
my $import_to = (ref $IN->param('import_to') eq 'ARRAY') ? $IN->param('import_to') : [$IN->param('import_to')];
|
||||
my $fd = $IN->param('fd') || ',';
|
||||
my $fe = $IN->param('fe') || '\\';
|
||||
my $rd = $IN->param('rd') || '\n';
|
||||
my $rl = $IN->param('rl') || 0;
|
||||
|
||||
# Setup the language for GT::SQL.
|
||||
local $GT::SQL::ERRORS->{UNIQUE} = GList::language('LST_IPT_DUPLICATE_EMAIL');
|
||||
local $GT::SQL::ERRORS->{NOTNULL} = GList::language('LST_IMP_NOTNULL') if ( GList::language('LST_IMP_NOTNULL') );
|
||||
local $GT::SQL::ERRORS->{ILLEGALVAL} = '';
|
||||
|
||||
my (@data, @results);
|
||||
if ($IN->param('sub_file')) { # from a text file
|
||||
my $file_name = $data;
|
||||
$file_name =~ s/.*?([^\\\/:]+)$/$1/;
|
||||
$file_name =~ s/[\[\]\s\$\#\%'"]/\_/g;
|
||||
$file_name = "$CFG->{priv_path}/tmp/$file_name";
|
||||
open (OUTFILE, "> $file_name") ;
|
||||
binmode(OUTFILE);
|
||||
my ($bytesread, $buffer, $count);
|
||||
while ($bytesread = read($data, $buffer, 1024)) {
|
||||
$buffer =~ s,\r\n,\n,g;
|
||||
print OUTFILE $buffer;
|
||||
}
|
||||
close OUTFILE;
|
||||
|
||||
if (!-T $file_name) {
|
||||
unlink $file_name;
|
||||
return lst_import_form(GList::language('LST_IPT_INVALID_FILE'));
|
||||
}
|
||||
|
||||
open (DATA, "< $file_name");
|
||||
my @lines = <DATA>;
|
||||
close DATA;
|
||||
unlink $file_name;
|
||||
|
||||
LINE: foreach (@lines) {
|
||||
$count++;
|
||||
( /^#/ ) and next LINE;
|
||||
( /^\s*$/ ) and next LINE;
|
||||
( $count eq $rl ) and next LINE;
|
||||
push @data, $_;
|
||||
}
|
||||
}
|
||||
else { # from listings
|
||||
@data = split(/$rd/, $data);
|
||||
}
|
||||
foreach my $id (@$import_to) {
|
||||
my $results = _import_subscriber($id, \@data);
|
||||
if (ref $results eq 'HASH') {
|
||||
push @results, $results;
|
||||
}
|
||||
else {
|
||||
push @results, { lst_id => $id, error => $results };
|
||||
}
|
||||
}
|
||||
return ('lst_import_success.html', { import_results => \@results });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_import_subscriber} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _import_subscriber {
|
||||
#-----------------------------------------------------------------
|
||||
#
|
||||
my ($list_id, $data) = @_;
|
||||
|
||||
# Verify data before importing
|
||||
return GList::language('LST_INVALID') if (!$list_id or !$data);
|
||||
|
||||
my $info = GList::check_owner('Lists', 'lst', $list_id);
|
||||
return $info if (ref $info ne 'HASH');
|
||||
|
||||
if (GList::check_limit('sublist', $list_id)) {
|
||||
return { list_name => $info->{lst_title}, overlimit => 1 };
|
||||
}
|
||||
my $db = $DB->table('Subscribers');
|
||||
my $fd = $IN->param('fd') || ',';
|
||||
my $fe = $IN->param('fe') || '\\';
|
||||
my $rd = $IN->param('rd') || '\n';
|
||||
my $rl = $IN->param('rl') || 0;
|
||||
|
||||
# Create stoplist database and load wild cards
|
||||
my $db_stl = $DB->table('StopLists');
|
||||
my $wild_cards = GList::wild_cards();
|
||||
|
||||
my @results;
|
||||
my ($invalid, $duplicate) = (0, 0);
|
||||
foreach my $row ( @$data ) {
|
||||
$row =~ s/[\r\n\"]//g; # Remove Windows linefeed character.
|
||||
if ($IN->param('cname')) {
|
||||
my ($n, $e) = split(/$fd/, $row);
|
||||
$e = $1 if ($e =~ /<([^> ]+)>/);
|
||||
$e = lc $e;
|
||||
my $error = _check_subscriber($e, $list_id, $db_stl, $wild_cards);
|
||||
if ($error) {
|
||||
push @results, { list_name => $info->{lst_title}, sub_email => $e || $n, status => $error };
|
||||
$invalid++;
|
||||
}
|
||||
else {
|
||||
push @results, { list_name => $info->{lst_title}, sub_email => $e || $n, status => '' };
|
||||
if ($db->count({ sub_email => $e, sub_list_id_fk => $list_id })) {
|
||||
$db->update({ sub_name => $n }, { sub_email => $e, sub_list_id_fk => $list_id }) if $n;
|
||||
$results[-1]->{status} = GList::language('SYS_DUPLICATE');
|
||||
$duplicate++;
|
||||
}
|
||||
else {
|
||||
$db->insert({ sub_email => $e, sub_name => $n, sub_created => time, sub_list_id_fk => $list_id, sub_user_id_fk => $info->{lst_user_id_fk} });
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$row = $1 if ($row =~ /<([^> ]+)>/);
|
||||
$row = lc $row;
|
||||
my $error = _check_subscriber($row, $list_id, $db_stl, $wild_cards);
|
||||
if ($error) {
|
||||
push @results, { list_name => $info->{lst_title}, sub_email => $row, status => $error };
|
||||
$invalid++;
|
||||
}
|
||||
else {
|
||||
push @results, { list_name => $info->{lst_title}, sub_email => $row, status => '' };
|
||||
if ($db->count({ sub_email => $row, sub_list_id_fk => $list_id })) {
|
||||
$results[-1]->{status} = GList::language('SYS_DUPLICATE');
|
||||
$duplicate++;
|
||||
}
|
||||
else {
|
||||
$db->insert({ sub_email => $row, sub_created => time, sub_list_id_fk => $list_id, sub_user_id_fk => $info->{lst_user_id_fk} });
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return {
|
||||
list_name => $info->{lst_title},
|
||||
results => \@results,
|
||||
invalid => $invalid,
|
||||
duplicate => $duplicate,
|
||||
hits => scalar @results,
|
||||
successful => scalar @results - $invalid - $duplicate,
|
||||
declined => $invalid + $duplicate
|
||||
};
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_check_subscriber} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _check_subscriber {
|
||||
#-----------------------------------------------------------------
|
||||
#
|
||||
my ($email, $lst_id, $db_stl, $wild_cards) = @_;
|
||||
return GList::language('LST_IPT_OVERLIMIT') if (GList::check_limit('sublist', $lst_id));
|
||||
return GList::language('LST_IPT_INVALID_EMAIL') if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/ );
|
||||
return GList::language('LST_IPT_ON_STOPLIST') if ($db_stl->count({ stl_email => $email }));
|
||||
foreach (@$wild_cards) {
|
||||
my $e = $_->[0];
|
||||
my $re = quotemeta $e;
|
||||
$re =~ s/\\\*/.*/;
|
||||
$re =~ s/\\\?/./;
|
||||
return GList::language('LST_IPT_ON_STOPLIST') if ($email =~ /$re/i);
|
||||
}
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_subscribers} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_subscribers {
|
||||
#--------------------------------------------------------------------
|
||||
# Print add form
|
||||
#
|
||||
my $do = shift || 0;
|
||||
|
||||
my $msg = ($do and $do =~ /^\d+$/) ? _sub_modify($do) : $do;
|
||||
if ($do =~ /^\d+$/ and ($do =~ /3|4/ or ($do == 1 and $IN->param('unbounced_form')))) { # Reset bounced emails
|
||||
return lst_unsub_bounced($msg);
|
||||
}
|
||||
return ('lst_subscriber_form.html') if ($IN->param('form'));
|
||||
|
||||
my $alpha;
|
||||
my $cgi = $IN->get_hash();
|
||||
my $hidden = GList::hidden;
|
||||
|
||||
# Create condition for subscriber's quick search bar
|
||||
require GT::SQL::Condition;
|
||||
my $cd = GT::SQL::Condition->new(lst_user_id_fk => '=' => $USER->{usr_username});
|
||||
my $cols = $DB->table('Subscribers')->cols;
|
||||
my $url = "glist.cgi?do=lst_subscribers$hidden->{hidden_query}";
|
||||
my $query= '';
|
||||
foreach my $c (keys % $cols) {
|
||||
next if (!$cgi->{$c});
|
||||
if ($c eq 'sub_list_id_fk') {
|
||||
$cd->add($c => '=' => $cgi->{$c});
|
||||
}
|
||||
else {
|
||||
$cd->add($c => 'like' => "%$cgi->{$c}%");
|
||||
}
|
||||
$url .= ";$c=$cgi->{$c}";
|
||||
}
|
||||
|
||||
# Do a search from the main page
|
||||
if ($IN->param('sub_search') and $IN->param('search_val')) {
|
||||
$cgi->{$cgi->{search_col}} = $cgi->{search_val};
|
||||
$url .= ";$cgi->{search_col}=$cgi->{$cgi->{search_col}}" if $cgi->{search_val};
|
||||
$query .= ";$cgi->{search_col}=$cgi->{$cgi->{search_col}}" if $cgi->{search_val};
|
||||
}
|
||||
# And from quick search bar
|
||||
if ($IN->param('alpha') and $IN->param('alpha') ne 'all') {
|
||||
$alpha = $IN->param('alpha');
|
||||
$query .= ";alpha=$alpha";
|
||||
}
|
||||
|
||||
# Search on date fields
|
||||
my $search_check = ($IN->param('search_form')) ? 1 : 0;
|
||||
if ($cgi->{'sub_created-ge'} or $cgi->{'sub_created-le'}) {
|
||||
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
||||
my ($valid_from, $valid_to) = (1, 1);
|
||||
|
||||
require GT::Date;
|
||||
if ($cgi->{'sub_created-ge'}) {
|
||||
$valid_from = GList::date_to_time($cgi->{'sub_created-ge'}, $format);
|
||||
$cgi->{'sub_created-ge'} = GT::Date::date_get($valid_from, $format) if ($valid_from);
|
||||
}
|
||||
if ($cgi->{'sub_created-le'}) {
|
||||
$valid_to = GList::date_to_time($cgi->{'sub_created-le'}, $format);
|
||||
$cgi->{'sub_created-le'} = GT::Date::date_get($valid_to, $format) if ($valid_to);
|
||||
}
|
||||
if ($search_check and (!$valid_from or !$valid_to)) {
|
||||
$format =~ s/\%//g;
|
||||
return ('lst_subscriber_form.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')) });
|
||||
}
|
||||
}
|
||||
if ($cgi->{sub_bounced}) {
|
||||
$cgi->{'sub_bounced-opt'} = '>=';
|
||||
}
|
||||
my $results = GList::search(
|
||||
cgi => $cgi,
|
||||
db => $DB->table('Subscribers'),
|
||||
prefix => 'sub',
|
||||
sb => 'sub_email',
|
||||
so => 'ASC',
|
||||
search_alpha=> $alpha,
|
||||
search_col => 'sub_email',
|
||||
search_check=> $search_check,
|
||||
show_user => $cgi->{show_user},
|
||||
return_msg => 'LST_SUB_RESULTS',
|
||||
);
|
||||
|
||||
my $page = ($IN->param('mn_disable')) ? 'lst_subscribers_preview.html' : 'lst_subscribers.html';
|
||||
my $subs_db = $DB->table('Lists', 'Subscribers');
|
||||
$subs_db->select_options('ORDER BY letter');
|
||||
|
||||
my $sth = $subs_db->select($cd, ['DISTINCT SUBSTRING(sub_email, 1, 1) as letter']);
|
||||
if (ref $results ne 'HASH') {
|
||||
$page = 'lst_subscriber_form.html' if ($search_check);
|
||||
return ($page, { msg => $msg || $results, search_bar => _search_bar($sth, $url) });
|
||||
}
|
||||
elsif ($results->{error} and $search_check) {
|
||||
return ('lst_subscriber_form.html', { msg => $results->{error} });
|
||||
}
|
||||
|
||||
if ($IN->param('mn_disable')) {
|
||||
$results->{msg} = '';
|
||||
}
|
||||
else {
|
||||
$results->{msg} = $msg if ($msg);
|
||||
}
|
||||
return ($page, { search_bar => _search_bar($sth, $url), toolbar_query => $query, %$results });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_sub_modify} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _sub_modify {
|
||||
#--------------------------------------------------------------------
|
||||
# Validate/delete subscribers user
|
||||
#
|
||||
my $do = shift;
|
||||
|
||||
# If they selected only one record to search we still need an array ref
|
||||
my $mod = ( ref $IN->param('modify') eq 'ARRAY' ) ? $IN->param('modify') : [$IN->param('modify')];
|
||||
my $db = $DB->table('Subscribers');
|
||||
my $cgi = $IN->get_hash;
|
||||
|
||||
my ($msg, $rec_modified) = ('', 0);
|
||||
if ($do == 1) { # Delete subscribers
|
||||
foreach my $rec_num ( @{$mod} ) {
|
||||
my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
|
||||
next if (!$info);
|
||||
|
||||
my $ret = $db->delete({ sub_id => $info->{sub_id} });
|
||||
if (defined $ret and $ret != 0) {
|
||||
$rec_modified++;
|
||||
}
|
||||
}
|
||||
$msg = GList::language('LST_SUB_DELETED', $rec_modified);
|
||||
}
|
||||
elsif ($do == 2) { # Validate subscribers
|
||||
foreach my $rec_num ( @{$mod} ) {
|
||||
my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
|
||||
next if (!$info);
|
||||
|
||||
if ($db->count({ sub_id => $info->{sub_id}, sub_validated => 0 })) {
|
||||
$db->update({ sub_validated => 1 }, { sub_id => $info->{sub_id} });
|
||||
$rec_modified++;
|
||||
}
|
||||
}
|
||||
$msg = GList::language('LST_SUB_VALIDATED', $rec_modified);
|
||||
}
|
||||
elsif ($do == 3) { # Unbounced subscribers
|
||||
require GT::SQL::Condition;
|
||||
foreach my $rec_num ( @{$mod} ) {
|
||||
my $info = GList::check_owner('Subscribers', 'sub', $cgi->{"$rec_num-sub_id"});
|
||||
next if (!$info);
|
||||
|
||||
if ($db->count(GT::SQL::Condition->new(sub_id => '=' => $info->{sub_id}, sub_bounced => '>=' => 1))) {
|
||||
$db->update({ sub_bounced => '0' }, { sub_id => $info->{sub_id} });
|
||||
$rec_modified++;
|
||||
}
|
||||
}
|
||||
$msg = GList::language('LST_SUB_UNBOUNCED', $rec_modified);
|
||||
}
|
||||
elsif ($do == 4) { # Remove all unbounced subscribers
|
||||
require GT::SQL::Condition;
|
||||
my $cond = new GT::SQL::Condition;
|
||||
$cond->add(sub_bounced => '>=' => 1, sub_user_id_fk => '=' => $USER->{usr_username});
|
||||
$cond->add(sub_list_id_fk => '=', $cgi->{list_id}) if $cgi->{list_id};
|
||||
if ($cgi->{sub_bounced} and $cgi->{sub_bounced} ne '*') {
|
||||
my $opt = $cgi->{'sub_bounced-opt'} || '=';
|
||||
$cond->add(sub_bounced => $opt => $cgi->{sub_bounced});
|
||||
}
|
||||
my $rec = $db->delete($cond);
|
||||
$msg = GList::language('LST_BOUNCED_REMOVED', $rec);
|
||||
}
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_unsub_bounced} = __LINE__ . <<'END_OF_SUB';
|
||||
sub lst_unsub_bounced {
|
||||
#--------------------------------------------------------------------
|
||||
# Let you to unsubscribe all bounced users
|
||||
#
|
||||
my $msg = shift;
|
||||
|
||||
my $cgi = $IN->get_hash();
|
||||
my %hash;
|
||||
my $conditions = '';
|
||||
$hash{sub_list_id_fk} = $cgi->{sub_list_id_fk} || '';
|
||||
$conditions .= ";list_id=$cgi->{sub_list_id_fk}" if $cgi->{sub_list_id_fk};
|
||||
|
||||
if ($cgi->{sub_bounced} and $cgi->{sub_bounced} eq '*') {
|
||||
$conditions .= ';sub_bounced=*';
|
||||
$hash{sub_bounced} = 1;
|
||||
$hash{'sub_bounced-opt'} = '>=';
|
||||
}
|
||||
else {
|
||||
$conditions .= ";sub_bounced=$cgi->{sub_bounced}";
|
||||
$conditions .= ";sub_bounced-opt=$cgi->{'sub_bounced-opt'}";
|
||||
if ($cgi->{'sub_bounced-opt'} and $cgi->{'sub_bounced-opt'} eq '<') {
|
||||
$hash{'sub_bounced-lt'} = $cgi->{sub_bounced};
|
||||
$hash{'sub_bounced-ge'} = 1;
|
||||
}
|
||||
elsif ($cgi->{'sub_bounced-opt'} and $cgi->{'sub_bounced-opt'} eq '<=') {
|
||||
$hash{'sub_bounced-le'} = $cgi->{sub_bounced};
|
||||
$hash{'sub_bounced-ge'} = 1;
|
||||
}
|
||||
else {
|
||||
$hash{sub_bounced} = $cgi->{sub_bounced} || 1;
|
||||
$hash{'sub_bounced-opt'} = $cgi->{'sub_bounced-opt'} || '>=';
|
||||
}
|
||||
}
|
||||
my $results = GList::search(
|
||||
cgi => \%hash,
|
||||
db => $DB->table('Subscribers'),
|
||||
prefix => 'sub',
|
||||
sb => 'sub_email',
|
||||
so => 'ASC',
|
||||
return_msg => 'LST_BOUNCED_RESULTS',
|
||||
int_field => 1,
|
||||
);
|
||||
if (ref $results ne 'HASH') {
|
||||
return ('lst_unsub_bounced.html', { msg => $msg || $results });
|
||||
}
|
||||
|
||||
$results->{msg} = $msg if ($msg);
|
||||
return ('lst_unsub_bounced.html', { %$results, conditions => $conditions });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_sub_add} = <<'END_OF_SUB';
|
||||
sub lst_sub_add {
|
||||
#-------------------------------------------------------------------
|
||||
# Add a subscriber
|
||||
#
|
||||
return ('lst_sub_add.html') if ($IN->param('form'));
|
||||
return ('lst_sub_add.html', { msg => GList::language('LST_IPT_LIST_EMPTY') }) if (!$IN->param('import_to'));
|
||||
|
||||
my $import_to = (ref $IN->param('import_to') eq 'ARRAY') ? $IN->param('import_to') : [$IN->param('import_to')];
|
||||
my $email = $IN->param('new_email');
|
||||
my $name = $IN->param('new_name');
|
||||
if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/) { # check email address
|
||||
return ('lst_sub_add.html', { msg => GList::language('LST_IPT_INVALID_EMAIL') });
|
||||
}
|
||||
$email = lc $email;
|
||||
|
||||
# Create stoplist database and load wild cards
|
||||
my $db = $DB->table('Subscribers');
|
||||
my $db_stl = $DB->table('StopLists');
|
||||
my $wild_cards = GList::wild_cards();
|
||||
|
||||
# Setup the language for GT::SQL.
|
||||
local $GT::SQL::ERRORS->{UNIQUE} = GList::language('SYS_DUPLICATE');
|
||||
local $GT::SQL::ERRORS->{NOTNULL} = GList::language('LST_IMP_NOTNULL') if ( GList::language('LST_IMP_NOTNULL') );
|
||||
local $GT::SQL::ERRORS->{ILLEGALVAL} = '';
|
||||
|
||||
my @results;
|
||||
foreach my $id (@$import_to) {
|
||||
my $info = GList::check_owner('Lists', 'lst', $id);
|
||||
push @results, { sub_email => $email, lst_title => $info->{lst_title}, status => lst_subscribers($info) } if ( ref $info ne 'HASH' );
|
||||
|
||||
push @results, { sub_email => $email, lst_title => $info->{lst_title}, status => '' };
|
||||
my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards);
|
||||
if ($error) {
|
||||
$results[-1]->{status} = $error;
|
||||
}
|
||||
elsif ($db->count({ sub_email => $email, sub_list_id_fk => $id })) {
|
||||
$results[-1]->{status} = GList::language('SYS_DUPLICATE');
|
||||
}
|
||||
else {
|
||||
$db->insert({ sub_email => $email, sub_name => $name, sub_list_id_fk => $id, sub_user_id_fk => $info->{lst_user_id_fk} });
|
||||
}
|
||||
}
|
||||
return ('lst_sub_success.html', { results => \@results, msg => GList::language('LST_SUB_ADDED', $email) });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_sub_modify} = <<'END_OF_SUB';
|
||||
sub lst_sub_modify {
|
||||
#-------------------------------------------------------------------
|
||||
# Modify a subscriber
|
||||
#
|
||||
my $sub_id = $IN->param('subid');
|
||||
my $old_data = $DB->table('Lists', 'Subscribers')->select({ sub_id => $sub_id }, [ 'lst_title', 'sub_email as new_email', 'sub_name as new_name', 'sub_validated as new_validated', 'sub_bounced as new_bounced', 'sub_list_id_fk'])->fetchrow_hashref;
|
||||
return lst_subscribers(GList::language('LST_INVALID')) if (!$old_data);
|
||||
|
||||
my $info = GList::check_owner('Lists', 'lst', $old_data->{sub_list_id_fk});
|
||||
return lst_subscribers($info) if (ref $info ne 'HASH');
|
||||
|
||||
return ('lst_sub_modify.html', $old_data) if ($IN->param('form'));
|
||||
|
||||
my $new_email = $IN->param('new_email');
|
||||
my $name = $IN->param('new_name');
|
||||
my $validated = ($IN->param('new_validated')) ? '1' : '0';
|
||||
my $bounced = $IN->param('new_bounced') || 0;
|
||||
|
||||
if ($new_email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $new_email =~ /\s/) { # check email address
|
||||
return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_INVALID_EMAIL'), %$info });
|
||||
}
|
||||
|
||||
require GT::SQL::Condition;
|
||||
if ($DB->table('Subscribers')->count( GT::SQL::Condition->new(
|
||||
sub_email => '=' => $new_email,
|
||||
sub_list_id_fk => '=' => $old_data->{sub_list_id_fk},
|
||||
sub_id => '<>'=> $sub_id,
|
||||
)) == 1 ) {
|
||||
return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_DUPLICATE_EMAIL'), %$info });
|
||||
}
|
||||
else {
|
||||
$DB->table('Subscribers')->update({
|
||||
sub_email => $new_email,
|
||||
sub_name => $name,
|
||||
sub_validated => $validated,
|
||||
sub_bounced => $bounced,
|
||||
}, { sub_id => $sub_id });
|
||||
}
|
||||
return lst_subscribers(GList::language('LST_SUB_MODIFIED', $old_data->{new_email}));
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
|
||||
$COMPILE{lst_sub_delete} = <<'END_OF_SUB';
|
||||
sub lst_sub_delete {
|
||||
#-------------------------------------------------------------------
|
||||
# Delete the subscribers
|
||||
#
|
||||
return lst_subscribers(1);
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_sub_validate} = <<'END_OF_SUB';
|
||||
sub lst_sub_validate {
|
||||
#-------------------------------------------------------------------
|
||||
# Validate the subscribers
|
||||
#
|
||||
return lst_subscribers(2);
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{lst_sub_unbounced} = <<'END_OF_SUB';
|
||||
sub lst_sub_unbounced {
|
||||
#-------------------------------------------------------------------
|
||||
# Validate the subscribers
|
||||
#
|
||||
my $action = $IN->param('all') ? 4 : 3;
|
||||
return lst_subscribers($action);
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_qsort} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _qsort {
|
||||
#------------------------------------------------------------------
|
||||
my ($list_file, $orderby, $sortdown) = @_;
|
||||
my $sorted;
|
||||
@$sorted =
|
||||
sort {
|
||||
my $da = lc $a->{$orderby}; #lower case
|
||||
my $db = lc $b->{$orderby};
|
||||
my $res;
|
||||
if ($orderby eq 'size' or $orderby eq 'date') {
|
||||
$res = $db <=> $da;
|
||||
}
|
||||
else {
|
||||
$res = $db cmp $da;
|
||||
}
|
||||
if ($res == 0 and $orderby ne 'name') {
|
||||
lc $b->{name} cmp lc $a->{name};
|
||||
}
|
||||
else {
|
||||
$res;
|
||||
}
|
||||
} @$list_file;
|
||||
($sortdown) and @$sorted = reverse @$sorted;
|
||||
return $sorted;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_search_bar} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _search_bar {
|
||||
#---------------------------------------------------------------------
|
||||
# create quick search bar
|
||||
#
|
||||
my ($sth, $url) = @_;
|
||||
my $current = $IN->param('alpha') || '';
|
||||
my @alpha = ('All', 'A'..'Z', '0..9', 'Other');
|
||||
|
||||
my ($search_bar, $items);
|
||||
$items->{All} = 'all';
|
||||
while (my ($letter) = $sth->fetchrow_array) {
|
||||
$letter = uc $letter;
|
||||
if ($letter =~ /\d/) {
|
||||
exists $items->{'0..9'} or $items->{'0..9'} = 'number';
|
||||
}
|
||||
elsif ($letter =~ /[\W_]/) {
|
||||
exists $items->{Other} or $items->{Other} = 'other';
|
||||
}
|
||||
else {
|
||||
exists $items->{$letter} or $items->{$letter} = $letter;
|
||||
}
|
||||
}
|
||||
foreach (@alpha) {
|
||||
if ($_ eq 'All') {
|
||||
$search_bar .= ( (!$current or $current eq 'all') and !$IN->param('bsearch') ) ? "<b>$_</b> " : "<a href='$url&alpha=all'>$_</a> ";
|
||||
}
|
||||
elsif ($items->{$_}) {
|
||||
my $l = ($_ eq '0..9') ? 'number' : lc $_;
|
||||
$search_bar .= ( lc $current eq lc $l ) ? "<b>$_</b> " : "<a href='$url;alpha=$l'>$_</a> ";
|
||||
}
|
||||
else {
|
||||
$search_bar .= "$_ ";
|
||||
}
|
||||
}
|
||||
return $search_bar;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _determine_action {
|
||||
#----------------------------------------------------------------------------
|
||||
# Check valid action
|
||||
#
|
||||
my $action = shift || undef;
|
||||
return if (!$action);
|
||||
return 'lst_home' if ($action eq 'lst_search' );
|
||||
|
||||
my %valid = (
|
||||
map { $_ => 1 } qw(
|
||||
lst_home
|
||||
lst_add
|
||||
lst_modify_form
|
||||
lst_modify
|
||||
lst_search_form
|
||||
lst_delete
|
||||
lst_html
|
||||
lst_import
|
||||
lst_subscribers
|
||||
lst_sub_add
|
||||
lst_sub_modify
|
||||
lst_sub_delete
|
||||
lst_sub_validate
|
||||
lst_sub_unbounced
|
||||
lst_unsub_bounced
|
||||
)
|
||||
);
|
||||
exists $valid{$action} and return $action;
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
1;
|
||||
|
||||
|
||||
1076
site/glist/lib/GList/Mailer.pm
Normal file
1076
site/glist/lib/GList/Mailer.pm
Normal file
File diff suppressed because it is too large
Load Diff
1185
site/glist/lib/GList/Message.pm
Normal file
1185
site/glist/lib/GList/Message.pm
Normal file
File diff suppressed because it is too large
Load Diff
167
site/glist/lib/GList/Plugins.pm
Normal file
167
site/glist/lib/GList/Plugins.pm
Normal file
@ -0,0 +1,167 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: Plugins.pm,v 1.9 2004/01/13 01:21:56 jagerman 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::Plugins;
|
||||
# ==================================================================
|
||||
use strict;
|
||||
use GList qw/$IN $CFG $USER/;
|
||||
|
||||
# ------------------------------------------------------------------------------------------------- #
|
||||
# Plugin config #
|
||||
# ------------------------------------------------------------------------------------------------- #
|
||||
|
||||
sub get_plugin_user_cfg {
|
||||
# --------------------------------------------------------------
|
||||
# Returns the user config hash for a given plugin.
|
||||
#
|
||||
my $class = ($_[0] eq 'GList::Plugins') ? shift : '';
|
||||
my $plugin_name = shift || return;
|
||||
my $cfg = GT::Plugins->load_cfg ( $CFG->{priv_path} . '/lib/GList/Plugins' );
|
||||
exists $cfg->{$plugin_name} or return {};
|
||||
(ref $cfg->{$plugin_name}->{user} eq 'ARRAY') or return {};
|
||||
|
||||
my $opts = {};
|
||||
foreach my $opt (@{$cfg->{$plugin_name}->{user}}) {
|
||||
$opts->{$opt->[0]} = $opt->[1];
|
||||
}
|
||||
return $opts;
|
||||
}
|
||||
|
||||
sub set_plugin_user_cfg {
|
||||
# --------------------------------------------------------------
|
||||
# Takes a plugin name and config hash and saves it.
|
||||
#
|
||||
my $class = ($_[0] eq 'GList::Plugins') ? shift : '';
|
||||
my $plugin_name = shift || return;
|
||||
my $hash = shift || return;
|
||||
|
||||
my $cfg = GT::Plugins->load_cfg ( $CFG->{priv_path} . '/lib/GList/Plugins' );
|
||||
exists $cfg->{$plugin_name} or return;
|
||||
(ref $cfg->{$plugin_name}->{user} eq 'ARRAY') or return {};
|
||||
|
||||
foreach my $opt (@{$cfg->{$plugin_name}->{user}}) {
|
||||
$opt->[1] = $hash->{$opt->[0]};
|
||||
}
|
||||
return GT::Plugins->save_cfg ( $CFG->{priv_path} . '/lib/GList/Plugins', $cfg );
|
||||
}
|
||||
|
||||
sub get_plugin_registry {
|
||||
# --------------------------------------------------------------
|
||||
# Returns the user config hash for a given plugin.
|
||||
#
|
||||
my $class = ($_[0] eq 'GList::Plugins') ? shift : '';
|
||||
my $plugin_name = shift || return;
|
||||
my $cfg = GT::Plugins->load_cfg ( $CFG->{priv_path} . '/lib/GList/Plugins' );
|
||||
exists $cfg->{$plugin_name} or return {};
|
||||
|
||||
return ( $cfg->{$plugin_name}->{registry} || {} );
|
||||
}
|
||||
|
||||
sub set_plugin_registry {
|
||||
# --------------------------------------------------------------
|
||||
# Takes a plugin name and config hash and saves it.
|
||||
#
|
||||
my $class = ($_[0] eq 'GList::Plugins') ? shift : '';
|
||||
my $plugin_name = shift || return;
|
||||
my $hash = shift || return;
|
||||
|
||||
my $cfg = GT::Plugins->load_cfg ( $CFG->{priv_path} . '/lib/GList/Plugins' );
|
||||
|
||||
exists $cfg->{$plugin_name} or return;
|
||||
|
||||
my $registry = ( $cfg->{$plugin_name}->{registry} ||= {} );
|
||||
foreach my $opt ( keys %{$hash} ) {
|
||||
$registry->{$opt} = $hash->{$opt};
|
||||
}
|
||||
|
||||
return GT::Plugins->save_cfg ( $CFG->{priv_path} . '/lib/GList/Plugins', $cfg );
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------------------------------------- #
|
||||
# Displaying #
|
||||
# ------------------------------------------------------------------------------------------------- #
|
||||
|
||||
sub manager {
|
||||
# -------------------------------------------------------------------
|
||||
# Manages the plugin installer, basically just creates an installerobject,
|
||||
# and returns the output. Real work is done in GT::Plugins::Installer
|
||||
#
|
||||
|
||||
require GT::Plugins::Manager;
|
||||
my $man = new GT::Plugins::Manager (
|
||||
cgi => $IN,
|
||||
tpl_root => "$CFG->{priv_path}/templates/$CFG->{template_set}",
|
||||
plugin_dir => $CFG->{priv_path} . "/lib/GList/Plugins",
|
||||
prog_name => 'mlist',
|
||||
prog_ver => $CFG->{version},
|
||||
prog_reg => $CFG->{reg_number},
|
||||
prefix => 'GList::Plugins::',
|
||||
base_url => "glist.cgi?do=admin_page&pg=plugin_manager.html".(( $USER->{use_cookie} ) ? '' : "&sid=$USER->{session_id}"),
|
||||
path_to_perl => $CFG->{path_to_perl},
|
||||
perl_args => "-cw -I$CFG->{priv_path}"
|
||||
) or return "Error loading plugin manager: $GT::Plugins::error";
|
||||
return $man->process;
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------------------------------------- #
|
||||
# Wizard #
|
||||
# ------------------------------------------------------------------------------------------------- #
|
||||
|
||||
sub wizard {
|
||||
# -------------------------------------------------------------------
|
||||
# Manages the plugin wizard, basically just creates a wizard object,
|
||||
# and returns the output. Real work is done in GT::Plugins::Wizard.
|
||||
#
|
||||
require GT::Plugins::Wizard;
|
||||
my $wiz = new GT::Plugins::Wizard (
|
||||
cgi => $IN,
|
||||
tpl_root => "$CFG->{priv_path}/templates/$CFG->{template_set}",
|
||||
plugin_dir => $CFG->{priv_path} . "/lib/GList/Plugins",
|
||||
prog_ver => $CFG->{version},
|
||||
install_header => 'use GList qw/$IN $DB $CFG/;',
|
||||
initial_indent => '',
|
||||
prefix => 'GList::Plugins::',
|
||||
dirs => {
|
||||
user_cgi => '$CFG->{cgi_path}',
|
||||
admin_cgi => '$CFG->{cgi_path}'
|
||||
}
|
||||
);
|
||||
return $wiz->process;
|
||||
}
|
||||
|
||||
# ------------------------------------------------------------------------------------------------- #
|
||||
# Displaying #
|
||||
# ------------------------------------------------------------------------------------------------- #
|
||||
|
||||
sub admin_menu {
|
||||
# -----------------------------------------------------------------
|
||||
# Displays the admin menu with the plugin options shown.
|
||||
#
|
||||
require GT::Plugins::Manager;
|
||||
my $man = new GT::Plugins::Manager(
|
||||
cgi => $IN,
|
||||
tpl_root => "$CFG->{priv_path}/templates/$CFG->{template_set}",
|
||||
plugin_dir => $CFG->{priv_path} . "/lib/GList/Plugins",
|
||||
prefix => 'GList::Plugins::',
|
||||
prog_name => 'glist',
|
||||
prog_ver => $CFG->{version},
|
||||
prog_reg => $CFG->{reg_number},
|
||||
base_url => 'glist.cgi?do=admin_page&pg=plugin_manager.html'.(( $USER->{use_cookie} ) ? '' : "&sid=$USER->{session_id}"),
|
||||
path_to_perl => $CFG->{path_to_perl},
|
||||
perl_args => "-cw -I$CFG->{priv_path}"
|
||||
);
|
||||
return { menu => $man->admin_menu, cgi_url => $CFG->{cgi_url} };
|
||||
}
|
||||
1;
|
||||
|
||||
103
site/glist/lib/GList/Plugins/SubscribersMod.pm
Normal file
103
site/glist/lib/GList/Plugins/SubscribersMod.pm
Normal file
@ -0,0 +1,103 @@
|
||||
# ==================================================================
|
||||
# GList::Plugins::SubscribersMod - Auto Generated Program Module
|
||||
#
|
||||
# GList::Plugins::SubscribersMod
|
||||
# Author : Virginia Lo
|
||||
# Version : 1
|
||||
# Updated : Wed Jun 4 12:24:28 2008
|
||||
#
|
||||
# ==================================================================
|
||||
#
|
||||
|
||||
package GList::Plugins::SubscribersMod;
|
||||
# ==================================================================
|
||||
|
||||
use strict;
|
||||
use GT::Base;
|
||||
use GT::Plugins qw/STOP CONTINUE/;
|
||||
use GList qw/$IN $DB $CFG/;
|
||||
|
||||
# Inherit from base class for debug and error methods
|
||||
@GList::Plugins::SubscribersMod::ISA = qw(GT::Base);
|
||||
|
||||
# Your code begins here.
|
||||
|
||||
|
||||
# PLUGIN HOOKS
|
||||
# ===================================================================
|
||||
|
||||
|
||||
sub lst_sub_modify {
|
||||
# -----------------------------------------------------------------------------
|
||||
# This subroutine will be called whenever the hook 'lst_sub_modify' is run. You
|
||||
# should call GT::Plugins->action(STOP) if you don't want the regular
|
||||
# 'lst_sub_modify' code to run, otherwise the code will continue as normal.
|
||||
#
|
||||
my (@args) = @_;
|
||||
|
||||
# Do something useful here
|
||||
GT::Plugins->action(STOP);
|
||||
|
||||
my $sub_id = $IN->param('subid');
|
||||
my $old_data = $DB->table('Lists', 'Subscribers')->select({ sub_id => $sub_id }, [ 'lst_title', 'sub_email as new_email', 'sub_name as new_name', 'sub_validated as new_validated', 'sub_bounced as new_bounced', 'sub_list_id_fk', 'Subscribers.*'])->fetchrow_hashref;
|
||||
return lst_subscribers(GList::language('LST_INVALID')) if (!$old_data);
|
||||
|
||||
my $cols = $DB->table('Subscribers')->cols;
|
||||
foreach (keys %$cols) {
|
||||
next if ($_ eq 'sub_created' or $_ eq 'sub_id' or $_ eq 'sub_user_id_fk' or $_ eq 'sub_list_id_fk' or $_ eq 'sub_val_code');
|
||||
my $key = $_;
|
||||
$key =~ s/sub_/new_/g;
|
||||
$old_data->{$key} ||= $old_data->{$_};
|
||||
delete $old_data->{$_};
|
||||
}
|
||||
|
||||
my $info = GList::check_owner('Lists', 'lst', $old_data->{sub_list_id_fk});
|
||||
return lst_subscribers($info) if (ref $info ne 'HASH');
|
||||
|
||||
return ('lst_sub_modify.html', $old_data) if ($IN->param('form'));
|
||||
|
||||
my $new_email = $IN->param('new_email');
|
||||
my $name = $IN->param('new_name');
|
||||
my $validated = ($IN->param('new_validated')) ? '1' : '0';
|
||||
my $bounced = $IN->param('new_bounced') || 0;
|
||||
|
||||
if ($new_email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $new_email =~ /\s/) { # check email address
|
||||
return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_INVALID_EMAIL'), %$info });
|
||||
}
|
||||
|
||||
require GT::SQL::Condition;
|
||||
if ($DB->table('Subscribers')->count( GT::SQL::Condition->new(
|
||||
sub_email => '=' => $new_email,
|
||||
sub_list_id_fk => '=' => $old_data->{sub_list_id_fk},
|
||||
sub_id => '<>'=> $sub_id,
|
||||
)) == 1 ) {
|
||||
return ('lst_sub_modify.html', { msg => GList::language('LST_IPT_DUPLICATE_EMAIL'), %$info });
|
||||
}
|
||||
else {
|
||||
my $update = {
|
||||
sub_email => $new_email,
|
||||
sub_name => $name,
|
||||
sub_validated => $validated,
|
||||
sub_bounced => $bounced,
|
||||
};
|
||||
foreach (keys %$cols) {
|
||||
my $key = $_;
|
||||
$key =~ s/sub_/new_/g;
|
||||
if ($IN->param($key)) {
|
||||
$update->{$_} ||= $IN->param($key);
|
||||
}
|
||||
}
|
||||
#use Data::Dumper; print $IN->header . "<pre>".Dumper($old_data,$update)."</pre>";
|
||||
$DB->table('Subscribers')->update({
|
||||
%$update
|
||||
}, { sub_id => $sub_id });
|
||||
}
|
||||
require GList::List;
|
||||
return GList::List::lst_subscribers(GList::language('LST_SUB_MODIFIED', $old_data->{new_email}));
|
||||
|
||||
|
||||
return @args;
|
||||
}
|
||||
|
||||
# Always end with a 1.
|
||||
1;
|
||||
393
site/glist/lib/GList/Profile.pm
Normal file
393
site/glist/lib/GList/Profile.pm
Normal file
@ -0,0 +1,393 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: Profile.pm,v 1.39 2004/10/14 22:57:54 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::Profile;
|
||||
|
||||
use strict;
|
||||
use GList qw/:objects :user_type $DEBUG/;
|
||||
use GT::AutoLoader;
|
||||
|
||||
sub process {
|
||||
#--------------------------------------------------
|
||||
# Determine what to do
|
||||
#
|
||||
my $do = $IN->param('do') || '';
|
||||
my $action = _determine_action($do) or die "Error: Invalid Action! ($do)";
|
||||
my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
|
||||
|
||||
if ($tpl) {
|
||||
my $hidden = GList::hidden();
|
||||
$results->{hidden_query} = $hidden->{hidden_query};
|
||||
$results->{hidden_objects} = $hidden->{hidden_objects};
|
||||
GList::display($tpl, $results);
|
||||
}
|
||||
}
|
||||
|
||||
$COMPILE{pro_profile} = <<'END_OF_SUB';
|
||||
sub pro_profile {
|
||||
#-------------------------------------------------------------------------
|
||||
# print account information
|
||||
#
|
||||
my $msg = shift;
|
||||
|
||||
my $db = $DB->table('Users');
|
||||
my $info = $db->get($USER->{usr_username});
|
||||
my $cols = $db->cols();
|
||||
|
||||
my $hsh = {};
|
||||
foreach (keys %$cols) {
|
||||
$hsh->{"mod_$_"} = $info->{$_};
|
||||
}
|
||||
my $pg = ($IN->param('pro_mailing')) ? 'pro_mailing.html' : 'pro_profile.html';
|
||||
return ($pg, { msg => $msg, %$hsh });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{pro_update} = <<'END_OF_SUB';
|
||||
sub pro_update {
|
||||
#---------------------------------------------------------
|
||||
# Update account information
|
||||
#
|
||||
|
||||
#------------demo code-----------
|
||||
|
||||
my $db = $DB->table('Users');
|
||||
my $cols = $db->cols();
|
||||
my $cgi = $IN->get_hash();
|
||||
my %restricted_field = (
|
||||
usr_username => 1,
|
||||
usr_password => 1,
|
||||
usr_status => 1,
|
||||
usr_type => 1,
|
||||
usr_limit_list => 1,
|
||||
usr_limit_sublist=> 1,
|
||||
usr_limit_email30=> 1,
|
||||
usr_validate_code=> 1
|
||||
);
|
||||
|
||||
my $hsh;
|
||||
foreach (keys %$cols) {
|
||||
next if (exists $restricted_field{$_});
|
||||
$hsh->{$_} = $cgi->{"mod_$_"} if (exists $cgi->{"mod_$_"});
|
||||
}
|
||||
|
||||
$hsh->{usr_date_format} = $IN->param('date_preview') if ($IN->param('date_preview'));
|
||||
$hsh->{usr_date_format}||= "%yyyy%-%mm%-%dd%";
|
||||
$hsh->{usr_username} = $USER->{usr_username};
|
||||
$hsh->{usr_updated} = '1';
|
||||
if ($db->modify($hsh)) {
|
||||
my $msg = ($cgi->{pro_mailing}) ? GList::language('USR_TPL_UPDATED') : GList::language('USR_UPDATED', $USER->{usr_username});
|
||||
return pro_profile($msg);
|
||||
}
|
||||
else {
|
||||
local $^W;
|
||||
return pro_profile("<font color=red><b>$GT::SQL::error</b></font>");
|
||||
}
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{pro_password} = <<'END_OF_SUB';
|
||||
sub pro_password {
|
||||
#---------------------------------------------------------
|
||||
# Update the new password
|
||||
#
|
||||
return ('pro_password_form.html') if ($IN->param('form'));
|
||||
#------------demo code-----------
|
||||
|
||||
my $old = $IN->param('old_pass');
|
||||
my $new = $IN->param('new_pass');
|
||||
my $con = $IN->param('con_pass');
|
||||
|
||||
return ('pro_password_form.html', { msg => GList::language('ADM_PWD_ERR') }) if (!$old or !$new or !$con);
|
||||
return ('pro_password_form.html', { msg => GList::language('ADM_PWD_NOT_MATCH') }) if ($new ne $con);
|
||||
return ('pro_password_form.html', { msg => GList::language('ADM_PWD_INVALID') }) if ($new ne $con or length $new < 4);
|
||||
|
||||
my $db = $DB->table('Users');
|
||||
my $user = $db->get($USER->{usr_username});
|
||||
|
||||
return ('pro_password_form.html', { msg => GList::language('ADM_OLDPWD_ERR') }) if ($user->{usr_password} ne GList::encrypt($old, $user->{usr_password}));
|
||||
my $crypted = GList::encrypt($new);
|
||||
if ($db->update({ usr_password => $crypted }, { usr_username => $USER->{usr_username} })) {
|
||||
if ($USER->{usr_type} == ADMINISTRATOR and exists $CFG->{admin}->{$USER->{usr_username}}) { # Update new password in Data.pm
|
||||
$CFG->{admin}->{$USER->{usr_username}}->[0] = $crypted;
|
||||
$CFG->save();
|
||||
}
|
||||
return pro_profile(GList::language('ADM_PWD_CHANGED'));
|
||||
}
|
||||
else {
|
||||
local $^W;
|
||||
return ('pro_password_form.html', { msg => "<font color=red><b>$GT::SQL::error</b></font>" });
|
||||
}
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{pro_report} = <<'END_OF_SUB';
|
||||
sub pro_report {
|
||||
#-----------------------------------------------------------
|
||||
# Build report
|
||||
#
|
||||
return ('pro_report_form.html') if ($IN->param('form'));
|
||||
|
||||
my $id = $IN->param('id');
|
||||
if ($USER->{usr_type} != ADMINISTRATOR) {
|
||||
return _report_details($USER->{usr_username});
|
||||
}
|
||||
elsif ($USER->{usr_type} == ADMINISTRATOR and $IN->param('d')) { # Show the details reports
|
||||
my $info = $DB->table('Users')->get($id);
|
||||
return ('pro_report.html', { msg => GList::language('RPT_NOT_FOUND', $id) }) if (!$info);
|
||||
return _report_details($id);
|
||||
}
|
||||
my ($from, $to, $mm, $yy, $msg, $url, $toolbar_query);
|
||||
my $date_format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
||||
my @items = ('date_to', 'date_from');
|
||||
|
||||
# Create url
|
||||
foreach (@items) {
|
||||
$url .= "&$_=".$IN->param($_) if ($IN->param($_));
|
||||
}
|
||||
|
||||
if ($IN->param('date_from') or $IN->param('date_to')) {
|
||||
require GT::Date;
|
||||
my $date_from = $IN->param('date_from');
|
||||
my $date_to = $IN->param('date_to');
|
||||
my ($valid_from, $valid_to) = (1, 1);
|
||||
if ($date_from) {
|
||||
$toolbar_query .= "date_from=$date_from;";
|
||||
$valid_from = GList::date_to_time($date_from, $date_format);
|
||||
$date_from = GT::Date::date_get($valid_from, $date_format) if ($valid_from);
|
||||
}
|
||||
if ($date_to) {
|
||||
$toolbar_query .= "date_to=$date_to;";
|
||||
$valid_to = GList::date_to_time($date_to, $date_format);
|
||||
$date_to = GT::Date::date_get($valid_to, $date_format) if ($valid_to);
|
||||
}
|
||||
if (!$valid_from or !$valid_to) {
|
||||
$date_format =~ s/\%//g;
|
||||
return ('pro_report_form.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')) });
|
||||
}
|
||||
|
||||
$from = GT::Date::timelocal(GT::Date::parse_format($date_from, $date_format));
|
||||
$to = GT::Date::timelocal(GT::Date::parse_format($date_to.' 23:59:59', "$date_format %hh%:%MM%:%ss%"));
|
||||
$msg = GList::language('RPT_CUS_FROM', $date_from)
|
||||
. ($IN->param('date_to') ? GList::language('RPT_CUS_TO', $date_to) : '')
|
||||
. '</b></font>';
|
||||
}
|
||||
else {
|
||||
($from, $to) = _period_time();
|
||||
($mm, $yy) = _period_time(1);
|
||||
$toolbar_query .= "month=".$IN->param('month').";" if ($IN->param('month'));
|
||||
$toolbar_query .= "year=".$IN->param('year').";" if ($IN->param('year'));
|
||||
if ($IN->param('month') or $IN->param('year') or !defined $IN->param('flag')) {
|
||||
$msg = GList::language('RPT_SUMARY'). (( $IN->param('flag') and !$IN->param('month') ) ? '' : "$mm/");
|
||||
$msg .= ( $IN->param('flag') and !$IN->param('month') ) ? $IN->param('year') : "$yy</b>";
|
||||
$url .= (( $IN->param('flag') and !$IN->param('month') ) ? '' : "&month=$mm"). "&year=$yy";
|
||||
}
|
||||
else {
|
||||
$msg = GList::language('RPT_TITLE2');
|
||||
}
|
||||
}
|
||||
|
||||
# Load database object
|
||||
require GT::SQL::Condition;
|
||||
my $db = $DB->table('MailingIndex');
|
||||
my $cd = new GT::SQL::Condition('mli_done', '>=', $from, 'mli_done', '<=', $to);
|
||||
$db->select_options('GROUP BY mli_user_id_fk ORDER BY mli_user_id_fk');
|
||||
$cd->add('mli_user_id_fk', 'like', "%$id%") if ( $id );
|
||||
|
||||
my $sth = $db->select($cd, ['mli_user_id_fk as email', 'count(mli_id) as sent']);
|
||||
my $hsh = {};
|
||||
while (my ($id, $sent) = $sth->fetchrow_array) {
|
||||
$hsh->{$id} += $sent;
|
||||
}
|
||||
|
||||
# Get user listings
|
||||
my $db_usr = $DB->table('Users');
|
||||
my $cd_usr = new GT::SQL::Condition();
|
||||
my $sb = $IN->param('sb') || 'usr_username';
|
||||
my $so = $IN->param('so') || 'ASC';
|
||||
$cd_usr->add('usr_username', 'like', "%$id%") if ( $id );
|
||||
|
||||
my $mh = $IN->param('mh') || 25;
|
||||
my $nh = $IN->param('nh') || 1;
|
||||
my $ns = ($nh == 1) ? 0 : ( $nh - 1 ) * $mh;
|
||||
|
||||
$db_usr->select_options("ORDER BY usr_type desc, $sb $so", "LIMIT $ns, $mh");
|
||||
my $users = $db_usr->select($cd_usr);
|
||||
my $hits = $db_usr->hits;
|
||||
return ('pro_report.html', { msg => GList::language('RPT_NO_RESULT') }) if ($hits == 0);
|
||||
|
||||
my @output;
|
||||
while ( my $rs = $users->fetchrow_hashref ) {
|
||||
$rs->{sent} = $hsh->{$rs->{usr_username}} if ($hsh->{$rs->{usr_username}});
|
||||
push @output, $rs;
|
||||
}
|
||||
|
||||
return ('pro_report.html', {
|
||||
msg => $msg,
|
||||
results => \@output,
|
||||
hits => $hits,
|
||||
mh => $mh,
|
||||
nh => $nh,
|
||||
url => $url,
|
||||
toolbar_query => $toolbar_query,
|
||||
});
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_report_details} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _report_details {
|
||||
#-----------------------------------------------------------
|
||||
# Build report details
|
||||
#
|
||||
my $id = shift;
|
||||
|
||||
my $cgi = $IN->get_hash();
|
||||
my $db = $DB->table('MailingIndex', 'EmailMailings');
|
||||
my $cd = new GT::SQL::Condition(mli_user_id_fk => '=' => $id, eml_sent => '<>' => 0);
|
||||
my $mh = $cgi->{mh} || 25;
|
||||
my $nh = $cgi->{nh} || 1;
|
||||
my $sb = $cgi->{sb} || 'mli_id';
|
||||
my $so = $cgi->{so} || 'DESC';
|
||||
my $ns = ( $nh == 1 ) ? 0 : ( $nh - 1 ) * $mh;
|
||||
|
||||
my $date_format = $USER->{usr_date_format} || '%mm%-%dd%-%yyyy%';
|
||||
|
||||
my $query = "id=$id;d=1;";
|
||||
my ($period, $mm, $yy, $from, $to);
|
||||
if ($cgi->{date_from} or $cgi->{date_to}) { # Searching by date
|
||||
require GT::Date;
|
||||
my ($valid_from, $valid_to) = (1, 1);
|
||||
my $date_from = $cgi->{date_from};
|
||||
my $date_to = $cgi->{date_to};
|
||||
|
||||
if ($date_from) {
|
||||
$query .= "date_from=$cgi->{date_from};";
|
||||
$period = " from <b>$cgi->{date_from}</b>";
|
||||
$valid_from = GList::date_to_time($cgi->{date_from}, $date_format);
|
||||
$date_from = GT::Date::date_get($valid_from, $date_format) if ($valid_from);
|
||||
}
|
||||
if ($date_to) {
|
||||
$query .= "date_to=$cgi->{date_to};";
|
||||
$period .= " to <b>$cgi->{date_to}";
|
||||
$valid_to = GList::date_to_time($date_to, $date_format);
|
||||
$date_to = GT::Date::date_get($valid_to, $date_format) if ($valid_to);
|
||||
}
|
||||
|
||||
if (!$valid_from or !$valid_to) {
|
||||
$date_format =~ s/\%//g;
|
||||
return ('pro_report_form.html', { msg => GList::language('SYS_DATE_FORMAT_INVALID', uc GList::language('SYS_DATE_FORMAT')) });
|
||||
}
|
||||
|
||||
$from = GT::Date::timelocal(GT::Date::parse_format($date_from, $date_format));
|
||||
$to = GT::Date::timelocal(GT::Date::parse_format($date_to.' 23:59:59', "$date_format %hh%:%MM%:%ss%"));
|
||||
}
|
||||
else {
|
||||
($from, $to) = _period_time();
|
||||
($mm, $yy) = _period_time(1);
|
||||
$period = (( $cgi->{month} ) ? "$cgi->{month}/$cgi->{year}" : $cgi->{year});
|
||||
$query .= "month=$cgi->{month};" if ($cgi->{month});
|
||||
$query .= "year=$cgi->{year};" if ($cgi->{year});
|
||||
}
|
||||
require GT::SQL::Condition;
|
||||
$cd->new('mli_done', '>=', $from, 'mli_done', '<=', $to);
|
||||
|
||||
$db->select_options("GROUP BY mli_id, mli_subject, mli_done ORDER BY $sb $so");
|
||||
$db->select($cd, ['mli_id', 'mli_subject', 'mli_done', 'count(eml_mailing_id_fk) as "sent"']);
|
||||
my $hits = $db->hits;
|
||||
return ('pro_report.html', { msg => GList::language('RPT_NO_RESULT') }) if ($hits == 0);
|
||||
|
||||
$db->select_options("GROUP BY mli_id, mli_subject, mli_done ORDER BY $sb $so", "LIMIT $ns, $mh");
|
||||
my $results = $db->select($cd, ['mli_id', 'mli_subject', 'mli_done', 'count(eml_mailing_id_fk) as "sent"'])->fetchall_hashref or die $GT::SQL::error;
|
||||
my ($total) = $db->select($cd, ['count(*) as total'])->fetchrow_array;
|
||||
my $msg = ( $period ) ? GList::language('RPT_TITLE', $period) : GList::language('RPT_TITLE2');
|
||||
return ('pro_report.html', {
|
||||
msg => $msg,
|
||||
results => $results,
|
||||
hits => $hits,
|
||||
mh => $mh,
|
||||
nh => $nh,
|
||||
url => "month=$mm;year=$yy;id=$id;d=1",
|
||||
total_recipients => $total,
|
||||
toolbar_query => $query
|
||||
});
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{pro_template} = <<'END_OF_SUB';
|
||||
sub pro_template {
|
||||
#-------------------------------------------------------------------------
|
||||
# Edit the email template
|
||||
#
|
||||
return ('pro_template.html');
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_period_time} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _period_time {
|
||||
#--------------------------------------------------------------------
|
||||
# Convert a date to unix time
|
||||
#
|
||||
my $type = shift;
|
||||
require GT::Date;
|
||||
require GT::SQL::Condition;
|
||||
my ($from, $to);
|
||||
my $mm = $IN->param('month') || GT::Date::date_get(time, '%mm%');
|
||||
my $yy = $IN->param('year') || GT::Date::date_get(time, '%yyyy%');
|
||||
return ($mm, $yy) if (defined $type and $type == 1);
|
||||
|
||||
if (!$IN->param('month') and $IN->param('flag')) {
|
||||
$type = 2;
|
||||
}
|
||||
|
||||
if ( !$type ) {
|
||||
$from = GT::Date::timelocal(GT::Date::parse_format("$yy-$mm-01", '%yyyy%-%mm%-%dd%'));
|
||||
$to = GT::Date::timelocal(GT::Date::parse_format("$yy-$mm-30 00:00:00", '%yyyy%-%mm%-%dd% %hh%:%MM%:%ss%'));
|
||||
}
|
||||
else {
|
||||
$from = GT::Date::timelocal(GT::Date::parse_format("$yy-01-01", '%yyyy%-%mm%-%dd%'));
|
||||
$to = GT::Date::timelocal(GT::Date::parse_format("$yy-12-31 23:59:59", '%yyyy%-%mm%-%dd% %hh%:%MM%:%ss%'));
|
||||
}
|
||||
return ($from, $to);
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _determine_action {
|
||||
#----------------------------------------------------------------------------
|
||||
# Check valid action
|
||||
#
|
||||
my $action = shift || undef;
|
||||
if ( $action =~ /pro_report/ ) {
|
||||
$MN_SELECTED = 4;
|
||||
}
|
||||
else {
|
||||
$MN_SELECTED = 5;
|
||||
}
|
||||
return if ( !$action );
|
||||
|
||||
my %valid = (
|
||||
map { $_ => 1 } qw(
|
||||
pro_profile
|
||||
pro_update
|
||||
pro_password
|
||||
pro_report
|
||||
pro_template
|
||||
)
|
||||
);
|
||||
exists $valid{$action} and return $action;
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
1;
|
||||
448
site/glist/lib/GList/SQL.pm
Normal file
448
site/glist/lib/GList/SQL.pm
Normal file
@ -0,0 +1,448 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: SQL.pm,v 1.40 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::SQL;
|
||||
|
||||
use strict;
|
||||
use vars qw/@TABLES $EMAIL_RE/;
|
||||
use GList qw/$DB $CFG/;
|
||||
|
||||
@TABLES = qw/Users Users_Sessions EmailTemplates Messages Lists Subscribers
|
||||
MailingIndex EmailMailings CatMessages CatMailing MessageAttachments
|
||||
MailingAttachments StopLists/;
|
||||
|
||||
$EMAIL_RE = '.@\S+\.\S+$';
|
||||
|
||||
# Index naming format:
|
||||
#
|
||||
# a_bcd[_q]
|
||||
#
|
||||
# Where "a" is (usually) the capital letters from the table name (i.e. EmailTemplates gets "et"),
|
||||
# except for CatMailing, which is cml, and MailingAttachments, which is mla.
|
||||
#
|
||||
# b,c,d,... correspond to the following:
|
||||
#
|
||||
# b - sub_bounced
|
||||
# c - *_cat_id_fk | eml_code
|
||||
# d - session_date | mli_delete
|
||||
# e - usr_email | sub_email | stl_email
|
||||
# l - *_list_id_fk
|
||||
# m - *_message_id_fk
|
||||
# n - tpl_name | mli_done
|
||||
# t - lst_title
|
||||
# u - *_user_id_fk
|
||||
# v - sub_validated
|
||||
#
|
||||
# Finally, the optional "_q" is used for unique indices.
|
||||
#
|
||||
|
||||
sub tables {
|
||||
#----------------------------------------------------------------
|
||||
# Defines the SQL tables
|
||||
#
|
||||
my $action = shift || 'warn';
|
||||
my $output = '';
|
||||
|
||||
#---------- Users Table -----------------
|
||||
create_table(\$output, 'Users', $action,
|
||||
cols => [
|
||||
usr_username => { type => 'CHAR', size => 50, not_null => 1, form_display => 'User Name' },
|
||||
usr_email => { type => 'CHAR', size => 50, not_null => 1, form_display => 'Email Address', form_regex => $EMAIL_RE },
|
||||
usr_password => { type => 'CHAR', size => 100, not_null => 1, form_display => 'Password' },
|
||||
usr_type => { type => 'TINYINT', not_null => 1, default => 1, form_display => 'Type' },
|
||||
usr_reply_email => { type => 'CHAR', size => 100, not_null => 0, form_display => 'Reply to Email', form_regex => $EMAIL_RE },
|
||||
usr_bounce_email => { type => 'CHAR', size => 100, not_null => 0, form_display => 'Bounce Email', form_regex => $EMAIL_RE },
|
||||
usr_date_format => { type => 'CHAR', size => 50, form_display => 'Date Format' },
|
||||
usr_compose_mode => { type => 'CHAR', size => 5, form_display => 'Editor Advanced', default => 'text' },
|
||||
usr_editor_advanced => { type => 'TINYINT', not_null => 1, default => 0 },
|
||||
usr_status => { type => 'TINYINT', default => '1', form_display => 'Status' },
|
||||
usr_limit_list => { type => 'INT', default => '0', form_display => 'Limit Number of List' },
|
||||
usr_limit_sublist => { type => 'INT', default => '0', form_display => 'Limit Number of subscriber per List' },
|
||||
usr_limit_email30 => { type => 'INT', default => '0', form_display => 'Limit Number of Email Sending in The Last 30 days' },
|
||||
usr_mail_host => { type => 'CHAR', size => 100, form_display => 'Server Mail hostname' },
|
||||
usr_mail_port => { type => 'CHAR', size => 3, form_display => 'Server Mail port' },
|
||||
usr_mail_account => { type => 'CHAR', size => 50, form_display => 'Mail Account' },
|
||||
usr_mail_password => { type => 'CHAR', size => 20, form_display => 'Mail Password' },
|
||||
usr_validate_code => { type => 'CHAR', size => 32, binary => 1, form_display => 'Validate Code' },
|
||||
usr_updated => { type => 'TINYINT', default => '0', form_display => 'Account Updated' },
|
||||
usr_header_html => { type => 'TEXT', default => '', form_display => 'Mailing Header' },
|
||||
usr_header_text => { type => 'TEXT', default => '', form_display => 'Mailing Header' },
|
||||
usr_footer_html => { type => 'TEXT', default => '', form_display => 'Mailing Footer' },
|
||||
usr_footer_text => { type => 'TEXT', default => '', form_display => 'Mailing Footer' },
|
||||
pro_first_name => { type => 'CHAR', size => 20, not_null => 1, form_display => 'First Name', form_size => '35' },
|
||||
pro_last_name => { type => 'CHAR', size => 30, not_null => 1, form_display => 'Last Name', form_size => '35' },
|
||||
pro_company => { type => 'CHAR', size => 100, form_display => 'Company Name', form_size => '35' },
|
||||
pro_url => { type => 'CHAR', size => 255, form_display => 'URL', form_size => '35' },
|
||||
],
|
||||
pk => 'usr_username',
|
||||
unique => {
|
||||
u_e_q => ['usr_email']
|
||||
}
|
||||
);
|
||||
|
||||
#---------- Users_Sessions Table -----------------
|
||||
create_table(\$output, 'Users_Sessions', $action,
|
||||
cols => [
|
||||
session_id => { type => 'CHAR', binary => 1, size => 32, not_null => 1 },
|
||||
session_user_id => { type => 'CHAR', size => 50 },
|
||||
session_date => { type => 'INT', not_null => 1 },
|
||||
session_data => { type => 'TEXT' }
|
||||
],
|
||||
pk => 'session_id',
|
||||
fk => {
|
||||
Users => { session_user_id => 'usr_username' }
|
||||
},
|
||||
index => {
|
||||
us_d => ['session_date']
|
||||
}
|
||||
);
|
||||
|
||||
#---------- EmailTemplates Table -----------------
|
||||
create_table(\$output, 'EmailTemplates', $action,
|
||||
cols => [
|
||||
tpl_id => { type => 'INT', not_null=> 1, form_display => 'ID' },
|
||||
tpl_user_id_fk => { type => 'CHAR', size => 50, not_null => 1, form_display => 'User Name' },
|
||||
tpl_name => { type => 'CHAR', size => 50, not_null => 1, form_display => 'Template Name' },
|
||||
tpl_to => { type => 'CHAR', size => 50, not_null => 1, form_display => 'To' },
|
||||
tpl_subject => { type => 'CHAR', size => 100,not_null => 1, form_display => 'Subject' },
|
||||
tpl_from => { type => 'CHAR', size => 100,not_null => 1, form_display => 'From' },
|
||||
tpl_extra => { type => 'CHAR', size => 255, form_display => 'Extra Header' },
|
||||
tpl_body => { type => 'TEXT', not_null=> 1, form_display => 'Email Body' },
|
||||
],
|
||||
pk => 'tpl_id',
|
||||
ai => 'tpl_id',
|
||||
|
||||
unique => {
|
||||
et_un_q => [qw/tpl_user_id_fk tpl_name/]
|
||||
},
|
||||
fk => { Users => { tpl_user_id_fk => 'usr_username' } }
|
||||
);
|
||||
|
||||
#---------- CatMessages Table -----------------
|
||||
create_table(\$output, 'CatMessages', $action,
|
||||
cols => [
|
||||
cms_id => { type => 'INT', not_null => 1, form_display => 'ID' },
|
||||
cms_name => { type => 'CHAR', not_null => 1, size => 30, form_display => 'Folder Name' },
|
||||
cms_user_id_fk => { type => 'CHAR', not_null => 1, size => 50, form_display => 'User ID' },
|
||||
],
|
||||
pk => 'cms_id',
|
||||
ai => 'cms_id',
|
||||
index => {
|
||||
cm_u => ['cms_user_id_fk']
|
||||
},
|
||||
fk => { Users => { cms_user_id_fk => 'usr_username' } }
|
||||
);
|
||||
|
||||
#---------- Messages Table -----------------
|
||||
create_table(\$output, 'Messages', $action,
|
||||
cols => [
|
||||
msg_id => { type => 'INT', not_null => 1, form_display => 'Message ID' },
|
||||
msg_mode => { type => 'CHAR', size => 5, default => 'text', form_display => 'Message Mode' },
|
||||
msg_charset => { type => 'CHAR', size => 15, not_null => 1, default => 'us-ascii', form_display => 'Charset'},
|
||||
msg_subject => { type => 'CHAR', size => 100, not_null => 1, form_display => 'Subject', 'weight' => '1' },
|
||||
msg_from_name => { type => 'CHAR', size => 70, form_display => 'From Name' },
|
||||
msg_from_email => { type => 'CHAR', size => 100, not_null => 1, form_display => 'From Email', form_regex => $EMAIL_RE },
|
||||
msg_reply_to => { type => 'CHAR', size => 100, not_null => 1, form_display => 'Reply to Email', form_regex => $EMAIL_RE },
|
||||
msg_bounce_email => { type => 'CHAR', size => 100, not_null => 1, form_display => 'Bounce Email', form_regex => $EMAIL_RE },
|
||||
msg_created => { type => 'INT', form_display => 'Name' },
|
||||
msg_content_text => { type => 'LONGTEXT', form_display => 'TEXT Content', 'weight' => '1' },
|
||||
msg_content_html => { type => 'LONGTEXT', form_display => 'HTML Content', 'weight' => '1' },
|
||||
msg_cat_id_fk => { type => 'INT', default => 0, not_null => 1, form_display => 'Category ID' },
|
||||
msg_status => { type => 'TINYINT', default => 0, form_display => 'Status' },
|
||||
msg_track_open => { type => 'TINYINT', not_null => 1, default => 0, form_display => 'Track Number of Users opening this message' },
|
||||
msg_track_click => { type => 'TINYINT', not_null => 1, default => 0, form_display => 'Track Number of Clicks' },
|
||||
msg_user_id_fk => { type => 'CHAR', size => 50, not_null => 1, form_display => 'User ID' },
|
||||
],
|
||||
pk => 'msg_id',
|
||||
ai => 'msg_id',
|
||||
fk => {
|
||||
Users => { msg_user_id_fk => 'usr_username' },
|
||||
CatMessages => { msg_cat_id_fk => 'cms_id' }
|
||||
},
|
||||
index => {
|
||||
m_uc => [qw/msg_user_id_fk msg_cat_id_fk/]
|
||||
}
|
||||
);
|
||||
|
||||
#---------- MessageAttachments Table -----------------
|
||||
create_table(\$output, 'MessageAttachments', $action,
|
||||
cols => [
|
||||
att_id => { type => 'INT', not_null => 1, form_display => 'ID' },
|
||||
att_message_id_fk => { type => 'INT', not_null => 1, form_display => 'Campaign ID' },
|
||||
att_file_name => { type => 'CHAR', size => 255, form_display => 'File Name' },
|
||||
att_file_size => { type => 'INT', form_display => 'File Size' },
|
||||
],
|
||||
pk => 'att_id',
|
||||
ai => 'att_id',
|
||||
fk => { Messages => { att_message_id_fk => 'msg_id' } },
|
||||
index => {
|
||||
ma_m => ['att_message_id_fk']
|
||||
}
|
||||
);
|
||||
|
||||
#---------- Lists Table -----------------
|
||||
create_table(\$output, 'Lists', $action,
|
||||
cols => [
|
||||
lst_id => { type => 'INT', not_null => 1, form_display => 'List ID' },
|
||||
lst_title => { type => 'CHAR', size => 50, not_null => 1, form_display => 'List Name', weight => '1' },
|
||||
lst_description => { type => 'TEXT', form_display => 'Name', weight => '1' },
|
||||
lst_opt => { type => 'TINYINT', form_display => 'Double Opt In', default => '0' },
|
||||
lst_opt_template => { type => 'CHAR', size => 50, form_display => 'Opt In Template' },
|
||||
lst_subs_template => { type => 'CHAR', size => 50, form_display => 'Subscriber Template' },
|
||||
lst_unsubs_template => { type => 'CHAR', size => 50, form_display => 'Unsubscriber Template' },
|
||||
lst_date_created => { type => 'INT', form_display => 'Created' },
|
||||
lst_url_subscribe_success => { type => 'CHAR', size => 255, form_display => 'Success Subscribe URL' },
|
||||
lst_url_validate_success => { type => 'CHAR', size => 255, form_display => 'Success Validate URL' },
|
||||
lst_url_unsubscribe_success => { type => 'CHAR', size => 255, form_display => 'Success Unsubscribe URL' },
|
||||
lst_url_subscribe_failure => { type => 'CHAR', size => 255, form_display => 'Failure Subscribe URL' },
|
||||
lst_url_unsubscribe_failure => { type => 'CHAR', size => 255, form_display => 'Failure Unsubscribe URL' },
|
||||
lst_user_id_fk => { type => 'CHAR', size => 50, not_null => 1, form_display => 'User ID' },
|
||||
],
|
||||
pk => 'lst_id',
|
||||
ai => 'lst_id',
|
||||
fk => { Users => { lst_user_id_fk => 'usr_username' } },
|
||||
index => {
|
||||
l_ut => [qw/lst_user_id_fk lst_title/]
|
||||
}
|
||||
);
|
||||
|
||||
#---------- Subscribers Table -----------------
|
||||
create_table(\$output, 'Subscribers', $action,
|
||||
cols => [
|
||||
sub_id => { type => 'INT', not_null => 1, form_display => 'Subscriber ID' },
|
||||
sub_email => { type => 'CHAR', size => 50, not_null => 1, form_display => 'Subscriber Email', form_regex => $EMAIL_RE, weight => '1' },
|
||||
sub_name => { type => 'CHAR', size => 50, form_display => 'Subscriber Name', weight => '1' },
|
||||
sub_created => { type => 'INT', form_display => 'Created' },
|
||||
sub_list_id_fk => { type => 'INT', not_null => 1, form_display => 'List ID' },
|
||||
sub_validated => { type => 'TINYINT', not_null => 1, default => 1, form_display => 'Validated' },
|
||||
sub_val_code => { type => 'CHAR', size => 50, form_display => 'Validation Code' },
|
||||
sub_bounced => { type => 'INT', not_null => 1, default => 0, form_display => 'Bounced Email' },
|
||||
sub_user_id_fk => { type => 'CHAR', size => 50, not_null => 1, form_display => 'User ID' },
|
||||
],
|
||||
|
||||
pk => 'sub_id',
|
||||
ai => 'sub_id',
|
||||
fk => {
|
||||
Lists => { sub_list_id_fk => 'lst_id' },
|
||||
Users => { sub_user_id_fk => 'usr_username' }
|
||||
},
|
||||
index => {
|
||||
s_lb => [qw/sub_list_id_fk sub_bounced/],
|
||||
s_lvb => [qw/sub_list_id_fk sub_validated sub_bounced/],
|
||||
s_ue => [qw/sub_user_id_fk sub_email/],
|
||||
s_e => [qw/sub_email/]
|
||||
},
|
||||
unique => {
|
||||
s_le_q => [qw/sub_list_id_fk sub_email/]
|
||||
}
|
||||
);
|
||||
|
||||
#---------- CatMailing Table -----------------
|
||||
create_table(\$output, 'CatMailing', $action,
|
||||
cols => [
|
||||
cm_id => { type => 'INT', not_null => 1, form_display => 'ID' },
|
||||
cm_name => { type => 'CHAR', not_null => 1, size => 30, form_display => 'Folder Name' },
|
||||
cm_type => { type => 'TINYINT', default => '1', form_display => 'Type' },
|
||||
cm_user_id_fk => { type => 'CHAR', not_null => 1, size => 50, form_display => 'User ID' },
|
||||
],
|
||||
pk => 'cm_id',
|
||||
ai => 'cm_id',
|
||||
fk => { Users => { cm_user_id_fk => 'usr_username' } },
|
||||
index => {
|
||||
cml_u => ['cm_user_id_fk']
|
||||
}
|
||||
);
|
||||
|
||||
#---------- MailingIndex Table -----------------
|
||||
create_table(\$output, 'MailingIndex', $action,
|
||||
cols => [
|
||||
mli_id => { type => 'INT', not_null => 1, form_display => 'Mailing ID' },
|
||||
mli_done => { type => 'INT', default => 0, form_display => 'Done' },
|
||||
mli_from => { type => 'CHAR', size => 100, form_display => 'From Email', form_regex => $EMAIL_RE },
|
||||
mli_name => { type => 'CHAR', size => 50, form_display => 'From Name' },
|
||||
mli_reply_to => { type => 'CHAR', size => 100, form_display => 'Reply To Email', form_regex => $EMAIL_RE },
|
||||
mli_bounce_email => { type => 'CHAR', size => 100, form_display => 'Bounce Email', form_regex => $EMAIL_RE },
|
||||
mli_charset => { type => 'CHAR', size => 15, not_null => 1, default => 'us-ascii', form_display => 'Charset'},
|
||||
mli_subject => { type => 'CHAR', size => 100, form_display => 'Subject', 'weight' => '1' },
|
||||
mli_message_text => { type => 'LONGTEXT', form_display => 'TEXT Message', 'weight' => '1' },
|
||||
mli_message_html => { type => 'LONGTEXT', form_display => 'HTML Message', 'weight' => '1' },
|
||||
mli_cat_id_fk => { type => 'INT', not_null => 1, default => 0, form_display => 'Category ID' },
|
||||
mli_delete => { type => 'TINYINT', not_null => 1, default => 0, form_display => 'Delete' },
|
||||
mli_track_open => { type => 'TINYINT', not_null => 1, default => 0, form_display => 'Track Number of Users opening this message' },
|
||||
mli_track_click => { type => 'TINYINT', not_null => 1, default => 0, form_display => 'Track Number of clicks' },
|
||||
mli_num_opened => { type => 'INT', not_null => 1, default => 0, form_display => 'Number of Users opening this message' },
|
||||
mli_num_clicked => { type => 'INT', not_null => 1, default => 0, form_display => 'Number of clicks' },
|
||||
mli_scheduled => { type => 'TINYINT', not_null => 1, default => 0, form_display => 'Scheduled Mailing' },
|
||||
mli_user_id_fk => { type => 'CHAR', size => 50, not_null => 1, form_display => 'User ID' }
|
||||
],
|
||||
pk => 'mli_id',
|
||||
ai => 'mli_id',
|
||||
fk => {
|
||||
Users => { mli_user_id_fk => 'usr_username' },
|
||||
CatMailing => { mli_cat_id_fk => 'cm_id' }
|
||||
},
|
||||
|
||||
index => {
|
||||
mi_ucdn => [qw/mli_user_id_fk mli_cat_id_fk mli_delete mli_done/],
|
||||
mi_c => ['mli_cat_id_fk']
|
||||
}
|
||||
);
|
||||
|
||||
#---------- EmailMailings Table -----------------
|
||||
create_table(\$output, 'EmailMailings', $action,
|
||||
cols => [
|
||||
eml_id => { type => 'INT', not_null => 1, form_display => 'ID' },
|
||||
eml_mailing_id_fk => { type => 'INT', not_null => 1, form_display => 'Mailing ID' },
|
||||
eml_email => { type => 'CHAR', size => 50, not_null => 1, form_display => 'Email Address', form_regex => $EMAIL_RE },
|
||||
eml_name => { type => 'CHAR', size => 50, form_display => 'Name' },
|
||||
eml_sent => { type => 'INT', not_null => 1, default => 0 },
|
||||
eml_bounced => { type => 'TINYINT', not_null => 1, default => 0 },
|
||||
eml_skipped => { type => 'TINYINT', not_null => 1, default => 0 },
|
||||
eml_opened => { type => 'INT', not_null => 1, default => 0 },
|
||||
eml_code => { type => 'CHAR', size => 100 => not_null => 1 },
|
||||
eml_lists => { type => 'TEXT', default => '' },
|
||||
],
|
||||
pk => 'eml_id',
|
||||
ai => 'eml_id',
|
||||
fk => { MailingIndex => { eml_mailing_id_fk => 'mli_id' } },
|
||||
index => {
|
||||
em_mb => [qw/eml_mailing_id_fk eml_bounced/],
|
||||
em_ms => [qw/eml_mailing_id_fk eml_sent/],
|
||||
em_mo => [qw/eml_mailing_id_fk eml_opened/],
|
||||
em_e => [qw/eml_email/],
|
||||
em_c => [qw/eml_code/],
|
||||
},
|
||||
unique => {
|
||||
em_me_q => [qw/eml_mailing_id_fk eml_email/]
|
||||
}
|
||||
);
|
||||
|
||||
#---------- ScheduledMailings Table -----------------
|
||||
create_table(\$output, 'ScheduledMailings', $action,
|
||||
cols => [
|
||||
scm_id => { type => 'INT', not_null => 1, form_display => 'Schedule ID'},
|
||||
scm_hour => { type => 'INT', default => 0, form_display => 'Hour' },
|
||||
scm_minute => { type => 'INT', default => 0, form_display => 'Minute' },
|
||||
scm_type => { type => 'TINYINT', default => 0, form_display => 'Schedule Type' },
|
||||
scm_option => { type => 'CHAR', size => 10, default => '', form_display => 'Option' },
|
||||
scm_text_url => { type => 'CHAR', size => 225, default => '', form_display => 'Text URL' },
|
||||
scm_html_url => { type => 'CHAR', size => 225, default => '', form_display => 'Html URL' },
|
||||
scm_inprocess => { type => 'TINYINT', default => 0, form_display => 'In Process' },
|
||||
scm_sent => { type => 'INT', default => 0, form_display => 'Sent Time' },
|
||||
scm_mailing_id_fk => { type => 'INT', default => 0, form_display => 'Mailing ID' },
|
||||
],
|
||||
ai => 'scm_id',
|
||||
pk => 'scm_id',
|
||||
unique => {
|
||||
sm_m_q => [qw/scm_mailing_id_fk/]
|
||||
},
|
||||
fk => { MailingIndex => { scm_mailing_id_fk => 'mli_id' } }
|
||||
);
|
||||
|
||||
#---------- MailingAttachments Table -----------------
|
||||
create_table(\$output, 'MailingAttachments', $action,
|
||||
cols => [
|
||||
mat_id => { type => 'INT', not_null => 1, form_display => 'ID' },
|
||||
mat_mailing_id_fk => { type => 'INT', not_null => 1, form_display => 'Mailing ID' },
|
||||
mat_file_name => { type => 'CHAR', size => 255, form_display => 'File Name' },
|
||||
mat_file_size => { type => 'INT', form_display => 'File Size' },
|
||||
],
|
||||
pk => 'mat_id',
|
||||
ai => 'mat_id',
|
||||
fk => { MailingIndex => { mat_mailing_id_fk => 'mli_id' } },
|
||||
index => {
|
||||
mla_m => ['mat_mailing_id_fk']
|
||||
}
|
||||
);
|
||||
|
||||
#---------- StopLists Table -----------------
|
||||
create_table(\$output, 'StopLists', $action,
|
||||
cols => [
|
||||
stl_id => { type => 'INT', not_null => 1, form_display => 'ID' },
|
||||
stl_email => { type => 'CHAR', size => 50, not_null => 1, form_display => 'Email Address', form_regex => $EMAIL_RE },
|
||||
],
|
||||
pk => 'stl_id',
|
||||
ai => 'stl_id',
|
||||
unique => {
|
||||
s_e_q => ['stl_email']
|
||||
}
|
||||
);
|
||||
|
||||
return $output;
|
||||
}
|
||||
|
||||
sub create_table {
|
||||
my ($output, $table, $action, @def) = @_;
|
||||
|
||||
$$output .= "Creating $table table ... ";
|
||||
my $c = $DB->creator($table);
|
||||
$c->clear_schema() if $action eq 'force';
|
||||
|
||||
@def % 2 and die "Odd number of table defs passed to create_table()";
|
||||
while (@def) {
|
||||
my ($meth, $arg) = splice @def, 0, 2;
|
||||
$c->$meth($arg);
|
||||
}
|
||||
|
||||
if ($c->create($action)) {
|
||||
$$output .= "okay\n";
|
||||
return 1;
|
||||
}
|
||||
else {
|
||||
$GT::SQL::errcode if 0; # silence "used only once" warnings
|
||||
$$output .= $GT::SQL::errcode eq 'TBLEXISTS' ? "failed (table already exists)\n" : "failed ($GT::SQL::error)\n";
|
||||
$c->set_defaults;
|
||||
$c->save_schema;
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub load_from_sql {
|
||||
# ---------------------------------------------------------------
|
||||
# Creates def files based on existing tables.
|
||||
#
|
||||
my ($output, $return);
|
||||
foreach my $table (@TABLES) {
|
||||
$output .= "$table .. ";
|
||||
my $c = $DB->creator($table);
|
||||
$return = $c->load_table($table);
|
||||
if ($return) {
|
||||
$output .= "ok\n";
|
||||
$c->save_schema();
|
||||
}
|
||||
else {
|
||||
$output .= "failed: $GT::SQL::error\n";
|
||||
}
|
||||
}
|
||||
return $output;
|
||||
}
|
||||
|
||||
sub load {
|
||||
# ---------------------------------------------------------------
|
||||
# Return a hash of current connection settings.
|
||||
#
|
||||
my %h = ();
|
||||
$h{prefix} = $DB->prefix();
|
||||
$h{database} = $DB->{connect}->{database};
|
||||
$h{login} = $DB->{connect}->{login};
|
||||
$h{password} = $DB->{connect}->{password};
|
||||
$h{host} = $DB->{connect}->{host};
|
||||
$h{host} .= ":" . $DB->{connect}->{port} if $DB->{connect}->{port};
|
||||
$h{driver} = $DB->{connect}->{driver};
|
||||
return \%h;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
144
site/glist/lib/GList/Template.pm
Normal file
144
site/glist/lib/GList/Template.pm
Normal file
@ -0,0 +1,144 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: Template.pm,v 1.6 2004/03/10 01:04:53 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::Template;
|
||||
# ==================================================================
|
||||
use strict;
|
||||
|
||||
use GList qw/:objects $DEBUG/;
|
||||
use GList::Config;
|
||||
use GT::Template;
|
||||
use vars qw/@ISA %VARS %MVARS/;
|
||||
|
||||
@ISA = qw/GT::Template/;
|
||||
|
||||
# Need to reset %VARS on each access of the page for mod_perl.
|
||||
# Takes no args.
|
||||
sub reset_env {
|
||||
%VARS = ();
|
||||
}
|
||||
|
||||
# Takes no args, returns all the mlist globals
|
||||
sub globals {
|
||||
my $g = {
|
||||
version => $GList::CFG->{version},
|
||||
image_url => $GList::CFG->{image_url},
|
||||
cgi_url => $GList::CFG->{cgi_url},
|
||||
root_path => $GList::CFG->{root_path},
|
||||
priv_path => $GList::CFG->{priv_path}
|
||||
};
|
||||
|
||||
if ($ENV{HTTP_USER_AGENT} and $ENV{HTTP_USER_AGENT} =~ /MSIE (\d+(?:\.\d+)?)/i and $ENV{HTTP_USER_AGENT} !~ /mac/i) {
|
||||
$g->{is_ie} = 1;
|
||||
$g->{ie_version} = $1;
|
||||
}
|
||||
|
||||
$g;
|
||||
}
|
||||
|
||||
# Takes 0 or 1 args - the template set. If not provided, it will try to use hidden 't' or else fall back to the Config default.
|
||||
sub template_globals {
|
||||
|
||||
my $globals = GT::Config->load("$GList::CFG->{priv_path}/templates/common/globals.txt", { create_ok => 1, inheritance => 1, local => 1, compile_subs => 'GList', header => <<HEADER });
|
||||
# This file is auto-generated and contains a perl hash of your
|
||||
# global variables for the template set.
|
||||
# Generated: [localtime]
|
||||
# vim:syn=perl:ts=4
|
||||
|
||||
HEADER
|
||||
|
||||
my $ret = {}; # Since we are converting the values in $globals to scalar references, the cache will become screwed up under mod_perl, so we have to copy them out into this.
|
||||
|
||||
for (keys %$globals) {
|
||||
my $val = $globals->{$_};
|
||||
if (ref $val) {
|
||||
$ret->{$_} = $val;
|
||||
}
|
||||
else {
|
||||
$val =~ s/<%image_url%>/$CFG->{image_url}/g;
|
||||
$ret->{$_} = \$val;
|
||||
}
|
||||
}
|
||||
|
||||
$ret;
|
||||
}
|
||||
|
||||
# This is useful to set variables inside a loop, then retrieve them outside the
|
||||
# loop. It stores them in %VARS.
|
||||
# It takes args as a hash ref.
|
||||
sub store_gvars {
|
||||
my %vars = @_;
|
||||
@MVARS{keys %vars} = values %vars;
|
||||
return;
|
||||
}
|
||||
|
||||
# Takes no args, but returns a reference to the hash containing the "kept"
|
||||
# variables that were set inside some sort of loop
|
||||
sub retrieve_gvars {
|
||||
\%MVARS
|
||||
}
|
||||
|
||||
# Takes all the args of GT::Template, but this changes them a bit before giving them to
|
||||
# GT::Template to add on the variables, globals, and template set globals.
|
||||
sub parse {
|
||||
my $globals = globals();
|
||||
my $set_globals = template_globals();
|
||||
|
||||
my $self = shift;
|
||||
|
||||
local %MVARS; # Localize this so that it will be empty for this parse
|
||||
my $page = $_[0];
|
||||
my ($vars, $opt) = @_[1, 2];
|
||||
my ($retvars, $retopt);
|
||||
if (ref $vars eq 'ARRAY') {
|
||||
# put it on the beginning so that anything else will overwrite it
|
||||
$retvars = [{ ($set_globals ? (%$set_globals) : ()), %$globals, %VARS }, @$vars]
|
||||
}
|
||||
elsif (ref $vars eq 'HASH' or UNIVERSAL::isa($vars, 'GT::Config')) {
|
||||
$retvars = {%$vars};
|
||||
# %VARS is first because it overrides mlist globals and template set globals.
|
||||
for (keys %VARS) {
|
||||
$retvars->{$_} = $VARS{$_} unless exists $retvars->{$_}
|
||||
}
|
||||
# Generally, installation globals should be be overridable by template set globals.
|
||||
for (keys %$globals) {
|
||||
$retvars->{$_} = $globals->{$_} unless exists $retvars->{$_}
|
||||
}
|
||||
# Template set globals are considered last and are only set if nothing else has set them.
|
||||
for (keys %$set_globals) {
|
||||
$retvars->{$_} = $set_globals->{$_} unless exists $retvars->{$_}
|
||||
}
|
||||
}
|
||||
elsif (ref $vars) {
|
||||
$retvars = [{ %$set_globals, %$globals, %VARS }, $vars]
|
||||
}
|
||||
else {
|
||||
$retvars = { %$set_globals, %$globals, %VARS }
|
||||
}
|
||||
|
||||
# Put the "escape" option on by default - it specifically has to be
|
||||
# specified as 0 to disable it.
|
||||
if ($opt) {
|
||||
$retopt = {%$opt};
|
||||
$retopt->{escape} = 1 unless exists $retopt->{escape};
|
||||
$retopt->{compress} = $CFG->{compress} unless exists $retopt->{compress};
|
||||
}
|
||||
else {
|
||||
$retopt = { escape => 1, compress => $CFG->{compress} };
|
||||
}
|
||||
$retopt->{debug_level} = $CFG->{debug_level} if $CFG->{debug_level};
|
||||
$self->SUPER::parse($_[0], $retvars, $retopt, @_[3 .. $#_]);
|
||||
}
|
||||
|
||||
1;
|
||||
532
site/glist/lib/GList/Tools.pm
Normal file
532
site/glist/lib/GList/Tools.pm
Normal file
@ -0,0 +1,532 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: Tools.pm,v 1.37 2004/10/06 17:58:17 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::Tools;
|
||||
|
||||
use strict;
|
||||
use GList qw/:objects $LANGUAGE $GLOBALS/;
|
||||
|
||||
use constants KB => 1024, MB => 1024 * 1024;
|
||||
|
||||
sub generate_used_bar {
|
||||
#-------------------------------------------------------------------
|
||||
#
|
||||
my ($type, $max_width) = @_;
|
||||
|
||||
my ($percent, $img_width, $msg) = (0, 0, '');
|
||||
if ($type eq 'email30') {
|
||||
require GT::Date;
|
||||
require GT::SQL::Condition;
|
||||
my $last30 = GT::Date::date_sub(GT::Date::date_get(), 30);
|
||||
my $unix_time = GList::date_to_time($last30);
|
||||
my $num_sent = $DB->table('MailingIndex', 'EmailMailings')->count(
|
||||
GT::SQL::Condition->new(
|
||||
mli_user_id_fk => '=' => $USER->{usr_username},
|
||||
eml_sent => '>=' => $unix_time
|
||||
)
|
||||
);
|
||||
if ($num_sent >= $USER->{usr_limit_email30}) {
|
||||
$percent = 100;
|
||||
$img_width = $max_width;
|
||||
}
|
||||
else {
|
||||
$percent = int(100 * $num_sent / $USER->{usr_limit_email30});
|
||||
$img_width = int($num_sent * $max_width / $USER->{usr_limit_email30});
|
||||
}
|
||||
$msg = GList::language('SYS_USEDBAR_EMAIL30', $percent, $USER->{usr_limit_email30});
|
||||
}
|
||||
elsif ($type eq 'sublist') {
|
||||
my $num_lists = $DB->table('Lists')->count({ lst_user_id_fk => $USER->{usr_username} });
|
||||
my $num_subs = $DB->table('Subscribers')->count({ sub_user_id_fk => $USER->{usr_username} });
|
||||
my $sub_limit = ($num_lists) ? $num_lists * $USER->{usr_limit_sublist} : $USER->{usr_limit_sublist};
|
||||
if ($num_subs >= $sub_limit) {
|
||||
$percent = 100;
|
||||
$img_width = $max_width;
|
||||
}
|
||||
else {
|
||||
$percent = int(100 * $num_subs / $sub_limit);
|
||||
$img_width = int($num_subs * $max_width / $sub_limit);
|
||||
}
|
||||
$msg = GList::language('SYS_USEDBAR_SUBLIST', $percent, $sub_limit);
|
||||
}
|
||||
return { used_message => $msg, used_percent => $percent, used_image_width => $img_width };
|
||||
}
|
||||
|
||||
sub generate_list {
|
||||
# ------------------------------------------------------------------
|
||||
# Generates a list of lists
|
||||
#
|
||||
my $object = shift;
|
||||
|
||||
my $tags = GT::Template->tags;
|
||||
my $lists = $DB->table('Lists');
|
||||
$lists->select_options('ORDER BY lst_Title');
|
||||
|
||||
my $sth = $lists->select({ lst_user_id_fk => $tags->{usr_username} }) or die $GT::SQL::error;
|
||||
my $html = "";
|
||||
my $current = $tags->{$object};
|
||||
while ( my $rs = $sth->fetchrow_hashref ) {
|
||||
if (ref $current eq 'ARRAY') {
|
||||
my $id = 0;
|
||||
foreach (@$current) {
|
||||
if ($_ == $rs->{lst_id}) {
|
||||
$id = $_;last;
|
||||
}
|
||||
}
|
||||
$html .= ( $id == $rs->{lst_id} ) ? "<option value='$rs->{lst_id}' selected>$rs->{lst_title}</option>"
|
||||
: "<option value='$rs->{lst_id}'>$rs->{lst_title}</option>";
|
||||
}
|
||||
else {
|
||||
$html .= ( $current == $rs->{lst_id} ) ? "<option value='$rs->{lst_id}' selected>$rs->{lst_title}</option>"
|
||||
: "<option value='$rs->{lst_id}'>$rs->{lst_title}</option>";
|
||||
}
|
||||
}
|
||||
return $html;
|
||||
}
|
||||
|
||||
sub default_email_editor {
|
||||
#------------------------------------------------------------------
|
||||
# Load the default email templates editor
|
||||
#
|
||||
my $tags = GT::Template->tags;
|
||||
|
||||
my $cgi = $IN->get_hash();
|
||||
my $selected_dir = $cgi->{tpl_dir} || $CFG->{template_set} || 'gossamer';
|
||||
|
||||
my $demo;
|
||||
#------------demo code-----------
|
||||
|
||||
# Build the select lists.
|
||||
my $d_select_list = _template_dir_select();
|
||||
my ($f_select_list, $selected_file) = _default_select("$CFG->{priv_path}/templates/$selected_dir", $cgi->{tpl_file});
|
||||
|
||||
return { select_list => $f_select_list, tpl_dir => "$CFG->{priv_path}/templates/", selected_dir => $selected_dir, dir_select => $d_select_list, demo => $demo, tpl_file => $selected_file, bload => ($selected_file) ? 1 : 0 };
|
||||
}
|
||||
|
||||
sub email_editor {
|
||||
#------------------------------------------------------------------
|
||||
# Load the email template editor
|
||||
#
|
||||
my $tags = GT::Template->tags;
|
||||
|
||||
my $cgi = $IN->get_hash();
|
||||
|
||||
my $tpl = {};
|
||||
my $db = $DB->table('EmailTemplates');
|
||||
my $cols = $db->cols;
|
||||
my ($msg, $error, $demo);
|
||||
|
||||
#------------demo code-----------
|
||||
|
||||
# Save the email template
|
||||
my $save_as = $cgi->{save_as};
|
||||
if ( $cgi->{bsave} and $save_as ) {
|
||||
if ( $demo ) {
|
||||
$msg = '<font color="red">Edit email template has been disabled in the demo!</font>';
|
||||
}
|
||||
else {
|
||||
my @required = ('tpl_to', 'tpl_from', 'tpl_subject', 'tpl_body');
|
||||
my $hsh = {};
|
||||
foreach ( @required ) {
|
||||
$hsh->{$_} = $cgi->{$_} if ( defined $cgi->{$_} );
|
||||
}
|
||||
$hsh->{tpl_user_id_fk} = $tags->{usr_username};
|
||||
$hsh->{tpl_name} = $save_as;
|
||||
if ( $cgi->{tpl_extra} ) {
|
||||
for ( split /\s*\n\s*/, $cgi->{tpl_extra} ) { # This will weed out any blank lines
|
||||
my ($key, $value) = split /\s*:\s*/, $_, 2;
|
||||
$hsh->{tpl_extra} .= "$key: $value\n" if $key and $value;
|
||||
}
|
||||
}
|
||||
else {
|
||||
$hsh->{tpl_extra} = '';
|
||||
}
|
||||
|
||||
foreach ( @required ) {
|
||||
if ( !$hsh->{$_} ) {
|
||||
$msg = GList::language('TPL_INVALID');
|
||||
$error = 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
if ( !$msg ) {
|
||||
if ( $save_as eq $cgi->{tpl_name} ) { # Update an exist template
|
||||
$db->update($hsh, { tpl_user_id_fk => $tags->{usr_username}, tpl_name => $save_as });
|
||||
$msg = ( $GT::SQL::error ) ? "<font color=red><b>$GT::SQL::error</b></font>" : GList::language('TPL_UPDATED', $save_as);
|
||||
}
|
||||
else { # Add a new template
|
||||
$db->insert($hsh);
|
||||
$msg = ( $GT::SQL::error ) ? "<font color=red><b>$GT::SQL::error</b></font>" : GList::language('TPL_ADDED', $save_as);
|
||||
$cgi->{tpl_name} = $save_as if ( !$GT::SQL::error );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ( $cgi->{txtdelete} ) { # Delete an existing template
|
||||
if ( $demo ) {
|
||||
$msg = '<font color="red">Edit email template has been disabled in the demo !</font>';
|
||||
}
|
||||
else {
|
||||
require GT::SQL::Condition;
|
||||
my $cond = GT::SQL::Condition->new('lst_user_id_fk', '=', $tags->{usr_username});
|
||||
$cond->add(GT::SQL::Condition->new('lst_opt_template', '=', $cgi->{tpl_name}, 'lst_subs_template', '=', $cgi->{tpl_name}, 'lst_unsubs_template', '=', $cgi->{tpl_name}, 'OR'));
|
||||
|
||||
my $sth = $DB->table('Lists')->select($cond);
|
||||
if ( $sth->rows ) {
|
||||
$msg = GList::language('TPL_DELETE_ERROR', $cgi->{tpl_name});
|
||||
}
|
||||
else {
|
||||
$db->delete({ tpl_user_id_fk => $tags->{usr_username}, tpl_name => $cgi->{tpl_name} });
|
||||
$msg = ( $GT::SQL::error ) ? "<font color=red><b>$GT::SQL::error</b></font>" : GList::language('TPL_DELETED', $cgi->{tpl_name});
|
||||
}
|
||||
}
|
||||
}
|
||||
elsif ( $cgi->{bdefault} ) { # Load default templates
|
||||
GList::set_default_template('validation.eml', $tags->{usr_username});
|
||||
GList::set_default_template('subscribe.eml', $tags->{usr_username});
|
||||
GList::set_default_template('unsubscribe.eml', $tags->{usr_username});
|
||||
$msg = ( $GT::SQL::error ) ? "<font color=red><b>$GT::SQL::error</b></font>" : GList::language('TPL_LOADED');
|
||||
}
|
||||
|
||||
# Build the select lists.
|
||||
my $f_current_list = _current_select('tpl_name', $cgi->{tpl_name});
|
||||
if ( $cgi->{tpl_name} and !$GT::SQL::error and !$error ) {
|
||||
$tpl = $db->get({ tpl_user_id_fk => $tags->{usr_username}, tpl_name => $cgi->{tpl_name} });
|
||||
if ( !$tpl ) {
|
||||
foreach (keys %$cols) { $tpl->{$_} = ''; }
|
||||
}
|
||||
}
|
||||
|
||||
return { current_list => $f_current_list, msg => $msg, %$tpl };
|
||||
}
|
||||
|
||||
sub template_editor {
|
||||
# ------------------------------------------------------------------
|
||||
# Loads the template editor.
|
||||
#
|
||||
_editor_obj()->process;
|
||||
}
|
||||
|
||||
sub language_editor {
|
||||
# ------------------------------------------------------------------
|
||||
# Loads the language file editor.
|
||||
#
|
||||
my $tags = GT::Template->tags;
|
||||
|
||||
my ($font, $message, $table);
|
||||
my $cgi = $IN->get_hash;
|
||||
my $selected_dir = $cgi->{tpl_dir} || $CFG->{template_set} || 'gossamer';
|
||||
|
||||
$font = 'face="Tahoma,Arial,Helvetica" size="2"';
|
||||
|
||||
my $demo;
|
||||
#------------demo code-----------
|
||||
|
||||
GList::load_language($selected_dir);
|
||||
|
||||
if ($cgi->{save}) {
|
||||
if ($demo) {
|
||||
$message = '<font color="red">The language editor has been disabled in the demo!</font>';
|
||||
}
|
||||
else {
|
||||
my $need_save;
|
||||
foreach my $code (keys %$cgi) {
|
||||
if ($code =~ /^del-(.*)$/) {
|
||||
delete $LANGUAGE->{$1};
|
||||
++$need_save;
|
||||
}
|
||||
elsif ($code =~ /^save-(.*)/) {
|
||||
my $key = $1;
|
||||
next if $cgi->{"del-$key"};
|
||||
my $var = $cgi->{$code};
|
||||
$var =~ s/\r\n/\n/g; # Remove windows linefeeds.
|
||||
next if exists $LANGUAGE->{$key} and $LANGUAGE->{$key} eq $var;
|
||||
$LANGUAGE->{$key} = $var;
|
||||
++$need_save;
|
||||
}
|
||||
}
|
||||
|
||||
if (my $key = $cgi->{new} and my $var = $cgi->{'new-val'}) {
|
||||
$var =~ s/\r\n/\n/g;
|
||||
if ($key =~ /^([^_]*)_/) {
|
||||
$LANGUAGE->{$key} = $var;
|
||||
++$need_save;
|
||||
}
|
||||
else {
|
||||
$message = GList::language('TPL_LANG_INVALID');
|
||||
}
|
||||
}
|
||||
elsif ($cgi->{'new-val'}) {
|
||||
$message = GList::language('TPL_LANG_ERROR');
|
||||
}
|
||||
|
||||
if ($need_save) {
|
||||
$LANGUAGE->save();
|
||||
$LANGUAGE = undef; # Force a reload to catch inherited values
|
||||
$message = GList::language('TPL_LANG_SAVED');
|
||||
$tags->{'new-val'} = '';
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $prefix = $cgi->{'prefix'};
|
||||
my %prefix_list;
|
||||
foreach my $code (sort keys %$LANGUAGE) {
|
||||
if ($code =~ /^([^_]*)_/) {
|
||||
$prefix_list{$1}++;
|
||||
}
|
||||
next if $prefix and $code !~ /^$prefix\_/;
|
||||
my $lang = $IN->html_escape($LANGUAGE->{$code});
|
||||
$table .= <<HTML;
|
||||
<tr>
|
||||
<td valign=top><font $font>$code</font></td>
|
||||
<td>
|
||||
<textarea rows="5" cols="50" name="save-$code" class="object">$lang</textarea>
|
||||
</td>
|
||||
<td><input type=checkbox name="del-$code" value="1" /></td>
|
||||
</tr>
|
||||
HTML
|
||||
}
|
||||
my $prefix_output = join " | ",
|
||||
map qq'<a href="$CFG->{cgi_url}/glist.cgi?do=admin_page;pg=admin_template_language.html;prefix=$_;tpl_dir=$selected_dir"><nobr>$_ ($prefix_list{$_})</nobr></a>',
|
||||
sort keys %prefix_list;
|
||||
|
||||
my $d_select_list = _template_dir_select();
|
||||
|
||||
return {
|
||||
language_table => $table,
|
||||
prefix => $prefix,
|
||||
dir_select => $d_select_list,
|
||||
message => $message,
|
||||
prefix_list => $prefix_output
|
||||
};
|
||||
}
|
||||
|
||||
sub global_editor {
|
||||
# ------------------------------------------------------------------
|
||||
# Loads the global template vars.
|
||||
#
|
||||
my $tags = GT::Template->tags;
|
||||
my ($dir, $font, $file, $message, $table);
|
||||
my $cgi = $IN->get_hash();
|
||||
|
||||
my $selected_dir = $cgi->{tpl_dir} || $CFG->{template_set} || 'gossamer';
|
||||
$dir = $CFG->{priv_path} . "/templates/common";
|
||||
|
||||
GList::load_globals(1);
|
||||
|
||||
my $demo;
|
||||
#------------demo code-----------
|
||||
|
||||
if ($cgi->{save}) {
|
||||
if ($demo) {
|
||||
$message = '<font color="red">The global editor has been disabled in the demo!</font>';
|
||||
}
|
||||
else {
|
||||
my $need_save;
|
||||
foreach my $code (keys %$cgi) {
|
||||
if ($code =~ /^del-(.*)$/) {
|
||||
delete $GLOBALS->{$1};
|
||||
++$need_save;
|
||||
}
|
||||
elsif ($code =~ /^save-(.*)/) {
|
||||
my $key = $1;
|
||||
next if $cgi->{"del-$key"};
|
||||
my $var = $cgi->{$code};
|
||||
$var =~ s/\r\n/\n/g; # Remove windows linefeeds.
|
||||
next if exists $GLOBALS->{$key} and $GLOBALS->{$key} eq $var;
|
||||
$GLOBALS->{$key} = $var;
|
||||
++$need_save;
|
||||
}
|
||||
}
|
||||
|
||||
if (my $key = $cgi->{new} and my $var = $cgi->{'new-val'}) {
|
||||
$var =~ s/\r\n/\n/g;
|
||||
$GLOBALS->{$key} = $var;
|
||||
++$need_save;
|
||||
}
|
||||
elsif ($cgi->{'new-val'}) {
|
||||
$message = GList::language('TPL_GLOBAL_ERROR');
|
||||
}
|
||||
|
||||
if ($need_save) {
|
||||
$GLOBALS->save();
|
||||
$GLOBALS = undef; # Force a reload, to catch inherited/local values
|
||||
GList::load_globals(1);
|
||||
$message = GList::language('TPL_GLOBAL_SAVED');
|
||||
$tags->{'new-val'} = '';
|
||||
}
|
||||
}
|
||||
}
|
||||
for my $code (sort keys %$GLOBALS) {
|
||||
my $val = $IN->html_escape($GLOBALS->{$code});
|
||||
$table .= <<HTML;
|
||||
<tr>
|
||||
<td valign="top" class="body">$code</td>
|
||||
<td>
|
||||
<textarea rows="5" cols="50" name="save-$code" wrap="off" class="object">$val</textarea>
|
||||
</td>
|
||||
<td><input type="checkbox" name="del-$code" value="1"></td>
|
||||
</tr>
|
||||
HTML
|
||||
}
|
||||
return { global_table => $table, message => $message };
|
||||
}
|
||||
|
||||
sub convert_date {
|
||||
#----------------------------------------------------------------------
|
||||
my $time = shift or return GList::language('ADMNEVER_LOGIN');
|
||||
my $format = "%mm%-%dd%-%yyyy% %hh%:%MM%:%ss%";
|
||||
|
||||
require GT::Date;
|
||||
return GT::Date::date_get($time, $format);
|
||||
}
|
||||
|
||||
sub friendly_size {
|
||||
my $size = shift;
|
||||
return $size <= 100
|
||||
? "$size " . GList::language('FILESIZE_BYTES')
|
||||
: $size < 10 * KB
|
||||
? sprintf("%.2f ", $size / KB) . GList::language('FILESIZE_KILOBYTES')
|
||||
: $size < 100 * KB
|
||||
? sprintf("%.1f ", $size / KB) . GList::language('FILESIZE_KILOBYTES')
|
||||
: $size < MB
|
||||
? sprintf("%.0f ", $size / KB) . GList::language('FILESIZE_KILOBYTES')
|
||||
: $size < 10 * MB
|
||||
? sprintf("%.2f ", $size / MB) . GList::language('FILESIZE_MEGABYTES')
|
||||
: $size < 100 * MB
|
||||
? sprintf("%.1f ", $size / MB) . GList::language('FILESIZE_MEGABYTES')
|
||||
: sprintf("%.0f ", $size / MB) . GList::language('FILESIZE_MEGABYTES');
|
||||
}
|
||||
|
||||
sub list_title {
|
||||
my $list_id = shift;
|
||||
return if (!$list_id);
|
||||
|
||||
my $info = $DB->table('Lists')->get($list_id);
|
||||
return $info->{lst_title};
|
||||
}
|
||||
|
||||
sub _editor_obj {
|
||||
my ($name, $skip) = @_;
|
||||
$skip ||= [qw/CVS safe help/];
|
||||
require GT::Template::Editor;
|
||||
my $demo = 0;
|
||||
|
||||
#------------demo code-----------
|
||||
|
||||
GT::Template::Editor->new(
|
||||
root => "$CFG->{priv_path}/templates",
|
||||
backup => $CFG->{template_backups},
|
||||
cgi => $IN,
|
||||
demo => $demo,
|
||||
class => "object",
|
||||
default_dir => $CFG->{template_set} || 'gossamer',
|
||||
skip_dir => $skip,
|
||||
skip_file => [qw/*.eml/],
|
||||
$name ? (select_dir => $name) : ()
|
||||
);
|
||||
}
|
||||
|
||||
sub _template_dir_select {
|
||||
# ------------------------------------------------------------------
|
||||
# Returns a select list of template directories.
|
||||
#
|
||||
my $name = shift;
|
||||
_editor_obj($name, [qw/CVS help safe common/])->template_dir_select;
|
||||
}
|
||||
|
||||
sub _current_select {
|
||||
# ------------------------------------------------------------------
|
||||
# Returns a select list of user email templates
|
||||
#
|
||||
my ($name, $selected_file) = @_;
|
||||
|
||||
my $tags = GT::Template->tags;
|
||||
|
||||
my $sth = $DB->table('EmailTemplates')->select({ tpl_user_id_fk => $tags->{usr_username} }, ['tpl_name']);
|
||||
return if ( !$sth->rows );
|
||||
$selected_file ||= $tags->{$name};
|
||||
|
||||
my $f_select_list = "<select name='$name' class=object><option value=''>".GList::language('TPL_SELECT_TITLE')."</option>";
|
||||
while ( my $name = $sth->fetchrow_array ) {
|
||||
( $selected_file eq $name ) ? ($f_select_list .= "<option selected>$name") : ($f_select_list .= "<option>$name");
|
||||
}
|
||||
|
||||
return "$f_select_list</select>";
|
||||
}
|
||||
|
||||
sub _default_select {
|
||||
# ------------------------------------------------------------------
|
||||
# Returns a select list of email templates in a given dir.
|
||||
#
|
||||
my ( $dir, $selected_file ) = @_;
|
||||
|
||||
my ($file, @files);
|
||||
opendir (TPL, $dir) or die GList::language('DIR_OPEN_ERR', $dir, $!);
|
||||
|
||||
while (defined($file = readdir TPL)) {
|
||||
my ($ext) = $file =~ /\.([^.]+)$/;
|
||||
next unless $ext and $ext eq 'eml';
|
||||
push @files, $file;
|
||||
}
|
||||
closedir TPL;
|
||||
|
||||
my $f_select_list = "<select name='tpl_file' class=object><option value=''>".GList::language('TPL_SELECT_TITLE')."</option>";
|
||||
my $count = 0;
|
||||
foreach (sort @files) {
|
||||
$selected_file = $_ if (!$selected_file and !$count);
|
||||
($selected_file eq $_) ? ($f_select_list .= "<option selected>$_</option>") : ($f_select_list .= "<option>$_</option>");
|
||||
}
|
||||
$f_select_list .= "</select>";
|
||||
|
||||
return ($f_select_list, $selected_file);
|
||||
}
|
||||
|
||||
sub schedule_status {
|
||||
my $tags = GT::Template->tags;
|
||||
my ($scm_id, $scm_sent, $scm_type) = ($tags->{scm_id}, $tags->{scm_sent}, $tags->{scm_type});
|
||||
|
||||
my $schedule = $DB->table('ScheduledMailings')->get({ scm_id => $scm_id });
|
||||
return unless $schedule;
|
||||
return unless $scm_sent;
|
||||
|
||||
require GT::Date;
|
||||
if ($scm_type == 2) {
|
||||
return 1 if GT::Date::date_get(time, "%yyyy%-%mm%-%dd%") eq GT::Date::date_get($scm_sent, "%yyyy%-%mm%-%dd%");
|
||||
}
|
||||
elsif ($scm_type == 3) {
|
||||
my $today = GT::Date::date_get(time, "%yyyy%-%mm%-%dd%");
|
||||
my $next_7days = GT::Date::date_add(GT::Date::date_get($scm_sent, "%yyyy%-%mm%-%dd%"), 7);
|
||||
return GT::Date::date_is_greater($next_7days, $today);
|
||||
}
|
||||
elsif ($scm_type == 4) {
|
||||
return 1 if GT::Date::date_get(time, "%mm%") eq GT::Date::date_get($scm_sent, "%mm%");
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub schedule_info {
|
||||
my $mli_id = shift;
|
||||
|
||||
return unless $mli_id;
|
||||
my $info = $DB->table('ScheduledMailings')->get({ scm_mailing_id_fk => $mli_id });
|
||||
if ($info->{scm_type} == 1) {
|
||||
require GT::Date;
|
||||
my $format = $USER->{usr_date_format} || '%yyyy%-%mm%-%dd%';
|
||||
$info->{scm_option} = GT::Date::date_get($info->{scm_option}, $format);
|
||||
}
|
||||
return $info;
|
||||
}
|
||||
1;
|
||||
879
site/glist/lib/GList/User.pm
Normal file
879
site/glist/lib/GList/User.pm
Normal file
@ -0,0 +1,879 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: User.pm,v 1.49 2004/10/14 22:57:54 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::User;
|
||||
# ==================================================================
|
||||
|
||||
use strict;
|
||||
use GList qw/:objects :user_type $DEBUG/;
|
||||
use GT::AutoLoader;
|
||||
|
||||
sub process {
|
||||
#-------------------------------------------------------------------
|
||||
# Determine what to do
|
||||
#
|
||||
my $do = shift;
|
||||
|
||||
my $action = _determine_action($do) or die "Error: Invalid Action! ($do)";
|
||||
|
||||
my ($tpl, $results) = GT::Plugins->dispatch($CFG->{priv_path}.'/lib/GList/Plugins', $action, \&$action);
|
||||
$tpl ||= 'user_login.html';
|
||||
GList::display($tpl, $results);
|
||||
}
|
||||
|
||||
$COMPILE{user_click} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_click {
|
||||
#--------------------------------------------------------------------
|
||||
# Track number of clicks
|
||||
#
|
||||
my $id = $IN->param('mailing');
|
||||
my $url = $IN->param('url') || "$CFG->{cgi_url}/glist.cgi";
|
||||
my $db = $DB->table('MailingIndex');
|
||||
if ($db->count({ mli_id => $id })) {
|
||||
$db->update({ mli_num_clicked => \'mli_num_clicked + 1' }, { mli_id => $id });
|
||||
}
|
||||
print $IN->header( -url => $url );
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_open} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_open {
|
||||
#--------------------------------------------------------------------
|
||||
# Track number of users who open message
|
||||
#
|
||||
my $code = $IN->param('eml_code');
|
||||
my $mailing = $IN->param('mailing');
|
||||
my $db = $DB->table('EmailMailings');
|
||||
if ($code and $mailing and $db->count({ eml_mailing_id_fk => $mailing, eml_code => $code, eml_opened => 0 })) {
|
||||
$db->update({ eml_opened => time }, { eml_mailing_id_fk => $mailing, eml_code => $code });
|
||||
$DB->table('MailingIndex')->update({ mli_num_opened => \'mli_num_opened + 1' }, { mli_id => $mailing });
|
||||
}
|
||||
if (open DATA, "$CFG->{image_path}/pics/1pixel.gif") {
|
||||
print $IN->header({
|
||||
'-type' => 'image/gif',
|
||||
'-Content-Length' => -s "$CFG->{image_path}/pics/1pixel.gif",
|
||||
});
|
||||
binmode STDOUT;
|
||||
binmode DATA;
|
||||
my $buffer;
|
||||
print $buffer while (read(DATA, $buffer, 50000));
|
||||
close DATA;
|
||||
}
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_signup} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_signup {
|
||||
# -------------------------------------------------------------------
|
||||
# User Sign-up
|
||||
#
|
||||
return ('user_login.html', { msg => GList::language('USR_SIGNUP_DISABLE') }) if (!$CFG->{signup_enable});
|
||||
|
||||
return ('user_signup.html') if ($IN->param('form'));
|
||||
|
||||
my $cgi = $IN->get_hash();
|
||||
|
||||
my $error = _signup_check($cgi);
|
||||
return ('user_signup.html', { msg => $error }) if ($error);
|
||||
|
||||
$cgi->{usr_password} = GList::encrypt($cgi->{usr_password});
|
||||
$cgi->{usr_date_format}||= "%yyyy%-%mm%-%dd%";
|
||||
$cgi->{usr_bounce_email} = $cgi->{usr_email};
|
||||
$cgi->{usr_reply_email} = $cgi->{usr_email};
|
||||
$cgi->{usr_limit_list} = $CFG->{signup_limit_list} || 10;
|
||||
$cgi->{usr_limit_sublist}= $CFG->{signup_limit_sublist} || 10;
|
||||
$cgi->{usr_limit_email30}= $CFG->{signup_limit_email30} || 100;
|
||||
$cgi->{usr_type} = (!$CFG->{signup_email_validate} and !$CFG->{signup_admin_validate}) ? LIMITED_USER : UNVALIDATED_USER;
|
||||
my $info = $cgi;
|
||||
|
||||
# if it requires email validate
|
||||
if ($CFG->{signup_email_validate}) {
|
||||
my $val_code = join '', ('a'..'z', 'A'..'Z', 0..9)[map rand(62), 1 .. 30];
|
||||
$cgi->{usr_validate_code} = "GT$val_code";
|
||||
$info->{validate_code} = $val_code;
|
||||
}
|
||||
|
||||
GList::add('Users', 'usr', $cgi);
|
||||
return ('user_signup.html', { msg => "<font color=red><b>$GList::error</b></font>" }) if ($GList::error);
|
||||
|
||||
# Send a validate email
|
||||
my $msg = GList::language('USR_SIGNUP_SUCCESSFUL');
|
||||
if ($CFG->{signup_email_validate}) {
|
||||
foreach (keys %{$CFG->{admin}}) {
|
||||
next if (!$_);
|
||||
$info->{admin_email} = $CFG->{admin}->{$_}->[1]; last;
|
||||
}
|
||||
|
||||
my ($head, $body) = _parse_file('account_validation.eml', $info);
|
||||
GList::send($head, { text => $body });
|
||||
$msg = GList::language('USR_SIGNUP_EMAIL_SUCCESSFUL');
|
||||
}
|
||||
return ('user_login.html', { msg => $msg });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_account_validate} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_account_validate {
|
||||
#----------------------------------------------------------
|
||||
# User validate
|
||||
#
|
||||
my $id = $IN->param('id');
|
||||
my $db = $DB->table('Users');
|
||||
my $found= $db->count({ usr_validate_code => $id });
|
||||
return ('user_login.html', { msg => GList::language('USR_VALIDATE_FAILED') }) unless ($found);
|
||||
|
||||
# if it requires admin validate
|
||||
my %hash = (usr_validate_code => '', usr_type => LIMITED_USER);
|
||||
if ($CFG->{signup_admin_validate}) {
|
||||
$hash{usr_type} = UNVALIDATED_USER;
|
||||
}
|
||||
$db->update(\%hash, { usr_validate_code => $id });
|
||||
return ('user_login.html', { msg => GList::language('USR_VALIDATE_SUCCESSFUL') });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_login} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_login {
|
||||
# --------------------------------------------------------
|
||||
# Logs a user in, and creates a session ID.
|
||||
#
|
||||
|
||||
if (!defined $IN->param('username') or !defined $IN->param('password')) {
|
||||
return ('user_login.html', { msg => GList::language('LOG_IN', GList::_load_global('site_title')) });
|
||||
}
|
||||
|
||||
my $username = $IN->param('username') || shift;
|
||||
my $password = $IN->param('password') || shift;
|
||||
|
||||
# Make sure we have both a username and password.
|
||||
return ('user_login.html', { msg => GList::language('LOG_ERROR') }) if (!$username or !$password);
|
||||
|
||||
unless (GList::test_connection()) { # Database connection is failed
|
||||
if (GList::Authenticate::auth('admin_valid_user', { username => $username, password => $password })) {
|
||||
my $session = GList::Authenticate::auth('admin_create_session', { username => $username });
|
||||
if ($session) {
|
||||
$USER->{admin_user} = $username;
|
||||
$USER->{admin_pass} = $password;
|
||||
$USER->{session_id} = $session->{session_id};
|
||||
$USER->{use_cookie} = $session->{use_cookie};
|
||||
require GList::Admin;
|
||||
return GList::Admin::admin_initial_sql();
|
||||
}
|
||||
}
|
||||
return ('user_login.html', { msg => GList::language('LOG_ERROR') });
|
||||
}
|
||||
|
||||
# Check that the user exists, and that the password is valid.
|
||||
my $user = GList::init_user($username, $password);
|
||||
return ('user_login.html', { msg => GList::language('LOG_DEACTIVATE') }) if ($user and $user == 1);
|
||||
return ('user_login.html', { msg => GList::language('LOG_NOT_EMAIL_VALIDATED') }) if ($user and $user == 2);
|
||||
return ('user_login.html', { msg => GList::language('LOG_NOT_ADMIN_VALIDATED') }) if ($user and $user == 3);
|
||||
return ('user_login.html', { msg => GList::language('LOG_ERROR') }) if (ref $user ne 'HASH');
|
||||
|
||||
# Store the session in either a cookie or url based.
|
||||
my $results = GList::Authenticate::auth('create_session', { username => $user->{usr_username} });
|
||||
|
||||
return ('user_login.html', { msg => "<font color=red><b>$results->{error}</b></font>" }) if ($results->{error});
|
||||
$USER->{session_id} = $results->{session_id};
|
||||
$USER->{use_cookie} = $results->{use_cookie};
|
||||
|
||||
_cleanup_files();
|
||||
|
||||
if ($USER->{usr_updated}) {
|
||||
$MN_SELECTED = 1;
|
||||
require GList::Message;
|
||||
return GList::Message::msg_home(GList::language('LOG_WELCOME', "$USER->{pro_first_name} $USER->{pro_last_name}"));
|
||||
}
|
||||
else {
|
||||
$MN_SELECTED = 5;
|
||||
require GList::Profile;
|
||||
return GList::Profile::pro_profile(GList::language('LOG_UPDATE_REMIND'));
|
||||
}
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_logout} = <<'END_OF_SUB';
|
||||
sub user_logout {
|
||||
#-----------------------------------------------------------
|
||||
#
|
||||
require GList::Authenticate;
|
||||
GList::Authenticate::auth('delete_session');
|
||||
return ('user_login.html', { msg => GList::language('LOG_LOGGED_OFF', GList::_load_global('site_title')) });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_remind} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_remind {
|
||||
#---------------------------------------------------------
|
||||
# Send password to a user
|
||||
#
|
||||
|
||||
#------------demo code-----------
|
||||
|
||||
return ('user_remind_form.html') if (!defined $IN->param('email'));
|
||||
|
||||
my $email = $IN->param('email');
|
||||
return ('user_remind_form.html', { msg => GList::language('LOG_REM_ERROR') }) unless ($email);
|
||||
|
||||
my $db = $DB->table('Users');
|
||||
my $user = $db->get({ usr_email => $email });
|
||||
return ('user_remind_form.html', { msg => GList::language('LOG_REM_NOT_FOUND') }) if (!$user);
|
||||
|
||||
# Get Administrator info
|
||||
my $info;
|
||||
my $admin = $db->get({ usr_type => LIMITED_USER });
|
||||
if ($admin) {
|
||||
$info->{admin_email} = $admin->{usr_email};
|
||||
}
|
||||
|
||||
my @letters = (0 .. 9, 'a' .. 'z', 'A' .. 'Z');
|
||||
my $temp = '';
|
||||
for (1 .. 6) { $temp .= $letters[rand @letters]; }
|
||||
my $temp_enc = GList::encrypt($temp);
|
||||
$db->update({ usr_password => $temp_enc }, { usr_username => $user->{usr_username} });
|
||||
|
||||
$info->{usr_username} = $user->{usr_username};
|
||||
$info->{usr_email} = $user->{usr_email};
|
||||
$info->{usr_password} = $temp;
|
||||
$info->{usr_name} = "$user->{pro_first_name} $user->{pro_last_name}";
|
||||
$info->{usr_name} ||= $user->{usr_username};
|
||||
|
||||
my ($head, $body) = _parse_file('remindme.eml', $info);
|
||||
GList::send($head, { text => $body });
|
||||
|
||||
return ('user_login.html', { msg => GList::language('LOG_REM_SUCCESS', $email) });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_validate} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_validate {
|
||||
#-----------------------------------------------------------
|
||||
# Validate a subscriber
|
||||
#
|
||||
|
||||
my $admin = $db->get({ usr_type => LIMITED_USER });
|
||||
if ($admin) {
|
||||
$info->{admin_email} = $admin->{usr_email};
|
||||
}
|
||||
|
||||
my @letters = (0 .. 9, 'a' .. 'z', 'A' .. 'Z');
|
||||
my $temp = '';
|
||||
for (1 .. 6) { $temp .= $letters[rand @letters]; }
|
||||
my $temp_enc = GList::encrypt($temp);
|
||||
$db->update({ usr_password => $temp_enc }, { usr_username => $user->{usr_username} });
|
||||
|
||||
$info->{usr_username} = $user->{usr_username};
|
||||
$info->{usr_email} = $user->{usr_email};
|
||||
$info->{usr_password} = $temp;
|
||||
$info->{usr_name} = "$user->{pro_first_name} $user->{pro_last_name}";
|
||||
$info->{usr_name} ||= $user->{usr_username};
|
||||
|
||||
my ($head, $body) = _parse_file('remindme.eml', $info);
|
||||
GList::send($head, { text => $body });
|
||||
|
||||
return ('user_login.html', { msg => GList::language('LOG_REM_SUCCESS', $email) });
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_validate} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_validate {
|
||||
#-----------------------------------------------------------
|
||||
# Validate a subscriber
|
||||
#
|
||||
|
||||
#------------demo code-----------
|
||||
|
||||
my $id = $IN->param('id');
|
||||
my $db = $DB->table('Subscribers');
|
||||
my $info = $db->get({ sub_val_code => $id });
|
||||
|
||||
return ('error_form.html', { msg => GList::language('LOG_VAL_ERROR') }) if (!$info);
|
||||
return ('error_form.html', { msg => GList::language('LOG_VAL_ERROR2') }) if ($info->{sub_validated});
|
||||
|
||||
$db->update({ sub_validated => '1' }, { sub_val_code => $id });
|
||||
|
||||
my $lst_info = $DB->table('Lists')->get($info->{sub_list_id_fk});
|
||||
return ('user_success_form.html', { msg => GList::language('LOG_VALIDATED') }) if (!$lst_info->{lst_url_validate_success});
|
||||
|
||||
print $IN->header( -url => $lst_info->{lst_url_validate_success} );
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_subscribe} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_subscribe {
|
||||
#-----------------------------------------------------------
|
||||
# Subscribe a email address
|
||||
#
|
||||
# get subscribe success URLs
|
||||
my $url_success = "$CFG->{static_url}/page/subscribe_success.html";
|
||||
my $url_failure = "$CFG->{static_url}/page/subscribe_failure.html";
|
||||
# get the hash for this CGI instance
|
||||
my $cgi = $IN->get_hash();
|
||||
my $demo = 0;
|
||||
# errors if we don't have an accurate list ID
|
||||
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR') }) unless ($cgi->{lid});
|
||||
|
||||
#------------demo code-----------
|
||||
# $demo = 1;
|
||||
|
||||
# Get the relevant table lsits (Subscribers). StopLists is the unknown one--doesn't look like it's used anymore
|
||||
my $db_sub = $DB->table('Subscribers');
|
||||
my $db_stl = $DB->table('StopLists');
|
||||
my $wild_cards = GList::wild_cards();
|
||||
my $email;
|
||||
if ($cgi->{eml_code}) {
|
||||
my $eml = $DB->table('EmailMailings')->get({ eml_code => $cgi->{eml_code} });
|
||||
$email = lc $eml->{eml_email};
|
||||
}
|
||||
else {
|
||||
$email = lc $cgi->{email};
|
||||
}
|
||||
|
||||
# if there's an array of IDs, loop over them
|
||||
if (ref $cgi->{lid} eq 'ARRAY') {
|
||||
foreach my $id (@{$cgi->{lid}}) {
|
||||
my $info = $DB->table('Lists')->get($id);
|
||||
next unless ($info);
|
||||
|
||||
my $error = _check_subscriber($email, $id, $db_stl, $wild_cards);
|
||||
next if ($error);
|
||||
|
||||
# if it has been subscribed to the list
|
||||
next if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $id }));
|
||||
|
||||
my ($template, $data) = _generate_info($info, $email, $cgi->{name});
|
||||
next unless ($data);
|
||||
|
||||
$db_sub->insert($data);
|
||||
if ($template and !$demo) { # sending a confirmation or validation email
|
||||
GList::send($template->{head}, { text => $template->{body} });
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
my $info = $DB->table('Lists')->get($cgi->{lid});
|
||||
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $cgi->{lid}, GList::_load_global('site_title')) }) if (!$info);
|
||||
|
||||
$url_success = $info->{lst_url_subscribe_success} if ($info->{lst_url_subscribe_success});
|
||||
$url_failure = $info->{lst_url_subscribe_failure} if ($info->{lst_url_subscribe_failure});
|
||||
my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards);
|
||||
return ('error_form.html', { msg => $error }) if ($error);
|
||||
|
||||
# if it has been subscribed to the list
|
||||
if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $cgi->{lid} })) {
|
||||
print $IN->header( -url => $url_failure );
|
||||
return;
|
||||
}
|
||||
|
||||
my ($template, $data) = _generate_info($info, $email, $cgi->{name});
|
||||
unless ($data) {
|
||||
print $IN->header( -url => $url_failure );
|
||||
return;
|
||||
}
|
||||
$db_sub->insert($data);
|
||||
|
||||
if ($template and !$demo) { # sending a confirmation or validation email
|
||||
GList::send($template->{head}, { text => $template->{body} });
|
||||
}
|
||||
}
|
||||
|
||||
print $IN->header( -url => $url_success );
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_rm} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_rm {
|
||||
user_unsubscribe();
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_unsubscribe} = __LINE__ . <<'END_OF_SUB';
|
||||
sub user_unsubscribe {
|
||||
#-----------------------------------------------------------
|
||||
# Unsubscribe a email address
|
||||
#
|
||||
my $url_success = "$CFG->{static_url}/page/unsubscribe_success.html";
|
||||
my $url_failure = "$CFG->{static_url}/page/unsubscribe_failure.html";
|
||||
|
||||
my ($info, $email);
|
||||
# Gets hash from $IN? -> Global variable that's defined as what? I think it's the whole query parameter
|
||||
my $cgi = $IN->get_hash();
|
||||
# Get subscribers table -> We'll need this
|
||||
my $db_sub = $DB->table('Subscribers');
|
||||
# If lid is an array, return it as such, otherwise return the single array as an array
|
||||
my $lists = (ref $cgi->{lid} eq 'ARRAY') ? $cgi->{lid} : [$cgi->{lid}];
|
||||
# if this $cgi global has an eml_code (it should if cliked from a link)
|
||||
if ($cgi->{eml_code}) {
|
||||
# Get the e-mail Mailings table and then get the EML_CODE equal to this one
|
||||
# eml_code is equal to the hash that's sent -> Can use this again
|
||||
my $eml = $DB->table('EmailMailings')->get({ eml_code => $cgi->{eml_code} });
|
||||
# From the eml-code (hash), get the actual e-maile lowercased (this is probably a row)
|
||||
$email = lc $eml->{eml_email};
|
||||
}
|
||||
else {
|
||||
# Otherwise if not clicked from this, we're just going to try to get the e-mail from this instance
|
||||
$email = lc $cgi->{email};
|
||||
}
|
||||
|
||||
# If we don't have an e-mail, go to the failure url
|
||||
if (!$email or $#$lists < 0) {
|
||||
print $IN->header( -url => $url_failure );
|
||||
return;
|
||||
}
|
||||
|
||||
# This looks like it gets at the meat
|
||||
|
||||
# make sure we have our SQL condition command
|
||||
require GT::SQL::Condition;
|
||||
|
||||
# Look/create new for sub_email with e-mail
|
||||
my $cd = GT::SQL::Condition->new(sub_email => '=' => $email);
|
||||
|
||||
# if we only have one entry in our list
|
||||
if ($#$lists == 0) {
|
||||
# From "Lists" get our value
|
||||
$info = $DB->table('Lists')->get($lists->[0]);
|
||||
# if no results, return an error
|
||||
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $lists->[0]) }) if (!$info);
|
||||
|
||||
# depending on $info, go to success/failure ($info dpeendent failure/success)
|
||||
$url_success = $info->{lst_url_unsubscribe_success} if ($info->{lst_url_unsubscribe_success});
|
||||
$url_failure = $info->{lst_url_unsubscribe_failure} if ($info->{lst_url_unsubscribe_failure});
|
||||
|
||||
# to our foreign key list add this e-mail
|
||||
$cd->add(sub_list_id_fk => '=' => $lists->[0]);
|
||||
}
|
||||
else {
|
||||
# same thing as above, just do it if we have any in the list
|
||||
$cd->add(sub_list_id_fk => 'IN' => $lists);
|
||||
}
|
||||
|
||||
# if we didn't do any adding, go to the failure
|
||||
if (!$db_sub->count($cd)) {
|
||||
print $IN->header( -url => $url_failure );
|
||||
return;
|
||||
}
|
||||
# looks like this is in testing
|
||||
#------------demo code-----------
|
||||
# return ('user_success_form.html', { msg => GList::language('LOG_UNSUBS_SUCCESS', $info->{lst_title}) });
|
||||
|
||||
# from "Subscribers", delete this added unsubscription
|
||||
if ($db_sub->delete($cd)) {
|
||||
# from our #info get the unsubscribe tempalte
|
||||
if ($info->{lst_unsubs_template}) {
|
||||
# get the e-mail from this info and lowercase and send
|
||||
$info->{sub_email} = lc $cgi->{email};
|
||||
# now parse and unsubscribe
|
||||
my $unsubs_template = _parse($info, $info->{lst_unsubs_template});
|
||||
# from template, send the header/body of the unsubscription
|
||||
GList::send($unsubs_template->{head}, { text => $unsubs_template->{body} });
|
||||
}
|
||||
}
|
||||
# go to success
|
||||
print $IN->header( -url => $url_success );
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{user_move} = __LINE__ . << 'END_OF_SUB';
|
||||
sub user_move {
|
||||
#-----------------------------------------------------------
|
||||
# Remove a subscription and then create a new one
|
||||
#
|
||||
#----------------------------------
|
||||
# First, let's get the list information we're moving
|
||||
#----------------------------------
|
||||
my $cgi = $IN->get_hash();
|
||||
my @values = split('-', $cgi->{from_to_lid});
|
||||
my $element_count = scalar(@values);
|
||||
|
||||
# If invalid params, return an error
|
||||
return ('error_form.html', { msg => GList::language('LOG_ERROR') }) unless ($element_count == 2);
|
||||
|
||||
my $unsub = $values[0];
|
||||
my $sub = $values[1];
|
||||
|
||||
#----------------------------------
|
||||
# Prepare the unsubscription and do so
|
||||
#----------------------------------
|
||||
$cgi->{lid} = $unsub;
|
||||
|
||||
my $url_success = "$CFG->{static_url}/page/unsubscribe_success.html";
|
||||
my $url_failure = "$CFG->{static_url}/page/unsubscribe_failure.html";
|
||||
|
||||
my ($info, $email);
|
||||
my $db_sub = $DB->table('Subscribers');
|
||||
my $lists = (ref $cgi->{lid} eq 'ARRAY') ? $cgi->{lid} : [$cgi->{lid}];
|
||||
if ($cgi->{eml_code}) {
|
||||
my $eml = $DB->table('EmailMailings')->get({ eml_code => $cgi->{eml_code} });
|
||||
$email = lc $eml->{eml_email};
|
||||
}
|
||||
else {
|
||||
$email = lc $cgi->{email};
|
||||
}
|
||||
|
||||
# If we don't have an e-mail, go to the failure url
|
||||
if (!$email or $#$lists < 0) {
|
||||
print $IN->header( -url => $url_failure );
|
||||
return;
|
||||
}
|
||||
|
||||
require GT::SQL::Condition;
|
||||
|
||||
# Look/create new for sub_email with e-mail
|
||||
my $cd = GT::SQL::Condition->new(sub_email => '=' => $email);
|
||||
|
||||
# if we only have one entry in our list
|
||||
if ($#$lists == 0) {
|
||||
$info = $DB->table('Lists')->get($lists->[0]);
|
||||
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $lists->[0]) }) if (!$info);
|
||||
|
||||
$url_success = $info->{lst_url_unsubscribe_success} if ($info->{lst_url_unsubscribe_success});
|
||||
$url_failure = $info->{lst_url_unsubscribe_failure} if ($info->{lst_url_unsubscribe_failure});
|
||||
|
||||
$cd->add(sub_list_id_fk => '=' => $lists->[0]);
|
||||
}
|
||||
else {
|
||||
$cd->add(sub_list_id_fk => 'IN' => $lists);
|
||||
}
|
||||
|
||||
if (!$db_sub->count($cd)) {
|
||||
print $IN->header( -url => $url_failure );
|
||||
return;
|
||||
}
|
||||
|
||||
# Remove them from this list
|
||||
my $unsubs_template;
|
||||
if ($db_sub->delete($cd)) {
|
||||
# from our #info get the unsubscribe tempalte
|
||||
if ($info->{lst_unsubs_template}) {
|
||||
# get the e-mail from this info and lowercase and send
|
||||
$info->{sub_email} = lc $cgi->{email};
|
||||
# now parse and unsubscribe
|
||||
$unsubs_template = _parse($info, $info->{lst_unsubs_template});
|
||||
}
|
||||
}
|
||||
|
||||
#----------------------------------
|
||||
# Success means we proceed with the subscription
|
||||
#----------------------------------
|
||||
|
||||
# Prepare the subscription and so so
|
||||
$cgi->{lid} = $sub;
|
||||
|
||||
# get subscribe success URLs
|
||||
$url_success = "$CFG->{static_url}/page/subscribe_success.html";
|
||||
$url_failure = "$CFG->{static_url}/page/subscribe_failure.html";
|
||||
my $demo = 0;
|
||||
# errors if we don't have an accurate list ID
|
||||
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR') }) unless ($cgi->{lid});
|
||||
|
||||
# Get the relevant table lsits (Subscribers). StopLists is the unknown one--doesn't look like it's used anymore
|
||||
my $db_stl = $DB->table('StopLists');
|
||||
my $wild_cards = GList::wild_cards();
|
||||
|
||||
# if there's an array of IDs, loop over them
|
||||
if (ref $cgi->{lid} eq 'ARRAY') {
|
||||
foreach my $id (@{$cgi->{lid}}) {
|
||||
$info = $DB->table('Lists')->get($id);
|
||||
next unless ($info);
|
||||
|
||||
my $error = _check_subscriber($email, $id, $db_stl, $wild_cards);
|
||||
next if ($error);
|
||||
|
||||
# if it has been subscribed to the list
|
||||
next if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $id }));
|
||||
|
||||
my ($template, $data) = _generate_info($info, $email, $cgi->{name});
|
||||
next unless ($data);
|
||||
|
||||
$db_sub->insert($data);
|
||||
if ($template and !$demo) { # sending a confirmation or validation email
|
||||
GList::send($template->{head}, { text => $template->{body} });
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
$info = $DB->table('Lists')->get($cgi->{lid});
|
||||
return ('error_form.html', { msg => GList::language('LOG_SUBSCRIBE_ERROR2', $cgi->{lid}, GList::_load_global('site_title')) }) if (!$info);
|
||||
|
||||
$url_success = $info->{lst_url_subscribe_success} if ($info->{lst_url_subscribe_success});
|
||||
$url_failure = $info->{lst_url_subscribe_failure} if ($info->{lst_url_subscribe_failure});
|
||||
my $error = _check_subscriber($email, $info->{lst_id}, $db_stl, $wild_cards);
|
||||
return ('error_form.html', { msg => $error }) if ($error);
|
||||
|
||||
# if it has been subscribed to the list
|
||||
if ($db_sub->count({ sub_email => $email, sub_list_id_fk => $cgi->{lid} })) {
|
||||
print $IN->header( -url => $url_failure );
|
||||
return;
|
||||
}
|
||||
|
||||
my ($template, $data) = _generate_info($info, $email, $cgi->{name});
|
||||
unless ($data) {
|
||||
print $IN->header( -url => $url_failure );
|
||||
return;
|
||||
}
|
||||
$db_sub->insert($data);
|
||||
|
||||
if ($template and !$demo) { # sending a confirmation or validation email
|
||||
GList::send($template->{head}, { text => $template->{body} });
|
||||
}
|
||||
}
|
||||
|
||||
if ($unsubs_template) {
|
||||
# from template, send the header/body of the unsubscription
|
||||
GList::send($unsubs_template->{head}, { text => $unsubs_template->{body} });
|
||||
}
|
||||
|
||||
print $IN->header( -url => $url_success );
|
||||
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_generate_info} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _generate_info {
|
||||
my ($info, $email, $name) = @_;
|
||||
my %data = ( sub_email => $email, sub_name => $name, sub_created => time, sub_list_id_fk => $info->{lst_id}, sub_user_id_fk => $info->{lst_user_id_fk} );
|
||||
$info->{sub_email} = $email;
|
||||
$info->{sub_name} = $name;
|
||||
|
||||
my $template;
|
||||
if ($info->{lst_opt}) {
|
||||
my $val_code = join '', ('a'..'z', 'A'..'Z', 0..9)[map rand(62), 1 .. 30];
|
||||
$data{sub_validated} = '0';
|
||||
$data{sub_val_code} = "GT$val_code";
|
||||
$info->{validate_code} = $val_code;
|
||||
$template = _parse($info, $info->{lst_opt_template});
|
||||
}
|
||||
elsif ($info->{lst_subs_template}) {
|
||||
$template = _parse($info, $info->{lst_subs_template});
|
||||
}
|
||||
return ($template, \%data);
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_signup_check} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _signup_check {
|
||||
#-------------------------------------------------------------------
|
||||
#
|
||||
my $data = shift;
|
||||
|
||||
my $db = $DB->table('Users');
|
||||
my $refix = $CFG->{signup_username_regex} || '^[\w\-\.]{3,}$';
|
||||
|
||||
length $data->{usr_username} < 3 and return GList::language('USR_SIGNUP_USERNAME_INVALID');
|
||||
$data->{usr_username} =~ /$refix/ or return GList::language('USR_INVALID');
|
||||
$db->count({ usr_username => $data->{usr_username} }) and return GList::language('USR_SIGNUP_USERNAME_TAKEN');
|
||||
length $data->{usr_password} < 4 and return GList::language('ADM_PWD_INVALID');
|
||||
$data->{usr_password} ne $data->{con_password} and return GList::language('USR_SIGNUP_CONFIRM_PASS');
|
||||
$data->{usr_email} =~ /.@\S+\.\S+$/ or return GList::language('USR_SIGNUP_EMAIL_INVALID', $data->{usr_email});
|
||||
$db->count({ usr_email => $data->{usr_email} }) and return GList::language('USR_SIGNUP_EMAIL_INUSE', $data->{usr_email});
|
||||
|
||||
if ($CFG->{signup_restricted_email} and ref $CFG->{signup_restricted_email} eq 'ARRAY') {
|
||||
foreach my $e (@{$CFG->{signup_restricted_email}}) {
|
||||
$data->{usr_email} eq $e and return GList::language('USR_SIGNUP_EMAIL_RESTRICTED', $data->{usr_email});
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_check_subscriber} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _check_subscriber {
|
||||
#-----------------------------------------------------------------
|
||||
#
|
||||
my ($email, $lst_id, $db_stl, $wild_cards) = @_;
|
||||
|
||||
# trim blank spaces
|
||||
if ($email) {
|
||||
$email =~ s,^\s+,,g;
|
||||
$email =~ s,\s+$,,g;
|
||||
}
|
||||
|
||||
return GList::language('USR_SUB_OVERLIMIT') if (GList::check_limit('sublist', $lst_id));
|
||||
return GList::language('USR_SUB_INVALID_EMAIL') if ($email !~ /^(?:(?:.+\@.+\..+)|\s*)$/ or $email =~ /\s/ );
|
||||
return GList::language('USR_SUB_STOPLIST') if ($db_stl->count({ stl_email => $email }));
|
||||
foreach (@$wild_cards) {
|
||||
my $e = $_->[0];
|
||||
my $re = quotemeta $e;
|
||||
$re =~ s/\\\*/.*/;
|
||||
$re =~ s/\\\?/./;
|
||||
return GList::language('USR_SUB_STOPLIST') if ($email =~ /$re/i);
|
||||
}
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_parse} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _parse {
|
||||
#-----------------------------------------------------------
|
||||
# Load email template
|
||||
#
|
||||
my ($info, $name) = @_;
|
||||
|
||||
require GList::Template;
|
||||
my $db = $DB->table('EmailTemplates');
|
||||
my $template = $db->get({ tpl_user_id_fk => $info->{lst_user_id_fk}, tpl_name => $name });
|
||||
return if (!$template);
|
||||
|
||||
my $sth = $DB->table('Users')->select({ usr_username => $info->{lst_user_id_fk} });
|
||||
return unless $sth;
|
||||
|
||||
my $uinfo = $sth->fetchrow_hashref;
|
||||
@{$info}{keys %$uinfo} = (values %$uinfo);
|
||||
|
||||
foreach (keys %$template) {
|
||||
$template->{$_} = GList::Template->parse(
|
||||
"string",
|
||||
[$info],
|
||||
{
|
||||
string => $template->{$_},
|
||||
disable => { functions => 1 }
|
||||
}
|
||||
);
|
||||
}
|
||||
|
||||
my $headers;
|
||||
if ($template->{tpl_extra}) {
|
||||
for (split /\s*\n\s*/, $template->{tpl_extra}) { # This will weed out any blank lines
|
||||
my ($key, $value) = split /\s*:\s*/, $_, 2;
|
||||
$headers->{$key} = $value if $key and $value;
|
||||
}
|
||||
}
|
||||
$headers->{From} = $template->{tpl_from};
|
||||
$headers->{To} = $template->{tpl_to};
|
||||
$headers->{Subject} = $template->{tpl_subject};
|
||||
|
||||
return { body => $template->{tpl_body}, head => $headers };
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_parse_file} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _parse_file {
|
||||
my ($file, $info) = @_;
|
||||
require GT::Mail::Editor;
|
||||
require GList::Template;
|
||||
|
||||
my $tpl = GT::Mail::Editor->new( dir => "$CFG->{priv_path}/templates", template => $CFG->{template_set} );
|
||||
$tpl->load($file);
|
||||
|
||||
my %head;
|
||||
my $headers = $tpl->headers;
|
||||
while (my ($k, $v) = each %$headers) {
|
||||
my $val = $v;
|
||||
$val = GList::Template->parse(
|
||||
"string",
|
||||
[$info],
|
||||
{
|
||||
string => $val,
|
||||
disable => { functions => 1 }
|
||||
}
|
||||
);
|
||||
$head{$k} = $val;
|
||||
}
|
||||
my $body = GList::Template->parse(
|
||||
"string",
|
||||
[$info],
|
||||
{
|
||||
string => $tpl->{body},
|
||||
disable => { functions => 1 }
|
||||
}
|
||||
);
|
||||
return (\%head, $body);
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_cleanup_files} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _cleanup_files {
|
||||
#----------------------------------------------------------
|
||||
# Clear out old temporary attachments.
|
||||
#
|
||||
my $second = $CFG->{session_exp} * 3600 || 3600;
|
||||
opendir (DIR, "$CFG->{priv_path}/tmp") or die GList::language('DIR_OPEN_ERR', "$CFG->{priv_path}/tmp");
|
||||
my @files = readdir(DIR);
|
||||
closedir (DIR);
|
||||
foreach my $file (@files) {
|
||||
my $full_file = "$CFG->{priv_path}/tmp/$file";
|
||||
next if ( -d $full_file );
|
||||
|
||||
if ( (-M _) * 86400 > $second ) {
|
||||
$full_file =~ /(.*)/;
|
||||
$full_file = $1;
|
||||
unlink $full_file;
|
||||
}
|
||||
}
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_todo} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _todo {
|
||||
#---------------------------------------------------------------------------
|
||||
#
|
||||
my $do = shift;
|
||||
my %actions = (
|
||||
user_open => 1,
|
||||
user_click => 1,
|
||||
user_signup => 1,
|
||||
user_remind => 1,
|
||||
user_validate => 1,
|
||||
user_subscribe => 1,
|
||||
user_rm => 1,
|
||||
user_unsubscribe=> 1,
|
||||
user_account_validate => 1,
|
||||
# add in account updating
|
||||
user_move => 1
|
||||
);
|
||||
if (exists $actions{$do}) {
|
||||
return 1;
|
||||
}
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
$COMPILE{_determine_action} = __LINE__ . <<'END_OF_SUB';
|
||||
sub _determine_action {
|
||||
#----------------------------------------------------------------------------
|
||||
# Check valid action
|
||||
#
|
||||
my $action = shift || undef;
|
||||
return if ( !$action );
|
||||
return 'user_login' if ( !$USER and !_todo($action) );
|
||||
|
||||
my %valid = (
|
||||
map { $_ => 1 } qw(
|
||||
user_open
|
||||
user_click
|
||||
user_signup
|
||||
user_login
|
||||
user_logout
|
||||
user_remind
|
||||
user_validate
|
||||
user_subscribe
|
||||
user_rm
|
||||
user_unsubscribe
|
||||
user_account_validate
|
||||
# Add in ability to update account
|
||||
user_move
|
||||
)
|
||||
);
|
||||
exists $valid{$action} and return $action;
|
||||
return;
|
||||
}
|
||||
END_OF_SUB
|
||||
|
||||
1;
|
||||
63
site/glist/lib/GList/mod_perl.pm
Normal file
63
site/glist/lib/GList/mod_perl.pm
Normal file
@ -0,0 +1,63 @@
|
||||
# ==================================================================
|
||||
# Gossamer List - enhanced mailing list management system
|
||||
#
|
||||
# Website : http://gossamer-threads.com/
|
||||
# Support : http://gossamer-threads.com/scripts/support/
|
||||
# CVS Info :
|
||||
# Revision : $Id: mod_perl.pm,v 1.7 2004/09/13 23:12:25 jagerman 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::mod_perl;
|
||||
# ==================================================================
|
||||
|
||||
use strict;
|
||||
use lib '/home/slowtwitch/glist/lib';
|
||||
|
||||
# If under mod_perl, we use Apache::DBI to cache connections.
|
||||
use GT::Base qw/MOD_PERL/;
|
||||
BEGIN {
|
||||
require Apache::DBI if MOD_PERL;
|
||||
print STDERR "\nPreloading Gossamer List modules into mod_perl:\n\t"
|
||||
}
|
||||
|
||||
use GList();
|
||||
BEGIN { print STDERR " ." }
|
||||
|
||||
# Preload commonly used GT libs.
|
||||
use GT::CGI();
|
||||
use GT::Template();
|
||||
use GT::Dumper();
|
||||
use GT::Date();
|
||||
use GT::Mail();
|
||||
BEGIN { print STDERR " ." }
|
||||
use GT::SQL();
|
||||
use GT::SQL::Relation();
|
||||
|
||||
# Preload GList modules.
|
||||
BEGIN { print STDERR " ." }
|
||||
use GList::Authenticate();
|
||||
use GList::Admin();
|
||||
use GList::List();
|
||||
use GList::Mailer();
|
||||
use GList::Message();
|
||||
BEGIN { print STDERR " ." }
|
||||
use GList::Profile();
|
||||
use GList::SQL();
|
||||
use GList::Template();
|
||||
use GList::Tools();
|
||||
use GList::User();
|
||||
|
||||
BEGIN { print STDERR " .\nAll modules loaded ok!\n" };
|
||||
|
||||
print STDERR "Compiling all functions ...";
|
||||
|
||||
GT::AutoLoader::compile_all();
|
||||
|
||||
print STDERR " All modules compiled and loaded ok!\n\n";
|
||||
|
||||
1;
|
||||
Reference in New Issue
Block a user