1 files changed, 96 insertions, 0 deletions
diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm
new file mode 100644
index 0000000..ff93076
--- /dev/null
+++ b/lib/Sietima/Role/SubscriberOnly.pm
@@ -0,0 +1,96 @@
+package Sietima::Role::SubscriberOnly;
+use Moo::Role;
+use Sietima::Policy;
+use Email::Address;
+use List::AllUtils qw(any);
+use Types::Standard qw(Object CodeRef);
+use Type::Params qw(compile);
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Role::SubscriberOnly - base role for "closed" lists
+
+=head1 SYNOPSIS
+
+  package Sietima::Role::SubscriberOnly::MyPolicy;
+  use Moo::Role;
+  use Sietima::Policy;
+
+  sub munge_mail_from_non_subscriber($self,$mail) { ... }
+
+=head1 DESCRIPTION
+
+This is a base role; in other words, it's not useable directly.
+
+This role should be used when defining policies for "closed" lists:
+lists that accept messages from subscribers, but do something special
+with messages from non-subscribers.
+
+See L<< C<Sietima::Role::SubscriberOnly::Drop> >> and L<<
+C<Sietima::Role::SubscriberOnly::Moderate> >> for useable roles.
+
+=head1 REQUIRED METHODS
+
+=head2 C<munge_mail_from_non_subscriber>
+
+  sub munge_mail_from_non_subscriber($self,$mail) { ... }
+
+This method will be invoked from L<< C<munge_mail>|Sietima/munge_mail
+>> whenever an email is processed that does not come from one of the
+list's subscribers. This method should return a (possibly empty) list
+of L<< C<Sietima::Message> >> objects, just like C<munge_mail>. It can
+also have side-effects, like forwarding the email to the owner of the
+list.
+
+=cut
+
+requires 'munge_mail_from_non_subscriber';
+
+our $let_it_pass=0;
+
+=head1 MODIFIED METHODS
+
+=head2 C<munge_mail>
+
+If the incoming email's C<From:> header contains an address that
+L<matches|Sietima::Subscriber/match> any of the subscribers, the email
+is processed normally. Otherwise, L<<
+/C<munge_mail_from_non_subscriber> >> is invoked.
+
+=cut
+
+around munge_mail => sub ($orig,$self,$mail) {
+    my ($from) = Email::Address->parse( $mail->header_str('from') );
+    if ( $let_it_pass or
+             any { $_->match($from) } $self->subscribers->@* ) {
+        $self->$orig($mail);
+    }
+    else {
+        $self->munge_mail_from_non_subscriber($mail);
+    }
+};
+
+=head1 METHODS
+
+=head2 C<ignoring_subscriberonly>
+
+  $sietima->ignoring_subscriberonly(sub($s) {
+    $s->handle_mail($mail);
+  });
+
+This method provides a way to run Sietima ignoring the "subscriber
+only" beaviour. Your coderef will be passed a Sietima object that will
+behave exactly as the invocant of this method, minus this role's
+modifications.
+
+=cut
+
+sub ignoring_subscriberonly($self,$code) {
+    state $check = compile(Object,CodeRef); $check->(@_);
+
+    local $let_it_pass = 1;
+    return $code->($self);
+}
+
+1;