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 -sigs; use namespace::clean; # VERSION # ABSTRACT: 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 >> and L<< C >> for useable roles. =require C sub munge_mail_from_non_subscriber($self,$mail) { ... } This method will be invoked from L<< C|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 >> objects, just like C, for example to forward the email to the owner of the list. It can also have side-effects, like storing a copy of the message to approve later. =cut requires 'munge_mail_from_non_subscriber'; our $let_it_pass=0; ## no critic(ProhibitPackageVars) =modif C If the incoming email's C header contains an address that L any of the subscribers, the email is processed normally. Otherwise, L<< /C >> 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); } }; =method C $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 signature_for ignoring_subscriberonly => ( method => Object, positional => [ CodeRef ], ); sub ignoring_subscriberonly($self,$code) { local $let_it_pass = 1; return $code->($self); } 1;