A smarter way to all-caps a string.

allcaps.pl

#!/usr/bin/perl -w
# A smarter string capitaliser. Everyone knows that in words that start with certain prefixes,
# the prefix should be left in lower- or mixed-case when the word is made 'all-caps.'
# For instance, MacDonald becomes MacDONALD rather than MACDONALD, iPod becomes
# iPOD instead of IPOD, etc. This script attempts to be vaguely clever about doing that while
# also avoiding doing the same with intercapsed or camelcased product names like QuarkXPress.
# The cut-off point was set at four characters because the longest surname prefix that ought
# to be left in mixed-case that I could think of was 'Fitz,' but this causes problems with some
# product names, and they can be listed in @exceptions. Included are MacBook, AirPort, WiFi,
# and PostScript. If you have any other word suggestions, mail them to me at the address on
# http://dpk.org.uk/.
# --------------------------------------------------------------------------------------------
# Consider the algorithm public-domain--it's so simple as not to be worth insisting on attribution.
# But if you do use my implementation, I'd appreciate an attribution, so the code itself is BSD-
# licensed.

use strict;
use utf8;

my @exceptions = qw/macbook airport wifi postscript/;

undef $/;
my $string = <STDIN>;

my @words = split(/\b/, $string);
my $capitalised = "";

foreach (@words) {
  my $word = $_;
  if ($word =~ /^(.{0,4})([[:upper:]].*)$/) { # Up to four characters followed by a capital letter followed by any number of characters.
    my ($whole, $prefix, $main) = ($_, $1, $2);
    if (grep /$whole/i, @exceptions) {
      $prefix = uc($prefix);
    }
    my $ucmain = uc($main);
    $capitalised .= $prefix.$ucmain;
  } else {
    $capitalised .= uc($word);
  }
}

print $capitalised;