394 lines
14 KiB
Perl
394 lines
14 KiB
Perl
# ==================================================================
|
|
# Gossamer List - enhanced mailing list management system
|
|
#
|
|
# Website : http://gossamer-threads.com/
|
|
# Support : http://gossamer-threads.com/scripts/support/
|
|
# CVS Info :
|
|
# Revision : $Id: 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;
|