diff options
| -rw-r--r-- | lib/Sietima/Role/SubscriberOnly.pm | 6 | ||||
| -rw-r--r-- | lib/Sietima/Subscriber.pm | 24 | ||||
| -rw-r--r-- | t/tests/sietima/subscriber.t | 46 |
3 files changed, 58 insertions, 18 deletions
diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm index 98c02a6..644f2ef 100644 --- a/lib/Sietima/Role/SubscriberOnly.pm +++ b/lib/Sietima/Role/SubscriberOnly.pm @@ -11,11 +11,9 @@ our $let_it_pass=0; around munge_mail => sub { my ($orig,$self,$mail) = @_; - my $from = (Email::Address->parse( - $mail->header_str('from'), - ))[0]->address; + my ($from) = Email::Address->parse( $mail->header_str('from') ); if ( $let_it_pass or - any { $_->address eq $from } @{$self->subscribers} ) { + any { $_->match($from) } @{$self->subscribers} ) { $self->$orig($mail); } else { diff --git a/lib/Sietima/Subscriber.pm b/lib/Sietima/Subscriber.pm index 9954ffb..c223343 100644 --- a/lib/Sietima/Subscriber.pm +++ b/lib/Sietima/Subscriber.pm @@ -1,9 +1,11 @@ package Sietima::Subscriber; use 5.020; use Moo; -use Types::Standard qw(HashRef); +use Types::Standard qw(ArrayRef HashRef Object); +use Type::Params qw(compile); use Sietima::Types qw(Address AddressFromStr); use Email::Address; +use List::AllUtils qw(any); use namespace::clean; has raw_address => ( @@ -14,10 +16,30 @@ has raw_address => ( handles => [qw(address name original)], ); +my $address_array = ArrayRef[ + Address->plus_coercions( + AddressFromStr + ) +]; +has aliases => ( + isa => $address_array, + is => 'lazy', + coerce => $address_array->coercion, +); +sub _build_aliases { +[] } + has prefs => ( isa => HashRef, is => 'ro', default => sub { +{} }, ); +sub match { + state $check = compile(Object,Address->plus_coercions(AddressFromStr)); + my ($self,$addr) = $check->(@_); + + return any { $addr->address eq $_->address } + $self->raw_address, @{$self->aliases}; +} + 1; diff --git a/t/tests/sietima/subscriber.t b/t/tests/sietima/subscriber.t index 1f4c608..5a06bba 100644 --- a/t/tests/sietima/subscriber.t +++ b/t/tests/sietima/subscriber.t @@ -6,19 +6,39 @@ use Test2::Bundle::Extended; use Test2::Plugin::DieOnFail; use Sietima::Subscriber; -my $s = Sietima::Subscriber->new( - raw_address => 'Gino (pino) <gino@pino.example.com>', -); +subtest 'simple' => sub { + my $s = Sietima::Subscriber->new( + raw_address => 'Gino (pino) <gino@pino.example.com>', + ); -is( - $s, - object { - call address => 'gino@pino.example.com'; - call name => 'Gino'; - call original => 'Gino (pino) <gino@pino.example.com>'; - call prefs => {}; - }, - 'construction and delegation should work', -); + is( + $s, + object { + call address => 'gino@pino.example.com'; + call name => 'Gino'; + call original => 'Gino (pino) <gino@pino.example.com>'; + call prefs => {}; + }, + 'construction and delegation should work', + ); +}; + +subtest 'aliases' => sub { + my $s = Sietima::Subscriber->new( + raw_address => 'Gino (pino) <gino@pino.example.com>', + aliases => [qw(also-gino@pino.example.com maybe-gino@rino.example.com)], + ); + + is( + $s, + object { + for my $a (qw(gino@pino also-gino@pino maybe-gino@rino)) { + call [match => "${a}.example.com"] => T(); + } + }, + 'all addresses should ->match()', + ); + +}; done_testing; |