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; # VERSION # ABSTRACT: munge the C 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 >> list with this role applied will, on request, set the C header to the value of the L<< C|Sietima::Role::WithPostAddress >> attribute. This behaviour can be selected both at the list level (with the L<< /C >> attribute) and at the subscriber level (with the C preference). By default, the C header is not touched. This is a "sub-role" of L<< C|Sietima::Role::WithPostAddress >>. =cut with 'Sietima::Role::WithPostAddress'; =attr C Optional boolean, defaults to false. If set to a true value, all messages will have their C header set to the value of the L<< /C >> attribute. This setting can be overridden by individual subscribers with the C preference. =cut has munge_reply_to => ( is => 'ro', isa => Bool, default => 0, ); =modif C For each message returned by the original method, this method partitions the subscribers, who are recipients of the message, according to their C preference (or the L<< /C >> attribute, if a subscriber does not have the preference set). If no recipients want the C header modified, this method will just pass the message through. If all recipients want the C header modified, this method will set the header, and pass the modified message. If some recipients want the C 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. =cut 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;