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);
27 my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER};
65 sub GetNextSequenceNo;
85 my ($sender, $subject, $data) = @_;
87 # "Sanitize" some fields so that characters that are illegal to SQL are escaped
89 if (!defined $sender || $sender eq '');
90 $sender = $DB->quote ($sender);
91 $subject = $DB->quote ($subject);
92 $data = $DB->quote ($data);
94 my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
95 my $statement = "insert into email values (\"$userid\", $sender, $subject, \"$timestamp\", $data)";
98 or DBError 'AddEmail: Unable to do statement', $statement;
103 sub AddList ($$$;$$$) {
104 my ($listtype, $pattern, $sequence, $comment, $hitcount, $last_hit) = @_;
108 my ($user, $domain) = split /\@/, $pattern;
110 if (!$domain || $domain eq '') {
112 $pattern = $DB->quote ($user);
114 $domain = "'$domain'";
118 $pattern = $DB->quote ($user);
122 if (!$comment || $comment eq '') {
125 $comment = $DB->quote ($comment);
128 # Get next sequence #
129 if ($sequence == 0) {
130 $sequence = GetNextSequenceNo $userid, $listtype;
133 $last_hit //= UnixDatetime2SQLDatetime (scalar (localtime));
135 my $statement = "insert into list values (\"$userid\", \"$listtype\", $pattern, $domain, $comment, $sequence, $hitcount, \"$last_hit\")";
138 or DBError 'AddList: Unable to do statement', $statement;
144 my ($type, $sender, $msg) = @_;
146 my $timestamp = UnixDatetime2SQLDatetime (scalar (localtime));
149 # Use quote to protect ourselves
150 $msg = $DB->quote ($msg);
153 $statement = "insert into log values (\"$userid\", \"$timestamp\", null, \"$type\", $msg)";
155 $statement = "insert into log values (\"$userid\", \"$timestamp\", \"$sender\", \"$type\", $msg)";
159 or DBError 'AddLog: Unable to do statement', $statement;
165 my ($userid, $realname, $email, $password) = @_;
167 $password = Encrypt $password, $userid;
169 if (UserExists $userid) {
172 my $statement = "insert into user values ('$userid', '$realname', '$email', '$password')";
175 or DBError 'AddUser: Unable to do statement', $statement;
181 sub AddUserOption ($$$) {
182 my ($userid, $name, $value) = @_;
184 if (!UserExists $userid) {
188 my $statement = "insert into useropts values ('$userid', '$name', '$value')";
191 or DBError 'AddUserOption: Unable to do statement', $statement;
196 sub RecordHit ($$$) {
197 my ($listtype, $sequence, $hit_count) = @_;
199 my $current_date = UnixDatetime2SQLDatetime (scalar (localtime));
201 my $statement = "update list set hit_count=$hit_count, last_hit='$current_date' where userid='$userid' and type='$listtype' and sequence=$sequence";
204 or DBError 'AddList: Unable to do statement', $statement;
209 sub CheckOnList ($$;$) {
210 # CheckOnList will check to see if the $sender is on the $listfile.
211 # Return 1 if found 0 if not.
212 my ($listtype, $sender, $update) = @_;
217 my ($rule, $sequence, $hit_count);
219 my $statement = "select pattern, domain, comment, sequence, hit_count from list where userid = '$userid' and type = '$listtype'";
221 my $sth = $DB->prepare ($statement)
222 or DBError 'CheckOnList: Unable to prepare statement', $statement;
225 or DBError 'CheckOnList: Unable to execute statement', $statement;
227 while (my @row = $sth->fetchrow_array) {
230 $hit_count = pop (@row);
231 $sequence = pop (@row);
232 my $comment = pop (@row);
233 my $domain = pop (@row);
234 my $pattern = pop (@row);
238 $email_on_file = $pattern;
241 $email_on_file = '@' . $domain;
243 $email_on_file = $pattern . '@' . $domain;
247 # Escape some special characters
248 $email_on_file =~ s/\@/\\@/;
249 $email_on_file =~ s/^\*/.\*/;
251 # We want to terminate the search string with a "$" iff there's an
252 # "@" in there. This is because some "email_on_file" may have no
253 # domain (e.g. "mailer-daemon" with no domain). In that case we
254 # don't want to terminate the search string with a "$" rather we
255 # wish to terminate it with an "@". But in the case of say
256 # "@ti.com" if we don't terminate the search string with "$" then
257 # "@ti.com" would also match "@tixcom.com"!
258 my $search_for = $email_on_file =~ /\@/
264 if ($sender =~ /$search_for/i) {
265 $rule = "Matching rule: ($listtype:$sequence) \"$email_on_file\"";
266 $rule .= " - $comment" if $comment and $comment ne '';
269 RecordHit $listtype, $sequence, ++$hit_count if $update;
277 return ($status, $rule, $sequence, $hit_count);
281 my ($timestamp) = @_;
283 # First see if anything needs to be deleted
286 my $statement = "select count(*) from email where userid = '$userid' and timestamp < '$timestamp'";
289 my $sth = $DB->prepare ($statement)
290 or DBError 'CleanEmail: Unable to prepare statement', $statement;
294 or DBError 'CleanEmail: Unable to execute statement', $statement;
296 # Get return value, which should be how many entries were deleted
297 my @row = $sth->fetchrow_array;
302 # Retrieve returned value
309 # Just return if there's nothing to delete
310 return $count if ($count == 0);
312 # Delete emails for userid whose older than $timestamp
313 $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'";
316 $sth = $DB->prepare ($statement)
317 or DBError 'CleanEmail: Unable to prepare statement', $statement;
321 or DBError 'CleanEmail: Unable to execute statement', $statement;
327 my ($timestamp) = @_;
329 # First see if anything needs to be deleted
332 my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'";
335 my $sth = $DB->prepare ($statement)
336 or DBError $DB, 'CleanLog: Unable to prepare statement', $statement;
340 or DBError 'CleanLog: Unable to execute statement', $statement;
342 # Get return value, which should be how many entries were deleted
343 my @row = $sth->fetchrow_array;
348 # Retrieve returned value
355 # Just return if there's nothing to delete
356 return $count if ($count == 0);
358 # Delete log entries for userid whose older than $timestamp
359 $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'";
362 $sth = $DB->prepare ($statement)
363 or DBError 'CleanLog: Unable to prepare statement', $statement;
367 or DBError 'CleanLog: Unable to execute statement', $statement;
372 sub CleanList ($;$) {
373 my ($timestamp, $listtype) = @_;
375 $listtype = 'null' if !$listtype;
377 # First see if anything needs to be deleted
380 my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
383 my $sth = $DB->prepare ($statement)
384 or DBError $DB, 'CleanList: Unable to prepare statement', $statement;
388 or DBError 'CleanList: Unable to execute statement', $statement;
390 # Get return value, which should be how many entries were deleted
391 my @row = $sth->fetchrow_array;
396 # Retrieve returned value
397 $count = $row[0] ? $row[0] : 0;
399 # Just return if there's nothing to delete
400 return $count if ($count == 0);
402 # Get data for these entries
403 $statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
406 $sth = $DB->prepare ($statement)
407 or DBError 'CleanList: Unable to prepare statement', $statement;
411 or DBError 'CleanList: Unable to execute statement', $statement;
415 while (my @row = $sth->fetchrow_array) {
418 my $hit_count = pop (@row);
419 my $sequence = pop (@row);
420 my $listtype = pop (@row);
422 if ($hit_count == 0) {
425 $statement = "delete from list where userid='$userid' and type='$listtype' and sequence=$sequence";
427 or DBError 'CleanList: Unable to execute statement', $statement;
429 # Age entry: Sometimes entries are initially very popular and
430 # the $hit_count gets very high quickly. Then the domain is
431 # abandoned and no activity happens. One case recently observed
432 # was for phentermine.com. The $hit_count initially soared to
433 # 1920 within a few weeks. Then it all stopped as of
434 # 07/13/2007. Obvisously this domain was shutdown. With the
435 # previous aging algorithm of simply subtracting 1 this
436 # phentermine.com entry would hang around for over 5 years!
438 # So the tack here is to age the entry by dividing it's
439 # $hit_count in half. Sucessive halfing then will quickly age
440 # the entry down to size. However we don't want to age small
441 # $hit_count's too quickly, therefore once their numbers drop to
442 # < 30 we revert to the old method of subtracting 1.
443 if ($hit_count < 30) {
446 $hit_count = $hit_count / 2;
449 $statement = "update list set hit_count=$hit_count where userid='$userid' and type='$listtype' and sequence=$sequence;";
451 or DBError 'CleanList: Unable to execute statement', $statement;
455 ResequenceList $userid, $listtype if $count > 0;
469 return count ('email', "userid = '$userid' and sender like '%$sender%'");
473 my ($msg, $statement) = @_;
475 print 'MAPSDB::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n";
478 print "SQL Statement: $statement\n";
485 my ($password, $userid) = @_;
487 my $statement = "select decode('$password','$userid')";
489 my $sth = $DB->prepare ($statement)
490 or DBError 'Decrypt: Unable to prepare statement', $statement;
493 or DBError 'Decrypt: Unable to execute statement', $statement;
495 # Get return value, which should be the encoded password
496 my @row = $sth->fetchrow_array;
504 sub DeleteEmail ($) {
507 my ($username, $domain) = split /@/, $sender;
510 if ($username eq '') {
511 $condition = "userid = '$userid' and sender like '%\@$domain'";
513 $condition = "userid = '$userid' and sender = '$sender'";
516 # First see if anything needs to be deleted
517 my $count = count ('email', $condition);
519 # Just return if there's nothing to delete
520 return $count if ($count == 0);
522 my $statement = 'delete from email where ' . $condition;
525 or DBError 'DeleteEmail: Unable to execute statement', $statement;
530 sub DeleteList ($$) {
531 my ($type, $sequence) = @_;
533 # First see if anything needs to be deleted
534 my $count = count ('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'");
536 # Just return if there's nothing to delete
537 return $count if ($count == 0);
539 my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'";
542 or DBError 'DeleteList: Unable to execute statement', $statement;
550 my ($username, $domain) = split /@/, $sender;
553 if ($username eq '') {
554 $condition = "userid = '$userid' and sender like '%\@$domain'";
556 $condition = "userid = '$userid' and sender = '$sender'";
559 # First see if anything needs to be deleted
560 my $count = count ('log', $condition);
562 # Just return if there's nothing to delete
563 return $count if ($count == 0);
565 my $statement = 'delete from log where ' . $condition;
568 or DBError 'DeleteLog: Unable to execute statement', $statement;
574 my ($password, $userid) = @_;
576 my $statement = "select encode('$password','$userid')";
578 my $sth = $DB->prepare ($statement)
579 or DBError 'Encrypt: Unable to prepare statement', $statement;
582 or DBError 'Encrypt: Unable to execute statement', $statement;
584 # Get return value, which should be the encoded password
585 my @row = $sth->fetchrow_array;
598 if (!defined $sender || $sender eq '') {
599 $statement = "select * from email where userid = '$userid'";
601 $statement = "select * from email where userid = '$userid' and sender = '$sender'";
604 my $sth = $DB->prepare ($statement)
605 or DBError 'FindEmail: Unable to prepare statement', $statement;
608 or DBError 'FindEmail: Unable to execute statement', $statement;
614 my ($type, $sender) = @_;
619 $statement = "select * from list where userid = '$userid' and type = '$type'";
621 my ($pattern, $domain) = split /\@/, $sender;
622 $statement = "select * from list where userid = '$userid' and type = '$type' " .
623 "and pattern = '$pattern' and domain = '$domain'";
627 my $sth = $DB->prepare ($statement)
628 or DBError 'FindList: Unable to prepare statement', $statement;
632 or DBError 'FindList: Unable to execute statement', $statement;
634 # Get return value, which should be how many entries were deleted
639 my ($start_at, $end_at) = @_;
641 my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
644 my $sth = $DB->prepare ($statement)
645 or DBError 'FindLog: Unable to prepare statement', $statement;
649 or DBError 'FindLog: Unable to execute statement', $statement;
651 # Get return value, which should be how many entries were deleted
660 if (!defined $userid || $userid eq '') {
661 $statement = 'select * from user';
663 $statement = "select * from user where userid = '$userid'";
666 my $sth = $DB->prepare ($statement)
667 or DBError 'FindUser: Unable to prepare statement', $statement;
670 or DBError 'FindUser: Unable to execute statement', $statement;
684 if (@email = $sth->fetchrow_array) {
685 my $message = pop @email;
686 my $timestamp = pop @email;
687 my $subject = pop @email;
688 my $sender = pop @email;
689 my $userid = pop @email;
690 return $userid, $sender, $subject, $timestamp, $message;
701 if (@list = $sth->fetchrow_array) {
702 my $last_hit = pop @list;
703 my $hit_count = pop @list;
704 my $sequence = pop @list;
705 my $comment = pop @list;
706 my $domain = pop @list;
707 my $pattern = pop @list;
708 my $type = pop @list;
709 my $userid = pop @list;
710 return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
721 if (@log = $sth->fetchrow_array) {
722 my $message = pop @log;
724 my $sender = pop @log;
725 my $timestamp = pop @log;
726 my $userid = pop @log;
727 return $userid, $timestamp, $sender, $type, $message;
733 sub GetNextSequenceNo ($$) {
734 my ($userid, $listtype) = @_;
736 my $count = count ('list', "userid = '$userid' and type = '$listtype'");
739 } # GetNextSequenceNo
746 if (@user = $sth->fetchrow_array) {
747 my $password = pop @user;
748 my $email = pop @user;
749 my $name = pop @user;
750 my $userid = pop @user;
751 return ($userid, $name, $email, $password);
757 sub GetUserInfo ($) {
760 my $statement = "select name, email from user where userid='$userid'";
762 my $sth = $DB->prepare ($statement)
763 or DBError 'GetUserInfo: Unable to prepare statement', $statement;
766 or DBError 'GetUserInfo: Unable to execute statement', $statement;
768 my @userinfo = $sth->fetchrow_array;
769 my $user_email = lc (pop @userinfo);
770 my $username = lc (pop @userinfo);
774 return ($username, $user_email);
777 sub GetUserOptions ($) {
780 my $statement = "select * from useropts where userid = '$userid'";
782 my $sth = $DB->prepare ($statement)
783 or DBError 'GetUserOptions: Unable to prepare statement', $statement;
786 or DBError 'GetUserOptions: Unable to execute statement', $statement;
793 while (@useropts = $sth->fetchrow_array) {
794 my $value = pop @useropts;
795 my $name = pop @useropts;
797 $useropts{$name} = $value;
806 my ($statement) = @_;
808 my $sth = $DB->prepare ($statement)
809 or DBError 'Unable to prepare statement' , $statement;
812 or DBError 'Unable to execute statement' , $statement;
816 while (my @row = $sth->fetchrow_array) {
826 my ($username, $password) = @_;
829 my $dbdriver = 'mysql';
830 my $dbserver = $ENV{MAPS_SERVER} || 'localhost';
832 if (!$DB || $DB eq '') {
833 #$dbserver='localhost';
834 $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
835 or croak "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
842 my $statement = 'lock tables email read, list read, log read, user read, useropts read';
843 my $sth = $DB->prepare ($statement)
844 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
847 or DBError 'OptimizeDB: Unable to execute statement', $statement;
849 $statement = 'check table email, list, log, user, useropts';
850 $sth = $DB->prepare ($statement)
851 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
854 or DBError 'OptimizeDB: Unable to execute statement', $statement;
856 $statement = 'unlock tables';
857 $sth = $DB->prepare ($statement)
858 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
861 or DBError 'OptimizeDB: Unable to execute statement', $statement;
863 $statement = 'optimize table email, list, log, user, useropts';
864 $sth = $DB->prepare ($statement)
865 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
868 or DBError 'OptimizeDB: Unable to execute statement', $statement;
873 sub ResequenceList ($$) {
874 my ($userid, $type) = @_;
876 if ($type ne 'white' && $type ne 'black' && $type ne 'null') {
880 if (!UserExists $userid) {
884 my $statement = "select sequence from list where userid = '$userid' ".
885 " and type = '$type' order by sequence";
887 my $sth = $DB->prepare ($statement)
888 or DBError 'ResequenceList: Unable to prepare statement', $statement;
891 or DBError 'ResequenceList: Unable to execute statement', $statement;
895 while (my @row = $sth->fetchrow_array) {
897 my $old_sequence = pop (@row);
899 if ($old_sequence != $sequence) {
900 my $update_statement = "update list set sequence = $sequence " .
901 "where userid = '$userid' and " .
902 "type = '$type' and sequence = $old_sequence";
903 $DB->do ($update_statement)
904 or DBError 'ResequenceList: Unable to do statement', $statement;
913 # This subroutine returns an array of senders in reverse chronological
914 # order based on time timestamp from the log table of when we returned
915 # their message. The complication here is that a single sender may
916 # send multiple times in a single day. So if spammer@foo.com sends
917 # spam @ 1 second after midnight and then again at 2 Pm there will be
918 # at least two records in the log table saying that we returned his
919 # email. Getting records sorted by timestamp desc will have
920 # spammer@foo.com listed twice. But we want him listed only once, as
921 # the first entry in the returned array. Plus we may be called
922 # repeatedly with different $start_at's. Therefore we need to process
923 # the whole list of returns for today, eliminate duplicate entries for
924 # a single sender then slice the resulting array.
925 sub ReturnSenders ($$$;$$) {
926 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
933 my $sod = $date . ' 00:00:00';
934 my $eod = $date . ' 23:59:59';
936 $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
939 my $statement = <<"END";
946 userid = '$userid' and
953 my $sth = $DB->prepare ($statement)
954 or DBError 'ReturnSenders: Unable to prepare statement', $statement;
957 or DBError 'ReturnSenders: Unable to execute statement', $statement;
959 # Watch the distinction between senders (plural) and sender (singular)
960 my (%senders, %sendersByTimestamp);
962 # Run through the results and add to %senders by sender key. This
963 # results in a hash that has the sender in it and the first
964 # timestamp value. Since we already sorted timestamp desc by the
965 # above select statement, and we've narrowed it down to only log
966 # message that occurred for the given $date, we will have a hash
967 # containing 1 sender and the latest timestamp for the day.
968 while (my $senderRef = $sth->fetchrow_hashref) {
969 my %sender = %{$senderRef};
971 $senders{$sender{sender}} = $sender{timestamp}
972 unless $senders{$sender{sender}};
977 # Make a hash whose keys are the timestamp (so we can later sort on
979 while (my ($key, $value) = each %senders) {
980 $sendersByTimestamp{$value} = $key;
985 # Sort by timestamp desc and push on to the @senders array
986 push @senders, $sendersByTimestamp{$_}
987 foreach (sort { $b cmp $a } keys %sendersByTimestamp);
989 # Finally slice for the given range
990 my $end_at = $start_at + $nbr_emails - 1;
992 $end_at = (@senders - 1)
993 if $end_at > @senders;
995 return (@senders) [$start_at .. $end_at];
998 sub ReturnMessages ($$) {
999 my ($userid, $sender) = @_;
1001 my $statement = <<"END";
1008 userid = '$userid' and
1014 my $sth = $DB->prepare ($statement)
1015 or DBError 'ReturnMessages: Unable to prepare statement', $statement;
1018 or DBError 'ReturnMessages: Unable to execute statement', $statement;
1022 while (my @row = $sth->fetchrow_array) {
1023 my $date = pop @row;
1024 my $subject = pop @row;
1026 push @messages, [$subject, $date];
1034 sub ReturnEmails ($$$;$$) {
1035 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1042 my $sod = $date . ' 00:00:00';
1043 my $eod = $date . ' 23:59:59';
1045 if ($type eq 'returned') {
1046 $statement = <<"END";
1053 log.sender = email.sender and
1054 log.userid = '$userid' and
1055 log.timestamp > '$sod' and
1056 log.timestamp < '$eod' and
1061 $start_at, $nbr_emails
1064 $statement = <<"END";
1070 userid = '$userid' and
1071 timestamp > '$sod' and
1072 timestamp < '$eod' and
1077 $start_at, $nbr_emails
1081 if ($type eq 'returned') {
1082 $statement = <<"END";
1089 log.sender = email.sender and
1090 log.userid = '$userid' and
1097 $start_at, $nbr_emails
1100 $statement = <<"END";
1106 userid = '$userid' and
1113 $start_at, $nbr_emails
1118 my $sth = $DB->prepare ($statement)
1119 or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1122 or DBError 'ReturnEmails: Unable to execute statement', $statement;
1126 while (my $sender = $sth->fetchrow_array) {
1129 # Get emails for this sender. Format an array of subjects and timestamps.
1132 $statement = "select timestamp, subject from email where userid = '$userid' " .
1133 "and sender = '$sender'";
1135 my $sth2 = $DB->prepare ($statement)
1136 or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1139 or DBError 'ReturnEmails: Unable to execute statement', $statement;
1141 while (my @row = $sth2->fetchrow_array) {
1142 my $subject = pop @row;
1143 my $date = pop @row;
1145 if ($earliestDate) {
1146 my $earliestDateShort = substr $earliestDate, 0, 10;
1147 my $dateShort = substr $date, 0, 10;
1149 if ($earliestDateShort eq $dateShort and
1150 $earliestDate > $date) {
1151 $earliestDate = $date
1152 if $earliestDateShort eq $dateShort;
1155 $earliestDate = $date;
1158 push @messages, [$subject, $date];
1164 $earliestDate ||= '';
1166 unless ($type eq 'returned') {
1167 push @emails, [$earliestDate, [$sender, @messages]];
1169 push @emails, [$earliestDate, [$sender, @messages]]
1180 sub ReturnList ($$$) {
1181 my ($type, $start_at, $lines) = @_;
1188 $statement = "select * from list where userid = '$userid' " .
1189 "and type = '$type' order by sequence " .
1190 "limit $start_at, $lines";
1192 $statement = "select * from list where userid = '$userid' " .
1193 "and type = '$type' order by sequence";
1196 my $sth = $DB->prepare ($statement)
1197 or DBError 'ReturnList: Unable to prepare statement', $statement;
1200 or DBError 'ReturnList: Unable to execute statement', $statement;
1205 while (my @row = $sth->fetchrow_array) {
1206 last if $i++ > $lines;
1210 $list {last_hit} = pop @row;
1211 $list {hit_count} = pop @row;
1212 $list {sequence} = pop @row;
1213 $list {comment} = pop @row;
1214 $list {domain} = pop @row;
1215 $list {pattern} = pop @row;
1216 $list {type} = pop @row;
1217 $list {userid} = pop @row;
1224 sub ReturnListEntry ($$) {
1225 my ($type, $sequence) = @_;
1227 my $statement = "select * from list where userid = '$userid' " .
1228 "and type = '$type' and sequence = '$sequence'";
1230 my $sth = $DB->prepare ($statement)
1231 or DBError 'ReturnListEntry: Unable to prepare statement', $statement;
1234 or DBError 'ReturnListEntry: Unable to execute statement', $statement;
1237 my @row = $sth->fetchrow_array;
1239 $list {sequence} = pop @row;
1240 $list {comment} = pop @row;
1241 $list {domain} = pop @row;
1242 $list {pattern} = pop @row;
1243 $list {type} = pop @row;
1244 $list {userid} = pop @row;
1249 sub UpdateList ($$$$$$$) {
1250 my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
1252 if (!$pattern || $pattern eq '') {
1255 $pattern = "'" . quotemeta ($pattern) . "'";
1258 if (!$domain || $domain eq '') {
1261 $domain = "'" . quotemeta ($domain) . "'";
1264 if (!$comment || $comment eq '') {
1267 $comment = "'" . quotemeta ($comment) . "'";
1270 if (!$hit_count || $hit_count eq '') {
1273 # TODO: Check if numeric
1277 'update list set ' .
1278 "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " .
1279 "where userid = '$userid' and type = '$type' and sequence = $sequence";
1281 $DB->do ($statement)
1282 or DBError 'UpdateList: Unable to do statement', $statement;
1287 sub SearchEmails ($$) {
1288 my ($userid, $searchfield) = @_;
1293 "select sender, subject, timestamp from email where userid = '$userid' and (
1294 sender like '%$searchfield%' or subject like '%$searchfield%')
1295 order by timestamp desc";
1297 my $sth = $DB->prepare ($statement)
1298 or DBError 'SearchEmails: Unable to prepare statement', $statement;
1301 or DBError 'SearchEmails: Unable to execute statement', $statement;
1303 while (my @row = $sth->fetchrow_array) {
1304 my $date = pop @row;
1305 my $subject = pop @row;
1306 my $sender = pop @row;
1308 push @emails, [$sender, $subject, $date];
1316 sub SetContext ($) {
1319 my $old_user = $userid;
1321 if (UserExists $to_user) {
1323 GetUserOptions $userid;
1324 return GetUserInfo $userid;
1333 my $total_space = 0;
1336 my $statement = "select * from email where userid = '$userid'";
1337 my $sth = $DB->prepare ($statement)
1338 or DBError 'Unable to prepare statement', $statement;
1341 or DBError 'Unable to execute statement', $statement;
1343 while (my @row = $sth->fetchrow_array) {
1345 my $data = pop @row;
1346 my $timestamp = pop @row;
1347 my $subject = pop @row;
1348 my $sender = pop @row;
1349 my $user = pop @row;
1355 length ($timestamp) +
1358 $total_space += $msg_space;
1359 $msg_space{$sender} += $msg_space;
1364 return wantarray ? %msg_space : $total_space;
1367 sub UpdateUser ($$$$) {
1368 my ($userid, $fullname, $email, $password) = @_;
1370 if (!UserExists $userid) {
1376 if (!defined $password || $password eq '') {
1377 $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1379 $password = Encrypt $password, $userid;
1380 $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1383 $DB->do ($statement)
1384 or DBError 'UpdateUser: Unable to do statement', $statement;
1389 sub UpdateUserOption ($$$) {
1390 my ($userid, $name, $value) = @_;
1392 if (!UserExists $userid) {
1396 my $statement = "update useropts set value='$value' where userid='$userid' and name='$name'";
1398 $DB->do ($statement)
1399 or DBError 'UpdateUserOption: Unable to do statement', $statement;
1402 } # UpdateUserOptions
1404 sub UserExists ($) {
1410 my $statement = "select userid, password from user where userid = '$userid'";
1412 my $sth = $DB->prepare ($statement)
1413 or DBError 'UserExists: Unable to prepare statement', $statement;
1416 or DBError 'UserExists: Unable to execute statement', $statement;
1418 my @userdata = $sth->fetchrow_array;
1422 return 0 if scalar (@userdata) == 0;
1424 my $dbpassword = pop @userdata;
1425 my $dbuserid = pop @userdata;
1427 if ($dbuserid ne $userid) {
1435 my ($table, $condition) = @_;
1440 $statement = "select count(*) from $table where $condition";
1442 $statement = "select count(*) from $table";
1445 my $sth = $DB->prepare ($statement)
1446 or DBError 'count: Unable to prepare statement', $statement;
1449 or DBError 'count: Unable to execute statement', $statement;
1451 # Get return value, which should be how many message there are
1452 my @row = $sth->fetchrow_array;
1459 # Retrieve returned value
1469 sub count_distinct ($$$) {
1470 my ($table, $column, $condition) = @_;
1475 $statement = "select count(distinct $column) from $table where $condition";
1477 $statement = "select count(distinct $column) from $table";
1480 my $sth = $DB->prepare ($statement)
1481 or DBError 'count: Unable to prepare statement', $statement;
1484 or DBError 'count: Unable to execute statement', $statement;
1486 # Get return value, which should be how many message there are
1487 my @row = $sth->fetchrow_array;
1492 # Retrieve returned value
1500 sub countlog (;$$) {
1501 my ($additional_condition, $type) = @_;
1507 $condition = "userid=\'$userid\' ";
1509 $condition .= "and $additional_condition"
1510 if $additional_condition;
1512 return count_distinct ('log', 'sender', $condition);