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
15 use Debbugs::Log::Spam;
17 my $spam = Debbugs::Log::Spam->new(bug_num => '12345');
30 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
31 use base qw(Exporter);
35 $DEBUG = 0 unless defined $DEBUG;
40 Exporter::export_ok_tags(keys %EXPORT_TAGS);
41 $EXPORT_TAGS{all} = [@EXPORT_OK];
47 use Params::Validate qw(:types validate_with);
48 use Debbugs::Common qw(getbuglocation getbugcomponent filelock unfilelock);
56 Creates a new log spam reader.
58 my $spam_log = Debbugs::Log::Spam->new(log_spam_name => "56/123456.log.spam");
59 my $spam_log = Debbugs::Log::Spam->new(bug_num => $nnn);
65 =item bug_num -- bug number
67 =item log_spam_name -- name of log
71 One of the above options must be passed.
78 {bug_num => {type => SCALAR,
81 log_spam_name => {type => SCALAR,
86 validate_with(params => \@_,
89 if (grep({exists $param{$_} and
90 defined $param{$_}} qw(bug_num log_spam_name)) ne 1) {
91 croak "Exactly one of bug_num or log_spam_name".
92 "must be passed and must be defined";
95 my $class = ref($this) || $this;
99 if (exists $param{log_spam_name}) {
100 $self->{name} = $param{log_spam_name};
101 } elsif (exists $param{bug_num}) {
102 my $location = getbuglocation($param{bug_num},'log.spam');
103 my $bug_log = getbugcomponent($param{bug_num},'log.spam',$location);
104 $self->{name} = $bug_log;
115 if (-e $self->{name}) {
116 open(my $fh,'<',$self->{name}) or
117 croak "Unable to open bug log spam '$self->{name}' for reading: $!";
118 binmode($fh,':encoding(UTF-8)');
121 $self->{spam}{$_} = 1;
132 Saves changes to the bug log spam file.
138 return unless keys %{$self->{spam}};
139 filelock($self->{name}.'.lock');
140 open(my $fh,'>',$self->{name}.'.tmp') or
141 croak "Unable to open bug log spam '$self->{name}.tmp' for writing: $!";
142 binmode($fh,':encoding(UTF-8)');
143 for my $msgid (keys %{$self->{spam}}) {
144 print {$fh} $msgid."\n";
146 close($fh) or croak "Unable to write to '$self->{name}.tmp': $!";
147 rename($self->{name}.'.tmp',$self->{name});
153 next if ($spam_log->is_spam('12456@exmaple.com'));
155 Returns 1 if this message id confirms that the message is spam
157 Returns 0 if this message is not spam
161 my ($self,$msgid) = @_;
162 return 0 if not defined $msgid or not length $msgid;
164 if (exists $self->{spam}{$msgid} and
165 $self->{spam}{$msgid}
174 $spam_log->add_spam('123456@example.com');
176 Add a message id to the spam listing.
178 You must call C<$self->save()> if you wish the changes to be written out to disk.
183 my ($self,$msgid) = @_;
185 $self->{spam}{$msgid} = 1;
197 # indent-tabs-mode: nil
198 # cperl-indent-level: 4