]>
Commit | Line | Data |
---|---|---|
0a580593 DM |
1 | package PMG::RuleDB::Domain; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
0a580593 DM |
5 | use DBI; |
6 | ||
7 | use PMG::RuleDB::WhoRegex; | |
8 | ||
9 | use base qw(PMG::RuleDB::WhoRegex); | |
10 | ||
11 | sub otype { | |
12 | return 1002; | |
13 | } | |
14 | ||
15 | sub otype_text { | |
16 | return 'Domain'; | |
17 | } | |
18 | ||
0a580593 DM |
19 | sub new { |
20 | my ($type, $address, $ogroup) = @_; | |
693cf3b6 | 21 | |
0a580593 | 22 | my $class = ref($type) || $type; |
693cf3b6 | 23 | |
0a580593 DM |
24 | $address //= 'domain.tld'; |
25 | ||
26 | my $self = $class->SUPER::new($address, $ogroup); | |
27 | ||
28 | return $self; | |
29 | } | |
30 | ||
31 | sub who_match { | |
32 | my ($self, $addr) = @_; | |
33 | ||
693cf3b6 | 34 | $addr =~ m/^.+@(.+)$/; |
0a580593 | 35 | |
740736f4 DM |
36 | return undef if !defined($1); |
37 | ||
0a580593 DM |
38 | return (lc ($1) eq lc ($self->address)); |
39 | } | |
40 | ||
41 | sub short_desc { | |
42 | my $self = shift; | |
693cf3b6 | 43 | |
0a580593 | 44 | my $desc = $self->{address}; |
693cf3b6 | 45 | |
0a580593 DM |
46 | return $desc; |
47 | } | |
48 | ||
693cf3b6 DM |
49 | sub properties { |
50 | my ($class) = @_; | |
0a580593 | 51 | |
693cf3b6 DM |
52 | return { |
53 | domain => { | |
54 | description => "DNS domain name (Sender).", | |
55 | type => 'string', format => 'dns-name', | |
56 | }, | |
57 | }; | |
58 | } | |
59 | ||
ceb63d16 DM |
60 | sub get { |
61 | my ($self) = @_; | |
62 | ||
63 | return { domain => $self->{address} }; | |
64 | } | |
65 | ||
693cf3b6 DM |
66 | sub update { |
67 | my ($self, $param) = @_; | |
68 | ||
69 | $self->{address} = $param->{domain}; | |
70 | } | |
0a580593 DM |
71 | |
72 | 1; | |
73 | __END__ | |
74 | ||
75 | =head1 PMG::RuleDB::Domain | |
76 | ||
77 | A WHO object to check email domains. | |
78 | ||
79 | =head2 Attribues | |
80 | ||
81 | =head3 address | |
82 | ||
83 | An Email domain. We use case insensitive compares. | |
84 | ||
85 | =head2 Examples | |
86 | ||
87 | $obj = PMG::RuleDB::Domain->new ('yourdomain.com'); |