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);
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 filelock($self->{name});
139 open(my $fh,'>',$self->{name}.'.tmp') or
140 croak "Unable to open bug log spam '$self->{name}.tmp' for writing: $!";
141 binmode($fh,':encoding(UTF-8)');
142 for my $msgid (keys %{$self->{spam}}) {
143 print {$fh} $msgid."\n";
145 close($fh) or croak "Unable to write to '$self->{name}.tmp': $!";
146 rename($self->{name}.'.tmp',$self->{name});
152 next if ($spam_log->is_spam('12456@exmaple.com'));
154 Returns 1 if this message id confirms that the message is spam
156 Returns 0 if this message is not spam
160 my ($self,$msgid) = @_;
162 if (exists $self->{spam}{$msgid} and
163 $self->{spam}{$msgid}
172 $spam_log->add_spam('123456@example.com');
174 Add a message id to the spam listing.
176 You must call C<$self->save()> if you wish the changes to be written out to disk.
181 my ($self,$msgid) = @_;
183 $self->{spam}{$msgid} = 1;
191 # indent-tabs-mode: nil
192 # cperl-indent-level: 4