package Sietima::Role::SubscriberOnly::Moderate;
use Moo::Role;
use Sietima::Policy;
use Email::Stuffer;
use Email::MIME;
use namespace::clean;

# VERSION
# ABSTRACT: 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';

=method 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>

  $sietima->resume($mail_id);

Given an identifier returned when L<storing|Sietima::MailStore/store>
an email, this method retrieves the email and re-processes it via L<<
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>

  $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>

  $sietima->list_mails_in_moderation_queue($sietima_runner);

This method L<retrieves all the
identifiers|Sietima::MailStore/retrieve_by_tags> of messages tagged
C<moderation>, and L<prints them 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 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>

  $sietima->show_mail_from_moderation_queue($sietima_runner);

This method L<retrieves the email|Sietima::MailStore/retrieve_by_id>
of the message requested from the command line, and L<prints it
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>

  $sietima->resume_mail_from_moderation_queue($sietima_runner);

This method L<retrieves the email|Sietima::MailStore/retrieve_by_id>
of the message requested from the command line, and L<resumes|/resume>
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>

  $sietima->drop_mail_from_moderation_queue($sietima_runner);

This method L<retrieves the email|Sietima::MailStore/retrieve_by_id>
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

sub drop_mail_from_moderation_queue ($self,$runner,@) {
    $self->drop($runner->parameters->{'mail-id'});
}

=modif C<command_line_spec>

This method adds the following sub-commands for the command line:

=over

=item C<list-held>

  $ sietima list-held

Invokes the L<< /C<list_mails_in_moderation_queue> >> method, printing
the identifiers of all messages held for moderation.

=item C<show-held>

  $ sietima show-held 32946p6eu7867

Invokes the L<< /C<show_mail_from_moderation_queue> >> method,
printing one message held for moderation; the identifier is expected
as a positional parameter.

=item C<resume-held>

  $ sietima resume-held 32946p6eu7867

Invokes the L<< /C<resume> >> method, causing the held message to be
processed normally; the identifier is expected as a positional
parameter.

=item C<drop-held>

  $ sietima drop-held 32946p6eu7867

Invokes the L<< /C<drop> >> method, removing the held message; the
identifier is expected as a positional parameter.

=back

=cut

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;