File Coverage

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

Criterion	Covered	Total	%
statement	62	63	98.4
branch	19	26	73.0
condition	10	12	83.3
subroutine	10	10	100.0
pod	1	2	50.0
total	102	113	90.2

package Mail::ListDetector::Detector::ListSTAR;

use strict;
use warnings;

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

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

sub DEBUG { 0 }

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

	my $x_listserver = Email::Abstract->get_header($message, 'X-Listserver');
	my $x_list_software = Email::Abstract->get_header($message, 'X-List-Software');
	my $list_software = Email::Abstract->get_header($message, 'List-Software');
	my $listsoftware;
	if (defined($x_listserver) && ($x_listserver =~ m/(ListSTAR v[\w\.]+)/)) {
		$listsoftware = $1;
	} elsif (defined($list_software) && ($list_software =~ m/(ListSTAR v[\w\.]+)/)) {
		$listsoftware = $1;
	} elsif (defined($x_list_software) && ($x_list_software =~ m/(ListSTAR v[\w\.]+)/)) {
		$listsoftware = $1;
	} else {
		return undef;
	}

	my $listname;
	my $sender = Email::Abstract->get_header($message, 'Sender');
	if (defined($sender) && ($sender =~ m/<(.*)@.*>/)) {
		$listname = $1;
	}

	my $rfc2369 = new Mail::ListDetector::Detector::RFC2369
	my $list;
	unless ($list = $rfc2369->match($message)) {
		my $x_list_subscribe = Email::Abstract->get_header($message, 'X-List-Subscribe');

		return undef unless defined($x_list_subscribe);
		chomp $x_list_subscribe;
		return undef unless $x_list_subscribe =~ m/(<.*>)/;
		my $list_uri = new URI($1);
		return undef unless defined $list_uri;
		if ($list_uri->scheme ne 'mailto') {
			return undef;
		}
		my $posting_address = $list_uri->to;
		my $listname;
		if($posting_address =~ m/^(.*)@.*$/) {
			$listname = $1;
		}

		$list = new Mail::ListDetector::List;
		$list->listname($listname);
		$list->posting_address($posting_address);
	}

	if (defined($listname)) {
		$list->listname($listname);
	}

	$list->listsoftware($listsoftware);
	return $list;
}

1;

__END__