X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;ds=sidebyside;f=maps%2Flib%2FMAPS.pm;h=b66b64e4e5a0b4095df38b3496b2cf49de1788f0;hb=7435988c124aa8e03ac4dbfc9b2ccc8e98df8871;hp=c0e3448c7c0f291dee2619a785ae8c074ed0bca6;hpb=bdcd310c3621f450264f16cf4c7b347c738bf83f;p=clearscm.git diff --git a/maps/lib/MAPS.pm b/maps/lib/MAPS.pm index c0e3448..b66b64e 100644 --- a/maps/lib/MAPS.pm +++ b/maps/lib/MAPS.pm @@ -34,7 +34,7 @@ use base qw(Exporter); our $db; -our $Version = '2.0'; +our $VERSION = '2.0'; # Globals my $userid = $ENV{MAPS_USERNAME} ? $ENV{MAPS_USERNAME} : $ENV{USER}; @@ -57,6 +57,7 @@ our @EXPORT = qw( CountEmail CountList CountLog + CountLogDistinct Decrypt DeleteEmail DeleteList @@ -154,6 +155,8 @@ sub OpenDB($$) { $db = MyDB->new($username, $password, $dbname, $dbserver); croak "Unable to instantiate MyDB ($username\@$dbserver:$dbname)" unless $db; + + return; } # OpenDB BEGIN { @@ -223,6 +226,7 @@ sub Add2Whitelist(%) { # Add to white list $params{sequence} = 0; + my ($err, $msg) = AddList(%params); return -$err, $msg if $err; @@ -247,7 +251,7 @@ sub Add2Whitelist(%) { while (my $rec = $db->getnext) { last unless $rec->{userid}; - $status = Whitelist($rec->{sender}, $rec->data); + $status = Whitelist($rec->{sender}, $rec->{data}); last if $status; @@ -306,6 +310,9 @@ sub AddList(%) { sub AddLog(%) { my (%params) = @_; + # Some email senders are coming in mixed case. We don't want that + $params{sender} = $params{sender} ? lc $params{sender} : ''; + $params{timestamp} = UnixDatetime2SQLDatetime(scalar(localtime)); return $db->add('log', %params); @@ -344,6 +351,7 @@ sub AddUserOptions(%) { } # for return ($err, $msg) if $err; + return; } # AddUserOptions sub Blacklist(%) { @@ -415,6 +423,68 @@ sub CheckEmail(;$$) { } # if } # CheckEmail +sub CheckOnList2 ($$;$) { + # CheckOnList will check to see if the $sender is on the list. Return 1 if + # found 0 if not. + my ($listtype, $sender, $update) = @_; + + $update //= 1; + + my ($status, $rule, $sequence); + + my $table = 'list'; + my $condition = "userid='$userid' and type='$listtype'"; + + my ($err, $errmsg) = $db->find($table, $condition, '*', 'order by sequence'); + + my ($email_on_file, $rec); + + while ($rec = $db->getnext) { + unless ($rec->{domain}) { + $email_on_file = $rec->{pattern}; + } else { + unless ($rec->{pattern}) { + $email_on_file = '@' . $rec->{domain}; + } else { + $email_on_file = $rec->{pattern} . '@' . $rec->{domain}; + } # if + } # unless + + # Escape some special characters + $email_on_file =~ s/\@/\\@/; + $email_on_file =~ s/^\*/.\*/; + + # We want to terminate the search string with a "$" iff there's an + # "@" in there. This is because some "email_on_file" may have no + # domain (e.g. "mailer-daemon" with no domain). In that case we + # don't want to terminate the search string with a "$" rather we + # wish to terminate it with an "@". But in the case of say + # "@ti.com" if we don't terminate the search string with "$" then + # "@ti.com" would also match "@tixcom.com"! + my $search_for = $email_on_file =~ /\@/ + ? "$email_on_file\$" + : !defined $rec->{domain} + ? "$email_on_file\@" + : $email_on_file; + if ($sender and $sender =~ /$search_for/i) { + $status = 1; + + $rec->{hit_count} //= 0; + + RecordHit( + userid => $userid, + type => $listtype, + sequence => $rec->{sequence}, + hit_count => $rec->{hit_count} + 1, + ) if $update; + + last; + } # if + } # while + + return ($status, $rec); +} # CheckOnList2 + sub CheckOnList ($$;$) { # CheckOnList will check to see if the $sender is on the list. Return 1 if # found 0 if not. @@ -629,7 +699,20 @@ sub CountLog(%) { my $condition = "userid='$userid'"; $condition .= " and $additional_condition" if $additional_condition; - return $db->count_distinct('log', 'sender', $condition); + return $db->count('log', $condition); +} # CountLog + +sub CountLogDistinct(%) { + my (%params) = @_; + + CheckParms(['userid', 'column'], \%params); + + my ($additional_condition) = delete $params{additional} || ''; + + my $condition = "userid='$userid'"; + $condition .= " and $additional_condition" if $additional_condition; + + return $db->count_distinct('log', $params{column}, $condition); } # CountLog sub Decrypt ($$) { @@ -782,11 +865,7 @@ sub GetUser() { sub GetUserInfo($) { my ($userid) = @_; - my $userinfo = $db->getone('user', "userid='$userid'", ['name', 'email']); - return %{$db->getone('user', "userid='$userid'", ['name', 'email'])}; - - return %$userinfo; } # GetUserInfo sub GetUserOptions($) { @@ -851,13 +930,13 @@ sub Nulllist($;$$) { sub OnBlacklist($;$) { my ($sender, $update) = @_; - return CheckOnList('black', $sender, $update); + return CheckOnList2('black', $sender, $update); } # OnBlacklist sub OnNulllist($;$) { my ($sender, $update) = @_; - return CheckOnList('null', $sender, $update); + return CheckOnList2('null', $sender, $update); } # CheckOnNulllist sub OnWhitelist($;$$) { @@ -865,7 +944,7 @@ sub OnWhitelist($;$$) { SetContext($userid) if $userid; - return CheckOnList('white', $sender, $update); + return CheckOnList2('white', $sender, $update); } # OnWhitelist sub OptimizeDB() { @@ -992,13 +1071,9 @@ sub RecordHit(%) { my $current_date = UnixDatetime2SQLDatetime(scalar(localtime)); my $table = 'list'; - my $condition = "userid='rec{userid} and type=$rec{type} and sequence='$rec{sequence}"; + my $condition = "userid='$rec{userid}' and type='$rec{type}' and sequence='$rec{sequence}'"; - return $db->modify( - table => $table, - condition => $condition, - %rec, - ); + return $db->modify($table, $condition, %rec); } # RecordHit sub ResequenceList(%) { @@ -1160,21 +1235,27 @@ sub ReturnSenders(%) { unless $senders{$rec->{sender}}; } # while - # Make a hash whose keys are the timestamp (so we can later sort on - # them). - my %sendersByTimestamp = reverse %senders; - - my @senders; + my (@unsorted, @senders); + + # Here we have a hash in %senders that has email address and timestamp. In the + # past we would merely create a reverse hash by timestamp and sort that. The + # The problem is that it is possible for two emails to come in with the same + # timestamp. By reversing the hash we clobber any row that has a dumplicte + # timestamp. But we want to sort on timestamp. So first we convers this hash + # to an array of hashes and then we can sort by timestamp later. + while (my ($key, $value) = each %senders) { + push @unsorted, { + sender => $key, + timestamp => $value, + }; + } # while - # Sort by timestamp desc and push on to the @senders array - push @senders, $sendersByTimestamp{$_} - for (sort { $b cmp $a } keys %sendersByTimestamp); + push @senders, $_->{sender} for sort { $b->{timestamp} cmp $a->{timestamp}} @unsorted; # Finally slice for the given range - my $end_at = $params{start_at} + $params{lines} - 1; + my $end_at = $params{start_at} + ($params{lines} - 1); - $end_at = (@senders - 1) - if $end_at > @senders; + $end_at = (@senders) - 1 if $end_at >= @senders; return (@senders) [$params{start_at} .. $end_at]; } # ReturnSenders @@ -1277,7 +1358,7 @@ sub SetContext($) { if (UserExists($to_user)) { $userid = $to_user; - return GetUserInfo $userid; + return GetUserOptions $userid; } else { return 0; } # if @@ -1312,11 +1393,11 @@ sub UpdateList(%) { my $table = 'list'; my $condition = "userid = '$rec{userid}' and type = '$rec{type}' and sequence = $rec{sequence}"; - if ($rec{pattern} =~ /\@/ and !$rec{domain}) { + if ($rec{pattern} =~ /\@/ && !$rec{domain}) { ($rec{pattern}, $rec{domain}) = split /\@/, $rec{pattern}; - } elsif (!$rec{pattern} and $rec{domain} =~ /\@/) { + } elsif (!$rec{pattern} && $rec{domain} =~ /\@/) { ($rec{pattern}, $rec{domain}) = split /\@/, $rec{domain}; - } elsif (!$rec{pattern} and !$rec{domain}) { + } elsif (!$rec{pattern} && !$rec{domain}) { return "Must specify either Username or Domain"; } # if