X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lib%2FDebbugs%2FLog%2FSpam.pm;fp=lib%2FDebbugs%2FLog%2FSpam.pm;h=e5ed18f1c8f4441890f62b8a134797807313a315;hb=1e6633a3780f4fd53fc4303852e84d13cdad2dc6;hp=0000000000000000000000000000000000000000;hpb=466f7faff129a5699c7674f59900a92aa256175d;p=debbugs.git diff --git a/lib/Debbugs/Log/Spam.pm b/lib/Debbugs/Log/Spam.pm new file mode 100644 index 0000000..e5ed18f --- /dev/null +++ b/lib/Debbugs/Log/Spam.pm @@ -0,0 +1,279 @@ +# This module is part of debbugs, and is released under the terms of the GPL +# version 2, or any later version (at your option). See the file README and +# COPYING for more information. +# +# Copyright 2017 by Don Armstrong . + +package Debbugs::Log::Spam; + +=head1 NAME + +Debbugs::Log::Spam -- an interface to debbugs .log.spam files and .log.spam.d +directories + +=head1 SYNOPSIS + +use Debbugs::Log::Spam; + +my $spam = Debbugs::Log::Spam->new(bug_num => '12345'); + +=head1 DESCRIPTION + +Spam in bugs can be excluded using a .log.spam file and a .log.spam.d directory. +The file contains message ids, one per line, and the directory contains files +named after message ids, one per file. + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +BEGIN{ + $VERSION = 1; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (); + @EXPORT_OK = (); + Exporter::export_ok_tags(keys %EXPORT_TAGS); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +use Carp; +use feature 'state'; +use Params::Validate qw(:types validate_with); +use Debbugs::Common qw(getbuglocation getbugcomponent filelock unfilelock); + +=head1 FUNCTIONS + +=over 4 + +=item new + +Creates a new log spam reader. + + my $spam_log = Debbugs::Log::Spam->new(log_spam_name => "56/123456.log.spam"); + my $spam_log = Debbugs::Log::Spam->new(bug_num => $nnn); + +Parameters + +=over + +=item bug_num -- bug number + +=item log_spam_name -- name of log + +=back + +One of the above options must be passed. + +=cut + +sub new { + my $this = shift; + state $spec = + {bug_num => {type => SCALAR, + optional => 1, + }, + log_spam_name => {type => SCALAR, + optional => 1, + }, + }; + my %param = + validate_with(params => \@_, + spec => $spec + ); + if (grep({exists $param{$_} and + defined $param{$_}} qw(bug_num log_spam_name)) ne 1) { + croak "Exactly one of bug_num or log_spam_name". + "must be passed and must be defined"; + } + + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + + if (exists $param{log_spam_name}) { + $self->{name} = $param{log_spam_name}; + } elsif (exists $param{bug_num}) { + my $location = getbuglocation($param{bug_num},'log.spam'); + my $bug_log = getbugcomponent($param{bug_num},'log.spam',$location); + $self->{name} = $bug_log; + } + $self->_init(); + return $self; +} + + +sub _init { + my $self = shift; + + $self->{spam} = {}; + if (-e $self->{name}) { + open(my $fh,'<',$self->{name}) or + croak "Unable to open bug log spam '$self->{name}' for reading: $!"; + binmode($fh,':encoding(UTF-8)'); + while (<$fh>) { + chomp; + if (s/\sham$//) { + $self->{spam}{$_} = '0'; + } else { + $self->{spam}{$_} = '1'; + } + } + close ($fh) or + croak "Unable to close bug log filehandle: $!"; + } + if (-d $self->{name}.'.d') { + opendir(my $d,$self->{name}.'.d') or + croak "Unable to open bug log spamdir '$self->{name}.d' for reading: $!"; + for my $dir (readdir($d)) { + next unless $dir =~ m/([^\.].*)_(\w+)$/; + # .spam overrides .spam.d + next if exists $self->{spam}{$1}; + # set the spam HASH to $dir so we know where this value was set from + $self->{spam}{$1} = $dir; + } + closedir($d) or + croak "Unable to close bug log spamdir: $!"; + } + return $self; +} + +=item save + +C<$spam_log->save();> + +Saves changes to the bug log spam file. + +=cut + +sub save { + my $self = shift; + return unless keys %{$self->{spam}}; + filelock($self->{name}.'.lock'); + open(my $fh,'>',$self->{name}.'.tmp') or + croak "Unable to open bug log spam '$self->{name}.tmp' for writing: $!"; + binmode($fh,':encoding(UTF-8)'); + for my $msgid (keys %{$self->{spam}}) { + # was this message set to spam/ham by .d? If so, don't save it + if ($self->{spam}{$msgid} ne '0' and + $self->{spam}{$msgid} ne '1') { + next; + } + print {$fh} $msgid; + if ($self->{spam}{$msgid} eq '0') { + print {$fh} ' ham'; + } + print {$fh} "\n"; + } + close($fh) or croak "Unable to write to '$self->{name}.tmp': $!"; + rename($self->{name}.'.tmp',$self->{name}); + unfilelock(); +} + +=item is_spam + +Cis_spam('12456@exmaple.com'));> + +Returns 1 if this message id confirms that the message is spam + +Returns 0 if this message is not known to be spam + +=cut +sub is_spam { + my ($self,$msgid) = @_; + return 0 if not defined $msgid or not length $msgid; + $msgid =~ s/^<|>$//; + if (exists $self->{spam}{$msgid} and + $self->{spam}{$msgid} ne '0' + ) { + return 1; + } + return 0; +} + +=item is_ham + + next if ($spam_log->is_ham('12456@exmaple.com')); + +Returns 1 if this message id confirms that the message is ham + +Returns 0 if this message is not known to be ham + +=cut +sub is_ham { + my ($self,$msgid) = @_; + return 0 if not defined $msgid or not length $msgid; + $msgid =~ s/^<|>$//; + if (exists $self->{spam}{$msgid} and + $self->{spam}{$msgid} eq '0' + ) { + return 1; + } + return 0; +} + + +=item add_spam + + $spam_log->add_spam('123456@example.com'); + +Add a message id to the spam listing. + +You must call C<$spam_log->save()> if you wish the changes to be written out to disk. + +=cut + +sub add_spam { + my ($self,$msgid) = @_; + $msgid =~ s/^<|>$//; + $self->{spam}{$msgid} = '1'; +} + +=item add_ham + + $spam_log->add_ham('123456@example.com'); + +Add a message id to the ham listing. + +You must call C<$spam_log->save()> if you wish the changes to be written out to disk. + +=cut + +sub add_ham { + my ($self,$msgid) = @_; + $msgid =~ s/^<|>$//; + $self->{spam}{$msgid} = '0'; +} + +=item remove_message + + $spam_log->remove_message('123456@example.com'); + +Remove a message from the spam/ham listing. + +You must call C<$spam_log->save()> if you wish the changes to be written out to disk. + +=cut + + +1; + +=back + +=cut + +__END__ + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: