7.1/src/proc-census

   1 #!/usr/bin/perl
   2
   3 @namefiles = qw(21986na.mes 3897male.nam 4946fema.len);
   4
   5 foreach $f (@namefiles) {
   6     open IN, "l/proper-names/$f" or die;
   7     while (<IN>) {
   8         tr /\r\n//d;
   9         my $proper = $_;
  10         tr /\'//d;
  11         tr /[a-z]/[A-Z]/;
  12         next if !/^[A-Z]+$/;
  13         $proper{$_} = $proper;
  14     }
  15 }
  16
  17 chdir "r/census";
  18
  19 @files = qw(dist.all.last  dist.female.first  dist.male.first);
  20
  21 foreach $f (@files) {
  22     open IN, $f;
  23     open OUT, ">$f.lst";
  24     $i = 0;
  25     while (<IN>) {
  26         if ($i++ == 1000) {
  27             open OUT, ">$f-rest.lst";
  28         }
  29         ($_) = /^(\S+)/;
  30         if (exists $proper{$_}) {
  31             print OUT "$proper{$_}\n";
  32         } else {
  33             (s/^MC(.)(.+)/Mc$1\L$2\E/
  34              or s/(.)(.+)/$1\L$2\E/);
  35             print OUT "$_\n";
  36         }
  37     }
  38     close IN;
  39     close OUT;
  40     qx"sort $f.lst -o $f.lst";
  41     qx"sort $f-rest.lst -o $f-rest.lst";
  42 }