File Coverage

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

Criterion	Covered	Total	%
statement	54	54	100.0
branch	16	22	72.7
condition	1	3	33.3
subroutine	9	9	100.0
pod	1	2	50.0
total	81	90	90.0

package Mail::ListDetector::Detector::Fml;

use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '0.04';

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

sub DEBUG { 0 }

sub match {
    my($self, $message) = @_;
    print "Got message $message\n" if DEBUG;
    carp ("Mail::ListDetector::Detector::Fml - no message supplied") unless defined($message);
    my $mlserver = Email::Abstract->get_header($message, 'X-MLServer') or return;
    $mlserver =~ /^fml \[(fml [^\]]*)\]/ or return;

    # OK, this is FML message
    my $list = Mail::ListDetector::List->new;
    $list->listsoftware($1);

    my $post;
    if ($post = Email::Abstract->get_header($message, 'List-Post')) {
        chomp($post);
        $post = URI->new($post)->to;
    } elsif ($post = Email::Abstract->get_header($message, 'List-Subscribe')) {
        chomp($post);
        $post = URI->new($post)->to;
        $post =~ s/-ctl\@/\@/;
    } elsif ($post = Email::Abstract->get_header($message, 'X-ML-Info')) {
        chomp($post);
        $post =~ s/\n/ /;
        $post =~ m/(<.*>)/;
        $post = $1;
        $post = URI->new($post)->to;
        $post =~ s/-admin\@/\@/;
    } elsif ($post = Email::Abstract->get_header($message, 'Resent-To')) {
        chomp($post);
        $post =~ m/([\w\d\+\.\-]+@[\w\d\.\-]+)/;
        $post = $1;
    }

    if ($post && Email::Valid->address($post)) {
        $list->posting_address($post);
    }

    my $mlname;
    if ($mlname = Email::Abstract->get_header($message, 'X-ML-Name')) {
        chomp($mlname);
        $list->listname($mlname);
    } elsif ($mlname = $list->posting_address) {
        $mlname =~ s/\@.*$//;
		$list->listname($mlname);
    }


    $list;
}

1;
__END__