diff options
author | dakkar <dakkar@thenautilus.net> | 2017-03-24 16:32:52 +0000 |
---|---|---|
committer | dakkar <dakkar@thenautilus.net> | 2017-03-24 16:32:52 +0000 |
commit | 561dcb678dd6e8520e927365f3737315c0fe0577 (patch) | |
tree | 6788bc69a924a3dd39d080b804776fb681d85457 | |
parent | fix list headers (diff) | |
download | Sietima-561dcb678dd6e8520e927365f3737315c0fe0577.tar.gz Sietima-561dcb678dd6e8520e927365f3737315c0fe0577.tar.bz2 Sietima-561dcb678dd6e8520e927365f3737315c0fe0577.zip |
allow List-Post: NO
-rw-r--r-- | Changes | 1 | ||||
-rw-r--r-- | lib/Sietima/Role/Headers.pm | 27 | ||||
-rw-r--r-- | t/tests/sietima/role/headers.t | 56 |
3 files changed, 68 insertions, 16 deletions
@@ -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; |