aboutsummaryrefslogtreecommitdiff
path: root/lib/Sietima/Role/SubscriberOnly/Moderate.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Sietima/Role/SubscriberOnly/Moderate.pm')
-rw-r--r--lib/Sietima/Role/SubscriberOnly/Moderate.pm282
1 files changed, 152 insertions, 130 deletions
diff --git a/lib/Sietima/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm
index 42e5bc3..9de2967 100644
--- a/lib/Sietima/Role/SubscriberOnly/Moderate.pm
+++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm
@@ -4,9 +4,143 @@ use Sietima::Policy;
use Email::Stuffer;
use namespace::clean;
-# VERSION
+our $VERSION = '1.1.2'; # VERSION
# ABSTRACT: moderate messages from non-subscribers
+
+with 'Sietima::Role::SubscriberOnly',
+ 'Sietima::Role::WithMailStore',
+ 'Sietima::Role::WithOwner';
+
+
+sub munge_mail_from_non_subscriber ($self,$mail) {
+ my $id = $self->mail_store->store($mail,'moderation');
+ my $notice = Email::Stuffer
+ ->from($self->return_path->address)
+ ->to($self->owner->address)
+ ->subject("Message held for moderation - ".$mail->header_str('subject'))
+ ->text_body("Use id $id to refer to it")
+ ->attach(
+ $mail->as_string,
+ content_type => 'message/rfc822',
+ # some clients, most notably Claws-Mail, seem to have
+ # problems with encodings other than this
+ encoding => '7bit',
+ );
+
+ return Sietima::Message->new({
+ mail => $notice->email,
+ from => $self->return_path,
+ to => [ $self->owner ],
+ });
+}
+
+
+sub resume ($self,$mail_id) {
+ my $mail = $self->mail_store->retrieve_by_id($mail_id);
+ $self->ignoring_subscriberonly(
+ sub($s) { $s->handle_mail($mail) },
+ );
+ $self->mail_store->remove($mail_id);
+}
+
+
+sub drop ($self,$mail_id) {
+ $self->mail_store->remove($mail_id);
+}
+
+
+sub list_mails_in_moderation_queue ($self,$runner,@) {
+ my $mails = $self->mail_store->retrieve_by_tags('moderation');
+ $runner->out(sprintf 'There are %d messages held for moderation:',scalar($mails->@*));
+ for my $mail ($mails->@*) {
+ $runner->out(sprintf '* %s %s "%s" (%s)',
+ $mail->{id},
+ $mail->{mail}->header_str('From')//'<no from>',
+ $mail->{mail}->header_str('Subject')//'<no subject>',
+ $mail->{mail}->header_str('Date')//'<no date>',
+ );
+ }
+}
+
+
+sub show_mail_from_moderation_queue ($self,$runner,@) {
+ my $id = $runner->parameters->{'mail-id'};
+ my $mail = $self->mail_store->retrieve_by_id($id);
+ $runner->out("Message $id:");
+ $runner->out($mail->as_string =~ s{\r\n}{\n}gr);
+}
+
+
+sub resume_mail_from_moderation_queue ($self,$runner,@) {
+ $self->resume($runner->parameters->{'mail-id'});
+}
+
+
+sub drop_mail_from_moderation_queue ($self,$runner,@) {
+ $self->drop($runner->parameters->{'mail-id'});
+}
+
+
+around command_line_spec => sub ($orig,$self) {
+ my $spec = $self->$orig();
+
+ # this allows us to tab-complete identifiers from the shell!
+ my $list_mail_ids = sub ($self,$runner,$args) {
+ $self->mail_store->retrieve_ids_by_tags('moderation');
+ };
+ # a little factoring: $etc->($command_name) generates the spec for
+ # sub-commands that require a mail id
+ my $etc = sub($cmd) {
+ return (
+ summary => "$cmd the given mail, currently held for moderation",
+ parameters => [
+ {
+ name => 'mail-id',
+ required => 1,
+ summary => "id of the mail to $cmd",
+ completion => { op => $list_mail_ids },
+ },
+ ],
+ );
+ };
+
+ $spec->{subcommands}{'list-held'} = {
+ op => 'list_mails_in_moderation_queue',
+ summary => 'list all mails currently held for moderation',
+ };
+ $spec->{subcommands}{'show-held'} = {
+ op => 'show_mail_from_moderation_queue',
+ $etc->('show'),
+ };
+ $spec->{subcommands}{'resume-held'} = {
+ op => 'resume_mail_from_moderation_queue',
+ $etc->('resume'),
+ };
+ $spec->{subcommands}{'drop-held'} = {
+ op => 'drop_mail_from_moderation_queue',
+ $etc->('drop'),
+ };
+
+ return $spec;
+};
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Sietima::Role::SubscriberOnly::Moderate - moderate messages from non-subscribers
+
+=head1 VERSION
+
+version 1.1.2
+
=head1 SYNOPSIS
my $sietima = Sietima->with_traits('SubscribersOnly::Moderate')->new({
@@ -31,43 +165,15 @@ C<SubscribersOnly>|Sietima::Role::SubscriberOnly >>, L<<
C<WithMailStore>|Sietima::Role::WithMailStore >>, and L<<
C<WithOwner>|Sietima::Role::WithOwner >>.
-=cut
-
-with 'Sietima::Role::SubscriberOnly',
- 'Sietima::Role::WithMailStore',
- 'Sietima::Role::WithOwner';
+=head1 METHODS
-=method C<munge_mail_from_non_subscriber>
+=head2 C<munge_mail_from_non_subscriber>
L<Stores|Sietima::MailStore/store> the email with the C<moderation>
tag, and forwards it to the L<list
owner|Sietima::Role::WithOwner/owner>.
-=cut
-
-sub munge_mail_from_non_subscriber ($self,$mail) {
- my $id = $self->mail_store->store($mail,'moderation');
- my $notice = Email::Stuffer
- ->from($self->return_path->address)
- ->to($self->owner->address)
- ->subject("Message held for moderation - ".$mail->header_str('subject'))
- ->text_body("Use id $id to refer to it")
- ->attach(
- $mail->as_string,
- content_type => 'message/rfc822',
- # some clients, most notably Claws-Mail, seem to have
- # problems with encodings other than this
- encoding => '7bit',
- );
-
- return Sietima::Message->new({
- mail => $notice->email,
- from => $self->return_path,
- to => [ $self->owner ],
- });
-}
-
-=method C<resume>
+=head2 C<resume>
$sietima->resume($mail_id);
@@ -78,17 +184,7 @@ C<ignoring_subscriberonly>|Sietima::Role::SubscriberOnly/ignoring_subscriberonly
>>. This will make sure that the email is not caught again by the
subscriber-only filter.
-=cut
-
-sub resume ($self,$mail_id) {
- my $mail = $self->mail_store->retrieve_by_id($mail_id);
- $self->ignoring_subscriberonly(
- sub($s) { $s->handle_mail($mail) },
- );
- $self->mail_store->remove($mail_id);
-}
-
-=method C<drop>
+=head2 C<drop>
$sietima->drop($mail_id);
@@ -96,13 +192,7 @@ Given the identifier returned when
L<storing|Sietima::MailStore/store>-ing an email, this method deletes
the email from the store.
-=cut
-
-sub drop ($self,$mail_id) {
- $self->mail_store->remove($mail_id);
-}
-
-=method C<list_mails_in_moderation_queue>
+=head2 C<list_mails_in_moderation_queue>
$sietima->list_mails_in_moderation_queue($sietima_runner);
@@ -114,22 +204,7 @@ L<< C<Sietima::Runner> >> object.
This method is usually invoked from the command line, see L<<
/C<command_line_spec> >>.
-=cut
-
-sub list_mails_in_moderation_queue ($self,$runner,@) {
- my $mails = $self->mail_store->retrieve_by_tags('moderation');
- $runner->out(sprintf 'There are %d messages held for moderation:',scalar($mails->@*));
- for my $mail ($mails->@*) {
- $runner->out(sprintf '* %s %s "%s" (%s)',
- $mail->{id},
- $mail->{mail}->header_str('From')//'<no from>',
- $mail->{mail}->header_str('Subject')//'<no subject>',
- $mail->{mail}->header_str('Date')//'<no date>',
- );
- }
-}
-
-=method C<show_mail_from_moderation_queue>
+=head2 C<show_mail_from_moderation_queue>
$sietima->show_mail_from_moderation_queue($sietima_runner);
@@ -140,16 +215,7 @@ out|App::Spec::Runner/out> via the L<< C<Sietima::Runner> >> object.
This method is usually invoked from the command line, see L<<
/C<command_line_spec> >>.
-=cut
-
-sub show_mail_from_moderation_queue ($self,$runner,@) {
- my $id = $runner->parameters->{'mail-id'};
- my $mail = $self->mail_store->retrieve_by_id($id);
- $runner->out("Message $id:");
- $runner->out($mail->as_string =~ s{\r\n}{\n}gr);
-}
-
-=method C<resume_mail_from_moderation_queue>
+=head2 C<resume_mail_from_moderation_queue>
$sietima->resume_mail_from_moderation_queue($sietima_runner);
@@ -160,13 +226,7 @@ it.
This method is usually invoked from the command line, see L<<
/C<command_line_spec> >>.
-=cut
-
-sub resume_mail_from_moderation_queue ($self,$runner,@) {
- $self->resume($runner->parameters->{'mail-id'});
-}
-
-=method C<drop_mail_from_moderation_queue>
+=head2 C<drop_mail_from_moderation_queue>
$sietima->drop_mail_from_moderation_queue($sietima_runner);
@@ -176,13 +236,9 @@ of the message requested from the command line, and L<drops|/drop> it.
This method is usually invoked from the command line, see L<<
/C<command_line_spec> >>.
-=cut
+=head1 MODIFIED METHODS
-sub drop_mail_from_moderation_queue ($self,$runner,@) {
- $self->drop($runner->parameters->{'mail-id'});
-}
-
-=modif C<command_line_spec>
+=head2 C<command_line_spec>
This method adds the following sub-commands for the command line:
@@ -220,49 +276,15 @@ identifier is expected as a positional parameter.
=back
-=cut
+=head1 AUTHOR
-around command_line_spec => sub ($orig,$self) {
- my $spec = $self->$orig();
+Gianni Ceccarelli <dakkar@thenautilus.net>
- # this allows us to tab-complete identifiers from the shell!
- my $list_mail_ids = sub ($self,$runner,$args) {
- $self->mail_store->retrieve_ids_by_tags('moderation');
- };
- # a little factoring: $etc->($command_name) generates the spec for
- # sub-commands that require a mail id
- my $etc = sub($cmd) {
- return (
- summary => "$cmd the given mail, currently held for moderation",
- parameters => [
- {
- name => 'mail-id',
- required => 1,
- summary => "id of the mail to $cmd",
- completion => { op => $list_mail_ids },
- },
- ],
- );
- };
+=head1 COPYRIGHT AND LICENSE
- $spec->{subcommands}{'list-held'} = {
- op => 'list_mails_in_moderation_queue',
- summary => 'list all mails currently held for moderation',
- };
- $spec->{subcommands}{'show-held'} = {
- op => 'show_mail_from_moderation_queue',
- $etc->('show'),
- };
- $spec->{subcommands}{'resume-held'} = {
- op => 'resume_mail_from_moderation_queue',
- $etc->('resume'),
- };
- $spec->{subcommands}{'drop-held'} = {
- op => 'drop_mail_from_moderation_queue',
- $etc->('drop'),
- };
+This software is copyright (c) 2023 by Gianni Ceccarelli <dakkar@thenautilus.net>.
- return $spec;
-};
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
-1;
+=cut
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-13 00:22:57 +0000