doc/tools/find-suspiciousTags

   1 #!/usr/bin/perl -w
   2 use strict;
   3 use File::Find ();
   4
   5 # -----------------------------------------------------------------------------
   6 #
   7 # Script
   8 #     find-suspiciousTags
   9 #
  10 # Description
  11 #     Search for *.[CH] files with 'Class' or 'Namespace' starting in the
  12 #     first column but without a class being defined anywhere in the file.
  13 #     These are probably incorrect or should be at least be
  14 #     changed to 'In Class' / 'In Namespace' for now.
  15 #     - print filename and 'InClass' or 'InNamespace'
  16 #
  17 #     Find the namespaces used in the files and compare these to what is
  18 #     given on the 'Class' information
  19 #     - print filename and corrected Class
  20 #
  21 #     Check for trailing garbage in the 'Class' information
  22 #     - print filename and 'ClassWithTrailingInformation'
  23 #
  24 # -----------------------------------------------------------------------------
  25
  26 my $re_filespec = qr{^.+\.[CH]$};
  27
  28 # for the convenience of &wanted calls, including -eval statements:
  29 ## use vars qw( *name *dir *prune );
  30 ## *name   = *File::Find::name;
  31 ## *dir    = *File::Find::dir;
  32 ## *prune  = *File::Find::prune;
  33
  34 sub wanted {
  35     unless ( lstat($_) and -f _ and -r _ and not -l _ and /$re_filespec/ ) {
  36         return;
  37     }
  38
  39     # potential className
  40     ( my $fileClass = $_ ) =~ s{\.[A-Za-z]$}{};
  41
  42     my ( $namespace, $currentClass, %classes, %found ) = ('');
  43
  44     local @ARGV = $_;
  45     while (<>) {
  46         my $name;
  47
  48         ## look for (class|namespace), deal with repeats
  49         if ( ($name) = /^\s*class\s+(\w+)\s*/ ) {
  50             $classes{$name}++;
  51         }
  52         elsif ( ($name) = /^\s*namespace\s+(\w+)\s*/ ) {
  53             ## reset if 'Foam' namespace appears again
  54             $namespace = '' if $name eq "Foam";
  55             $namespace .= $name . "::";
  56         }
  57         elsif (/^(Class|Namespace)\s*/) {
  58             $found{$1}++;
  59
  60             ## examine the class name
  61             if (/^Class\s*$/) {
  62                 $_ = <>;
  63                 my @trailing;
  64                 ( $currentClass, @trailing ) = split;
  65                 if (@trailing) {
  66                     $found{-trailing}++;
  67                 }
  68
  69                 # the next line should be blank
  70                 $_ = <>;
  71                 $_ ||= '';
  72
  73                 if (not /^\s*$/) {
  74                     $found{-spacing}++;
  75                 }
  76             }
  77         }
  78     }
  79
  80     # always report if the Class has trailing information
  81     if ( delete $found{-trailing} ) {
  82         print "$File::Find::name ClassWithTrailingInformation\n";
  83     }
  84
  85     # always report if the Class has spacing problem
  86     if ( delete $found{-spacing} ) {
  87         print "$File::Find::name ClassWithSpacingIssue\n";
  88     }
  89
  90     if (%classes) {
  91         ## we have 'Class' tag
  92         if ( defined $currentClass ) {
  93             if ($namespace) {
  94                 my ($currentNamespace) = $currentClass =~ m{^(.+::)};
  95                 $currentNamespace ||= '';
  96
  97                 if ( $namespace ne $currentNamespace ) {
  98                     $currentClass =~ s{^(.+::)}{};
  99                     $currentClass ||= $fileClass;
 100
 101                     print "$File::Find::name $namespace$currentClass\n";
 102                 }
 103             }
 104             elsif ( not $currentClass ) {
 105                 ## supply a class name
 106                 print "$File::Find::name $fileClass\n";
 107             }
 108         }
 109     }
 110     else {
 111         ## no classes, all tags are deemed suspicious
 112         for ( sort keys %found ) {
 113             print "$File::Find::name In$_\n";
 114         }
 115     }
 116 }
 117
 118 ## Traverse desired filesystems
 119 for my $dir (@ARGV) {
 120     no warnings 'File::Find';
 121     warn "(**) checking '$dir' ...\n";
 122     File::Find::find( { wanted => \&wanted }, $dir );
 123 }
 124