X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=maps%2Flib%2FMAPS.pm;h=153c4bbd5d95221afe46024c1f5e035d3be075cf;hb=83737e59d30d46e80259f07dd8d528b06dd43858;hp=d63f9b9e4ad62b5d3d3b7fa7176f3bc201695440;hpb=9a7e8178524ea77a12d2793791b9630017e1cbe8;p=clearscm.git diff --git a/maps/lib/MAPS.pm b/maps/lib/MAPS.pm index d63f9b9..153c4bb 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; @@ -291,7 +295,7 @@ sub AddList(%) { $rec{hit_count} //= $db->count( 'email', - "userid = '$rec{userid}' and sender like '$rec{sender}%'" + "userid = '$rec{userid}' and sender like '%$rec{sender}%'" ); ($rec{pattern}, $rec{domain}) = split /\@/, delete $rec{sender}; @@ -344,6 +348,7 @@ sub AddUserOptions(%) { } # for return ($err, $msg) if $err; + return; } # AddUserOptions sub Blacklist(%) { @@ -403,6 +408,8 @@ sub CheckEmail(;$$) { if ($username) { if ($username =~ /(.*)\@(.*)/) { return lc "$1\@$2"; + } else { + return lc "$username\@"; } # if } elsif ($domain) { if ($domain =~ /(.*)\@(.*)/) { @@ -458,7 +465,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; @@ -544,6 +553,8 @@ sub CleanList(%) { return 0 unless $count; + $count = 0; + my ($err, $errmsg) = $db->find($table, $condition); croak "Unable to find $params{type} entries for $condition - $errmsg" if $err; @@ -623,7 +634,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 ($$) { @@ -776,11 +800,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($) { @@ -1011,7 +1031,7 @@ sub ResequenceList(%) { $db->lock('write', $table); # Get all records for $userid and $type - my $listrecs = $db->get($table, $condition); + my $listrecs = $db->get($table, $condition,'*', 'order by hit_count desc'); # Delete all of the list entries for this $userid and $type my ($count, $msg) = $db->delete($table, $condition); @@ -1271,7 +1291,7 @@ sub SetContext($) { if (UserExists($to_user)) { $userid = $to_user; - return GetUserInfo $userid; + return GetUserOptions $userid; } else { return 0; } # if @@ -1306,11 +1326,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