diff options
Diffstat (limited to 'lib/Sietima/Role/SubscriberOnly.pm')
-rw-r--r-- | lib/Sietima/Role/SubscriberOnly.pm | 98 |
1 files changed, 64 insertions, 34 deletions
diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm index 6524d39..41002f3 100644 --- a/lib/Sietima/Role/SubscriberOnly.pm +++ b/lib/Sietima/Role/SubscriberOnly.pm @@ -7,9 +7,50 @@ use Types::Standard qw(Object CodeRef); use Type::Params qw(compile); use namespace::clean; -# VERSION +our $VERSION = '1.0.5'; # VERSION # ABSTRACT: base role for "closed" lists + +requires 'munge_mail_from_non_subscriber'; + +our $let_it_pass=0; ## no critic(ProhibitPackageVars) + + +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); + } +}; + + +sub ignoring_subscriberonly($self,$code) { + state $check = compile(Object,CodeRef); $check->(@_); + + local $let_it_pass = 1; + return $code->($self); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::SubscriberOnly - base role for "closed" lists + +=head1 VERSION + +version 1.0.5 + =head1 SYNOPSIS package Sietima::Role::SubscriberOnly::MyPolicy; @@ -29,7 +70,9 @@ with messages from non-subscribers. See L<< C<Sietima::Role::SubscriberOnly::Drop> >> and L<< C<Sietima::Role::SubscriberOnly::Moderate> >> for useable roles. -=require C<munge_mail_from_non_subscriber> +=head1 REQUIRED METHODS + +=head2 C<munge_mail_from_non_subscriber> sub munge_mail_from_non_subscriber($self,$mail) { ... } @@ -40,50 +83,37 @@ 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 +=head1 METHODS -requires 'munge_mail_from_non_subscriber'; +=head2 C<ignoring_subscriberonly> -our $let_it_pass=0; ## no critic(ProhibitPackageVars) + $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. + +=head1 MODIFIED METHODS -=modif C<munge_mail> +=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 +=head1 AUTHOR -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); - } -}; +Gianni Ceccarelli <dakkar@thenautilus.net> -=method C<ignoring_subscriberonly> +=head1 COPYRIGHT AND LICENSE - $sietima->ignoring_subscriberonly(sub($s) { - $s->handle_mail($mail); - }); +This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. -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. +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. =cut - -sub ignoring_subscriberonly($self,$code) { - state $check = compile(Object,CodeRef); $check->(@_); - - local $let_it_pass = 1; - return $code->($self); -} - -1; |