lib/Sietima/Role/SubscriberOnly/Moderate.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137

package Sietima::Role::SubscriberOnly::Moderate; 
use Moo::Role;
use Sietima::Policy;
use Email::Stuffer;
use Email::MIME;
use namespace::clean;
 
=head1 NAME
 
Sietima::Role::SubscriberOnly::Moderate - moderate messages from non-subscribers
 
=head1 SYNOPSIS
 
  my $sietima = Sietima->with_traits('SubscribersOnly::Moderate')->new({
    %args,
    owner => 'listmaster@example.com',
    mail_store => {
      class => 'Sietima::MailStore::FS',
      root => '/tmp',
    },
  });
 
=head1 DESCRIPTION
 
A L<< C<Sietima> >> list with this role applied will accept incoming
emails coming from non-subscribers, and store it for moderation. Each
such email will be forwarded (as an attachment) to the list's owner.
 
The owner will the be able to delete the message, or allow it.
 
This is a "sub-role" of L<<
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';
 
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',
            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);
}
 
around command_line_spec => sub ($orig,$self) {
    my $spec = $self->$orig();
 
    my $list_mail_ids = sub ($self,$runner,$args) {
        $self->mail_store->retrieve_ids_by_tags('moderation');
    };
    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}{'show-held'} = {
        op => 'show_mail_from_moderation_queue',
        $etc->('show'),
    };
    $spec->{subcommands}{'resume-held'} = {
        op => sub ($self,$runner,$args) {
            $self->resume($runner->parameters->{'mail-id'});
        },
        $etc->('resume'),
    };
    $spec->{subcommands}{'drop-held'} = {
        op => sub ($self,$runner,$args) {
            $self->drop($runner->parameters->{'mail-id'});
        },
        $etc->('drop'),
    };
    $spec->{subcommands}{'list-held'} = {
        op => 'list_mails_in_moderation_queue',
        summary => 'list all mails currently held for moderation',
    };
 
    return $spec;
};
 
1;