#!/usr/bin/perl -w 
use strict;

my @pat = (
    [ 'queued',			'\|250 Queued', ],
    [ 'badmailfrom',		'550 Mail from .* not accepted here', ],
    [ 'mail-from-temp',		'\|450 Could not resolve ', ],
    [ 'spamcop',		'\|550 Blocked - see http://www.spamcop.net/bl.shtml', ],
    [ 'dsn.rfc-ignorant',	'\|550 Mail from .* rejected because it does not accept bounces. This violates RFC 821/2505/2821 http://www.rfc-ignorant.org/' ],
    [ 'whois',			'\|550 Inaccurate or missing WHOIS data', ],
    [ 'badrcptto',		'\|550 mail to .* not accepted here', ],
    [ 'relay',			'\|550 relaying denied', ],
    [ 'spamassassin',		'\|552 spam score exceeded', ],
    [ 'ordb',			'\|550 This mail was handled by an open relay - please visit <http://ORDB.org/lookup/', ],
    [ 'greylisting',		'\|450 This mail is temporarily denied', ],
    [ 'netcetera',		'\|550 Blocked. Contact spam@netcetera.dk Include this in the subject:' ],
    [ 'klez',			'\|552 Klez Virus Detected', ],
    [ 'no-such-user',		'\|550 no such user', ],
    [ 'early-talker',		'450 Don\'t be rude and talk before I say hello\!', ],
    [ 'queue-error',		'\|451 Unable to queue message', ],
    [ 'spamhaus',		'\|550 http://www.spamhaus.org/SBL/sbl.lasso', ],
    [ 'cbl',			'\|550 http://www.spamhaus.org/xbl/xbl.lasso', ],
    [ 'fqdn-required',		'\|450 FQDN required in the envelope sender', ],
    [ 'badhelo',		'\|550 Uh-huh. You\'re .* and I\'m a boil on the bottom of the Marquess of Queensbury\'s great-aunt.' ],
    [ 'message-too-big',	'\|552 Message too big' ],
    [ 'message-denied',		'\|552 Message denied' ],
    [ 'invalid-receipient',	'\|550 invalid receipient' ],
    [ 'clamav',			'\|552 Virus Found' ],
    [ 'spf',			'\|550 SPF forgery' ],
    [ 'dul',			'\|550 Dynamic IP Address' ],
    [ 'socks',			'\|550 SOCKS Proxy' ],
    [ 'exploit',                '\|550 Exploitable Server' ],
    [ 'web',                    '\|550 HTTP Proxy' ],
    [ 'resident',		'\|550 We don\'t accept mail from residential addresses.' ],
);

my %h;
line: while (<>) {
    for my $pat (@pat) {
	if (/$pat->[1]/) {
	    #print "$_\tmatched $pat->[1] => $pat->[0]\n";
	    $h{$pat->[0]}++;
	    next line;
	}
    }
    $h{OTHER}++;
}

for my $res (sort { $h{$b} <=> $h{$a} } keys %h) {
    print "$res $h{$res}\n";
}