New validate_flg.pl
  1 #!/usr/bin/perl
  2 #
  3 # CDDL HEADER START
  4 #
  5 # The contents of this file are subject to the terms of the
  6 # Common Development and Distribution License, Version 1.0 only
  7 # (the "License").  You may not use this file except in compliance
  8 # with the License.
  9 #
 10 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
 11 # or http://www.opensolaris.org/os/licensing.
 12 # See the License for the specific language governing permissions
 13 # and limitations under the License.
 14 #
 15 # When distributing Covered Code, include this CDDL HEADER in each
 16 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
 17 # If applicable, add the following below this CDDL HEADER, with the
 18 # fields enclosed by brackets "[]" replaced with your own identifying
 19 # information: Portions Copyright [yyyy] [name of copyright owner]
 20 #
 21 # CDDL HEADER END
 22 #
 23 
 24 # Copyright 2005 Sun Microsystems, Inc.  All rights reserved.
 25 # Use is subject to license terms.
 26 #
 27 #ident  "@(#)validate_flg.pl    1.4     05/12/17 SMI"
 28 
 29 use strict;
 30 use File::Find ();
 31 require v5.6.1;
 32 
 33 use vars qw/$f_flg *name *dir @execlist $basedir/;
 34 *name   = *File::Find::name;
 35 *dir    = *File::Find::dir;
 36 
 37 # Use the same mechanism as def.dir.flp to determine if there are any
 38 # SCCS files matching the pattern supplied for a "find_files"
 39 # statement.
 40 sub sccs_empty {
 41     my ($pat, $dir) = @_;
 42     return 0 if $f_flg;
 43     my $foo = `find $dir -name "$pat" -print | grep /SCCS/s.`;
 44     $foo eq "";
 45 }
 46 
 47 # Not pretty, but simple enough to work for the known cases.
 48 # Does not bother with curly braces or fancy substitutions.
 49 sub expand {
 50     my ($str) = @_;
 51     while ($str =~ /\$(\w+)/) {
 52         my $newstr = $ENV{$1};
 53         $str =~ s/\$$1/$newstr/g;
 54     }
 55     $str;
 56 }
 57 
 58 # Process a single inc.flg or req.flg file.
 59 sub process_file {
 60     my ($fname, $incpath) = @_;
 61     my ($dname, $isincflg);
 62     my ($expfile, $newpath, $line, $cont, $firstline, $text);
 63 
 64     $dname = $fname;
 65     $dname =~ s+/[^/]*$++;
 66 
 67     $isincflg = $fname =~ /inc.flg$/;
 68 
 69     if (defined $incpath) {
 70         $newpath = "$incpath, from $fname:";
 71     } else {
 72         $newpath = "from $fname:";
 73     }
 74 
 75     if (open INC, "<$fname") {
 76         $line = 0;
 77         $cont = 0;
 78         while (<INC>) {
 79             chomp;
 80             $line++;
 81             ( $cont = 0, next ) if /^\s*#/ || /^\s*$/;
 82             if ($cont) {
 83                 $text = $text . $_;
 84             } else {
 85                 $firstline = $line;
 86                 $text = $_;
 87             }
 88             if (/\\$/) {
 89                 $cont = 1;
 90                 $text =~ s/\\$//;
 91                 next;
 92             }
 93             $cont = 0;
 94             if ($text =~ /\s*echo_file\s+(\S+)/) {
 95                 $expfile = expand($1);
 96                 warn "$fname:$firstline: $1 isn't a file\n" if ! -f $expfile;
 97             } elsif ($text =~ /\s*find_files\s+['"]([^'"]+)['"]\s+(.*)/) {
 98                 foreach my $dir (split(/\s+/, "$2")) {
 99                     $expfile = expand($dir);
100                     if (! -d $expfile) {
101                         warn "$fname:$firstline: $dir isn't a directory\n";
102                     } elsif ($isincflg && $expfile eq $dname) {
103                         warn "$fname:$firstline: $dir is unnecessary\n";
104                     } elsif (sccs_empty($1, $expfile)) {
105                         warn "$fname:$firstline: $dir has no SCCS objects ",
106                                 "with '$1'\n";
107                     }
108                 }
109             } elsif ($text =~ /\s*exec_file\s+(\S+)/) {
110                 $expfile = expand($1);
111                 if (-f $expfile) {
112                     push @execlist, $expfile, "$newpath:$firstline";
113                 } else {
114                     warn "$fname:$firstline: $1 isn't a file\n";
115                     warn "included $incpath\n" if defined $incpath;
116                 }
117             } else {
118                 warn "$0: $fname:$firstline: unknown entry: $text\n";
119                 warn "included $incpath\n" if defined $incpath;
120             }
121         }
122         close INC;
123     } else {
124         warn "$0: $fname: $!\n";
125     }
126 }
127 
128 sub wanted {
129     process_file($_, undef) if /\/(inc|req)\.flg$/ && -f $_;
130 }
131 
132 $f_flg = $ARGV[0] eq "-f";
133 shift @ARGV if $f_flg;
134 
135 $basedir = "usr";
136 if ($#ARGV == 0) {
137     $basedir = shift @ARGV;
138 } elsif ($#ARGV > 0) {
139     die "$0: unexpected arguments\n";
140 }
141 
142 die "$0: \$CODEMGR_WS must be set\n" if $ENV{CODEMGR_WS} eq "";
143 chdir $ENV{CODEMGR_WS} or die "$0: chdir $ENV{CODEMGR_WS}: $!\n";
144 
145 # Only check for SCCS files if this is a Teamware workspace.
146 $f_flg = ! -d "$ENV{CODEMGR_WS}/Codemgr_wsdata";
147 
148 File::Find::find({wanted => \&wanted, no_chdir => 1}, $basedir);
149 
150 # After passing through the tree, process all of the included files.
151 # There aren't many of these, so don't bother trying to optimize the
152 # traversal.  Just do them all.
153 while (@execlist) {
154     my $file = shift @execlist;
155     my $incpath = shift @execlist;
156     process_file($file, $incpath);
157 }
158 
159 exit 0;