#!/usr/athena/bin/perl

#Set these two variables to be what you need.

#$mail folder is the directory to scan through
$mail_folder = "inbox" unless $mail_folder = $ARGV[0];

#$output_file is the name of the file to output the mailing list into
$output_file = "mailing_list.txt";

foreach $file (<$mail_folder/*>)
{
    open (MAIL_FILE, $file) || next;
    $got_name = 0;
    while (($current_line = <MAIL_FILE>) && ($got_name == 0))
    {
	if ($current_line =~ /^From:/)
	{
	    $current_line =~ /([^\"< \t\n]*@[^ \"\t\n>]*)/;
	    $username = $1;
	    if ($status{$username} eq undef)
	    {
		push (@users, $username);
		$status{$username} = "TRUE";
		$unique_users++;
	    }
	    $got_name = 1;
	}

    }
    close (MAIL_FILE);
}

print "Captured $unique_users email addresses\n";

open (OUTPUT, ">" . $output_file) || die "Could not open $output_file\n";

@users = sort by_domain @users;
foreach $user (@users)
{
    print OUTPUT "$user\n";
    ($name, $location) = split ("@", $user);
    
    $location =~ /([^\.\n \t]*\.)?([^\.\n \t]*\.[^\.\n \t]*)/;
    $location = $2;
    $location =~ tr/A-Z/a-z/;
    if ($location_count{$location} eq undef)
    {
	$unique_locations++;
	$location_count{$location} = 0;
    }
    $location_count{$location}++;
}

close OUTPUT;

print "from $unique_locations different sites\n";

foreach $user (@users)
{
    ($name, $location) = split ("@", $user);
    
    $location =~ /.*\.([^\.\n \t]*)/;
    $location = $1;
    $location =~ tr/A-Z/a-z/;
    if ($general_location_count{$location} eq undef)
    {
	$unique_locations++;
	$general_location_count{$location} = 1;
    }
    $general_location_count{$location}++;
}

print "with the following distribution:\n";

foreach $key (keys %general_location_count)
{
    push (@sites, sprintf ("Site: %-3s  Users: %4d Percentage: %4.1f\n", $key, $general_location_count{$key}, 100 * $general_location_count{$key} / $unique_users));
}

@new_sites = sort by_percent @sites;			       

foreach $site (@new_sites)
{
    print $site;
}

sub by_percent
{
    split (" ", $a);
    @b = split (" ", $b);
    $b[5] <=> $_[5];
}

sub by_domain
{
    @a = split ("@", $a);
    @b = split ("@", $b);
    $a[1] cmp $b[1];
    $a =~ y/A-Z/a-z/; $b =~ y/A-Z/a-z/;
    join('.',reverse(split(/[\.\@]/, $a))) cmp 
	join('.',reverse(split(/[\.\@]/, $b))); 
}