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 (lc ($1) eq lc ($self->address));
  37 }
  38
  39 sub short_desc {
  40     my $self = shift;
  41
  42     my $desc = $self->{address};
  43
  44     return $desc;
  45 }
  46
  47 sub properties {
  48     my ($class) = @_;
  49
  50     return {
  51         domain => {
  52             description => "DNS domain name (Sender).",
  53             type => 'string', format => 'dns-name',
  54         },
  55     };
  56 }
  57
  58 sub get {
  59     my ($self) = @_;
  60
  61     return { domain => $self->{address} };
  62 }
  63
  64 sub update {
  65     my ($self, $param) = @_;
  66
  67     $self->{address} = $param->{domain};
  68 }
  69
  70 1;
  71 __END__
  72
  73 =head1 PMG::RuleDB::Domain
  74
  75 A WHO object to check email domains.
  76
  77 =head2 Attribues
  78
  79 =head3 address
  80
  81 An Email domain. We use case insensitive compares.
  82
  83 =head2 Examples
  84
  85     $obj = PMG::RuleDB::Domain->new ('yourdomain.com');