#!/afs/athena/contrib/perl5/p -w

use strict;
use FileHandle;
use File::Find;

#select(STDERR);
#autoflush STDERR 1;

use lib '/mit/bert/PERL';
use DataDump;

use vars qw( @root $verbose %keyword %kmap %extract );

while (defined($ARGV[0]) && ($ARGV[0] =~ /^-/)) {
  my $flag = shift;
  ($flag eq '-v') && ($verbose=1,    next);
  die "usage: $0 [-v] directory [ directory ... ]\n";
}

(@root = @ARGV)
  || die "usage: $0 [-v] directory [directory ...]\n";

%kmap = ( 'ifdef' => 'ifdef', 'ifndef' => 'ifdef', 'if' => 'if',
	  'undef' => 'undef', 'define' => 'def',   'include' => 'include',
	  'else' => undef, 'endif' => undef
	);
%extract = ( 'include' => sub { (split /\s+/, $_[0], 2)[0]; },
	     'ifdef'   => sub { (split /\s+/, $_[0], 2)[0]; },
	     'ifndef'  => sub { (split /\s+/, $_[0], 2)[0]; },
	   );

sub eat ($) {
  my ($fh) = @_;
  local ($_);
  return unless defined($fh) && $fh->fileno;

  while (<$fh>) {
    chomp;
    if (/^\s*\#\s*(\S+)\s*/) {
      my ($key, $data) = ($1, $');
      exists $kmap{$key} || warn "key $key\n";
      my ($K) = $kmap{$key} || next;
      $data = &{$extract{$key}}($data) if $extract{$key};
      $keyword{$K}{$data}++;
    }
  }
}

sub wanted {
  stat or die;  # I think an evil Perl bug requires this
  return unless (/\.[ch]$/ && -f);
  # print STDERR "$File::Find::name\n";

  eat new FileHandle $_;
}

$File::Find::dont_use_nlink=1;
find(\&wanted, @root);

my ($k, $line);

for $k (sort keys %keyword) {
  print STDERR "writing cpp.$k ...\n";
  my $OUT = new FileHandle "> cpp.$k";
  for $line (sort 
	     ### {$keyword{$k}{$a} <=> $keyword{$k}{$b}}
	     keys %{$keyword{$k}}) {
    $OUT->printf("%4d %s\n", $keyword{$k}{$line}, $line);
  }
}
