Debbugs/Log/Spam.pm

   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.
   4 #
   5 # Copyright 2017 by Don Armstrong <don@donarmstrong.com>.
   6
   7 package Debbugs::Log::Spam;
   8
   9 =head1 NAME
  10
  11 Debbugs::Log::Spam -- an interface to debbugs .log.spam files
  12
  13 =head1 SYNOPSIS
  14
  15 use Debbugs::Log::Spam;
  16
  17 my $spam = Debbugs::Log::Spam->new(bug_num => '12345');
  18
  19 =head1 DESCRIPTION
  20
  21
  22 =head1 BUGS
  23
  24 None known.
  25
  26 =cut
  27
  28 use warnings;
  29 use strict;
  30 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
  31 use base qw(Exporter);
  32
  33 BEGIN{
  34     $VERSION = 1;
  35     $DEBUG = 0 unless defined $DEBUG;
  36
  37     @EXPORT = ();
  38     %EXPORT_TAGS = ();
  39     @EXPORT_OK = ();
  40     Exporter::export_ok_tags(keys %EXPORT_TAGS);
  41     $EXPORT_TAGS{all} = [@EXPORT_OK];
  42
  43 }
  44
  45 use Carp;
  46 use feature 'state';
  47 use Params::Validate qw(:types validate_with);
  48 use Debbugs::Common qw(getbuglocation getbugcomponent);
  49
  50 =head1 FUNCTIONS
  51
  52 =over 4
  53
  54 =item new
  55
  56 Creates a new log spam reader.
  57
  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);
  60
  61 Parameters
  62
  63 =over
  64
  65 =item bug_num -- bug number
  66
  67 =item log_spam_name -- name of log
  68
  69 =back
  70
  71 One of the above options must be passed.
  72
  73 =cut
  74
  75 sub new {
  76     my $this = shift;
  77     state $spec =
  78         {bug_num => {type => SCALAR,
  79                      optional => 1,
  80                     },
  81          log_spam_name => {type => SCALAR,
  82                            optional => 1,
  83                           },
  84         };
  85     my %param =
  86         validate_with(params => \@_,
  87                       spec   => $spec
  88                      );
  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";
  93     }
  94
  95     my $class = ref($this) || $this;
  96     my $self = {};
  97     bless $self, $class;
  98
  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;
 105     }
 106     $self->_init();
 107     return $self;
 108 }
 109
 110
 111 sub _init {
 112     my $self = shift;
 113
 114     $self->{spam} = {};
 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)');
 119         while (<$fh>) {
 120             chomp;
 121             $self->{spam}{$_} = 1;
 122         }
 123         close ($fh);
 124     }
 125     return $self;
 126 }
 127
 128 =item save
 129
 130 $self->save();
 131
 132 Saves changes to the bug log spam file.
 133
 134 =cut
 135
 136 sub save {
 137     my $self = shift;
 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";
 144     }
 145     close($fh) or croak "Unable to write to '$self->{name}.tmp': $!";
 146     rename($self->{name}.'.tmp',$self->{name});
 147     unfilelock();
 148 }
 149
 150 =item is_spam
 151
 152     next if ($spam_log->is_spam('12456@exmaple.com'));
 153
 154 Returns 1 if this message id confirms that the message is spam
 155
 156 Returns 0 if this message is not spam
 157
 158 =cut
 159 sub is_spam {
 160     my ($self,$msgid) = @_;
 161     return 0 if not defined $msgid or not length $msgid;
 162     $msgid =~ s/^<|>$//;
 163     if (exists $self->{spam}{$msgid} and
 164         $self->{spam}{$msgid}
 165        ) {
 166         return 1;
 167     }
 168     return 0;
 169 }
 170
 171 =item add_spam
 172
 173     $spam_log->add_spam('123456@example.com');
 174
 175 Add a message id to the spam listing.
 176
 177 You must call C<$self->save()> if you wish the changes to be written out to disk.
 178
 179 =cut
 180
 181 sub add_spam {
 182     my ($self,$msgid) = @_;
 183     $msgid =~ s/^<|>$//;
 184     $self->{spam}{$msgid} = 1;
 185 }
 186
 187 1;
 188
 189 =back
 190
 191 =cut
 192
 193 __END__
 194
 195 # Local Variables:
 196 # indent-tabs-mode: nil
 197 # cperl-indent-level: 4
 198 # End: