diff options
| -rw-r--r-- | lib/Sietima.pm | 4 | ||||
| -rw-r--r-- | lib/Sietima/Role/SubscriberOnly.pm | 23 | ||||
| -rw-r--r-- | lib/Sietima/Role/SubscriberOnly/Drop.pm | 9 | ||||
| -rw-r--r-- | t/tests/sietima/role/subscriberonly/drop.t | 94 |
4 files changed, 130 insertions, 0 deletions
diff --git a/lib/Sietima.pm b/lib/Sietima.pm index 2049d2c..fbf0566 100644 --- a/lib/Sietima.pm +++ b/lib/Sietima.pm @@ -14,6 +14,8 @@ use Email::Sender; use Email::Address; use namespace::clean; +with 'MooX::Traits'; + has return_path => ( isa => Address, is => 'ro', @@ -79,4 +81,6 @@ sub send_message { return; } +sub _trait_namespace { 'Sietima::Role' } + 1; diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm new file mode 100644 index 0000000..4dcb66c --- /dev/null +++ b/lib/Sietima/Role/SubscriberOnly.pm @@ -0,0 +1,23 @@ +package Sietima::Role::SubscriberOnly; +use Moo::Role; +use Email::Address; +use List::AllUtils qw(any); +use namespace::clean; + +requires 'munge_mail_from_non_subscriber'; + +around munge_mail => sub { + my ($orig,$self,$mail) = @_; + + my $from = (Email::Address->parse( + $mail->header_str('from'), + ))[0]->address; + if ( any { $_->address eq $from } @{$self->subscribers} ) { + $self->$orig($mail); + } + else { + $self->munge_mail_from_non_subscriber($mail); + } +}; + +1; diff --git a/lib/Sietima/Role/SubscriberOnly/Drop.pm b/lib/Sietima/Role/SubscriberOnly/Drop.pm new file mode 100644 index 0000000..91354e5 --- /dev/null +++ b/lib/Sietima/Role/SubscriberOnly/Drop.pm @@ -0,0 +1,9 @@ +package Sietima::Role::SubscriberOnly::Drop; +use Moo::Role; +use namespace::clean; + +with 'Sietima::Role::SubscriberOnly'; + +sub munge_mail_from_non_subscriber { } + +1; diff --git a/t/tests/sietima/role/subscriberonly/drop.t b/t/tests/sietima/role/subscriberonly/drop.t new file mode 100644 index 0000000..886acce --- /dev/null +++ b/t/tests/sietima/role/subscriberonly/drop.t @@ -0,0 +1,94 @@ +#!perl +use strict; +use warnings; +use 5.020; +use lib 't/lib'; +use Test2::Bundle::Extended; +use Test2::Tools::MoreCompare qw(bag); +use Test2::Plugin::DieOnFail; +use Email::Stuffer; +use Email::Sender::Transport::Test; +use Data::Printer; +use Sietima; + +my $return_path = 'sietima-test@list.example.com'; +my $transport = Email::Sender::Transport::Test->new; +sub make_sietima { + $transport->clear_deliveries; + Sietima + ->with_traits('SubscriberOnly::Drop') + ->new({ + return_path => $return_path, + transport => $transport, + @_, + }); +} + +sub make_mail { + my (%args) = @_; + Email::Stuffer + ->from($args{from}||'someone@users.example.com') + ->to($args{no}||$return_path) + ->text_body($args{body}||'some simple message') + ->email; +} + +my @subscriber_addresses = ( + 'one@users.example.com', + 'two@users.example.com', +); +my $s = make_sietima( + subscribers => [@subscriber_addresses], +); + +subtest 'from subscriber' => sub { + $transport->clear_deliveries; + my $m = make_mail(from=>'one@users.example.com'); + + ok( + lives { $s->handle_mail($m) }, + 'should handle the mail', + $@, + ); + + my @deliveries = $transport->deliveries; + is( + \@deliveries, + array { + item hash { + field envelope => hash { + field from => $return_path; + field to => bag { + for (@subscriber_addresses) { + item object { call address => $_ }; + } + }; + }; + }; + end(); + }, + 'there should be two deliveries', + np @deliveries, + ); +}; + +subtest 'from non-subscriber' => sub { + $transport->clear_deliveries; + my $m = make_mail(from=>'someone@users.example.com'); + + ok( + lives { $s->handle_mail($m) }, + 'should handle the mail', + $@, + ); + + my @deliveries = $transport->deliveries; + is( + \@deliveries, + [], + 'there should be no deliveries', + np @deliveries, + ); +}; + +done_testing; |