SubjectTag role

3 files changed, 88 insertions, 2 deletions

diff --git a/TODO.md b/TODO.md
index dca85f3..08062b2 100644
--- a/TODO.md
+++ b/TODO.md
@@ -13,7 +13,5 @@
     * `List-Subscribe: <mailto:$sub_address>` (if we can (un)subscribe)
     * `List-Post: <mailto:$post_address>`
     * `List-Archive: NO` (configurable)
-* subject [tag]
-  * test what happens with mime-word-encoded subjects!
 * reply-to munging
   * set `Reply-to` to list's post address (return path)
diff --git a/lib/Sietima/Role/SubjectTag.pm b/lib/Sietima/Role/SubjectTag.pm
new file mode 100644
index 0000000..1daa662
--- /dev/null
+++ b/lib/Sietima/Role/SubjectTag.pm
@@ -0,0 +1,26 @@
+package Sietima::Role::SubjectTag;
+use 5.024;
+use Moo::Role;
+use Types::Standard qw(Str);
+use namespace::clean;
+
+has subject_tag => (
+    is => 'ro',
+    isa => Str,
+    required => 1,
+);
+
+around munge_mail => sub {
+    my ($orig,$self,$mail) = @_;
+
+    my $tag = '['.$self->subject_tag.']';
+    my $subject = $mail->header_str('Subject');
+    unless ($subject =~ m{\Q$tag\E}) {
+        $mail->header_str_set(
+            Subject => "$tag $subject",
+        );
+    }
+    return $self->$orig($mail);
+};
+
+1;
diff --git a/t/tests/sietima/role/subject-tag.t b/t/tests/sietima/role/subject-tag.t
new file mode 100644
index 0000000..6dc579a
--- /dev/null
+++ b/t/tests/sietima/role/subject-tag.t
@@ -0,0 +1,62 @@
+#!perl
+use strict;
+use warnings;
+use 5.024;
+use lib 't/lib';
+use Test::Sietima;
+
+my $s = make_sietima(
+    with_traits => ['SubjectTag'],
+    subscribers => [
+        'one@users.example.com',
+        'two@users.example.com',
+    ],
+    subject_tag => 'foo',
+);
+
+subtest 'adding tag' => sub {
+    test_sending(
+        sietima => $s,
+    );
+
+    is(
+        [ transport->deliveries ],
+        array {
+            item hash {
+                field email => object {
+                    call [cast=>'Email::MIME'] => object {
+                        call [ header_str => 'Subject' ] =>
+                            '[foo] Test Message';
+                    };
+                };
+            };
+        },
+        'subject tag should be added to all messages',
+    );
+};
+
+subtest 'tag already there' => sub {
+    test_sending(
+        sietima => $s,
+        mail => {
+            subject => my $subject = "[foo] \N{HEAVY BLACK HEART} test",
+        },
+    );
+
+    is(
+        [ transport->deliveries ],
+        array {
+            item hash {
+                field email => object {
+                    call [cast=>'Email::MIME'] => object {
+                        call [ header_str => 'Subject' ] =>
+                            $subject;
+                    };
+                };
+            };
+        },
+        'subject tag should not be duplicated',
+    );
+};
+
+done_testing;