lib/Sietima/Role/ReplyTo.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

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;
 
=head1 NAME
 
Sietima::Role::ReplyTo - munge the C<Reply-To> header
 
=head1 SYNOPSIS
 
  my $sietima = Sietima->with_traits('ReplyTo')->new({
    %args,
    return_path => 'list-bounce@example.com',
    munge_reply_to => 1,
    post_address => 'list@example.com',
    subscribers => [
      { primary => 'special@example.com', prefs => { munge_reply_to => 0 } },
      @other_subscribers,
    ],
  });
 
=head1 DESCRIPTION
 
A L<< C<Sietima> >> list with this role applied will, on request, set
the C<Reply-To:> header to the value of the L<< /C<post_address> >>
attribute.
 
This behaviour can be selected both at the list level (with the L<<
/C<munge_reply_to> >> attribute) and at the subscriber level (with the
C<munge_reply_to> preference). By default, the C<Reply-To:> header is
not touched.
 
=head1 ATTRIBUTES
 
=head2 C<munge_reply_to>
 
Optional boolean, defaults to false. If set to a true value, all
messages will have their C<Reply-To:> header set to the value of the
L<< /C<post_address> >> attribute. This setting can be overridden by
individual subscribers with the C<munge_reply_to> preference.
 
=cut
 
has munge_reply_to => (
    is => 'ro',
    isa => Bool,
    default => 0,
);
 
=head2 C<post_address>
 
An L<< C<Email::Address> >> object, defaults to the value of the L<<
C<return_path>|Sietima/return_path >> attribute. This is the address
that the mailing list receives messages at.
 
This role extends the L<< C<list_addresses>|Sietima/list_addresses >>
method to include this address.
 
=cut
 
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;