diff options
Diffstat (limited to 'lib/Sietima/Role/SubscriberOnly/Moderate.pm')
-rw-r--r-- | lib/Sietima/Role/SubscriberOnly/Moderate.pm | 280 |
1 files changed, 151 insertions, 129 deletions
diff --git a/lib/Sietima/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm index ee8d0c6..ba58c5b 100644 --- a/lib/Sietima/Role/SubscriberOnly/Moderate.pm +++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm @@ -4,9 +4,142 @@ use Sietima::Policy; use Email::Stuffer; use namespace::clean; -# VERSION +our $VERSION = '1.1.0'; # 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', + ); + $self->transport->send($notice->email,{ + from => $self->return_path, + to => [ $self->owner ], + }); + return; +} + + +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.0 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('SubscribersOnly::Moderate')->new({ @@ -31,42 +164,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', - ); - $self->transport->send($notice->email,{ - from => $self->return_path, - to => [ $self->owner ], - }); - return; -} - -=method C<resume> +=head2 C<resume> $sietima->resume($mail_id); @@ -76,30 +182,14 @@ 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); Given an identifier returned when L<storing|Sietima::MailStore/store> 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); @@ -111,22 +201,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); @@ -137,16 +212,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); @@ -157,13 +223,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); @@ -173,13 +233,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: @@ -217,49 +273,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 |