2 #################################################################################
4 # File: $RCSfile: MAPSDB.pm,v $
5 # Revision: $Revision: 1.1 $
6 # Description: MAPS Database routines
7 # Author: Andrew@DeFaria.com
8 # Created: Fri Nov 29 14:17:21 2002
9 # Modified: $Date: 2013/06/12 14:05:47 $
12 # (c) Copyright 2000-2006, Andrew@DeFaria.com, all rights reserved.
14 ################################################################################
18 use vars qw (@ISA @EXPORT);
26 my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER};
64 sub GetNextSequenceNo;
84 my ($sender, $subject, $data) = @_;
86 # "Sanitize" some fields so that characters that are illegal to SQL are escaped
88 if (!defined $sender || $sender eq '');
89 $sender = $DB->quote ($sender);
90 $subject = $DB->quote ($subject);
91 $data = $DB->quote ($data);
93 my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
94 my $statement = "insert into email values (\"$userid\", $sender, $subject, \"$timestamp\", $data)";
97 or DBError 'AddEmail: Unable to do statement', $statement;
100 sub AddList ($$$;$$) {
101 my ($listtype, $pattern, $sequence, $comment, $hitcount) = @_;
105 my ($user, $domain) = split /\@/, $pattern;
107 if (!$domain || $domain eq '') {
109 $pattern = $DB->quote ($user);
111 $domain = "'$domain'";
115 $pattern = $DB->quote ($user);
119 if (!$comment || $comment eq '') {
122 $comment = $DB->quote ($comment);
125 # Get next sequence #
126 if ($sequence eq 0) {
127 $sequence = GetNextSequenceNo $userid, $listtype;
130 my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
132 my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hitcount, \"$timestamp\")";
135 or DBError 'AddList: Unable to do statement', $statement;
139 my ($type, $sender, $msg) = @_;
141 my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
144 # Use quote to protect ourselves
145 $msg = $DB->quote ($msg);
148 $statement = "insert into log values (\"$userid\", \"$timestamp\", null, \"$type\", $msg)";
150 $statement = "insert into log values (\"$userid\", \"$timestamp\", \"$sender\", \"$type\", $msg)";
154 or DBError 'AddLog: Unable to do statement', $statement;
158 my ($userid, $realname, $email, $password) = @_;
160 $password = Encrypt $password, $userid;
162 if (UserExists $userid) {
165 my $statement = "insert into user values ('$userid', '$realname', '$email', '$password')";
168 or DBError 'AddUser: Unable to do statement', $statement;
174 sub AddUserOption ($$$) {
175 my ($userid, $name, $value) = @_;
177 if (!UserExists $userid) {
181 my $statement = "insert into useropts values ('$userid', '$name', '$value')";
184 or DBError 'AddUserOption: Unable to do statement', $statement;
189 sub RecordHit ($$$) {
190 my ($listtype, $sequence, $hit_count) = @_;
192 my $current_date = UnixDatetime2SQLDatetime (scalar (localtime));
194 my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence";
197 or DBError 'AddList: Unable to do statement', $statement;
200 sub CheckOnList ($$) {
201 # CheckOnList will check to see if the $sender is on the $listfile.
202 # Return 1 if found 0 if not.
203 my ($listtype, $sender) = @_;
208 my $statement = "select pattern, domain, comment, sequence, hit_count from list where userid = '$userid' and type = '$listtype'";
210 my $sth = $DB->prepare ($statement)
211 or DBError 'CheckOnList: Unable to prepare statement', $statement;
214 or DBError 'CheckOnList: Unable to execute statement', $statement;
216 while (my @row = $sth->fetchrow_array) {
219 my $hit_count = pop (@row);
220 my $sequence = pop (@row);
221 my $comment = pop (@row);
222 my $domain = pop (@row);
223 my $pattern = pop (@row);
227 $email_on_file = $pattern;
230 $email_on_file = '@' . $domain;
232 $email_on_file = $pattern . '@' . $domain;
236 # Escape some special characters
237 $email_on_file =~ s/\@/\\@/;
238 $email_on_file =~ s/^\*/.\*/;
240 # We want to terminate the search string with a "$" iff there's an
241 # "@" in there. This is because some "email_on_file" may have no
242 # domain (e.g. "mailer-daemon" with no domain). In that case we
243 # don't want to terminate the search string with a "$" rather we
244 # wish to terminate it with an "@". But in the case of say
245 # "@ti.com" if we don't terminate the search string with "$" then
246 # "@ti.com" would also match "@tixcom.com"!
247 my $search_for = $email_on_file =~ /\@/
253 if ($sender =~ /$search_for/i) {
254 $rule = "Matching rule: ($listtype:$sequence) \"$email_on_file\"";
255 $rule .= " - $comment" if $comment and $comment ne '';
258 RecordHit $listtype, $sequence, ++$hit_count;
266 return ($status, $rule);
270 my ($timestamp) = @_;
272 # First see if anything needs to be deleted
275 my $statement = "select count(*) from email where userid = '$userid' and timestamp < '$timestamp'";
278 my $sth = $DB->prepare ($statement)
279 or DBError 'CleanEmail: Unable to prepare statement', $statement;
283 or DBError 'CleanEmail: Unable to execute statement', $statement;
285 # Get return value, which should be how many entries were deleted
286 my @row = $sth->fetchrow_array;
291 # Retrieve returned value
298 # Just return if there's nothing to delete
299 return $count if ($count eq 0);
301 # Delete emails for userid whose older than $timestamp
302 $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'";
305 $sth = $DB->prepare ($statement)
306 or DBError 'CleanEmail: Unable to prepare statement', $statement;
310 or DBError 'CleanEmail: Unable to execute statement', $statement;
316 my ($timestamp) = @_;
318 # First see if anything needs to be deleted
321 my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'";
324 my $sth = $DB->prepare ($statement)
325 or DBError $DB, 'CleanLog: Unable to prepare statement', $statement;
329 or DBError 'CleanLog: Unable to execute statement', $statement;
331 # Get return value, which should be how many entries were deleted
332 my @row = $sth->fetchrow_array;
337 # Retrieve returned value
344 # Just return if there's nothing to delete
345 return $count if ($count eq 0);
347 # Delete log entries for userid whose older than $timestamp
348 $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'";
351 $sth = $DB->prepare ($statement)
352 or DBError 'CleanLog: Unable to prepare statement', $statement;
356 or DBError 'CleanLog: Unable to execute statement', $statement;
361 sub CleanList ($;$) {
362 my ($timestamp, $listtype) = @_;
364 $listtype = 'null' if !$listtype;
366 # First see if anything needs to be deleted
369 my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
372 my $sth = $DB->prepare ($statement)
373 or DBError $DB, 'CleanList: Unable to prepare statement', $statement;
377 or DBError 'CleanList: Unable to execute statement', $statement;
379 # Get return value, which should be how many entries were deleted
380 my @row = $sth->fetchrow_array;
385 # Retrieve returned value
386 $count = $row[0] ? $row[0] : 0;
388 # Just return if there's nothing to delete
389 return $count if ($count eq 0);
391 # Get data for these entries
392 $statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
395 $sth = $DB->prepare ($statement)
396 or DBError 'CleanList: Unable to prepare statement', $statement;
400 or DBError 'CleanList: Unable to execute statement', $statement;
404 while (my @row = $sth->fetchrow_array) {
407 my $hit_count = pop (@row);
408 my $sequence = pop (@row);
409 my $listtype = pop (@row);
411 if ($hit_count == 0) {
414 $statement = "delete from list where userid='$userid' and type='$listtype' and sequence=$sequence";
416 or DBError 'CleanList: Unable to execute statement', $statement;
418 # Age entry: Sometimes entries are initially very popular and
419 # the $hit_count gets very high quickly. Then the domain is
420 # abandoned and no activity happens. One case recently observed
421 # was for phentermine.com. The $hit_count initially soared to
422 # 1920 within a few weeks. Then it all stopped as of
423 # 07/13/2007. Obvisously this domain was shutdown. With the
424 # previous aging algorithm of simply subtracting 1 this
425 # phentermine.com entry would hang around for over 5 years!
427 # So the tack here is to age the entry by dividing it's
428 # $hit_count in half. Sucessive halfing then will quickly age
429 # the entry down to size. However we don't want to age small
430 # $hit_count's too quickly, therefore once their numbers drop to
431 # < 30 we revert to the old method of subtracting 1.
432 if ($hit_count < 30) {
435 $hit_count = $hit_count / 2;
438 $statement = "update list set hit_count=$hit_count where userid='$userid' and type='$listtype' and sequence=$sequence;";
440 or DBError 'CleanList: Unable to execute statement', $statement;
444 ResequenceList $userid, $listtype if $count > 0;
456 return count ('email', "userid = '$userid' and sender like '%$sender%'");
460 my ($msg, $statement) = @_;
462 print 'MAPSDB::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n";
465 print "SQL Statement: $statement\n";
472 my ($password, $userid) = @_;
474 my $statement = "select decode('$password','$userid')";
476 my $sth = $DB->prepare ($statement)
477 or DBError 'Decrypt: Unable to prepare statement', $statement;
480 or DBError 'Decrypt: Unable to execute statement', $statement;
482 # Get return value, which should be the encoded password
483 my @row = $sth->fetchrow_array;
491 sub DeleteEmail ($) {
494 my ($username, $domain) = split /@/, $sender;
497 if ($username eq '') {
498 $condition = "userid = '$userid' and sender like '%\@$domain'";
500 $condition = "userid = '$userid' and sender = '$sender'";
503 # First see if anything needs to be deleted
504 my $count = count ('email', $condition);
506 # Just return if there's nothing to delete
507 return $count if ($count eq 0);
509 my $statement = 'delete from email where ' . $condition;
512 or DBError 'DeleteEmail: Unable to execute statement', $statement;
517 sub DeleteList ($$) {
518 my ($type, $sequence) = @_;
520 # First see if anything needs to be deleted
521 my $count = count ('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'");
523 # Just return if there's nothing to delete
524 return $count if ($count eq 0);
526 my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'";
529 or DBError 'DeleteList: Unable to execute statement', $statement;
537 my ($username, $domain) = split /@/, $sender;
540 if ($username eq '') {
541 $condition = "userid = '$userid' and sender like '%\@$domain'";
543 $condition = "userid = '$userid' and sender = '$sender'";
546 # First see if anything needs to be deleted
547 my $count = count ('log', $condition);
549 # Just return if there's nothing to delete
550 return $count if ($count eq 0);
552 my $statement = 'delete from log where ' . $condition;
555 or DBError 'DeleteLog: Unable to execute statement', $statement;
561 my ($password, $userid) = @_;
563 my $statement = "select encode('$password','$userid')";
565 my $sth = $DB->prepare ($statement)
566 or DBError 'Encrypt: Unable to prepare statement', $statement;
569 or DBError 'Encrypt: Unable to execute statement', $statement;
571 # Get return value, which should be the encoded password
572 my @row = $sth->fetchrow_array;
585 if (!defined $sender || $sender eq '') {
586 $statement = "select * from email where userid = '$userid'";
588 $statement = "select * from email where userid = '$userid' and sender = '$sender'";
591 my $sth = $DB->prepare ($statement)
592 or DBError 'FindEmail: Unable to prepare statement', $statement;
595 or DBError 'FindEmail: Unable to execute statement', $statement;
601 my ($type, $sender) = @_;
606 $statement = "select * from list where userid = '$userid' and type = '$type'";
608 my ($pattern, $domain) = split /\@/, $sender;
609 $statement = "select * from list where userid = '$userid' and type = '$type' " .
610 "and pattern = '$pattern' and domain = '$domain'";
614 my $sth = $DB->prepare ($statement)
615 or DBError 'FindList: Unable to prepare statement', $statement;
619 or DBError 'FindList: Unable to execute statement', $statement;
621 # Get return value, which should be how many entries were deleted
626 my ($start_at, $end_at) = @_;
628 my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
631 my $sth = $DB->prepare ($statement)
632 or DBError 'FindLog: Unable to prepare statement', $statement;
636 or DBError 'FindLog: Unable to execute statement', $statement;
638 # Get return value, which should be how many entries were deleted
647 if (!defined $userid || $userid eq '') {
648 $statement = 'select * from user';
650 $statement = "select * from user where userid = '$userid'";
653 my $sth = $DB->prepare ($statement)
654 or DBError 'FindUser: Unable to prepare statement', $statement;
657 or DBError 'FindUser: Unable to execute statement', $statement;
671 if (@email = $sth->fetchrow_array) {
672 my $message = pop @email;
673 my $timestamp = pop @email;
674 my $subject = pop @email;
675 my $sender = pop @email;
676 my $userid = pop @email;
677 return $userid, $sender, $subject, $timestamp, $message;
688 if (@list = $sth->fetchrow_array) {
689 my $last_hit = pop @list;
690 my $hit_count = pop @list;
691 my $sequence = pop @list;
692 my $comment = pop @list;
693 my $domain = pop @list;
694 my $pattern = pop @list;
695 my $type = pop @list;
696 my $userid = pop @list;
697 return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
708 if (@log = $sth->fetchrow_array) {
709 my $message = pop @log;
711 my $sender = pop @log;
712 my $timestamp = pop @log;
713 my $userid = pop @log;
714 return $userid, $timestamp, $sender, $type, $message;
720 sub GetNextSequenceNo ($$) {
721 my ($userid, $listtype) = @_;
723 my $count = count ('list', "userid = '$userid' and type = '$listtype'");
726 } # GetNextSequenceNo
733 if (@user = $sth->fetchrow_array) {
734 my $password = pop @user;
735 my $email = pop @user;
736 my $name = pop @user;
737 my $userid = pop @user;
738 return ($userid, $name, $email, $password);
744 sub GetUserInfo ($) {
747 my $statement = "select name, email from user where userid='$userid'";
749 my $sth = $DB->prepare ($statement)
750 or DBError 'GetUserInfo: Unable to prepare statement', $statement;
753 or DBError 'GetUserInfo: Unable to execute statement', $statement;
755 my @userinfo = $sth->fetchrow_array;
756 my $user_email = lc (pop @userinfo);
757 my $username = lc (pop @userinfo);
761 return ($username, $user_email);
764 sub GetUserOptions ($) {
767 my $statement = "select * from useropts where userid = '$userid'";
769 my $sth = $DB->prepare ($statement)
770 or DBError 'GetUserOptions: Unable to prepare statement', $statement;
773 or DBError 'GetUserOptions: Unable to execute statement', $statement;
780 while (@useropts = $sth->fetchrow_array) {
781 my $value = pop @useropts;
782 my $name = pop @useropts;
784 $useropts{$name} = $value;
793 my ($statement) = @_;
795 my $sth = $DB->prepare ($statement)
796 or DBError 'Unable to prepare statement' , $statement;
799 or DBError 'Unable to execute statement' , $statement;
803 while (my @row = $sth->fetchrow_array) {
813 my ($username, $password) = @_;
816 my $dbdriver = 'mysql';
817 my $dbserver = $ENV{MAPS_SERVER} || 'jupiter';
819 if (!$DB || $DB eq '') {
820 #$dbserver='localhost';
821 $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
822 or die "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
829 my $statement = 'lock tables email read, list read, log read, user read, useropts read';
830 my $sth = $DB->prepare ($statement)
831 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
834 or DBError 'OptimizeDB: Unable to execute statement', $statement;
836 $statement = 'check table email, list, log, user, useropts';
837 $sth = $DB->prepare ($statement)
838 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
841 or DBError 'OptimizeDB: Unable to execute statement', $statement;
843 $statement = 'unlock tables';
844 $sth = $DB->prepare ($statement)
845 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
848 or DBError 'OptimizeDB: Unable to execute statement', $statement;
850 $statement = 'optimize table email, list, log, user, useropts';
851 $sth = $DB->prepare ($statement)
852 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
855 or DBError 'OptimizeDB: Unable to execute statement', $statement;
858 sub ResequenceList ($$) {
859 my ($userid, $type) = @_;
861 if ($type ne 'white' && $type ne 'black' && $type ne 'null') {
865 if (!UserExists $userid) {
869 my $statement = "select sequence from list where userid = '$userid' ".
870 " and type = '$type' order by sequence";
872 my $sth = $DB->prepare ($statement)
873 or DBError 'ResequenceList: Unable to prepare statement', $statement;
876 or DBError 'ResequenceList: Unable to execute statement', $statement;
880 while (my @row = $sth->fetchrow_array) {
882 my $old_sequence = pop (@row);
884 if ($old_sequence != $sequence) {
885 my $update_statement = "update list set sequence = $sequence " .
886 "where userid = '$userid' and " .
887 "type = '$type' and sequence = $old_sequence";
888 $DB->do ($update_statement)
889 or DBError 'ResequenceList: Unable to do statement', $statement;
898 # This subroutine returns an array of senders in reverse chronological
899 # order based on time timestamp from the log table of when we returned
900 # their message. The complication here is that a single sender may
901 # send multiple times in a single day. So if spammer@foo.com sends
902 # spam @ 1 second after midnight and then again at 2 Pm there will be
903 # at least two records in the log table saying that we returned his
904 # email. Getting records sorted by timestamp desc will have
905 # spammer@foo.com listed twice. But we want him listed only once, as
906 # the first entry in the returned array. Plus we may be called
907 # repeatedly with different $start_at's. Therefore we need to process
908 # the whole list of returns for today, eliminate duplicate entries for
909 # a single sender then slice the resulting array.
910 sub ReturnSenders ($$$;$$) {
911 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
918 my $sod = $date . ' 00:00:00';
919 my $eod = $date . ' 23:59:59';
921 $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
924 my $statement = <<END;
931 userid = '$userid' and
938 my $sth = $DB->prepare ($statement)
939 or DBError 'ReturnSenders: Unable to prepare statement', $statement;
942 or DBError 'ReturnSenders: Unable to execute statement', $statement;
944 # Watch the distinction between senders (plural) and sender (singular)
945 my (%senders, %sendersByTimestamp);
947 # Run through the results and add to %senders by sender key. This
948 # results in a hash that has the sender in it and the first
949 # timestamp value. Since we already sorted timestamp desc by the
950 # above select statement, and we've narrowed it down to only log
951 # message that occurred for the given $date, we will have a hash
952 # containing 1 sender and the latest timestamp for the day.
953 while (my $senderRef = $sth->fetchrow_hashref) {
954 my %sender = %{$senderRef};
956 $senders{$sender{sender}} = $sender{timestamp}
957 unless $senders{$sender{sender}};
962 # Make a hash whose keys are the timestamp (so we can later sort on
964 while (my ($key, $value) = each %senders) {
965 $sendersByTimestamp{$value} = $key;
970 # Sort by timestamp desc and push on to the @senders array
971 push @senders, $sendersByTimestamp{$_}
972 foreach (sort { $b cmp $a } keys %sendersByTimestamp);
974 # Finally slice for the given range
975 my $end_at = $start_at + $nbr_emails - 1;
977 $end_at = (@senders - 1)
978 if $end_at > @senders;
980 return (@senders) [$start_at .. $end_at];
983 sub ReturnMessages ($$) {
984 my ($userid, $sender) = @_;
986 # Note, the left(timestamp,16) chops off the seconds and the group
987 # by effectively squashes two emails received in the same minute to
988 # just one. We get a lot of double emails within the same minute. I
989 # think it's a result of the mailer configuration and it attempting
990 # to resend the message, not that it's the spammer sending just two
991 # emails in under a minute then going away. This will mean we will
992 # see fewer emails listed (essentially dups within one minute are
993 # squashed) yet they still will count towards the number of hits
994 # before we autonullist. We should squash these upon receipt, not
995 # upon report. Maybe latter...
996 my $statement = <<END;
1003 userid = '$userid' and
1006 left(timestamp,16) desc
1009 my $sth = $DB->prepare ($statement)
1010 or DBError 'ReturnMessages: Unable to prepare statement', $statement;
1013 or DBError 'ReturnMessages: Unable to execute statement', $statement;
1017 while (my @row = $sth->fetchrow_array) {
1018 my $date = pop @row;
1019 my $subject = pop @row;
1021 push @messages, [$subject, $date];
1029 sub ReturnEmails ($$$;$$) {
1030 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1037 my $sod = $date . ' 00:00:00';
1038 my $eod = $date . ' 23:59:59';
1040 if ($type eq 'returned') {
1048 log.sender = email.sender and
1049 log.userid = '$userid' and
1050 log.timestamp > '$sod' and
1051 log.timestamp < '$eod' and
1056 $start_at, $nbr_emails
1065 userid = '$userid' and
1066 timestamp > '$sod' and
1067 timestamp < '$eod' and
1072 $start_at, $nbr_emails
1076 if ($type eq 'returned') {
1084 log.sender = email.sender and
1085 log.userid = '$userid' and
1092 $start_at, $nbr_emails
1101 userid = '$userid' and
1108 $start_at, $nbr_emails
1113 my $sth = $DB->prepare ($statement)
1114 or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1117 or DBError 'ReturnEmails: Unable to execute statement', $statement;
1121 while (my $sender = $sth->fetchrow_array) {
1124 # Get emails for this sender. Format an array of subjects and timestamps.
1127 $statement = "select timestamp, subject from email where userid = '$userid' " .
1128 "and sender = '$sender'";
1130 my $sth2 = $DB->prepare ($statement)
1131 or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1134 or DBError 'ReturnEmails: Unable to execute statement', $statement;
1136 while (my @row = $sth2->fetchrow_array) {
1137 my $subject = pop @row;
1138 my $date = pop @row;
1140 if ($earliestDate) {
1141 my $earliestDateShort = substr $earliestDate, 0, 10;
1142 my $dateShort = substr $date, 0, 10;
1144 if ($earliestDateShort eq $dateShort and
1145 $earliestDate > $date) {
1146 $earliestDate = $date
1147 if $earliestDateShort eq $dateShort;
1150 $earliestDate = $date;
1153 push @messages, [$subject, $date];
1159 $earliestDate ||= '';
1161 unless ($type eq 'returned') {
1162 push @emails, [$earliestDate, [$sender, @messages]];
1164 push @emails, [$earliestDate, [$sender, @messages]]
1175 sub ReturnList ($$$) {
1176 my ($type, $start_at, $lines) = @_;
1183 $statement = "select * from list where userid = '$userid' " .
1184 "and type = '$type' order by sequence " .
1185 "limit $start_at, $lines";
1187 $statement = "select * from list where userid = '$userid' " .
1188 "and type = '$type' order by sequence";
1191 my $sth = $DB->prepare ($statement)
1192 or DBError 'ReturnList: Unable to prepare statement', $statement;
1195 or DBError 'ReturnList: Unable to execute statement', $statement;
1200 while (my @row = $sth->fetchrow_array) {
1201 last if $i++ > $lines;
1205 $list {last_hit} = pop @row;
1206 $list {hit_count} = pop @row;
1207 $list {sequence} = pop @row;
1208 $list {comment} = pop @row;
1209 $list {domain} = pop @row;
1210 $list {pattern} = pop @row;
1211 $list {type} = pop @row;
1212 $list {userid} = pop @row;
1219 sub ReturnListEntry ($$) {
1220 my ($type, $sequence) = @_;
1222 my $statement = "select * from list where userid = '$userid' " .
1223 "and type = '$type' and sequence = '$sequence'";
1225 my $sth = $DB->prepare ($statement)
1226 or DBError 'ReturnListEntry: Unable to prepare statement', $statement;
1229 or DBError 'ReturnListEntry: Unable to execute statement', $statement;
1232 my @row = $sth->fetchrow_array;
1234 $list {sequence} = pop @row;
1235 $list {comment} = pop @row;
1236 $list {domain} = pop @row;
1237 $list {pattern} = pop @row;
1238 $list {type} = pop @row;
1239 $list {userid} = pop @row;
1244 sub UpdateList ($$$$$$) {
1245 my ($userid, $type, $pattern, $domain, $comment, $sequence) = @_;
1247 if (!$pattern || $pattern eq '') {
1250 $pattern = "'" . quotemeta ($pattern) . "'";
1253 if (!$domain || $domain eq '') {
1256 $domain = "'" . quotemeta ($domain) . "'";
1259 if (!$comment || $comment eq '') {
1262 $comment = "'" . quotemeta ($comment) . "'";
1266 'update list set ' .
1267 "pattern = $pattern, domain = $domain, comment = $comment " .
1268 "where userid = '$userid' and type = '$type' and sequence = $sequence";
1270 $DB->do ($statement)
1271 or DBError 'UpdateList: Unable to do statement', $statement;
1276 sub SearchEmails ($$) {
1277 my ($userid, $searchfield) = @_;
1282 "select sender, subject, timestamp from email where userid = '$userid' and (
1283 sender like '%$searchfield%' or subject like '%$searchfield%')
1284 order by timestamp desc";
1286 my $sth = $DB->prepare ($statement)
1287 or DBError 'SearchEmails: Unable to prepare statement', $statement;
1290 or DBError 'SearchEmails: Unable to execute statement', $statement;
1292 while (my @row = $sth->fetchrow_array) {
1293 my $date = pop @row;
1294 my $subject = pop @row;
1295 my $sender = pop @row;
1297 push @emails, [$sender, $subject, $date];
1305 sub SetContext ($) {
1308 my $old_user = $userid;
1310 if (UserExists $to_user) {
1312 GetUserOptions $userid;
1313 return GetUserInfo $userid;
1322 my $total_space = 0;
1325 my $statement = "select * from email where userid = '$userid'";
1326 my $sth = $DB->prepare ($statement)
1327 or DBError 'Unable to prepare statement', $statement;
1330 or DBError 'Unable to execute statement', $statement;
1332 while (my @row = $sth->fetchrow_array) {
1334 my $data = pop @row;
1335 my $timestamp = pop @row;
1336 my $subject = pop @row;
1337 my $sender = pop @row;
1338 my $user = pop @row;
1344 length ($timestamp) +
1347 $total_space += $msg_space;
1348 $msg_space{$sender} += $msg_space;
1353 return wantarray ? %msg_space : $total_space;
1356 sub UpdateUser ($$$$) {
1357 my ($userid, $fullname, $email, $password) = @_;
1359 if (!UserExists $userid) {
1365 if (!defined $password || $password eq '') {
1366 $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1368 $password = Encrypt $password, $userid;
1369 $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1372 $DB->do ($statement)
1373 or DBError 'UpdateUser: Unable to do statement', $statement;
1378 sub UpdateUserOption ($$$) {
1379 my ($userid, $name, $value) = @_;
1381 if (!UserExists $userid) {
1385 my $statement = "update useropts set value='$value' where userid='$userid' and name='$name'";
1387 $DB->do ($statement)
1388 or DBError 'UpdateUserOption: Unable to do statement', $statement;
1391 } # UpdateUserOptions
1393 sub UserExists ($) {
1399 my $statement = "select userid, password from user where userid = '$userid'";
1401 my $sth = $DB->prepare ($statement)
1402 or DBError 'UserExists: Unable to prepare statement', $statement;
1405 or DBError 'UserExists: Unable to execute statement', $statement;
1407 my @userdata = $sth->fetchrow_array;
1411 return 0 if scalar (@userdata) == 0;
1413 my $dbpassword = pop @userdata;
1414 my $dbuserid = pop @userdata;
1416 if ($dbuserid ne $userid) {
1424 my ($table, $condition) = @_;
1429 $statement = "select count(*) from $table where $condition";
1431 $statement = "select count(*) from $table";
1434 my $sth = $DB->prepare ($statement)
1435 or DBError 'count: Unable to prepare statement', $statement;
1438 or DBError 'count: Unable to execute statement', $statement;
1440 # Get return value, which should be how many message there are
1441 my @row = $sth->fetchrow_array;
1448 # Retrieve returned value
1458 sub count_distinct ($$$) {
1459 my ($table, $column, $condition) = @_;
1464 $statement = "select count(distinct $column) from $table where $condition";
1466 $statement = "select count(distinct $column) from $table";
1469 my $sth = $DB->prepare ($statement)
1470 or DBError 'count: Unable to prepare statement', $statement;
1473 or DBError 'count: Unable to execute statement', $statement;
1475 # Get return value, which should be how many message there are
1476 my @row = $sth->fetchrow_array;
1481 # Retrieve returned value
1489 sub countlog (;$$) {
1490 my ($additional_condition, $type) = @_;
1496 $condition = "userid=\'$userid\' ";
1498 $condition .= "and $additional_condition"
1499 if $additional_condition;
1501 return count_distinct ('log', 'sender', $condition);