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 filelock unfilelock);
  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     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";
 145     }
 146     close($fh) or croak "Unable to write to '$self->{name}.tmp': $!";
 147     rename($self->{name}.'.tmp',$self->{name});
 148     unfilelock();
 149 }
 150
 151 =item is_spam
 152
 153     next if ($spam_log->is_spam('12456@exmaple.com'));
 154
 155 Returns 1 if this message id confirms that the message is spam
 156
 157 Returns 0 if this message is not spam
 158
 159 =cut
 160 sub is_spam {
 161     my ($self,$msgid) = @_;
 162     return 0 if not defined $msgid or not length $msgid;
 163     $msgid =~ s/^<|>$//;
 164     if (exists $self->{spam}{$msgid} and
 165         $self->{spam}{$msgid}
 166        ) {
 167         return 1;
 168     }
 169     return 0;
 170 }
 171
 172 =item add_spam
 173
 174     $spam_log->add_spam('123456@example.com');
 175
 176 Add a message id to the spam listing.
 177
 178 You must call C<$self->save()> if you wish the changes to be written out to disk.
 179
 180 =cut
 181
 182 sub add_spam {
 183     my ($self,$msgid) = @_;
 184     $msgid =~ s/^<|>$//;
 185     $self->{spam}{$msgid} = 1;
 186 }
 187
 188 1;
 189
 190 =back
 191
 192 =cut
 193
 194 __END__
 195
 196 # Local Variables:
 197 # indent-tabs-mode: nil
 198 # cperl-indent-level: 4
 199 # End: