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