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) = @_;
217 my $statement = "select pattern, domain, comment, sequence, hit_count from list where userid = '$userid' and type = '$listtype'";
219 my $sth = $DB->prepare ($statement)
220 or DBError 'CheckOnList: Unable to prepare statement', $statement;
223 or DBError 'CheckOnList: Unable to execute statement', $statement;
225 while (my @row = $sth->fetchrow_array) {
228 my $hit_count = pop (@row);
229 my $sequence = pop (@row);
230 my $comment = pop (@row);
231 my $domain = pop (@row);
232 my $pattern = pop (@row);
236 $email_on_file = $pattern;
239 $email_on_file = '@' . $domain;
241 $email_on_file = $pattern . '@' . $domain;
245 # Escape some special characters
246 $email_on_file =~ s/\@/\\@/;
247 $email_on_file =~ s/^\*/.\*/;
249 # We want to terminate the search string with a "$" iff there's an
250 # "@" in there. This is because some "email_on_file" may have no
251 # domain (e.g. "mailer-daemon" with no domain). In that case we
252 # don't want to terminate the search string with a "$" rather we
253 # wish to terminate it with an "@". But in the case of say
254 # "@ti.com" if we don't terminate the search string with "$" then
255 # "@ti.com" would also match "@tixcom.com"!
256 my $search_for = $email_on_file =~ /\@/
262 if ($sender =~ /$search_for/i) {
263 $rule = "Matching rule: ($listtype:$sequence) \"$email_on_file\"";
264 $rule .= " - $comment" if $comment and $comment ne '';
267 RecordHit $listtype, $sequence, ++$hit_count;
275 return ($status, $rule);
279 my ($timestamp) = @_;
281 # First see if anything needs to be deleted
284 my $statement = "select count(*) from email where userid = '$userid' and timestamp < '$timestamp'";
287 my $sth = $DB->prepare ($statement)
288 or DBError 'CleanEmail: Unable to prepare statement', $statement;
292 or DBError 'CleanEmail: Unable to execute statement', $statement;
294 # Get return value, which should be how many entries were deleted
295 my @row = $sth->fetchrow_array;
300 # Retrieve returned value
307 # Just return if there's nothing to delete
308 return $count if ($count == 0);
310 # Delete emails for userid whose older than $timestamp
311 $statement = "delete from email where userid = '$userid' and timestamp < '$timestamp'";
314 $sth = $DB->prepare ($statement)
315 or DBError 'CleanEmail: Unable to prepare statement', $statement;
319 or DBError 'CleanEmail: Unable to execute statement', $statement;
325 my ($timestamp) = @_;
327 # First see if anything needs to be deleted
330 my $statement = "select count(*) from log where userid = '$userid' and timestamp < '$timestamp'";
333 my $sth = $DB->prepare ($statement)
334 or DBError $DB, 'CleanLog: Unable to prepare statement', $statement;
338 or DBError 'CleanLog: Unable to execute statement', $statement;
340 # Get return value, which should be how many entries were deleted
341 my @row = $sth->fetchrow_array;
346 # Retrieve returned value
353 # Just return if there's nothing to delete
354 return $count if ($count == 0);
356 # Delete log entries for userid whose older than $timestamp
357 $statement = "delete from log where userid = '$userid' and timestamp < '$timestamp'";
360 $sth = $DB->prepare ($statement)
361 or DBError 'CleanLog: Unable to prepare statement', $statement;
365 or DBError 'CleanLog: Unable to execute statement', $statement;
370 sub CleanList ($;$) {
371 my ($timestamp, $listtype) = @_;
373 $listtype = 'null' if !$listtype;
375 # First see if anything needs to be deleted
378 my $statement = "select count(*) from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
381 my $sth = $DB->prepare ($statement)
382 or DBError $DB, 'CleanList: Unable to prepare statement', $statement;
386 or DBError 'CleanList: Unable to execute statement', $statement;
388 # Get return value, which should be how many entries were deleted
389 my @row = $sth->fetchrow_array;
394 # Retrieve returned value
395 $count = $row[0] ? $row[0] : 0;
397 # Just return if there's nothing to delete
398 return $count if ($count == 0);
400 # Get data for these entries
401 $statement = "select type, sequence, hit_count from list where userid = '$userid' and type = '$listtype' and last_hit < '$timestamp'";
404 $sth = $DB->prepare ($statement)
405 or DBError 'CleanList: Unable to prepare statement', $statement;
409 or DBError 'CleanList: Unable to execute statement', $statement;
413 while (my @row = $sth->fetchrow_array) {
416 my $hit_count = pop (@row);
417 my $sequence = pop (@row);
418 my $listtype = pop (@row);
420 if ($hit_count == 0) {
423 $statement = "delete from list where userid='$userid' and type='$listtype' and sequence=$sequence";
425 or DBError 'CleanList: Unable to execute statement', $statement;
427 # Age entry: Sometimes entries are initially very popular and
428 # the $hit_count gets very high quickly. Then the domain is
429 # abandoned and no activity happens. One case recently observed
430 # was for phentermine.com. The $hit_count initially soared to
431 # 1920 within a few weeks. Then it all stopped as of
432 # 07/13/2007. Obvisously this domain was shutdown. With the
433 # previous aging algorithm of simply subtracting 1 this
434 # phentermine.com entry would hang around for over 5 years!
436 # So the tack here is to age the entry by dividing it's
437 # $hit_count in half. Sucessive halfing then will quickly age
438 # the entry down to size. However we don't want to age small
439 # $hit_count's too quickly, therefore once their numbers drop to
440 # < 30 we revert to the old method of subtracting 1.
441 if ($hit_count < 30) {
444 $hit_count = $hit_count / 2;
447 $statement = "update list set hit_count=$hit_count where userid='$userid' and type='$listtype' and sequence=$sequence;";
449 or DBError 'CleanList: Unable to execute statement', $statement;
453 ResequenceList $userid, $listtype if $count > 0;
467 return count ('email', "userid = '$userid' and sender like '%$sender%'");
471 my ($msg, $statement) = @_;
473 print 'MAPSDB::' . $msg . "\nError #" . $DB->err . ' ' . $DB->errstr . "\n";
476 print "SQL Statement: $statement\n";
483 my ($password, $userid) = @_;
485 my $statement = "select decode('$password','$userid')";
487 my $sth = $DB->prepare ($statement)
488 or DBError 'Decrypt: Unable to prepare statement', $statement;
491 or DBError 'Decrypt: Unable to execute statement', $statement;
493 # Get return value, which should be the encoded password
494 my @row = $sth->fetchrow_array;
502 sub DeleteEmail ($) {
505 my ($username, $domain) = split /@/, $sender;
508 if ($username eq '') {
509 $condition = "userid = '$userid' and sender like '%\@$domain'";
511 $condition = "userid = '$userid' and sender = '$sender'";
514 # First see if anything needs to be deleted
515 my $count = count ('email', $condition);
517 # Just return if there's nothing to delete
518 return $count if ($count == 0);
520 my $statement = 'delete from email where ' . $condition;
523 or DBError 'DeleteEmail: Unable to execute statement', $statement;
528 sub DeleteList ($$) {
529 my ($type, $sequence) = @_;
531 # First see if anything needs to be deleted
532 my $count = count ('list', "userid = '$userid' and type = '$type' and sequence = '$sequence'");
534 # Just return if there's nothing to delete
535 return $count if ($count == 0);
537 my $statement = "delete from list where userid = '$userid' and type = '$type' and sequence = '$sequence'";
540 or DBError 'DeleteList: Unable to execute statement', $statement;
548 my ($username, $domain) = split /@/, $sender;
551 if ($username eq '') {
552 $condition = "userid = '$userid' and sender like '%\@$domain'";
554 $condition = "userid = '$userid' and sender = '$sender'";
557 # First see if anything needs to be deleted
558 my $count = count ('log', $condition);
560 # Just return if there's nothing to delete
561 return $count if ($count == 0);
563 my $statement = 'delete from log where ' . $condition;
566 or DBError 'DeleteLog: Unable to execute statement', $statement;
572 my ($password, $userid) = @_;
574 my $statement = "select encode('$password','$userid')";
576 my $sth = $DB->prepare ($statement)
577 or DBError 'Encrypt: Unable to prepare statement', $statement;
580 or DBError 'Encrypt: Unable to execute statement', $statement;
582 # Get return value, which should be the encoded password
583 my @row = $sth->fetchrow_array;
596 if (!defined $sender || $sender eq '') {
597 $statement = "select * from email where userid = '$userid'";
599 $statement = "select * from email where userid = '$userid' and sender = '$sender'";
602 my $sth = $DB->prepare ($statement)
603 or DBError 'FindEmail: Unable to prepare statement', $statement;
606 or DBError 'FindEmail: Unable to execute statement', $statement;
612 my ($type, $sender) = @_;
617 $statement = "select * from list where userid = '$userid' and type = '$type'";
619 my ($pattern, $domain) = split /\@/, $sender;
620 $statement = "select * from list where userid = '$userid' and type = '$type' " .
621 "and pattern = '$pattern' and domain = '$domain'";
625 my $sth = $DB->prepare ($statement)
626 or DBError 'FindList: Unable to prepare statement', $statement;
630 or DBError 'FindList: Unable to execute statement', $statement;
632 # Get return value, which should be how many entries were deleted
637 my ($start_at, $end_at) = @_;
639 my $statement = "select * from log where userid = '$userid' order by timestamp limit $start_at, $end_at";
642 my $sth = $DB->prepare ($statement)
643 or DBError 'FindLog: Unable to prepare statement', $statement;
647 or DBError 'FindLog: Unable to execute statement', $statement;
649 # Get return value, which should be how many entries were deleted
658 if (!defined $userid || $userid eq '') {
659 $statement = 'select * from user';
661 $statement = "select * from user where userid = '$userid'";
664 my $sth = $DB->prepare ($statement)
665 or DBError 'FindUser: Unable to prepare statement', $statement;
668 or DBError 'FindUser: Unable to execute statement', $statement;
682 if (@email = $sth->fetchrow_array) {
683 my $message = pop @email;
684 my $timestamp = pop @email;
685 my $subject = pop @email;
686 my $sender = pop @email;
687 my $userid = pop @email;
688 return $userid, $sender, $subject, $timestamp, $message;
699 if (@list = $sth->fetchrow_array) {
700 my $last_hit = pop @list;
701 my $hit_count = pop @list;
702 my $sequence = pop @list;
703 my $comment = pop @list;
704 my $domain = pop @list;
705 my $pattern = pop @list;
706 my $type = pop @list;
707 my $userid = pop @list;
708 return $userid, $type, $pattern, $domain, $comment, $sequence, $hit_count, $last_hit;
719 if (@log = $sth->fetchrow_array) {
720 my $message = pop @log;
722 my $sender = pop @log;
723 my $timestamp = pop @log;
724 my $userid = pop @log;
725 return $userid, $timestamp, $sender, $type, $message;
731 sub GetNextSequenceNo ($$) {
732 my ($userid, $listtype) = @_;
734 my $count = count ('list', "userid = '$userid' and type = '$listtype'");
737 } # GetNextSequenceNo
744 if (@user = $sth->fetchrow_array) {
745 my $password = pop @user;
746 my $email = pop @user;
747 my $name = pop @user;
748 my $userid = pop @user;
749 return ($userid, $name, $email, $password);
755 sub GetUserInfo ($) {
758 my $statement = "select name, email from user where userid='$userid'";
760 my $sth = $DB->prepare ($statement)
761 or DBError 'GetUserInfo: Unable to prepare statement', $statement;
764 or DBError 'GetUserInfo: Unable to execute statement', $statement;
766 my @userinfo = $sth->fetchrow_array;
767 my $user_email = lc (pop @userinfo);
768 my $username = lc (pop @userinfo);
772 return ($username, $user_email);
775 sub GetUserOptions ($) {
778 my $statement = "select * from useropts where userid = '$userid'";
780 my $sth = $DB->prepare ($statement)
781 or DBError 'GetUserOptions: Unable to prepare statement', $statement;
784 or DBError 'GetUserOptions: Unable to execute statement', $statement;
791 while (@useropts = $sth->fetchrow_array) {
792 my $value = pop @useropts;
793 my $name = pop @useropts;
795 $useropts{$name} = $value;
804 my ($statement) = @_;
806 my $sth = $DB->prepare ($statement)
807 or DBError 'Unable to prepare statement' , $statement;
810 or DBError 'Unable to execute statement' , $statement;
814 while (my @row = $sth->fetchrow_array) {
824 my ($username, $password) = @_;
827 my $dbdriver = 'mysql';
828 my $dbserver = $ENV{MAPS_SERVER} || 'localhost';
830 if (!$DB || $DB eq '') {
831 #$dbserver='localhost';
832 $DB = DBI->connect("DBI:$dbdriver:$dbname:$dbserver", $username, $password, {PrintError => 0})
833 or croak "Couldn't connect to $dbname database as $username\n" . $DBI::errstr;
840 my $statement = 'lock tables email read, list read, log read, user read, useropts read';
841 my $sth = $DB->prepare ($statement)
842 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
845 or DBError 'OptimizeDB: Unable to execute statement', $statement;
847 $statement = 'check table email, list, log, user, useropts';
848 $sth = $DB->prepare ($statement)
849 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
852 or DBError 'OptimizeDB: Unable to execute statement', $statement;
854 $statement = 'unlock tables';
855 $sth = $DB->prepare ($statement)
856 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
859 or DBError 'OptimizeDB: Unable to execute statement', $statement;
861 $statement = 'optimize table email, list, log, user, useropts';
862 $sth = $DB->prepare ($statement)
863 or DBError 'OptimizeDB: Unable to prepare statement', $statement;
866 or DBError 'OptimizeDB: Unable to execute statement', $statement;
871 sub ResequenceList ($$) {
872 my ($userid, $type) = @_;
874 if ($type ne 'white' && $type ne 'black' && $type ne 'null') {
878 if (!UserExists $userid) {
882 my $statement = "select sequence from list where userid = '$userid' ".
883 " and type = '$type' order by sequence";
885 my $sth = $DB->prepare ($statement)
886 or DBError 'ResequenceList: Unable to prepare statement', $statement;
889 or DBError 'ResequenceList: Unable to execute statement', $statement;
893 while (my @row = $sth->fetchrow_array) {
895 my $old_sequence = pop (@row);
897 if ($old_sequence != $sequence) {
898 my $update_statement = "update list set sequence = $sequence " .
899 "where userid = '$userid' and " .
900 "type = '$type' and sequence = $old_sequence";
901 $DB->do ($update_statement)
902 or DBError 'ResequenceList: Unable to do statement', $statement;
911 # This subroutine returns an array of senders in reverse chronological
912 # order based on time timestamp from the log table of when we returned
913 # their message. The complication here is that a single sender may
914 # send multiple times in a single day. So if spammer@foo.com sends
915 # spam @ 1 second after midnight and then again at 2 Pm there will be
916 # at least two records in the log table saying that we returned his
917 # email. Getting records sorted by timestamp desc will have
918 # spammer@foo.com listed twice. But we want him listed only once, as
919 # the first entry in the returned array. Plus we may be called
920 # repeatedly with different $start_at's. Therefore we need to process
921 # the whole list of returns for today, eliminate duplicate entries for
922 # a single sender then slice the resulting array.
923 sub ReturnSenders ($$$;$$) {
924 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
931 my $sod = $date . ' 00:00:00';
932 my $eod = $date . ' 23:59:59';
934 $dateCond = "and timestamp > '$sod' and timestamp < '$eod'";
937 my $statement = <<"END";
944 userid = '$userid' and
951 my $sth = $DB->prepare ($statement)
952 or DBError 'ReturnSenders: Unable to prepare statement', $statement;
955 or DBError 'ReturnSenders: Unable to execute statement', $statement;
957 # Watch the distinction between senders (plural) and sender (singular)
958 my (%senders, %sendersByTimestamp);
960 # Run through the results and add to %senders by sender key. This
961 # results in a hash that has the sender in it and the first
962 # timestamp value. Since we already sorted timestamp desc by the
963 # above select statement, and we've narrowed it down to only log
964 # message that occurred for the given $date, we will have a hash
965 # containing 1 sender and the latest timestamp for the day.
966 while (my $senderRef = $sth->fetchrow_hashref) {
967 my %sender = %{$senderRef};
969 $senders{$sender{sender}} = $sender{timestamp}
970 unless $senders{$sender{sender}};
975 # Make a hash whose keys are the timestamp (so we can later sort on
977 while (my ($key, $value) = each %senders) {
978 $sendersByTimestamp{$value} = $key;
983 # Sort by timestamp desc and push on to the @senders array
984 push @senders, $sendersByTimestamp{$_}
985 foreach (sort { $b cmp $a } keys %sendersByTimestamp);
987 # Finally slice for the given range
988 my $end_at = $start_at + $nbr_emails - 1;
990 $end_at = (@senders - 1)
991 if $end_at > @senders;
993 return (@senders) [$start_at .. $end_at];
996 sub ReturnMessages ($$) {
997 my ($userid, $sender) = @_;
999 my $statement = <<"END";
1006 userid = '$userid' and
1012 my $sth = $DB->prepare ($statement)
1013 or DBError 'ReturnMessages: Unable to prepare statement', $statement;
1016 or DBError 'ReturnMessages: Unable to execute statement', $statement;
1020 while (my @row = $sth->fetchrow_array) {
1021 my $date = pop @row;
1022 my $subject = pop @row;
1024 push @messages, [$subject, $date];
1032 sub ReturnEmails ($$$;$$) {
1033 my ($userid, $type, $start_at, $nbr_emails, $date) = @_;
1040 my $sod = $date . ' 00:00:00';
1041 my $eod = $date . ' 23:59:59';
1043 if ($type eq 'returned') {
1044 $statement = <<"END";
1051 log.sender = email.sender and
1052 log.userid = '$userid' and
1053 log.timestamp > '$sod' and
1054 log.timestamp < '$eod' and
1059 $start_at, $nbr_emails
1062 $statement = <<"END";
1068 userid = '$userid' and
1069 timestamp > '$sod' and
1070 timestamp < '$eod' and
1075 $start_at, $nbr_emails
1079 if ($type eq 'returned') {
1080 $statement = <<"END";
1087 log.sender = email.sender and
1088 log.userid = '$userid' and
1095 $start_at, $nbr_emails
1098 $statement = <<"END";
1104 userid = '$userid' and
1111 $start_at, $nbr_emails
1116 my $sth = $DB->prepare ($statement)
1117 or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1120 or DBError 'ReturnEmails: Unable to execute statement', $statement;
1124 while (my $sender = $sth->fetchrow_array) {
1127 # Get emails for this sender. Format an array of subjects and timestamps.
1130 $statement = "select timestamp, subject from email where userid = '$userid' " .
1131 "and sender = '$sender'";
1133 my $sth2 = $DB->prepare ($statement)
1134 or DBError 'ReturnEmails: Unable to prepare statement', $statement;
1137 or DBError 'ReturnEmails: Unable to execute statement', $statement;
1139 while (my @row = $sth2->fetchrow_array) {
1140 my $subject = pop @row;
1141 my $date = pop @row;
1143 if ($earliestDate) {
1144 my $earliestDateShort = substr $earliestDate, 0, 10;
1145 my $dateShort = substr $date, 0, 10;
1147 if ($earliestDateShort eq $dateShort and
1148 $earliestDate > $date) {
1149 $earliestDate = $date
1150 if $earliestDateShort eq $dateShort;
1153 $earliestDate = $date;
1156 push @messages, [$subject, $date];
1162 $earliestDate ||= '';
1164 unless ($type eq 'returned') {
1165 push @emails, [$earliestDate, [$sender, @messages]];
1167 push @emails, [$earliestDate, [$sender, @messages]]
1178 sub ReturnList ($$$) {
1179 my ($type, $start_at, $lines) = @_;
1186 $statement = "select * from list where userid = '$userid' " .
1187 "and type = '$type' order by sequence " .
1188 "limit $start_at, $lines";
1190 $statement = "select * from list where userid = '$userid' " .
1191 "and type = '$type' order by sequence";
1194 my $sth = $DB->prepare ($statement)
1195 or DBError 'ReturnList: Unable to prepare statement', $statement;
1198 or DBError 'ReturnList: Unable to execute statement', $statement;
1203 while (my @row = $sth->fetchrow_array) {
1204 last if $i++ > $lines;
1208 $list {last_hit} = pop @row;
1209 $list {hit_count} = pop @row;
1210 $list {sequence} = pop @row;
1211 $list {comment} = pop @row;
1212 $list {domain} = pop @row;
1213 $list {pattern} = pop @row;
1214 $list {type} = pop @row;
1215 $list {userid} = pop @row;
1222 sub ReturnListEntry ($$) {
1223 my ($type, $sequence) = @_;
1225 my $statement = "select * from list where userid = '$userid' " .
1226 "and type = '$type' and sequence = '$sequence'";
1228 my $sth = $DB->prepare ($statement)
1229 or DBError 'ReturnListEntry: Unable to prepare statement', $statement;
1232 or DBError 'ReturnListEntry: Unable to execute statement', $statement;
1235 my @row = $sth->fetchrow_array;
1237 $list {sequence} = pop @row;
1238 $list {comment} = pop @row;
1239 $list {domain} = pop @row;
1240 $list {pattern} = pop @row;
1241 $list {type} = pop @row;
1242 $list {userid} = pop @row;
1247 sub UpdateList ($$$$$$$) {
1248 my ($userid, $type, $pattern, $domain, $comment, $hit_count, $sequence) = @_;
1250 if (!$pattern || $pattern eq '') {
1253 $pattern = "'" . quotemeta ($pattern) . "'";
1256 if (!$domain || $domain eq '') {
1259 $domain = "'" . quotemeta ($domain) . "'";
1262 if (!$comment || $comment eq '') {
1265 $comment = "'" . quotemeta ($comment) . "'";
1268 if (!$hit_count || $hit_count eq '') {
1271 # TODO: Check if numeric
1275 'update list set ' .
1276 "pattern = $pattern, domain = $domain, comment = $comment, hit_count = $hit_count " .
1277 "where userid = '$userid' and type = '$type' and sequence = $sequence";
1279 $DB->do ($statement)
1280 or DBError 'UpdateList: Unable to do statement', $statement;
1285 sub SearchEmails ($$) {
1286 my ($userid, $searchfield) = @_;
1291 "select sender, subject, timestamp from email where userid = '$userid' and (
1292 sender like '%$searchfield%' or subject like '%$searchfield%')
1293 order by timestamp desc";
1295 my $sth = $DB->prepare ($statement)
1296 or DBError 'SearchEmails: Unable to prepare statement', $statement;
1299 or DBError 'SearchEmails: Unable to execute statement', $statement;
1301 while (my @row = $sth->fetchrow_array) {
1302 my $date = pop @row;
1303 my $subject = pop @row;
1304 my $sender = pop @row;
1306 push @emails, [$sender, $subject, $date];
1314 sub SetContext ($) {
1317 my $old_user = $userid;
1319 if (UserExists $to_user) {
1321 GetUserOptions $userid;
1322 return GetUserInfo $userid;
1331 my $total_space = 0;
1334 my $statement = "select * from email where userid = '$userid'";
1335 my $sth = $DB->prepare ($statement)
1336 or DBError 'Unable to prepare statement', $statement;
1339 or DBError 'Unable to execute statement', $statement;
1341 while (my @row = $sth->fetchrow_array) {
1343 my $data = pop @row;
1344 my $timestamp = pop @row;
1345 my $subject = pop @row;
1346 my $sender = pop @row;
1347 my $user = pop @row;
1353 length ($timestamp) +
1356 $total_space += $msg_space;
1357 $msg_space{$sender} += $msg_space;
1362 return wantarray ? %msg_space : $total_space;
1365 sub UpdateUser ($$$$) {
1366 my ($userid, $fullname, $email, $password) = @_;
1368 if (!UserExists $userid) {
1374 if (!defined $password || $password eq '') {
1375 $statement = "update user set userid='$userid', name='$fullname', email='$email' where userid='$userid'";
1377 $password = Encrypt $password, $userid;
1378 $statement = "update user set userid='$userid', name='$fullname', email='$email', password='$password' where userid='$userid'";
1381 $DB->do ($statement)
1382 or DBError 'UpdateUser: Unable to do statement', $statement;
1387 sub UpdateUserOption ($$$) {
1388 my ($userid, $name, $value) = @_;
1390 if (!UserExists $userid) {
1394 my $statement = "update useropts set value='$value' where userid='$userid' and name='$name'";
1396 $DB->do ($statement)
1397 or DBError 'UpdateUserOption: Unable to do statement', $statement;
1400 } # UpdateUserOptions
1402 sub UserExists ($) {
1408 my $statement = "select userid, password from user where userid = '$userid'";
1410 my $sth = $DB->prepare ($statement)
1411 or DBError 'UserExists: Unable to prepare statement', $statement;
1414 or DBError 'UserExists: Unable to execute statement', $statement;
1416 my @userdata = $sth->fetchrow_array;
1420 return 0 if scalar (@userdata) == 0;
1422 my $dbpassword = pop @userdata;
1423 my $dbuserid = pop @userdata;
1425 if ($dbuserid ne $userid) {
1433 my ($table, $condition) = @_;
1438 $statement = "select count(*) from $table where $condition";
1440 $statement = "select count(*) from $table";
1443 my $sth = $DB->prepare ($statement)
1444 or DBError 'count: Unable to prepare statement', $statement;
1447 or DBError 'count: Unable to execute statement', $statement;
1449 # Get return value, which should be how many message there are
1450 my @row = $sth->fetchrow_array;
1457 # Retrieve returned value
1467 sub count_distinct ($$$) {
1468 my ($table, $column, $condition) = @_;
1473 $statement = "select count(distinct $column) from $table where $condition";
1475 $statement = "select count(distinct $column) from $table";
1478 my $sth = $DB->prepare ($statement)
1479 or DBError 'count: Unable to prepare statement', $statement;
1482 or DBError 'count: Unable to execute statement', $statement;
1484 # Get return value, which should be how many message there are
1485 my @row = $sth->fetchrow_array;
1490 # Retrieve returned value
1498 sub countlog (;$$) {
1499 my ($additional_condition, $type) = @_;
1505 $condition = "userid=\'$userid\' ";
1507 $condition .= "and $additional_condition"
1508 if $additional_condition;
1510 return count_distinct ('log', 'sender', $condition);