File Coverage

blib/lib/Mail/AddressSort.pm

Criterion	Covered	Total	%
statement	6	105	5.7
branch	0	20	0.0
condition	0	9	0.0
subroutine	2	12	16.6
pod	7	7	100.0
total	15	153	9.8

# Mail::AddressSort
# Sorts an array of  email addresses
# for the purpose of expediting delivery of multiple recipients

#
# Package Definition
#

package Mail::AddressSort;

#
# Compiler Directives
#

use strict;

#
# Global Variables
#

use vars qw/$VERSION/;

$VERSION=1.0;

#
# Subroutines
#

# Constructor method
sub new
{
my ($class)=shift;
my ($object);
$object={};
bless ($object);
return($object);
}

# Add addresses to the list
sub input
{
my ($self)=shift;
my ($addr,$parsed);
while (@_)
{
	($addr)=shift;
	$parsed=_sortFmt($addr);
	$self->{list}->{$parsed}=$addr;
}
return();
}

# Return all addresses in one sorted array
sub sorted
{
my ($self)=shift;
my ($key,@array);
foreach $key (sort(keys(%{$self->{list}})))
{
	push(@array,$self->{list}->{$key});
}
return(@array);
}

# Return a count of the number of addresses in the list
sub count
{
my ($self)=shift;
return scalar(keys(%{$self->{list}}));
}

# Return all addresses in an array of arrays limited by a
# maximun number of addresses per array and also by domain if necessary

sub batches
{
my ($self)=shift;
my ($arg,$max,$hostSplit,$count,$batchNum,$host,$lastHost,$address
	,$out,@list,$batches);
while (@_)
{
	($arg)=shift;
	if ($arg eq "-maxRecipients")
	{
		$max=shift;
		print("MaxRecp passed as $max\n");
	} elsif ($arg eq "-byHost")
	{
		$hostSplit=1;
	}
}
if ($max <=0)
{
	my ($num)=$self->count();
	if ($num < 100)
	{
		$max=int($num/5);
		$max++ if ($max ==0);
	} else {
		$max=100;
	}
}
print("MaxRecp set to $max\n");
$max++;
$batches=[];
$count=1;
$batchNum=1;
foreach $address (sort(keys(%{$self->{list}})))
{
	$out=$self->{list}->{$address};
	($host)=split(/\@/,$address);
	$lastHost=$host unless ($lastHost);
	if ($count == $max || ($host ne $lastHost && $hostSplit))
	{
		push(@{$batches},[ @list ]);
		(@list)=();
		$batchNum++;
		$count=1;
	}
	push(@list,$out);
	$count++;
	$lastHost=$host;
}
if (@list)
{
	push(@{$batches},[ @list ]);
}
return($batches);
}

sub printBatches
{
my ($self,$batch,$number)=@_;
my ($sub,$count,$size,$addr);
if ($number)
{
	_printBatch($batch,$number);
} else {
	$count=scalar(@{$batch});
	for ($sub=1;$sub<=$count;$sub++)
	{
		_printBatch($batch,$sub);
	}
}
return;
}

sub printHostCount
{
my ($self)=shift;
my (%report,$host,$domain);
(%report)=$self->_hostCount();
foreach $host (sort(keys(%report)))
{
	$domain=join(".",reverse(split(/\./,$host)));
	printf("%5d %-40s\n",$report{$host},$domain);
}
return;
}

#
# Hidden Subroutines
#

sub _sortFmt
{
my ($addr)=shift;
my ($parsed,$user,$domain,@dp,@rdp);
($user,$domain)=split(/\@/,$addr);
($domain)=lc($domain);
(@dp)=split(/\./,$domain);
$parsed=join(".",reverse(@dp))."\@".$user;
return($parsed);
}

sub _printBatch
{
my ($batch,$number)=@_;
my ($count,$size,$address);
$count=$#$batch;
return undef if ($number < 1 || $ number > $count);
$size=scalar(@{$batch->[$number-1]});
print("Batch $number of $count ($size entries)\n");
foreach $address (@{$batch->[$number-1]})
{
	print("\t$address\n");
}
return;
}

sub _hostCount
{
my ($self)=shift;
my ($entry,$domain,%count);
foreach $entry (keys(%{$self->{list}}))
{
	($domain)=split(/\@/,$entry);
	$count{$domain}++;
}
return(%count);
}

#
# Exit Area
#
1;

__END__