MAPSDB::AddEmail $sender, $subject, $data;
} # AddEmail
-sub AddList ($$$;$$) {
- my ($listtype, $pattern, $sequence, $comment, $hit_count) = @_;
+sub AddList ($$$;$$$) {
+ my ($listtype, $pattern, $sequence, $comment, $hit_count, $last_hit) = @_;
$hit_count //= CountMsg $pattern;
- MAPSDB::AddList $listtype, $pattern, $sequence, $comment, $hit_count;
+ MAPSDB::AddList $listtype, $pattern, $sequence, $comment, $hit_count, $last_hit;
} # AddList
sub AddUser ($$$$) {
use strict;
use vars qw (@ISA @EXPORT);
use DBI;
+use Carp;
use MAPSUtil;
$DB->do ($statement)
or DBError 'AddEmail: Unable to do statement', $statement;
+
+ return;
} # AddEmail
-sub AddList ($$$;$$) {
- my ($listtype, $pattern, $sequence, $comment, $hitcount) = @_;
-
+sub AddList ($$$;$$$) {
+ my ($listtype, $pattern, $sequence, $comment, $hitcount, $last_hit) = @_;
+
$hitcount ||= 0;
my ($user, $domain) = split /\@/, $pattern;
} # if
# Get next sequence #
- if ($sequence eq 0) {
+ if ($sequence == 0) {
$sequence = GetNextSequenceNo $userid, $listtype;
} # if
- my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
+ $last_hit //= UnixDatetime2SQLDatetime (scalar (localtime));
- my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hitcount, \"$timestamp\")";
+ my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hitcount, \"$last_hit\")";
$DB->do ($statement)
or DBError 'AddList: Unable to do statement', $statement;
+
+ return;
} # AddList
sub AddLog ($$$) {
$DB->do ($statement)
or DBError 'AddLog: Unable to do statement', $statement;
+
+ return;
} # AddLog
sub AddUser ($$$$) {
$DB->do ($statement)
or DBError 'AddList: Unable to do statement', $statement;
+
+ return;
} # RecordHit
sub CheckOnList ($$) {
} # unless
# Just return if there's nothing to delete
- return $count if ($count eq 0);
+ return $count if ($count == 0);
# Delete emails for userid whose older than $timestamp
$statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'";
} # unless
# Just return if there's nothing to delete
- return $count if ($count eq 0);
+ return $count if ($count == 0);
# Delete log entries for userid whose older than $timestamp
$statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'";
$count = $row[0] ? $row[0] : 0;
# Just return if there's nothing to delete
- return $count if ($count eq 0);
+ return $count if ($count == 0);
# Get data for these entries
$statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
sub CloseDB () {
$DB->disconnect;
+
+ return;
} # CloseDB
sub CountMsg ($) {
my $count = count ('email', $condition);
# Just return if there's nothing to delete
- return $count if ($count eq 0);
+ return $count if ($count == 0);
my $statement = 'delete from email where ' . $condition;
my $count = count ('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'");
# Just return if there's nothing to delete
- return $count if ($count eq 0);
+ return $count if ($count == 0);
my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'";
my $count = count ('log', $condition);
# Just return if there's nothing to delete
- return $count if ($count eq 0);
+ return $count if ($count == 0);
my $statement = 'delete from log where ' . $condition;
my $userid = pop @email;
return $userid, $sender, $subject, $timestamp, $message;
} else {
- return undef;
+ return;
} # if
} # GetEmail
my $userid = pop @list;
return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
} else {
- return undef;
+ return;
} # if
} # GetList
my $userid = pop @log;
return $userid, $timestamp, $sender, $type, $message;
} else {
- return undef;
+ return;
} # if
} # GetLog
my $userid = pop @user;
return ($userid, $name, $email, $password);
} else {
- return undef;
+ return;
} # if
} # GetUser
if (!$DB || $DB eq '') {
#$dbserver='localhost';
$DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
- or die "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
+ or croak "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
} # if
return $DB;
$sth->execute
or DBError 'OptimizeDB: Unable to execute statement', $statement;
+
+ return;
} # OptimizeDB
sub ResequenceList ($$) {
$dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
} # if
- my $statement = <<END;
+ my $statement = <<"END";
select
sender,
timestamp
# squashed) yet they still will count towards the number of hits
# before we autonullist. We should squash these upon receipt, not
# upon report. Maybe latter...
- my $statement = <<END;
+ my $statement = <<"END";
select
subject,
left(timestamp,16)
my $eod = $date . ' 23:59:59';
if ($type eq 'returned') {
- $statement = <<END;
+ $statement = <<"END";
select
log.sender
from
$start_at, $nbr_emails
END
} else {
- $statement = <<END;
+ $statement = <<"END";
select
sender
from
} # if
} else {
if ($type eq 'returned') {
- $statement = <<END;
+ $statement = <<"END";
select
log.sender
from
$start_at, $nbr_emails
END
} else {
- $statement = <<END;
+ $statement = <<"END";
select
sender
from
#} else {
# TODO: Check if numeric
} # fi
-
+
my $statement =
'update list set ' .
"pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " .
while (my @row = $sth->fetchrow_array) {
last if !@row;
- my $data = pop @row;
- my $timestamp = pop @row;
- my $subject = pop @row;
- my $sender = pop @row;
- my $user = pop @row;
+ my $data = pop @row;
+ my $timestamp = pop @row;
+ my $subject = pop @row;
+ my $sender = pop @row;
+ my $user = pop @row;
my $msg_space =
- length ($userid) +
- length ($sender) +
- length ($subject) +
- length ($timestamp) +
+ length ($userid) +
+ length ($sender) +
+ length ($subject) +
+ length ($timestamp) +
length ($data);
- $total_space += $msg_space;
- $msg_space{$sender} += $msg_space;
+ $total_space += $msg_space;
+ $msg_space{$sender} += $msg_space;
} # while
$sth->finish;
################################################################################
#
# File: $RCSfile: exportlist.cgi,v $
-# Revision: $Revision: 1.1 $
-# Description: Export an address list
+# Revision: $Revision: 1.1 $
+# Description: Export an address list
# Author: Andrew@DeFaria.com
# Created: Mon Jan 16 20:25:32 PST 2006
# Modified: $Date: 2013/06/12 14:05:47 $
use strict;
use FindBin;
-$0 = $FindBin::Script;
+local $0 = $FindBin::Script;
use lib $FindBin::Bin;
use CGI qw/:standard *table/;
use CGI::Carp "fatalsToBrowser";
-my $type = param ("type");
-my $userid = cookie ("MAPSUser");
-my $Userid = ucfirst $userid;
+my $type = param ("type");
+my $userid = cookie ("MAPSUser");
+ $userid //= $ENV{USER};
+my $Userid = ucfirst $userid;
sub PrintList {
my $type = shift;
while (($_, $_, $pattern, $domain, $comment, $_, $hit_count, $last_hit) = GetList $sth) {
last if !(defined $pattern or defined $domain);
- $pattern = !defined $pattern ? "" : $pattern;
- $domain = !defined $domain ? "" : $domain;
- if ($domain eq "") {
+
+ $pattern //= '';
+ $domain //= '';
+
+ if ($domain eq '') {
print "$pattern,$comment,$hit_count,$last_hit\n";
} else {
print "$pattern\@$domain,$comment,$hit_count,$last_hit\n";
} # if
} # while
+
+ return;
} # PrintList
# Main
SetContext $userid;
-print header (-type => "application/octet-stream",
- -attachment => "$type.list");
+print header (
+ -type => "application/octet-stream",
+ -attachment => "$type.list",
+);
+
PrintList $type;
+
exit;
--- /dev/null
+#!/usr/bin/perl
+################################################################################
+#
+# File: $RCSfile: importlist.cgi,v $
+# Revision: $Revision: 1.1 $
+# Description: Export an address list
+# Author: Andrew@DeFaria.com
+# Created: Mon Jan 16 20:25:32 PST 2006
+# Modified: $Date: 2013/06/12 14:05:47 $
+# Language: perl
+#
+# (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
+#
+################################################################################
+use strict;
+
+use FindBin;
+local $0 = $FindBin::Script;
+
+use lib $FindBin::Bin;
+
+use Getopt::Long;
+use Pod::Usage;
+
+use MAPS;
+use MAPSWeb;
+
+use CGI qw/:standard *table/;
+use CGI::Carp "fatalsToBrowser";
+
+my $type = param('type');
+my $userid = cookie('MAPSUser');
+ $userid //= $ENV{USER};
+my $Userid = ucfirst $userid;
+
+my %opts = (
+ usage => sub { pod2usage },
+ help => sub { pod2usage (-verbose => 2)},
+ file => param('file'),
+);
+
+sub importList ($) {
+ my ($type) = @_;
+
+ my $count = 0;
+
+ open my $file, '<', $opts{file}
+ or die "Unable to open $opts{file} - $!\n";
+
+ while (<$file>) {
+ next if /^\s*#/;
+
+ chomp;
+
+ my ($pattern, $comment, $hit_count, $last_hit) = split /,/;
+
+ my $alreadyExists;
+
+ if ($type eq 'white') {
+ $alreadyExists = OnWhitelist $pattern, $userid;
+ } elsif ($type eq 'black') {
+ $alreadyExists = OnBlacklist $pattern, $userid;
+ } elsif ($type eq 'null') {
+ $alreadyExists = OnNulllist $pattern, $userid;
+ } # if
+
+ unless ($alreadyExists) {
+ AddList ($type, $pattern, 0, $comment, $hit_count, $last_hit);
+
+ $count++;
+ } # unless
+ } # while
+
+ close $file;
+
+ return $count;
+} # importList
+
+# Main
+GetOptions (
+ \%opts,
+ 'usage',
+ 'help',
+ 'verbose',
+ 'debug',
+ 'file=s',
+);
+
+pod2usage "Type not specified" unless $type;
+pod2usage '-file should be specified' unless $opts{file};
+pod2usage "Unable to read $opts{file}" unless -r $opts{file};
+
+$userid = Heading (
+ 'getcookie',
+ '',
+ 'Import List',
+ 'Import List',
+);
+
+SetContext $userid;
+
+NavigationBar $userid;
+
+my $count = importList $type;
+
+if ($count == 1) {
+ print br "$count list entry imported";
+} elsif ($count == 0) {
+ print br 'No entries imported';
+} else {
+ print br "$count list entries imported";
+} # if
+
+exit;
################################################################################
#
# File: $RCSfile: list.cgi,v $
-# Revision: $Revision: 1.1 $
-# Description: Manage lists
+# Revision: $Revision: 1.1 $
+# Description: Manage lists
# Author: Andrew@DeFaria.com
# Created: Mon Jan 16 20:25:32 PST 2006
# Modified: $Date: 2013/06/12 14:05:47 $
use warnings;
use FindBin;
-$0 = $FindBin::Script;
+
+local $0 = $FindBin::Script;
use lib $FindBin::Bin;
use CGI qw (:standard *table start_div end_div);
use CGI::Carp "fatalsToBrowser";
-my $next = param ("next");
-my $lines = param ("lines");
-my $type = param ("type");
-my $message = param ("message");
-my $Type = ucfirst $type;
+my $next = param("next");
+my $lines = param("lines");
+my $type = param("type");
+my $message = param("message");
+my $Type = ucfirst $type;
my $userid;
my $prev;
my $total;
my $type = shift;
if (defined $message) {
- print div {-align => "center"},
- font {-class => "error"}, $message;
+ print div {-align => "center"},
+ font {-class => "error"}, $message;
} # if
print start_form {
- -method => "post",
- -action => "processaction.cgi",
- -name => "list"
+ -method => "post",
+ -action => "processaction.cgi",
+ -name => "list"
};
# Print some hidden fields to pass along
print
- hidden (-name => "type",
- -default => $type),
- hidden (-name => "next",
- -default => $next);
+ hidden (-name => "type",
+ -default => $type),
+ hidden (-name => "next",
+ -default => $next);
my $current = $next + 1;
print div {-align => "center"}, b (
"(" . $current . "-" . $last . " of " . $total . ")");
- print start_div {-class => "toolbar",
- -align => "center"};
+ print start_div {-class => "toolbar",
+ -align => "center"};
my $prev_button = $prev >= 0 ?
a ({-href => "list.cgi?type=$type;next=$prev"},
"<img src=/maps/images/previous.gif border=0 alt=Previous align=middle>") : "";
a {-href => "list.cgi?type=$type;next=" . ($next + $lines)},
"<img src=/maps/images/next.gif border=0 alt=Next align=middle>" : "";
print $prev_button,
- submit ({-name => "action",
- -value => "Add New Entry",
- -onClick => "return NoneChecked (document.list);"}),
- submit ({-name => "action",
- -value => "Delete Marked",
- -onClick => "return CheckAtLeast1Checked (document.list) && AreYouSure ('Are you sure you want to delete these entries?');"}),
- submit ({-name => "action",
- -value => "Modify Marked",
- -onClick => "return CheckAtLeast1Checked (document.list);"}),
- submit ({-name => "action",
- -value => "Reset Marks",
- -onClick => "return ClearAll (document.list);"}),
+ submit ({-name => "action",
+ -value => "Add New Entry",
+ -onClick => "return NoneChecked (document.list);"}),
+ submit ({-name => "action",
+ -value => "Delete Marked",
+ -onClick => "return CheckAtLeast1Checked (document.list) && AreYouSure ('Are you sure you want to delete these entries?');"}),
+ submit ({-name => "action",
+ -value => "Modify Marked",
+ -onClick => "return CheckAtLeast1Checked (document.list);"}),
+ submit ({-name => "action",
+ -value => "Reset Marks",
+ -onClick => "return ClearAll (document.list);"}),
$next_button;
print end_div;
- print start_table {-align => "center",
- -id => $table_name,
- -border => 0,
- -cellspacing => 0,
- -cellpadding => 4,
- -width => "100%"};
+ print start_table {-align => "center",
+ -id => $table_name,
+ -border => 0,
+ -cellspacing => 0,
+ -cellpadding => 4,
+ -width => "100%"};
print Tr [
- th {-class => "tableleftend"}, "Seq",
- th {-class => "tableheader"}, "Mark",
- th {-class => "tableheader"}, "Username",
- th {-class => "tableheader"}, "@",
- th {-class => "tableheader"}, "Domain",
- th {-class => "tablerightend"}, "Comments"
+ th {-class => "tableleftend"}, "Seq",
+ th {-class => "tableheader"}, "Mark",
+ th {-class => "tableheader"}, "Username",
+ th {-class => "tableheader"}, "@",
+ th {-class => "tableheader"}, "Domain",
+ th {-class => "tablerightend"}, "Comments"
];
my @list = ReturnList $type, $next, $lines;
foreach (@list) {
%record = %{$_};
- $record{pattern} = " " if !defined $record{pattern};
- $record{domain} = " " if !defined $record{domain};
- $record{comment} = " " if !defined $record{comment};
+ $record{pattern} = " " if !defined $record{pattern};
+ $record{domain} = " " if !defined $record{domain};
+ $record{comment} = " " if !defined $record{comment};
my $leftclass = ($i eq $lines || $record{sequence} eq $total) ?
"tablebottomleft" : "tableleftdata";
$i++;
print Tr [
- td {-class => $leftclass,
- -align => "center"}, $record{sequence},
- td {-class => $dataclass,
- -align => "center"},
- checkbox ({-name => "action$record{sequence}",
- -label => ""}),
- td {-class => $dataclass,
- -align => "right"}, $record{pattern},
- td {-class => $dataclass,
- -align => "center"}, "\@",
- td {-class => $dataclass,
- -align => "left"}, $record{domain},
- td {-class => $rightclass,
- -align => "left"}, $record{comment}
+ td {-class => $leftclass,
+ -align => "center"}, $record{sequence},
+ td {-class => $dataclass,
+ -align => "center"},
+ checkbox ({-name => "action$record{sequence}",
+ -label => ""}),
+ td {-class => $dataclass,
+ -align => "right"}, $record{pattern},
+ td {-class => $dataclass,
+ -align => "center"}, "\@",
+ td {-class => $dataclass,
+ -align => "left"}, $record{domain},
+ td {-class => $rightclass,
+ -align => "left"}, $record{comment}
];
} # foreach
print end_table;
print end_form;
- print div ({-align => "center"},
+ print div ({-align => "center"},
a ({-href => "/maps/bin/exportlist.cgi?type=$type"},
- submit ({-name => "export",
- -value => "Export list"})),
+ submit ({-name => "export",
+ -value => "Export List"})),
a ({-href => "/maps/bin/importlist.cgi?type=$type"},
- submit ({-name => "import",
- -value => "Import List"})));
+ submit ({-name => "import",
+ -value => "Import List"})));
+
+ return;
} # Body
# Main
if (($next - $lines) > 0) {
$prev = $next - $lines;
} else {
- $prev = $next eq 0 ? -1 : 0;
+ $prev = $next == 0 ? -1 : 0;
} # if
Body $type;
<br>
<div align=center>
<a href="/maps/bin/exportlist.cgi?type=<?php echo $type?>">
- <input type=submit name=export value="Export list"></a>
+ <input type=submit name=export value="Export List"></a>
<a href="/maps/bin/importlist.cgi?type=<?php echo $type?>">
<input type=submit name=import value="Import List"></a>
</div>