File Coverage

blib/lib/Sietima/Role/ReplyTo.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 24 24 100.0


line stmt bran cond sub pod time code
1             package Sietima::Role::ReplyTo;
2 2     2   1308 use Moo::Role;
  2         5  
  2         17  
3 2     2   821 use Sietima::Policy;
  2         4  
  2         46  
4 2     2   18 use Types::Standard qw(Bool);
  2         4  
  2         35  
5 2     2   1743 use Sietima::Types qw(Address AddressFromStr);
  2         5  
  2         19  
6 2     2   1284 use List::AllUtils qw(part);
  2         4  
  2         124  
7 2     2   13 use namespace::clean;
  2         4  
  2         19  
8              
9             our $VERSION = '1.0.4'; # VERSION
10             # ABSTRACT: munge the C<Reply-To> header
11              
12              
13             with 'Sietima::Role::WithPostAddress';
14              
15              
16             has munge_reply_to => (
17             is => 'ro',
18             isa => Bool,
19             default => 0,
20             );
21              
22              
23             around munge_mail => sub ($orig,$self,$mail) {
24             my @messages = $self->$orig($mail);
25             my @ret;
26             for my $m (@messages) {
27             my ($leave,$munge) = part {
28             my $m = $_->prefs->{munge_reply_to};
29             defined $m ? (
30             $m ? 1 : 0
31             ) : ( $self->munge_reply_to ? 1 : 0 )
32             } $m->to->@*;
33              
34             if (not ($munge and $munge->@*)) {
35             # nothing to do
36             push @ret,$m;
37             }
38             elsif (not ($leave and $leave->@*)) {
39             # all these recipients want munging
40             $m->mail->header_str_set('Reply-To',$self->post_address->address);
41             push @ret,$m;
42             }
43             else {
44             # some want it, some don't: create two different messages
45             my $leave_message = Sietima::Message->new({
46             mail => $m->mail,
47             from => $m->from,
48             to => $leave,
49             });
50              
51             my $munged_mail = Email::MIME->new($m->mail->as_string);
52             $munged_mail->header_str_set('Reply-To',$self->post_address->address);
53              
54             my $munged_message = Sietima::Message->new({
55             mail => $munged_mail,
56             from => $m->from,
57             to => $munge,
58             });
59              
60             push @ret,$leave_message,$munged_message;
61             }
62             }
63             return @ret;
64             };
65              
66             1;
67              
68             __END__
69              
70             =pod
71              
72             =encoding UTF-8
73              
74             =head1 NAME
75              
76             Sietima::Role::ReplyTo - munge the C<Reply-To> header
77              
78             =head1 VERSION
79              
80             version 1.0.4
81              
82             =head1 SYNOPSIS
83              
84             my $sietima = Sietima->with_traits('ReplyTo')->new({
85             %args,
86             return_path => 'list-bounce@example.com',
87             munge_reply_to => 1,
88             post_address => 'list@example.com',
89             subscribers => [
90             { primary => 'special@example.com', prefs => { munge_reply_to => 0 } },
91             @other_subscribers,
92             ],
93             });
94              
95             =head1 DESCRIPTION
96              
97             A L<< C<Sietima> >> list with this role applied will, on request, set
98             the C<Reply-To:> header to the value of the L<<
99             C<post_address>|Sietima::Role::WithPostAddress >> attribute.
100              
101             This behaviour can be selected both at the list level (with the L<<
102             /C<munge_reply_to> >> attribute) and at the subscriber level (with the
103             C<munge_reply_to> preference). By default, the C<Reply-To:> header is
104             not touched.
105              
106             This is a "sub-role" of L<<
107             C<WithPostAddress>|Sietima::Role::WithPostAddress >>.
108              
109             =head1 ATTRIBUTES
110              
111             =head2 C<munge_reply_to>
112              
113             Optional boolean, defaults to false. If set to a true value, all
114             messages will have their C<Reply-To:> header set to the value of the
115             L<< /C<post_address> >> attribute. This setting can be overridden by
116             individual subscribers with the C<munge_reply_to> preference.
117              
118             =head1 MODIFIED METHODS
119              
120             =head2 C<munge_mail>
121              
122             For each message returned by the original method, this method
123             partitions the subscribers, who are recipients of the message,
124             according to their C<munge_reply_to> preference (or the L<<
125             /C<munge_reply_to> >> attribute, if a subscriber does not have the
126             preference set).
127              
128             If no recipients want the C<Reply-To:> header modified, this method
129             will just pass the message through.
130              
131             If all recipients want the C<Reply-To:> header modified, this method
132             will set the header, and pass the modified message.
133              
134             If some recipients want the C<Reply-To:> header modified, and some
135             don't, this method will clone the message, modify the header in one
136             copy, set the appropriate part of the recipients to each copy, and
137             pass both through.
138              
139             =head1 AUTHOR
140              
141             Gianni Ceccarelli <dakkar@thenautilus.net>
142              
143             =head1 COPYRIGHT AND LICENSE
144              
145             This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>.
146              
147             This is free software; you can redistribute it and/or modify it under
148             the same terms as the Perl 5 programming language system itself.
149              
150             =cut