#!/afs/athena/contrib/perl5/p -w
use strict;
use File::Find;
use IO;

### show progress

autoflush STDOUT;
sub mark { print STDOUT @_; }
sub mark_end { print STDOUT "\n"; }

### process a source file

use vars qw( %directive );

sub eat {
  my ($file) = @_;
  my ($cmd, $body, $xbody);
  mark 'r';
  open FILE, $file;
  while (<FILE>) {
    next unless ($cmd, $body) = /^\s*\#\s*(\w*)\s*(.*?)\s*$/;
    s@/\*.*?\*/@@g;
    ($xbody) = /^\s*\#\s*\w*\s*(.*?)\s*$/;
    next if (($cmd eq 'else') || ($cmd eq 'endif')) && !length($xbody);
    $cmd = 'ifdef' if $cmd eq 'ifndef';
    $directive{$cmd}{$xbody}++;
  }
  close FILE;
  mark 'R';
}

sub expel {
  my ($cmd, $map, $body);
  for $cmd (sort keys %directive) {
    mark 'w';
    open EXPEL, "> cpp.$cmd";
    $map = $directive{$cmd};
    for $body (sort {$map->{$b} <=> $map->{$a}} keys %$map) {
      printf EXPEL "%5d %s\n", $map->{$body}, $body;
    }
    close EXPEL;
    mark 'W';
  }
  mark_end;
}

### deal with traversing the source tree

$File::Find::dont_use_nlink = 1;
$SIG{__WARN__} = sub {
  warn @_ unless $_[$#_] =~ m@Use of uninit.*Find.pm line 150@;
};

sub wanted {
  ($_ eq 'RCS') and $File::Find::prune = 1;
  return unless /\.[ch]$/;
  eat $_;
}

find(\&wanted, 'src');
expel;