--- /dev/null
+# 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 <don@donarmstrong.com>.
+
+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
+
+C<next if ($spam_log->is_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:
projects / debbugs.git / blobdiff