X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FLog%2FSpam.pm;fp=Debbugs%2FLog%2FSpam.pm;h=0000000000000000000000000000000000000000;hb=1e6633a3780f4fd53fc4303852e84d13cdad2dc6;hp=e5ed18f1c8f4441890f62b8a134797807313a315;hpb=466f7faff129a5699c7674f59900a92aa256175d;p=debbugs.git diff --git a/Debbugs/Log/Spam.pm b/Debbugs/Log/Spam.pm deleted file mode 100644 index e5ed18f..0000000 --- a/Debbugs/Log/Spam.pm +++ /dev/null @@ -1,279 +0,0 @@ -# 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: