File Coverage

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

Criterion	Covered	Total	%
statement	60	60	100.0
branch	23	34	67.6
condition			n/a
subroutine	9	9	100.0
pod	1	2	50.0
total	93	105	88.5

package Mail::ListDetector::Detector::Listar;

use strict;
use warnings;

use base qw(Mail::ListDetector::Detector::Base);
use Mail::ListDetector::List;
use Email::Valid;
use Carp;

sub DEBUG { 0 }

sub match {
  my $self = shift;
  my $message = shift;
  print "Got message $message\n" if DEBUG;
  carp ("Mail::ListDetector::Detector::Listar - no message supplied") unless defined($message);
  use Email::Abstract;
  my @senders = Email::Abstract->get_header($message, 'Sender');
  my $list;
  foreach my $sender (@senders) {
    chomp $sender;

    ($list) = ($sender =~ /^owner-(\S+)$/);
    if (!(defined $list)) {
      print "Sender didn't match owner-, trying -owner\n" if DEBUG;
      if ($sender =~  /^(\S+?)-owner/) {
        print "Sender matched -owner, removing\n" if DEBUG;
        $list = $sender;
        $list =~ s/-owner@/@/;
      } else {
        print "Sender didn't match second owner form\n" if DEBUG;
        if ($sender =~ /^(\S+?)-bounce/) {
          print "Sender matched -bounce, removing\n" if DEBUG;
          $list = $sender;
          $list =~ s/-bounce@/@/;
        } else {
          print "Sender didn't match bounce form\n" if DEBUG;
        }
      }
    }
    last if defined $list;
  }

  return unless defined $list;
  chomp $list;
  print "Got list [$list]\n" if DEBUG;
  return unless Email::Valid->address($list);
  print "List is valid email\n" if DEBUG;

  # get listar version
  my $lv = Email::Abstract->get_header($message, 'X-listar-version');
  return undef unless defined $lv;
  chomp $lv;
  my $listname = Email::Abstract->get_header($message, 'X-list');
  return undef unless defined $listname;
  chomp $listname;
  my $l = new Mail::ListDetector::List;
  $l->listsoftware($lv);
  $l->posting_address($list);
  $l->listname($listname);
  return $l;
}

1;

__END__