::Subscriber now supports aliases

and has a ->match method

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;