Word count, keeping all-caps word forms, with better ordering

wordcount.pl

#!/usr/bin/perl

binmode(STDIN, 'utf8');
binmode(STDOUT, 'utf8');

sub smart_lowercase($)
{
    my $word = shift;
    return $word if (length($word) > 1 and uc($word) eq $word);
    return lc $word;
}

my %counter = ();
foreach (<STDIN>) { foreach (split /[^-\w]+/, $_) { $counter{smart_lowercase $_} += 1; } }

my @ordered = sort { $counter{$b} <=> $counter{$b} || $a <=> $b } keys %counter;
foreach (@ordered) { print "$counter{$_}\t$_\n"; }