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     $addr =~ m/^.+@(.+)$/;
  35
  36     return undef if !defined($1);
  37
  38     return (lc ($1) eq lc ($self->address));
  39 }
  40
  41 sub short_desc {
  42     my $self = shift;
  43
  44     my $desc = $self->{address};
  45
  46     return $desc;
  47 }
  48
  49 sub properties {
  50     my ($class) = @_;
  51
  52     return {
  53         domain => {
  54             description => "DNS domain name (Sender).",
  55             type => 'string', format => 'dns-name',
  56         },
  57     };
  58 }
  59
  60 sub get {
  61     my ($self) = @_;
  62
  63     return { domain => $self->{address} };
  64 }
  65
  66 sub update {
  67     my ($self, $param) = @_;
  68
  69     $self->{address} = $param->{domain};
  70 }
  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');