X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=maps%2Flib%2FMAPS.pm;h=5802aa5165abcc345efa2d4ba299e5827d6ea19a;hb=ba57ae1ecef418590984480c4d363044eed70ab4;hp=618fb67ed0ca9ecd5cbffc3fcdfb6e417c7442d0;hpb=f6c2a9114dff9bf8882180bbf49ed6b3e3533a91;p=clearscm.git diff --git a/maps/lib/MAPS.pm b/maps/lib/MAPS.pm index 618fb67..5802aa5 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,10 @@ sub AddList(%) { sub AddLog(%) { my (%params) = @_; + # Some email senders are coming in mixed case. We don't want that + $params{pattern} = $params{pattern} ? lc $params{pattern} : ''; + $params{domain} = $params{domain} ? lc $params{domain} : ''; + $params{timestamp} = UnixDatetime2SQLDatetime(scalar(localtime)); return $db->add('log', %params); @@ -344,6 +352,7 @@ sub AddUserOptions(%) { } # for return ($err, $msg) if $err; + return; } # AddUserOptions sub Blacklist(%) { @@ -403,6 +412,8 @@ sub CheckEmail(;$$) { if ($username) { if ($username =~ /(.*)\@(.*)/) { return lc "$1\@$2"; + } else { + return lc "$username\@"; } # if } elsif ($domain) { if ($domain =~ /(.*)\@(.*)/) { @@ -413,6 +424,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. @@ -458,7 +531,9 @@ sub CheckOnList ($$;$) { ? "$email_on_file\@" : $email_on_file; if ($sender and $sender =~ /$search_for/i) { - $rule = "Matching rule: ($listtype:$rec->{sequence}) \"$email_on_file\""; + my $comment = $rec->{comment} ? " - $rec->{comment}" : ''; + + $rule = "Matching rule: ($listtype:$rec->{sequence}) \"$email_on_file$comment\""; $rule .= " - $rec->{comment}" if $rec->{comment}; $status = 1; @@ -625,7 +700,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 ($$) { @@ -778,11 +866,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($) { @@ -847,13 +931,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($;$$) { @@ -861,7 +945,7 @@ sub OnWhitelist($;$$) { SetContext($userid) if $userid; - return CheckOnList('white', $sender, $update); + return CheckOnList2('white', $sender, $update); } # OnWhitelist sub OptimizeDB() { @@ -1156,21 +1240,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 @@ -1273,7 +1363,7 @@ sub SetContext($) { if (UserExists($to_user)) { $userid = $to_user; - return GetUserInfo $userid; + return GetUserOptions $userid; } else { return 0; } # if @@ -1308,11 +1398,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