aboutsummaryrefslogtreecommitdiff
path: root/lib/Sietima/Role/ReplyTo.pm
blob: 583b1dea58823e7c0989f310dcd01bd9d04d7a97 (plain)
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
package Sietima::Role::ReplyTo; 
use Moo::Role;
use Sietima::Policy;
use Types::Standard qw(Bool);
use Sietima::Types qw(Address AddressFromStr);
use List::AllUtils qw(part);
use namespace::clean;
 
has munge_reply_to => (
    is => 'ro',
    isa => Bool,
    default => 0,
);
 
has post_address => (
    is => 'lazy',
    isa => Address,
    coerce => AddressFromStr,
);
sub _build_post_address($self) { $self->return_path }
 
around munge_mail => sub ($orig,$self,$mail) {
    my @messages = $self->$orig($mail);
    my @ret;
    for my $m (@messages) {
        my ($leave,$munge) = part {
            my $m = $_->prefs->{munge_reply_to};
            defined $m ? (
                $m ? 1 : 0
            ) : ( $self->munge_reply_to ? 1 : 0 )
        $m->to->@*;
 
        if (not ($munge and $munge->@*)) {
            # nothing to do 
            push @ret,$m;
        }
        elsif (not ($leave and $leave->@*)) {
            # all these recipients want munging 
            $m->mail->header_str_set('Reply-To',$self->post_address->address);
            push @ret,$m;
        }
        else {
            # some want it, some don't: create two different messages 
            my $leave_message = Sietima::Message->new({
                mail => $m->mail,
                from => $m->from,
                to => $leave,
            });
 
            my $munged_mail = Email::MIME->new($m->mail->as_string);
            $munged_mail->header_str_set('Reply-To',$self->post_address->address);
 
            my $munged_message = Sietima::Message->new({
                mail => $munged_mail,
                from => $m->from,
                to => $munge,
            });
 
            push @ret,$leave_message,$munged_message;
        }
    }
    return @ret;
};
 
around list_addresses => sub ($orig,$self) {
    return +{
        $self->$orig->%*,
        post => $self->post_address,
    };
};
 
1;