line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sietima::Role::SubscriberOnly; |
2
|
3
|
|
|
3
|
|
1323
|
use Moo::Role; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
14
|
|
3
|
3
|
|
|
3
|
|
770
|
use Sietima::Policy; |
|
3
|
|
|
|
|
16
|
|
|
3
|
|
|
|
|
16
|
|
4
|
3
|
|
|
3
|
|
17
|
use Email::Address; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
86
|
|
5
|
3
|
|
|
3
|
|
14
|
use List::AllUtils qw(any); |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
150
|
|
6
|
3
|
|
|
3
|
|
15
|
use Types::Standard qw(Object CodeRef); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
43
|
|
7
|
3
|
|
|
3
|
|
2716
|
use Type::Params qw(compile); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
21
|
|
8
|
3
|
|
|
3
|
|
553
|
use namespace::clean; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
14
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our $VERSION = '1.0.5'; # VERSION |
11
|
|
|
|
|
|
|
# ABSTRACT: base role for "closed" lists |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
requires 'munge_mail_from_non_subscriber'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $let_it_pass=0; ## no critic(ProhibitPackageVars) |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
around munge_mail => sub ($orig,$self,$mail) { |
20
|
|
|
|
|
|
|
my ($from) = Email::Address->parse( $mail->header_str('from') ); |
21
|
|
|
|
|
|
|
if ( $let_it_pass or |
22
|
|
|
|
|
|
|
any { $_->match($from) } $self->subscribers->@* ) { |
23
|
|
|
|
|
|
|
$self->$orig($mail); |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
else { |
26
|
|
|
|
|
|
|
$self->munge_mail_from_non_subscriber($mail); |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
}; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
3
|
|
|
3
|
1
|
8
|
sub ignoring_subscriberonly($self,$code) { |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
3
|
|
32
|
3
|
|
|
|
|
14
|
state $check = compile(Object,CodeRef); $check->(@_); |
|
3
|
|
|
|
|
2162
|
|
33
|
|
|
|
|
|
|
|
34
|
3
|
|
|
|
|
33
|
local $let_it_pass = 1; |
35
|
3
|
|
|
|
|
10
|
return $code->($self); |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
1; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
__END__ |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=pod |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=encoding UTF-8 |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 NAME |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Sietima::Role::SubscriberOnly - base role for "closed" lists |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 VERSION |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
version 1.0.5 |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 SYNOPSIS |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
package Sietima::Role::SubscriberOnly::MyPolicy; |
57
|
|
|
|
|
|
|
use Moo::Role; |
58
|
|
|
|
|
|
|
use Sietima::Policy; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub munge_mail_from_non_subscriber($self,$mail) { ... } |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 DESCRIPTION |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
This is a base role; in other words, it's not useable directly. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
This role should be used when defining policies for "closed" lists: |
67
|
|
|
|
|
|
|
lists that accept messages from subscribers, but do something special |
68
|
|
|
|
|
|
|
with messages from non-subscribers. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
See L<< C<Sietima::Role::SubscriberOnly::Drop> >> and L<< |
71
|
|
|
|
|
|
|
C<Sietima::Role::SubscriberOnly::Moderate> >> for useable roles. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head1 REQUIRED METHODS |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 C<munge_mail_from_non_subscriber> |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub munge_mail_from_non_subscriber($self,$mail) { ... } |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
This method will be invoked from L<< C<munge_mail>|Sietima/munge_mail |
80
|
|
|
|
|
|
|
>> whenever an email is processed that does not come from one of the |
81
|
|
|
|
|
|
|
list's subscribers. This method should return a (possibly empty) list |
82
|
|
|
|
|
|
|
of L<< C<Sietima::Message> >> objects, just like C<munge_mail>. It can |
83
|
|
|
|
|
|
|
also have side-effects, like forwarding the email to the owner of the |
84
|
|
|
|
|
|
|
list. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=head1 METHODS |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head2 C<ignoring_subscriberonly> |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
$sietima->ignoring_subscriberonly(sub($s) { |
91
|
|
|
|
|
|
|
$s->handle_mail($mail); |
92
|
|
|
|
|
|
|
}); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
This method provides a way to run Sietima ignoring the "subscriber |
95
|
|
|
|
|
|
|
only" beaviour. Your coderef will be passed a Sietima object that will |
96
|
|
|
|
|
|
|
behave exactly as the invocant of this method, minus this role's |
97
|
|
|
|
|
|
|
modifications. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head1 MODIFIED METHODS |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head2 C<munge_mail> |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
If the incoming email's C<From:> header contains an address that |
104
|
|
|
|
|
|
|
L<matches|Sietima::Subscriber/match> any of the subscribers, the email |
105
|
|
|
|
|
|
|
is processed normally. Otherwise, L<< |
106
|
|
|
|
|
|
|
/C<munge_mail_from_non_subscriber> >> is invoked. |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head1 AUTHOR |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Gianni Ceccarelli <dakkar@thenautilus.net> |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
117
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |