role: ReplyTo

per-user reply-to munging!

also:
* deliveries_are can now test whole messages
* deliveries_are fails on extra recipients
* easier-to-use Subscriber-from-HashRef coercion
* nomail.t checks more

2 files changed, 60 insertions, 1 deletions

diff --git a/lib/Sietima/Role/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm
new file mode 100644
index 0000000..d4eb5e5
--- /dev/null
+++ b/lib/Sietima/Role/ReplyTo.pm
@@ -0,0 +1,59 @@
+package Sietima::Role::ReplyTo;
+use 5.024;
+use Moo::Role;
+use Types::Standard qw(Bool);
+use List::AllUtils qw(part);
+use namespace::clean;
+
+has munge_reply_to => (
+    is => 'ro',
+    isa => Bool,
+    default => 0,
+);
+
+around munge_mail => sub {
+    my ($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->return_path->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->return_path->address);
+
+            my $munged_message = Sietima::Message->new({
+                mail => $munged_mail,
+                from => $m->from,
+                to => $munge,
+            });
+
+            push @ret,$leave_message,$munged_message;
+        }
+    }
+    return @ret;
+};
+
+1;
diff --git a/lib/Sietima/Types.pm b/lib/Sietima/Types.pm
index f8b5faf..af650b9 100644
--- a/lib/Sietima/Types.pm
+++ b/lib/Sietima/Types.pm
@@ -33,6 +33,6 @@ declare_coercion SubscriberFromStr,
 
 declare_coercion SubscriberFromHashRef,
     to_type Subscriber, from HashRef,
-    q{ Sietima::Subscriber->new($_) };
+    q{ my $a = delete $_->{address};Sietima::Subscriber->new({raw_address => $a, prefs => $_ }) };
 
 1;