tools/build/check-modules.pl

   1 #!/usr/bin/env perl
   2
   3 # ***** BEGIN LICENSE BLOCK *****
   4 # Version: MPL 1.1/GPL 2.0/LGPL 2.1
   5 #
   6 # The contents of this file are subject to the Mozilla Public License Version
   7 # 1.1 (the "License"); you may not use this file except in compliance with
   8 # the License. You may obtain a copy of the License at
   9 # http://www.mozilla.org/MPL/
  10 #
  11 # Software distributed under the License is distributed on an "AS IS" basis,
  12 # WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  13 # for the specific language governing rights and limitations under the
  14 # License.
  15 #
  16 # The Original Code is this file as it was released upon February 25, 1999.
  17 #
  18 # The Initial Developer of the Original Code is
  19 # Netscape Communications Corporation.
  20 # Portions created by the Initial Developer are Copyright (C) 1999
  21 # the Initial Developer. All Rights Reserved.
  22 #
  23 # Contributor(s):
  24 #
  25 # Alternatively, the contents of this file may be used under the terms of
  26 # either the GNU General Public License Version 2 or later (the "GPL"), or
  27 # the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  28 # in which case the provisions of the GPL or the LGPL are applicable instead
  29 # of those above. If you wish to allow use of your version of this file only
  30 # under the terms of either the GPL or the LGPL, and not to allow others to
  31 # use your version of this file under the terms of the MPL, indicate your
  32 # decision by deleting the provisions above and replace them with the notice
  33 # and other provisions required by the GPL or the LGPL. If you do not delete
  34 # the provisions above, a recipient may use your version of this file under
  35 # the terms of any one of the MPL, the GPL or the LGPL.
  36 #
  37 # ***** END LICENSE BLOCK *****
  38
  39 #
  40 # check-modules.pl - Check cvs modules file for duplicates and syntax errors.
  41 #
  42 # TODO:
  43 #  - Parse output of 'cvs co -c' command in addition to the raw file.
  44 #
  45 # Send comments, improvements, bugs to Steve Lamm (slamm@netscape.com).
  46
  47 # $Id: check-modules.pl,v 1.4 2004/04/25 21:07:13 gerv%gerv.net Exp $
  48
  49 require 5.004;
  50
  51 use Getopt::Std;
  52
  53 sub usage
  54 {
  55   my ($progname) = $0 =~ /([^\/]+)$/;
  56   die "Usage: $progname [options] [<module_file>]
  57    Reads from stdin if no file is given.
  58    Options:
  59       -v    Verbose. Print the modules and what they include.
  60       -h    Print this usage message.
  61 ";
  62 }
  63
  64 &usage if !getopts('hv');
  65 &usage if defined($opt_h);
  66
  67 ######################################################################
  68 # begin main
  69
  70
  71 # The subroutine &parse_input creates the globals @module_names,
  72 #    %module_tree, and %line_number (described below).
  73 &parse_input;
  74
  75 foreach $module (@module_names)
  76 {
  77   &check_module($module);
  78 }
  79
  80 # end main
  81 ######################################################################
  82 # begin subroutines
  83
  84 sub parse_input
  85 {
  86   # Globals created:
  87   #      @module_names - List of module names in the order they are seen.
  88   #      %module_tree - Hash table of lists.  Keys are module names.
  89   #                     Values are lists of module names and diretories.
  90   #      %line_number - Hash indexed by module name and module item.
  91   #                     Values are line numbers.
  92
  93   @module_names = ();
  94   %module_tree = ();
  95   %line_number = ();
  96
  97   while (<>)
  98   {
  99     next if /^\#/ || /^\s*$/;
 100
 101     # Check for a module definition
 102     if (/^([_a-zA-Z0-9]+)\s+(?:-l\s+)?-a\s*(.*)$/)
 103     {
 104       my ($module_name) = $1;
 105       my (@sub_items) = ();
 106       my ($line) = $2;
 107
 108       push @module_names, $module_name;
 109
 110       # Read line continuations (i.e. lines with '\' on the end).
 111       while ($line =~ /\\$/)
 112       {
 113         chomp $line;
 114         $line =~ s/^\s*(.*?)\s*\\$/$1/;
 115         if (length($line) > 0)
 116         {
 117           my (@line_items) = split(/\s+/, $line);
 118           push @sub_items, @line_items;
 119           &save_line_numbers($module_name, $., @line_items);
 120         }
 121         $line = <>;
 122       }
 123       chomp $line;
 124       $line =~ s/^\s*(.*?)\s*$/$1/;
 125       my (@line_items) = split(/\s+/, $line);
 126       push @sub_items, @line_items;
 127       &save_line_numbers($module_name, $., @line_items);
 128
 129       $module_tree{$module_name} = \@sub_items;
 130     }
 131     else
 132     {
 133       die "Unexpected input: line $.: $_\n";
 134     }
 135   }
 136 }
 137
 138 sub check_module
 139 {
 140   my ($module) = $_[0];
 141   my ($sub_module, $sub_dir, $prev_module);
 142
 143   # Globals created:
 144   #      %have_checked - List of modules already checked.
 145   #      %full_list    - All the directories for a module.
 146   #                      Indexed by module and sub directory.
 147   #                      Values are the module that added the directory.
 148
 149   return if defined($have_checked{$module});
 150
 151   $full_list{$module} = {};
 152
 153   foreach $sub_module ( &get_modules($module) )
 154   {
 155     &check_module($sub_module);
 156
 157     # Add the directories of the sub_module to this module
 158     while (($sub_dir, $prev_module) = each %{$full_list{$sub_module}})
 159     {
 160       $full_list{$module}{$sub_dir} = $prev_module;
 161     }
 162   }
 163   foreach $sub_dir ( &get_directories($module) )
 164   {
 165     if (defined($full_list{$module}{$sub_dir}))
 166     {
 167       my ($previous_module) = $full_list{$module}{$sub_dir};
 168
 169       &warn_multiple($sub_dir, $module, $previous_module);
 170     }
 171     else
 172     {
 173       $full_list{$module}{$sub_dir} = $module;
 174
 175       # Check if parent or child of directory was previously added
 176       #
 177       &check_inclusion($sub_dir, $module);
 178     }
 179   }
 180   if (defined($opt_v))
 181   {
 182     print "$module\n";
 183     while (($sub_dir, $prev_module) = each %{$full_list{$module}})
 184     {
 185       print "  $sub_dir, $prev_module\n";
 186     }
 187   }
 188   $have_checked{$module} = 1;
 189 }
 190
 191 sub get_modules
 192 {
 193   my ($module) = $_[0];
 194   my (@output) = ();
 195   my ($sub_item);
 196
 197   foreach $sub_item ( @{ $module_tree{$module} } )
 198   {
 199     push @output, $sub_item if defined($module_tree{$sub_item});
 200   }
 201   return @output;
 202 }
 203
 204 sub get_directories
 205 {
 206   my ($module) = $_[0];
 207   my (@output) = ();
 208   my ($sub_item);
 209
 210   foreach $sub_item ( @{ $module_tree{$module} } )
 211   {
 212     push @output, $sub_item unless defined($module_tree{$sub_item});
 213   }
 214   return @output;
 215 }
 216
 217 sub save_line_numbers
 218 {
 219   my ($module, $line_num, @sub_items) = @_;
 220   my ($sub_item);
 221
 222   foreach $sub_item (@sub_items)
 223   {
 224     if (defined($line_number{$module}{$sub_item}))
 225     {
 226       $line_number{$module}{$sub_item} =
 227         "$line_number{$module}{$sub_item}, $line_num";
 228     }
 229     else
 230     {
 231       $line_number{$module}{$sub_item} = $line_num;
 232     }
 233   }
 234 }
 235
 236 sub warn_multiple
 237 {
 238   my ($sub_item, $module, $previous_module) = @_;
 239   my ($line_txt) = '';
 240
 241   my (@lines) = split(', ', $line_number{$module}{$sub_item});
 242
 243   push(@lines, split(', ', $line_number{$previous_module}{$sub_item}))
 244     unless $previous_module eq $module;
 245
 246   $line_txt = "lines ".join(', ', sort { $a <=> $b } @lines);
 247
 248   warn "Error: Multiple listing: $line_txt: $sub_item.\n";
 249 }
 250
 251 sub check_inclusion
 252 {
 253   my ($sub_dir, $module) = @_;
 254   my ($dir);
 255
 256   foreach $dir (keys %{$full_list{$module}})
 257   {
 258     next if $dir eq $sub_dir;
 259     if (length($dir) < length($sub_dir))
 260     {
 261       my ($temp) = $sub_dir;
 262       $sub_dir = $dir;
 263       $dir = $temp;
 264     }
 265     if ($dir =~ /^$sub_dir\//)
 266     {
 267       warn "Warning: $dir (line "
 268       .$line_number{$full_list{$module}{$dir}}{$dir}
 269       .") pulled by $sub_dir (line "
 270       .$line_number{$full_list{$module}{$sub_dir}}{$sub_dir}
 271       .")\n";
 272     }
 273   }
 274 }