lib/Sietima/Role/SubscriberOnly.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

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<Sietima::Role::SubscriberOnly::Drop> >> and L<<
C<Sietima::Role::SubscriberOnly::Moderate> >> for useable roles.
 
=require 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; ## no critic(ProhibitPackageVars) 
 
=modif 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);
    }
};
 
=method 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
 
signature_for ignoring_subscriberonly => (
    method => Object,
    positional => [ CodeRef ],
);
sub ignoring_subscriberonly($self,$code) {
    local $let_it_pass = 1;
    return $code->($self);
}
 
1;