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)');
126 $self->{spam}{$_} = '0';
128 $self->{spam}{$_} = '1';
132 croak "Unable to close bug log filehandle: $!";
134 if (-d $self->{name}.'.d') {
135 opendir(my $d,$self->{name}.'.d') or
136 croak "Unable to open bug log spamdir '$self->{name}.d' for reading: $!";
137 for my $dir (readdir($d)) {
138 next unless $dir =~ m/([^\.].*)_(\w+)$/;
139 # .spam overrides .spam.d
140 next if exists $self->{spam}{$1};
141 # set the spam HASH to $dir so we know where this value was set from
142 $self->{spam}{$1} = $dir;
145 croak "Unable to close bug log spamdir: $!";
152 C<$spam_log->save();>
154 Saves changes to the bug log spam file.
160 return unless keys %{$self->{spam}};
161 filelock($self->{name}.'.lock');
162 open(my $fh,'>',$self->{name}.'.tmp') or
163 croak "Unable to open bug log spam '$self->{name}.tmp' for writing: $!";
164 binmode($fh,':encoding(UTF-8)');
165 for my $msgid (keys %{$self->{spam}}) {
166 # was this message set to spam/ham by .d? If so, don't save it
167 if ($self->{spam}{$msgid} ne '0' and
168 $self->{spam}{$msgid} ne '1') {
172 if ($self->{spam}{$msgid} eq '0') {
177 close($fh) or croak "Unable to write to '$self->{name}.tmp': $!";
178 rename($self->{name}.'.tmp',$self->{name});
184 C<next if ($spam_log->is_spam('12456@exmaple.com'));>
186 Returns 1 if this message id confirms that the message is spam
188 Returns 0 if this message is not known to be spam
192 my ($self,$msgid) = @_;
193 return 0 if not defined $msgid or not length $msgid;
195 if (exists $self->{spam}{$msgid} and
196 $self->{spam}{$msgid} ne '0'
205 next if ($spam_log->is_ham('12456@exmaple.com'));
207 Returns 1 if this message id confirms that the message is ham
209 Returns 0 if this message is not known to be ham
213 my ($self,$msgid) = @_;
214 return 0 if not defined $msgid or not length $msgid;
216 if (exists $self->{spam}{$msgid} and
217 $self->{spam}{$msgid} eq '0'
227 $spam_log->add_spam('123456@example.com');
229 Add a message id to the spam listing.
231 You must call C<$spam_log->save()> if you wish the changes to be written out to disk.
236 my ($self,$msgid) = @_;
238 $self->{spam}{$msgid} = '1';
243 $spam_log->add_ham('123456@example.com');
245 Add a message id to the ham listing.
247 You must call C<$spam_log->save()> if you wish the changes to be written out to disk.
252 my ($self,$msgid) = @_;
254 $self->{spam}{$msgid} = '0';
259 $spam_log->remove_message('123456@example.com');
261 Remove a message from the spam/ham listing.
263 You must call C<$spam_log->save()> if you wish the changes to be written out to disk.
277 # indent-tabs-mode: nil
278 # cperl-indent-level: 4