1package Mail::ListDetector::Detector::RFC2369; 2 3use strict; 4use warnings; 5use base qw(Mail::ListDetector::Detector::Base); 6use Mail::ListDetector::List; 7use URI; 8use Carp; 9 10sub DEBUG { 0 } 11 12sub match { 13 my $self = shift; 14 my $message = shift; 15 print "Got message $message\n" if DEBUG; 16 carp ("Mail::ListDetector::Detector::RFC2369 - no message supplied") unless defined($message); 17 use Email::Abstract; 18 19 my $posting_uri = Email::Abstract->get_header($message, 'List-Post'); 20 return undef unless defined($posting_uri); 21 chomp $posting_uri; 22 return undef unless $posting_uri =~ m/(<.*>)/; 23 my $posting_u = new URI($1); 24 return undef unless defined $posting_u; 25 if ($posting_u->scheme ne 'mailto') { 26 return undef; 27 } 28 my $posting_email = $posting_u->to; 29 my $software = 'RFC2369'; 30 my ($listname) = ($posting_email =~ /^([^@]+)@/); 31 my $list = new Mail::ListDetector::List; 32 $list->listsoftware($software); 33 $list->posting_address($posting_email); 34 $list->listname($listname); 35 return $list; 36 37} 38 391; 40 41__END__ 42 43=pod 44 45=head1 NAME 46 47Mail::ListDetector::Detector::RFC2369 - RFC2369 message detector 48 49=head1 SYNOPSIS 50 51 use Mail::ListDetector::Detector::RFC2369; 52 53=head1 DESCRIPTION 54 55An implementation of a mailing list detector, for RFC2369 compliant 56mailing lists. 57 58=head1 METHODS 59 60=head2 new() 61 62Inherited from Mail::ListDetector::Detector::Base. 63 64=head2 match() 65 66Accepts a Mail::Internet object and returns either a 67Mail::ListDetector::List object if it is a post to a RFC2369 compliant 68mailing list, or C<undef>. 69 70The RFC2369 standard does not REQUIRE all the information we wish to 71extract to be present - therefore this module may not be able to 72return full information for all RFC2369 compliant lists. 73 74=head1 BUGS 75 76No known bugs. 77 78=head1 AUTHOR 79 80Michael Stevens - michael@etla.org. 81 82=cut 83 84