src/PMG/RuleDB/Domain.pm

   1 package PMG::RuleDB::Domain;
   2
   3 use strict;
   4 use warnings;
   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
  19 sub new {
  20     my ($type, $address, $ogroup) = @_;
  21
  22     my $class = ref($type) || $type;
  23
  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
  34     my @parts = split('@', $addr);
  35
  36     return undef if scalar(@parts) < 2;
  37
  38     my $domain = $parts[-1]; # last element
  39     return lc $domain eq lc $self->{address};
  40 }
  41
  42 sub short_desc {
  43     my $self = shift;
  44
  45     my $desc = $self->{address};
  46
  47     return $desc;
  48 }
  49
  50 sub properties {
  51     my ($class) = @_;
  52
  53     return {
  54         domain => {
  55             description => "DNS domain name (Sender).",
  56             type => 'string', format => 'dns-name',
  57         },
  58     };
  59 }
  60
  61 sub get {
  62     my ($self) = @_;
  63
  64     return { domain => $self->{address} };
  65 }
  66
  67 sub update {
  68     my ($self, $param) = @_;
  69
  70     $self->{address} = $param->{domain};
  71 }
  72
  73 1;
  74 __END__
  75
  76 =head1 PMG::RuleDB::Domain
  77
  78 A WHO object to check email domains.
  79
  80 =head2 Attributes
  81
  82 =head3 address
  83
  84 An Email domain. We use case insensitive compares.
  85
  86 =head2 Examples
  87
  88     $obj = PMG::RuleDB::Domain->new ('yourdomain.com');