Skip to content

Instantly share code, notes, and snippets.

@dpk dpk/allcaps.pl
Last active Sep 23, 2015

Embed
What would you like to do?
A smarter way to all-caps a string.
#!/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;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.