switch to compatibility level 12

[debbugs.git] / Debbugs / Log / Spam.pm

diff --git a/Debbugs/Log/Spam.pm b/Debbugs/Log/Spam.pm
index 3b14b39cfafed904231eab82d224f27a3c063bc6..e5ed18f1c8f4441890f62b8a134797807313a315 100644 (file)
--- a/Debbugs/Log/Spam.pm
+++ b/Debbugs/Log/Spam.pm
@@ -8,7 +8,8 @@ package Debbugs::Log::Spam;
 
 =head1 NAME
 
-Debbugs::Log::Spam -- an interface to debbugs .log.spam files
+Debbugs::Log::Spam -- an interface to debbugs .log.spam files and .log.spam.d
+directories
 
 =head1 SYNOPSIS
 
@@ -18,6 +19,9 @@ my $spam = Debbugs::Log::Spam->new(bug_num => '12345');
 
 =head1 DESCRIPTION
 
+Spam in bugs can be excluded using a .log.spam file and a .log.spam.d directory.
+The file contains message ids, one per line, and the directory contains files
+named after message ids, one per file.
 
 =head1 BUGS
 
@@ -45,7 +49,7 @@ BEGIN{
 use Carp;
 use feature 'state';
 use Params::Validate qw(:types validate_with);
-use Debbugs::Common qw(getbuglocation getbugcomponent);
+use Debbugs::Common qw(getbuglocation getbugcomponent filelock unfilelock);
 
 =head1 FUNCTIONS
 
@@ -118,16 +122,34 @@ sub _init {
         binmode($fh,':encoding(UTF-8)');
         while (<$fh>) {
             chomp;
-            $self->{spam}{$_} = 1;
+            if (s/\sham$//) {
+                $self->{spam}{$_} = '0';
+            } else {
+                $self->{spam}{$_} = '1';
+            }
         }
-        close ($fh);
+        close ($fh) or
+            croak "Unable to close bug log filehandle: $!";
+    }
+    if (-d $self->{name}.'.d') {
+        opendir(my $d,$self->{name}.'.d') or
+            croak "Unable to open bug log spamdir '$self->{name}.d' for reading: $!";
+        for my $dir (readdir($d)) {
+            next unless $dir =~ m/([^\.].*)_(\w+)$/;
+            # .spam overrides .spam.d
+            next if exists $self->{spam}{$1};
+            # set the spam HASH to $dir so we know where this value was set from
+            $self->{spam}{$1} = $dir;
+        }
+        closedir($d) or
+            croak "Unable to close bug log spamdir: $!";
     }
     return $self;
 }
 
 =item save
 
-$self->save();
+C<$spam_log->save();>
 
 Saves changes to the bug log spam file.
 
@@ -135,12 +157,22 @@ Saves changes to the bug log spam file.
 
 sub save {
     my $self = shift;
-    filelock($self->{name});
+    return unless keys %{$self->{spam}};
+    filelock($self->{name}.'.lock');
     open(my $fh,'>',$self->{name}.'.tmp') or
         croak "Unable to open bug log spam '$self->{name}.tmp' for writing: $!";
     binmode($fh,':encoding(UTF-8)');
     for my $msgid (keys %{$self->{spam}}) {
-        print {$fh} $msgid."\n";
+        # was this message set to spam/ham by .d? If so, don't save it
+        if ($self->{spam}{$msgid} ne '0' and
+            $self->{spam}{$msgid} ne '1') {
+            next;
+        }
+        print {$fh} $msgid;
+        if ($self->{spam}{$msgid} eq '0') {
+            print {$fh} ' ham';
+        }
+        print {$fh} "\n";
     }
     close($fh) or croak "Unable to write to '$self->{name}.tmp': $!";
     rename($self->{name}.'.tmp',$self->{name});
@@ -149,40 +181,90 @@ sub save {
 
 =item is_spam
 
-    next if ($spam_log->is_spam('12456@exmaple.com'));
+C<next if ($spam_log->is_spam('12456@exmaple.com'));>
 
 Returns 1 if this message id confirms that the message is spam
 
-Returns 0 if this message is not spam
+Returns 0 if this message is not known to be spam
 
 =cut
 sub is_spam {
     my ($self,$msgid) = @_;
+    return 0 if not defined $msgid or not length $msgid;
+    $msgid =~ s/^<|>$//;
+    if (exists $self->{spam}{$msgid} and
+        $self->{spam}{$msgid} ne '0'
+       ) {
+        return 1;
+    }
+    return 0;
+}
+
+=item is_ham
+
+    next if ($spam_log->is_ham('12456@exmaple.com'));
+
+Returns 1 if this message id confirms that the message is ham
+
+Returns 0 if this message is not known to be ham
+
+=cut
+sub is_ham {
+    my ($self,$msgid) = @_;
+    return 0 if not defined $msgid or not length $msgid;
     $msgid =~ s/^<|>$//;
     if (exists $self->{spam}{$msgid} and
-        $self->{spam}{$msgid}
+        $self->{spam}{$msgid} eq '0'
        ) {
         return 1;
     }
     return 0;
 }
 
+
 =item add_spam
 
     $spam_log->add_spam('123456@example.com');
 
 Add a message id to the spam listing.
 
-You must call C<$self->save()> if you wish the changes to be written out to disk.
+You must call C<$spam_log->save()> if you wish the changes to be written out to disk.
 
 =cut
 
 sub add_spam {
     my ($self,$msgid) = @_;
     $msgid =~ s/^<|>$//;
-    $self->{spam}{$msgid} = 1;
+    $self->{spam}{$msgid} = '1';
+}
+
+=item add_ham
+
+    $spam_log->add_ham('123456@example.com');
+
+Add a message id to the ham listing.
+
+You must call C<$spam_log->save()> if you wish the changes to be written out to disk.
+
+=cut
+
+sub add_ham {
+    my ($self,$msgid) = @_;
+    $msgid =~ s/^<|>$//;
+    $self->{spam}{$msgid} = '0';
 }
 
+=item remove_message
+
+     $spam_log->remove_message('123456@example.com');
+
+Remove a message from the spam/ham listing.
+
+You must call C<$spam_log->save()> if you wish the changes to be written out to disk.
+
+=cut
+
+
 1;
 
 =back