1 # This module is part of debbugs, and is released under the terms of the GPL
2 # version 2, or any later version (at your option). See the file README and
3 # COPYING for more information.
5 # Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
7 package Debbugs::Log::Spam;
11 Debbugs::Log::Spam -- an interface to debbugs .log.spam files and .log.spam.d
16 use Debbugs::Log::Spam;
18 my $spam = Debbugs::Log::Spam->new(bug_num => '12345');
22 Spam in bugs can be excluded using a .log.spam file and a .log.spam.d directory.
23 The file contains message ids, one per line, and the directory contains files
24 named after message ids, one per file.
34 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
35 use base qw(Exporter);
39 $DEBUG = 0 unless defined $DEBUG;
44 Exporter::export_ok_tags(keys %EXPORT_TAGS);
45 $EXPORT_TAGS{all} = [@EXPORT_OK];
51 use Params::Validate qw(:types validate_with);
52 use Debbugs::Common qw(getbuglocation getbugcomponent filelock unfilelock);
60 Creates a new log spam reader.
62 my $spam_log = Debbugs::Log::Spam->new(log_spam_name => "56/123456.log.spam");
63 my $spam_log = Debbugs::Log::Spam->new(bug_num => $nnn);
69 =item bug_num -- bug number
71 =item log_spam_name -- name of log
75 One of the above options must be passed.
82 {bug_num => {type => SCALAR,
85 log_spam_name => {type => SCALAR,
90 validate_with(params => \@_,
93 if (grep({exists $param{$_} and
94 defined $param{$_}} qw(bug_num log_spam_name)) ne 1) {
95 croak "Exactly one of bug_num or log_spam_name".
96 "must be passed and must be defined";
99 my $class = ref($this) || $this;
103 if (exists $param{log_spam_name}) {
104 $self->{name} = $param{log_spam_name};
105 } elsif (exists $param{bug_num}) {
106 my $location = getbuglocation($param{bug_num},'log.spam');
107 my $bug_log = getbugcomponent($param{bug_num},'log.spam',$location);
108 $self->{name} = $bug_log;
119 if (-e $self->{name}) {
120 open(my $fh,'<',$self->{name}) or
121 croak "Unable to open bug log spam '$self->{name}' for reading: $!";
122 binmode($fh,':encoding(UTF-8)');
125 $self->{spam}{$_} = 1;
128 croak "Unable to close bug log filehandle: $!";
130 if (-d $self->{name}.'.d') {
131 opendir(my $d,$self->{name}.'.d') or
132 croak "Unable to open bug log spamdir '$self->{name}.d' for reading: $!";
133 for my $dir (readdir($d)) {
134 next unless $dir =~ m/([^\.].*)_(\w+)$/;
135 $self->{spam}{$1} = 1;
138 croak "Unable to close bug log spamdir: $!";
147 Saves changes to the bug log spam file.
153 return unless keys %{$self->{spam}};
154 filelock($self->{name}.'.lock');
155 open(my $fh,'>',$self->{name}.'.tmp') or
156 croak "Unable to open bug log spam '$self->{name}.tmp' for writing: $!";
157 binmode($fh,':encoding(UTF-8)');
158 for my $msgid (keys %{$self->{spam}}) {
159 print {$fh} $msgid."\n";
161 close($fh) or croak "Unable to write to '$self->{name}.tmp': $!";
162 rename($self->{name}.'.tmp',$self->{name});
168 next if ($spam_log->is_spam('12456@exmaple.com'));
170 Returns 1 if this message id confirms that the message is spam
172 Returns 0 if this message is not spam
176 my ($self,$msgid) = @_;
177 return 0 if not defined $msgid or not length $msgid;
179 if (exists $self->{spam}{$msgid} and
180 $self->{spam}{$msgid}
189 $spam_log->add_spam('123456@example.com');
191 Add a message id to the spam listing.
193 You must call C<$self->save()> if you wish the changes to be written out to disk.
198 my ($self,$msgid) = @_;
200 $self->{spam}{$msgid} = 1;
212 # indent-tabs-mode: nil
213 # cperl-indent-level: 4