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

3 files changed, 192 insertions, 29 deletions

diff --git a/t/lib/Test/Sietima.pm b/t/lib/Test/Sietima.pm
index 867fd5a..31fb809 100644
--- a/t/lib/Test/Sietima.pm
+++ b/t/lib/Test/Sietima.pm
@@ -80,26 +80,56 @@ sub deliveries_are {
     my (%args) = @_;
 
     my $ctx = context();
-    my $to = $args{to};
-    my @recipients = ref($to) ? $to->@* : $to;
-    my @deliveries = transport->deliveries;
-    is(
-        \@deliveries,
-        array {
-            if (@recipients) {
+
+    my $checker;
+    if (my @mails = ($args{mails}||[])->@*) {
+        $checker = bag {
+            for my $m (@mails) {
                 item hash {
-                    field envelope => hash {
-                        field from => $args{from}||$return_path;
-                        field to => bag {
-                            for (@recipients) {
-                                item $_;
-                            }
+                    if (ref($m) eq 'HASH') {
+                        field email => object {
+                            call [cast=>'Email::MIME'] => $m->{o};
                         };
-                    };
+                        field envelope => hash {
+                            field to => bag {
+                                item $_ for $m->{to}->@*;
+                            };
+                        };
+                    }
+                    else {
+                        field email => object {
+                            call [cast=>'Email::MIME'] => $m;
+                        };
+                    }
                 };
             }
             end();
-        },
+        };
+    }
+    elsif (my @recipients = do {my $to = $args{to}; ref($to) ? $to->@* : $to }) {
+        $checker = array {
+            item hash {
+                field envelope => hash {
+                    field from => $args{from}||$return_path;
+                    field to => bag {
+                        for (@recipients) {
+                            item $_;
+                        }
+                        end();
+                    };
+                };
+            };
+            end();
+        };
+    }
+    else {
+        $checker = [];
+    }
+
+    my @deliveries = transport->deliveries;
+    is(
+        \@deliveries,
+        $checker,
         'the deliveries should be as expected',
         np @deliveries,
     );
diff --git a/t/tests/sietima/role/nomail.t b/t/tests/sietima/role/nomail.t
index fe64e84..a0be192 100644
--- a/t/tests/sietima/role/nomail.t
+++ b/t/tests/sietima/role/nomail.t
@@ -5,20 +5,40 @@ use 5.024;
 use lib 't/lib';
 use Test::Sietima;
 
-my $s = make_sietima(
-    with_traits => ['NoMail'],
-    subscribers => [
-        {
-            raw_address => 'one@users.example.com',
-            wants_mail => 0,
-        },
-        'two@users.example.com',
-    ],
-);
+subtest 'disabled' => sub {
+    my $s = make_sietima(
+        with_traits => ['NoMail'],
+        subscribers => [
+            {
+                address => 'one@users.example.com',
+                wants_mail => 0,
+            },
+            'two@users.example.com',
+        ],
+    );
 
-test_sending(
-    sietima => $s,
-    to => ['two@users.example.com'],
-);
+    test_sending(
+        sietima => $s,
+        to => ['two@users.example.com'],
+    );
+};
+
+subtest 'enabled' => sub {
+    my $s = make_sietima(
+        with_traits => ['NoMail'],
+        subscribers => [
+            {
+                address => 'one@users.example.com',
+                wants_mail => 1,
+            },
+            'two@users.example.com',
+        ],
+    );
+
+    test_sending(
+        sietima => $s,
+        to => ['one@users.example.com','two@users.example.com'],
+    );
+};
 
 done_testing;
diff --git a/t/tests/sietima/role/replyto.t b/t/tests/sietima/role/replyto.t
new file mode 100644
index 0000000..1bd2d02
--- /dev/null
+++ b/t/tests/sietima/role/replyto.t
@@ -0,0 +1,113 @@
+#!perl
+use strict;
+use warnings;
+use 5.024;
+use lib 't/lib';
+use Test::Sietima;
+
+subtest 'disabled' => sub {
+    my $s = make_sietima(
+        with_traits => ['ReplyTo'],
+        munge_reply_to => 0,
+        subscribers => [
+            'one@users.example.com',
+            'two@users.example.com',
+        ],
+    );
+
+    test_sending(
+        sietima => $s,
+        mails => [
+            object {
+                call [ header_str => 'reply-to' ] => undef;
+            },
+        ],
+    );
+};
+
+subtest 'enabled' => sub {
+    my $s = make_sietima(
+        with_traits => ['ReplyTo'],
+        munge_reply_to => 1,
+        subscribers => [
+            'one@users.example.com',
+            'two@users.example.com',
+        ],
+    );
+
+    test_sending(
+        sietima => $s,
+        mails => [
+            object {
+                call [ header_str => 'reply-to' ] => $s->return_path->address;
+            },
+        ],
+    );
+};
+
+subtest 'enabled for some' => sub {
+    my $s = make_sietima(
+        with_traits => ['ReplyTo'],
+        munge_reply_to => 0,
+        subscribers => [
+            {
+                address => 'one@users.example.com',
+                munge_reply_to => 1,
+            },
+            'two@users.example.com',
+        ],
+    );
+
+    test_sending(
+        sietima => $s,
+        mails => [
+            {
+                o => object {
+                    call [ header_str => 'reply-to' ] => $s->return_path->address;
+                },
+                to => [ 'one@users.example.com' ],
+            },
+            {
+                o => object {
+                    call [ header_str => 'reply-to' ] => undef;
+                },
+                to => [ 'two@users.example.com' ],
+            },
+        ],
+    );
+};
+
+
+subtest 'disabled for some' => sub {
+    my $s = make_sietima(
+        with_traits => ['ReplyTo'],
+        munge_reply_to => 1,
+        subscribers => [
+            {
+                address => 'one@users.example.com',
+                munge_reply_to => 0,
+            },
+            'two@users.example.com',
+        ],
+    );
+
+    test_sending(
+        sietima => $s,
+        mails => [
+            {
+                o => object {
+                    call [ header_str => 'reply-to' ] => $s->return_path->address;
+                },
+                to => [ 'two@users.example.com' ],
+            },
+            {
+                o => object {
+                    call [ header_str => 'reply-to' ] => undef;
+                },
+                to => [ 'one@users.example.com' ],
+            },
+        ],
+    );
+};
+
+done_testing;