From 561dcb678dd6e8520e927365f3737315c0fe0577 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Fri, 24 Mar 2017 16:32:52 +0000
Subject: allow List-Post: NO

---
 Changes                        |  1 +
 lib/Sietima/Role/Headers.pm    | 27 ++++++++++++++------
 t/tests/sietima/role/headers.t | 56 +++++++++++++++++++++++++++++++++++-------
 3 files changed, 68 insertions(+), 16 deletions(-)

diff --git a/Changes b/Changes
index 55ed858..94d6f78 100644
--- a/Changes
+++ b/Changes
@@ -3,6 +3,7 @@
    * list headers are structured, should never be encoded
    * they can have comments
    * each header can have multiple values
+   * 'post' can be set to a false value to indicate a no-post list
 
 1.0.0     2017-03-16 17:45:48+00:00 Europe/London
  - first release
diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm
index fe3f8a5..5ab0d58 100644
--- a/lib/Sietima/Role/Headers.pm
+++ b/lib/Sietima/Role/Headers.pm
@@ -61,6 +61,15 @@ sub _normalise_address($self,$address) {
     } @items;
 }
 
+sub _set_header($self,$mail,$name,$value) {
+    my $header_name = 'List-' . ucfirst($name =~ s{[^[:alnum:]]+}{-}gr);
+    my @items = $self->_normalise_address($value);
+
+    $mail->header_raw_set(
+        $header_name => join ', ', map { $_->as_header_raw } @items,
+    );
+}
+
 sub _add_headers_to($self,$message) {
     my $addresses = $self->list_addresses;
     my $mail = $message->mail;
@@ -77,15 +86,19 @@ sub _add_headers_to($self,$message) {
 
     # if nobody declared a "post" address, let's guess it's the same
     # as the address we send from
-    $addresses->{post} //= $return_path;
+    if (not exists $addresses->{post}) {
+        $self->_set_header( $mail, post => $return_path );
+    }
+    # but if they explicitly set a false value, this list does not
+    # allow posting, so we need to set the special value 'NO'
+    elsif (not $addresses->{post}) {
+        delete $addresses->{post};
+        $mail->header_raw_set('List-Post','NO');
+    }
+    # otherwise we can treat 'post' as normal
 
     for my $name (sort keys $addresses->%*) {
-        my $header_name = 'List-' . ucfirst($name =~ s{[^[:alnum:]]+}{-}gr);
-        my @items = $self->_normalise_address($addresses->{$name});
-
-        $mail->header_raw_set(
-            $header_name => join ', ', map { $_->as_header_raw } @items,
-        );
+        $self->_set_header( $mail, $name => $addresses->{$name} );
     }
     return;
 }
diff --git a/t/tests/sietima/role/headers.t b/t/tests/sietima/role/headers.t
index eb96dd2..6dcfff3 100644
--- a/t/tests/sietima/role/headers.t
+++ b/t/tests/sietima/role/headers.t
@@ -17,17 +17,30 @@ package Sietima::Role::ForTesting {
     };
 };
 
-my $s = make_sietima(
-    with_traits => ['Headers','WithOwner','ForTesting'],
-    name => 'test-list',
-    owner => 'owner@example.com',
-    subscribers => [
-        'one@users.example.com',
-        'two@users.example.com',
-    ],
-);
+package Sietima::Role::ForTesting2 {
+    use Moo::Role;
+    use Sietima::Policy;
+    use Sietima::Types qw(AddressFromStr);
+
+    around list_addresses => sub($orig,$self) {
+        return {
+            $self->$orig->%*,
+            post => 0,
+        };
+    };
+};
 
 subtest 'list headers should be added' => sub {
+    my $s = make_sietima(
+        with_traits => ['Headers','WithOwner','ForTesting'],
+        name => 'test-list',
+        owner => 'owner@example.com',
+        subscribers => [
+            'one@users.example.com',
+            'two@users.example.com',
+        ],
+    );
+
     test_sending(
         sietima => $s,
         mails => [
@@ -55,4 +68,29 @@ subtest 'list headers should be added' => sub {
     );
 };
 
+subtest 'no-post list' => sub {
+    my $s = make_sietima(
+        with_traits => ['Headers','WithOwner','ForTesting2'],
+        name => 'test-list',
+        owner => 'owner@example.com',
+        subscribers => [
+            'one@users.example.com',
+            'two@users.example.com',
+        ],
+    );
+
+    test_sending(
+        sietima => $s,
+        mails => [
+            object {
+                call sub { +{ shift->header_raw_pairs } } => hash {
+                    field 'List-Post' => 'NO';
+
+                    etc;
+                };
+            },
+        ],
+    );
+};
+
 done_testing;
-- 
cgit v1.2.3