From: The List Server Administrator at UNH (currently Bill Costa) NOTES from Author: For your dining pleasure, another silly little Perl script. This one creates a report looking at subscriber addresses by domain. The report looks something like this: % qnd-domain-profile ~/lists/SOME.LIST/.subscribers 1 nortel.ca 1 hrcu.org : : 2 hotmail.com 15 aol.com 1 banta-im.com : : 1 cbl.cees.edu 1 polymail.calpoly.edu -------- 87 Total Subscribers Tested using V7 of ListProc. - - - - - - - - - - - - - - - - - - cut here - - - - - - - 8< - - - - - - #!/usr/local/bin/perl -w # # File: qnd-domain-profile # Usage: qnd-domain-profile $LPDIR/lists/*/.subscribers [ | sort -r ] # # Abstract: A quick-n-dirty (qnd) program to show subscriber # profiles by domain. # # Author: Bill.Costa@unh.edu, UNH Computing & Information Services # Date: 11-FEB-1999 # Version: 1.000 # # Bugs and # Limitations: Very simple minded, no real error checking of any kind. # Does a very lazy sort of the domain names, not really # correct, but they do bunch up the way I want. # # Revision History # ------------------------------------------------------------------------ # 11-FEB-1999 WFC Initial creation. # #============================================================================== #-------------------------------+ # Environment Settings/Tests | #-------------------------------+ use strict; # to help us keep things squeaky clean. #-------------------------------+ # Main Line Vars | #-------------------------------+ my $sub; # A subscriber address. my %counts = (); # Count of subscribers keyed by domain. my $domain; # One of the domains in question. my $tmp; # A temp string. my $total; # Total subscribers counted. #============================================================================= # Main Line ================================================================ #============================================================================= #-------------------------------+ # Suck in and parse standard | # input. | #-------------------------------+ while (<>) { $sub = (split(/ /,$_,2))[0]; # Get just the address. $sub =~ s/<(.+?)>.*/$1/; # Extract "addr" from "" format. if ($sub =~ /.+?\@(.+)/) # Extract domain into $1. { $counts{lc(reverse($1))}++; # Reverse domain for sorting purposes } else { warn("ignored: $sub\n"); } } #-------------------------------+ # Now dump it by domain, with | # the domain name set right. | #-------------------------------+ $total = 0; foreach $domain (sort keys(%counts)) { $tmp = $domain; $tmp = reverse($tmp); printf("%8d\t%40s\n", $counts{$domain}, $tmp); $total += $counts{$domain}; } printf("%8s\n%8d\t%40s\n", "-" x 8, $total, "Total Subscribers"); #==============================================================================