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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149

package Sietima::Role::ReplyTo; 
use Moo::Role;
use Sietima::Policy;
use Types::Standard qw(Bool);
use List::AllUtils qw(part);
use namespace::clean;
 
our $VERSION = '1.1.1'; # VERSION 
# ABSTRACT: munge the C<Reply-To> header 
 
 
with 'Sietima::Role::WithPostAddress';
 
 
has munge_reply_to => (
    is => 'ro',
    isa => Bool,
    default => 0,
);
 
 
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;
};
 
1;
 
__END__
 
=pod
 
=encoding UTF-8
 
=head1 NAME
 
Sietima::Role::ReplyTo - munge the C<Reply-To> header
 
=head1 VERSION
 
version 1.1.1
 
=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>|Sietima::Role::WithPostAddress >> 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.
 
This is a "sub-role" of L<<
C<WithPostAddress>|Sietima::Role::WithPostAddress >>.
 
=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.
 
=head1 MODIFIED METHODS
 
=head2 C<munge_mail>
 
For each message returned by the original method, this method
partitions the subscribers, who are recipients of the message,
according to their C<munge_reply_to> preference (or the L<<
/C<munge_reply_to> >> attribute, if a subscriber does not have the
preference set).
 
If no recipients want the C<Reply-To:> header modified, this method
will just pass the message through.
 
If all recipients want the C<Reply-To:> header modified, this method
will set the header, and pass the modified message.
 
If some recipients want the C<Reply-To:> header modified, and some
don't, this method will clone the message, modify the header in one
copy, set the appropriate part of the recipients to each copy, and
pass both through.
 
=head1 AUTHOR
 
Gianni Ceccarelli <dakkar@thenautilus.net>
 
=head1 COPYRIGHT AND LICENSE
 
This software is copyright (c) 2023 by Gianni Ceccarelli <dakkar@thenautilus.net>.
 
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
 
=cut