File Coverage

blib/lib/Mail/ListDetector/Detector/RFC2919.pm
Criterion Covered Total %
statement 38 38 100.0
branch 5 8 62.5
condition 2 3 66.6
subroutine 10 10 100.0
pod 1 2 50.0
total 56 61 91.8


line stmt bran cond sub pod time code
1             package Mail::ListDetector::Detector::RFC2919;
2              
3 39     39   221 use strict;
  39         71  
  39         1380  
4 39     39   215 use warnings;
  39         75  
  39         1142  
5              
6 39     39   199 use base qw(Mail::ListDetector::Detector::Base);
  39         68  
  39         3159  
7 39     39   227 use Mail::ListDetector::List;
  39         71  
  39         930  
8 39     39   25426 use Mail::ListDetector::Detector::RFC2369;
  39         117  
  39         1268  
9 39     39   225 use URI;
  39         70  
  39         679  
10 39     39   268 use Carp;
  39         73  
  39         22509  
11              
12 35     35 0 318 sub DEBUG { 0 }
13              
14             sub match {
15 35     35 1 94 my $self = shift;
16 35         78 my $message = shift;
17 35 50       853 print "Got message $message\n" if DEBUG;
18 35 50       166 carp ("Mail::ListDetector::Detector::RFC2919 - no message supplied") unless defined($message);
19 39     39   247 use Email::Abstract;
  39         68  
  39         6387  
20              
21 35         345 my $list_id = Email::Abstract->get_header($message, 'List-ID');
22 35 100       3860 return undef unless defined($list_id);
23 5 50       38 $list_id =~ m/<(.+)>/ or return undef;
24 5         15 my $listname = $1;
25            
26 5         53 my $rfc2369 = new Mail::ListDetector::Detector::RFC2369;
27 5   66     39 my $list = ( $rfc2369->match($message) or new Mail::ListDetector::List );
28              
29 5         24 $list->listsoftware('RFC2919');
30 5         28 $list->listname($listname);
31              
32 5         89 return $list;
33             }
34              
35             1;
36              
37             __END__