File Coverage

blib/lib/Mail/ListDetector/Detector/Ezmlm.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	16	28	57.1
condition	2	3	66.6
subroutine	8	8	100.0
pod	1	2	50.0
total	75	89	84.2

package Mail::ListDetector::Detector::Ezmlm;

use strict;
use warnings;

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

sub DEBUG { 0 }

sub match {
  my $self = shift;
  my $message = shift;
  print "Got message $message\n" if DEBUG;
  carp ("Mail::ListDetector::Detector::Ezmlm - no message supplied") unless defined($message);
  use Email::Abstract;

  print "Getting mailing list header\n" if DEBUG;
  my $mailing_list = Email::Abstract->get_header($message, 'Mailing-List');
  return undef unless defined $mailing_list;
  print "Got header, and isn't null\n" if DEBUG;
  chomp $mailing_list;
  print "Mailing-List is [$mailing_list]\n" if DEBUG;
  my ($help, $listsoftware);
  print "Matching for information\n" if DEBUG;
  ($help, $listsoftware) = ($mailing_list =~ /^contact (\S+?)\; run by (\w+)$/);
  print "Help was [$help], listsoftware was [$listsoftware]\n" if DEBUG;
  if ((defined $listsoftware) and ($listsoftware eq 'ezmlm')) {
    print "List software matched\n" if DEBUG;
    my $list = new Mail::ListDetector::List;
    print "Set listsoftware = [$listsoftware]\n" if DEBUG;
    $list->listsoftware($listsoftware);
    my $posting = $help;
    $posting =~ s/-help\@/\@/;
    DEBUG && print "posting is [$posting]\n";
    $list->posting_address($posting);
    # FIXME: dodgy for unusual addresses.
    my ($listname) = ($posting =~ /^([^@]+)@/);
    $list->listname($listname);
    print "Returning list object\n" if DEBUG;
    return $list;
  } else {
    print "Didn't match, returning\n" if DEBUG;
    return undef;
  }
}

1;

__END__