/usr/share/perl5/Mail/ListDetector/Detector/Listbox.pm is in libmail-listdetector-perl 1.03+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | package Mail::ListDetector::Detector::Listbox;
use strict;
use vars qw($VERSION);
$VERSION = '0.02';
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::Listbox - no message supplied") unless defined($message);
use Email::Abstract;
my $posting_address;
my $list_software = Email::Abstract->get_header($message, 'List-Software');
my $list_id = Email::Abstract->get_header($message, 'List-Id');
if(defined($list_software) && ($list_software =~ m/listbox.com v/)) {
unless (defined($list_id) && ($list_id =~ m/<([^\@]+\@[^\@]+)>/)) { return undef; }
$posting_address = $1;
chomp($list_software);
} elsif(defined($list_id) && ($list_id =~ m/<([^\@]+\@v2.listbox.com)>/)) {
$posting_address = $1;
$list_software = 'listbox.com v2.0';
} else {
return undef;
}
my $list = new Mail::ListDetector::List;
$list->listname($posting_address);
$list->listsoftware($list_software);
$list->posting_address($posting_address);
return $list;
}
1;
__END__
=pod
=head1 NAME
Mail::ListDetector::Detector::Listbox - Listbox message detector
=head1 SYNOPSIS
use Mail::ListDetector::Detector::Listbox;
=head1 DESCRIPTION
An implementation of a mailing list detector, for Listbox mailing lists,
Listbox is a commercial list hosting service, see http://www.listbox.com/
for details about Listbox.
Listbox mailing list messages look like RFC2919 messages to the current RFC2919
detector (although they are not compliant) but this module provides more
information and does not test for their full compliance (like a future
RFC2919 module might). For this reason this module must be installed
before the RFC2919 module.
=head1 METHODS
=head2 new()
Inherited from Mail::ListDetector::Detector::Base.
=head2 match()
Accepts a Mail::Internet object and returns either a
Mail::ListDetector::List object if it is a post to a Listbox
mailing list, or C<undef>.
=head1 BUGS
No known bugs.
=head1 NOTES
Thanks to Mark Overmeer <Mark@Overmeer.net> for asking and
Meng Weng Wong <mengwong@pobox.com> for adding the List-Software
header to Listbox mails to make this detector more robust.
=head1 AUTHOR
Matthew Walker - matthew@walker.wattle.id.au,
Michael Stevens - michael@etla.org,
Peter Oliver - p.d.oliver@mavit.freeserve.co.uk.
Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
|