Mail::ListDetector::Detector::Listar - Listar message detector

Mail-ListDetector documentation Contained in the Mail-ListDetector distribution.

Index

Code Index:

NAME

Top

Mail::ListDetector::Detector::Listar - Listar message detector

SYNOPSIS

Top

  use Mail::ListDetector::Detector::Listar;

DESCRIPTION

Top

An implementation of a mailing list detector, for Listar.

Listar can be configured for rfc2369 compliance, however often this is not done. If an Listar list is configured to be rfc2369 compliant then it will be recognized by that detector instead.

METHODS

Top

new()

Inherited from Mail::ListDetector::Detector::Base.

match()

Accepts a Mail::Internet object and returns either a Mail::ListDetector::List object if it is a post to a listar mailing list, or undef.

BUGS

Top

None known.

AUTHOR

Top

Michael Stevens - michael@etla.org.

Mail-ListDetector documentation Contained in the Mail-ListDetector distribution. 
package Mail::ListDetector::Detector::Listar;

use strict;
use warnings;

use base qw(Mail::ListDetector::Detector::Base);
use Mail::ListDetector::List;
use Email::Valid;
use Carp;

sub DEBUG { 0 }

sub match {
  my $self = shift;
  my $message = shift;
  print "Got message $message\n" if DEBUG;
  carp ("Mail::ListDetector::Detector::Listar - no message supplied") unless defined($message);
  use Email::Abstract;
  my @senders = Email::Abstract->get_header($message, 'Sender');
  my $list;
  foreach my $sender (@senders) {
    chomp $sender;

    ($list) = ($sender =~ /^owner-(\S+)$/);
    if (!(defined $list)) {
      print "Sender didn't match owner-, trying -owner\n" if DEBUG;
      if ($sender =~  /^(\S+?)-owner/) {
        print "Sender matched -owner, removing\n" if DEBUG;
        $list = $sender;
        $list =~ s/-owner@/@/;
      } else {
        print "Sender didn't match second owner form\n" if DEBUG;
        if ($sender =~ /^(\S+?)-bounce/) {
          print "Sender matched -bounce, removing\n" if DEBUG;
          $list = $sender;
          $list =~ s/-bounce@/@/;
        } else {
          print "Sender didn't match bounce form\n" if DEBUG;
        }
      }
    }
    last if defined $list;
  }

  return unless defined $list;
  chomp $list;
  print "Got list [$list]\n" if DEBUG;
  return unless Email::Valid->address($list);
  print "List is valid email\n" if DEBUG;

  # get listar version
  my $lv = Email::Abstract->get_header($message, 'X-listar-version');
  return undef unless defined $lv;
  chomp $lv;
  my $listname = Email::Abstract->get_header($message, 'X-list');
  return undef unless defined $listname;
  chomp $listname;
  my $l = new Mail::ListDetector::List;
  $l->listsoftware($lv);
  $l->posting_address($list);
  $l->listname($listname);
  return $l;
}

1;

__END__