From 98b6d1ba27fa2a2e1434e1fecd3479a2b4903fe7 Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 16 Mar 2017 17:45:56 +0000 Subject: Dzil-build release 1.0.0 (from 9f1fc6d on master) --- lib/Sietima/Role/ReplyTo.pm | 136 ++++++++++++++++++++++++++------------------ 1 file changed, 82 insertions(+), 54 deletions(-) (limited to 'lib/Sietima/Role/ReplyTo.pm') diff --git a/lib/Sietima/Role/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm index 6b21f20..4a1ca48 100644 --- a/lib/Sietima/Role/ReplyTo.pm +++ b/lib/Sietima/Role/ReplyTo.pm @@ -6,9 +6,79 @@ use Sietima::Types qw(Address AddressFromStr); use List::AllUtils qw(part); use namespace::clean; -# VERSION +our $VERSION = '1.0.0'; # VERSION # ABSTRACT: munge the C 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 header + +=head1 VERSION + +version 1.0.0 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('ReplyTo')->new({ @@ -36,26 +106,18 @@ not touched. This is a "sub-role" of L<< C|Sietima::Role::WithPostAddress >>. -=cut - -with 'Sietima::Role::WithPostAddress'; +=head1 ATTRIBUTES -=attr C +=head2 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, -); +=head1 MODIFIED METHODS -=modif C +=head2 C For each message returned by the original method, this method partitions the subscribers, who are recipients of the message, @@ -74,49 +136,15 @@ 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 +=head1 AUTHOR -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->@*; +Gianni Ceccarelli - 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); +=head1 COPYRIGHT AND LICENSE - my $munged_message = Sietima::Message->new({ - mail => $munged_mail, - from => $m->from, - to => $munge, - }); +This software is copyright (c) 2017 by Gianni Ceccarelli . - push @ret,$leave_message,$munged_message; - } - } - return @ret; -}; +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. -1; +=cut -- cgit v1.2.3