--- /dev/null
+#!/usr/bin/perl
+
+@namefiles = qw(21986na.mes 3897male.nam 4946fema.len);
+
+foreach $f (@namefiles) {
+ open IN, "l/proper-names/$f" or die;
+ while (<IN>) {
+ tr /\r\n//d;
+ my $proper = $_;
+ tr /\'//d;
+ tr /[a-z]/[A-Z]/;
+ next if !/^[A-Z]+$/;
+ $proper{$_} = $proper;
+ }
+}
+
+chdir "r/census";
+
+@files = qw(dist.all.last dist.female.first dist.male.first);
+
+foreach $f (@files) {
+ open IN, $f;
+ open OUT, ">$f.lst";
+ $i = 0;
+ while (<IN>) {
+ if ($i++ == 1000) {
+ open OUT, ">$f-rest.lst";
+ }
+ ($_) = /^(\S+)/;
+ if (exists $proper{$_}) {
+ print OUT "$proper{$_}\n";
+ } else {
+ (s/^MC(.)(.+)/Mc$1\L$2\E/
+ or s/(.)(.+)/$1\L$2\E/);
+ print OUT "$_\n";
+ }
+ }
+ close IN;
+ close OUT;
+ qx"sort $f.lst -o $f.lst";
+ qx"sort $f-rest.lst -o $f-rest.lst";
+}