File Coverage

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

Criterion	Covered	Total	%
statement	44	44	100.0
branch	15	24	62.5
condition	2	3	66.6
subroutine	8	8	100.0
pod	1	2	50.0
total	70	81	86.4

package Mail::ListDetector::Detector::Yahoogroups;

use strict;
use warnings;

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::Yahoogroups - no message supplied") unless defined($message);
  use Email::Abstract;
  my $mailing_list = Email::Abstract->get_header($message, 'Mailing-List');
  chomp $mailing_list if defined $mailing_list;
  if ((!defined $mailing_list) or $mailing_list =~ /^\s*$/) {
    print "Returning undef - couldn't find Mailing-List header\n" if DEBUG;
    return undef;
  }
  print "Yahoo! Groups: $mailing_list\n" if DEBUG
  my $list;
  $list = new Mail::ListDetector::List;
  $list->listsoftware("Yahoo! Groups");
  my $listname;
  my $posting_address;
  if ($mailing_list =~ /^\s*list\s+([^@\s]+)@((?:e|yahoo)groups\.(..|com));\s+contact\s+\1-owner@\2$/) {
    print "Mailing-List matches pattern\n" if DEBUG;
    $listname = $1;
    $posting_address = "$1\@$2";
    print "Got listname $listname\n" if DEBUG;
    $list->listname($listname);
    print "Got posting address $posting_address\n" if DEBUG;
    $list->posting_address($posting_address);
  } else {
    print "Mailing-List doesn't match\n" if DEBUG;
    return undef;
  }

  print "Returning object $list\n" if DEBUG;
  return $list;
}

1;

__END__