3544 save-args matcher could be considerably more robust
[unleashed.git] / usr / src / tools / scripts / validate_flg.pl
blob14c7580ab7ce8791fc51ef7820f21aa673a0a0b8
1 #!/usr/bin/perl
3 # CDDL HEADER START
5 # The contents of this file are subject to the terms of the
6 # Common Development and Distribution License (the "License").
7 # You may not use this file except in compliance with the License.
9 # You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10 # or http://www.opensolaris.org/os/licensing.
11 # See the License for the specific language governing permissions
12 # and limitations under the License.
14 # When distributing Covered Code, include this CDDL HEADER in each
15 # file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16 # If applicable, add the following below this CDDL HEADER, with the
17 # fields enclosed by brackets "[]" replaced with your own identifying
18 # information: Portions Copyright [yyyy] [name of copyright owner]
20 # CDDL HEADER END
23 # Copyright 2008 Sun Microsystems, Inc. All rights reserved.
24 # Use is subject to license terms.
27 use strict;
28 use File::Find ();
29 require v5.8.4;
31 use vars qw/$f_flg *name *dir @execlist $basedir @opt_e @exclude/;
32 *name = *File::Find::name;
33 *dir = *File::Find::dir;
35 # Use the same mechanism as def.dir.flp to determine if there are any
36 # SCCS files matching the pattern supplied for a "find_files"
37 # statement.
38 sub sccs_empty {
39 my ($pat, $dir) = @_;
40 return 0 if $f_flg;
41 my $foo = `find $dir -name "$pat" -print | grep /SCCS/s.`;
42 $foo eq "";
45 # Not pretty, but simple enough to work for the known cases.
46 # Does not bother with curly braces or fancy substitutions.
47 # Returns undef if this pattern is excluded.
48 sub expand {
49 my ($str) = @_;
50 while ($str =~ /\$(\w+)/) {
51 my $newstr = $ENV{$1};
52 $str =~ s/\$$1/$newstr/g;
54 foreach my $pat (@exclude) {
55 return undef if $str =~ /$pat/;
57 $str;
60 # Process a single inc.flg or req.flg file.
61 sub process_file {
62 my ($fname, $incpath) = @_;
63 my ($dname, $isincflg);
64 my ($expfile, $newpath, $line, $cont, $firstline, $text);
66 $dname = $fname;
67 $dname =~ s+/[^/]*$++;
69 $isincflg = $fname =~ /inc.flg$/;
71 if (defined $incpath) {
72 $newpath = "$incpath, from $fname:";
73 } else {
74 $newpath = "from $fname:";
77 if (open INC, "<$fname") {
78 $line = 0;
79 $cont = 0;
80 while (<INC>) {
81 chomp;
82 $line++;
83 ( $cont = 0, next ) if /^\s*#/ || /^\s*$/;
84 if ($cont) {
85 $text = $text . $_;
86 } else {
87 $firstline = $line;
88 $text = $_;
90 if (/\\$/) {
91 $cont = 1;
92 $text =~ s/\\$//;
93 next;
95 $cont = 0;
96 if ($text =~ /\s*echo_file\s+(\S+)/) {
97 next if !defined($expfile = expand($1));
98 warn "$fname:$firstline: $1 isn't a file\n" if ! -f $expfile;
99 } elsif ($text =~ /\s*find_files\s+['"]([^'"]+)['"]\s+(.*)/) {
100 foreach my $dir (split(/\s+/, "$2")) {
101 next if !defined($expfile = expand($dir));
102 if (! -d $expfile) {
103 warn "$fname:$firstline: $dir isn't a directory\n";
104 } elsif ($isincflg && $expfile eq $dname) {
105 warn "$fname:$firstline: $dir is unnecessary\n";
106 } elsif (sccs_empty($1, $expfile)) {
107 warn "$fname:$firstline: $dir has no SCCS objects ",
108 "with '$1'\n";
111 } elsif ($text =~ /\s*exec_file\s+(\S+)/) {
112 next if !defined($expfile = expand($1));
113 if (-f $expfile) {
114 push @execlist, $expfile, "$newpath:$firstline";
115 } else {
116 warn "$fname:$firstline: $1 isn't a file\n";
117 warn "included $incpath\n" if defined $incpath;
119 } else {
120 warn "$0: $fname:$firstline: unknown entry: $text\n";
121 warn "included $incpath\n" if defined $incpath;
124 close INC;
125 } else {
126 warn "$0: $fname: $!\n";
130 sub wanted {
131 process_file($_, undef) if /\/(inc|req)\.flg$/ && -f $_;
134 sub next_arg {
135 my ($arg) = @_;
136 if ($arg eq "") {
137 die "$0: missing argument for $_\n" if $#ARGV == -1;
138 $arg = shift @ARGV;
140 $arg;
143 # I'd like to use Perl's getopts here, but it doesn't handle repeated
144 # options, and using comma separators is just too ugly.
145 # This doesn't handle combined options (as in '-rm'), but I don't care.
146 my $arg;
147 while ($#ARGV >= 0) {
148 $_ = $ARGV[0];
149 last if /^[^-]/;
150 shift @ARGV;
151 last if /^--$/;
152 SWITCH: {
153 /^-f/ && do { $f_flg = 1; last SWITCH; };
154 if (/^-e(.*)$/) {
155 $arg = next_arg($1);
156 push @opt_e, $arg;
157 last SWITCH;
159 print "$0: unknown option $_\n";
160 usage();
164 # compile the 'exclude' regexps
165 @exclude = map qr/$_/x, @opt_e;
167 $basedir = "usr";
168 if ($#ARGV == 0) {
169 $basedir = shift @ARGV;
170 } elsif ($#ARGV > 0) {
171 die "$0: unexpected arguments\n";
174 die "$0: \$CODEMGR_WS must be set\n" if $ENV{CODEMGR_WS} eq "";
175 chdir $ENV{CODEMGR_WS} or die "$0: chdir $ENV{CODEMGR_WS}: $!\n";
177 File::Find::find({wanted => \&wanted, no_chdir => 1}, $basedir);
179 # After passing through the tree, process all of the included files.
180 # There aren't many of these, so don't bother trying to optimize the
181 # traversal. Just do them all.
182 while (@execlist) {
183 my $file = shift @execlist;
184 my $incpath = shift @execlist;
185 process_file($file, $incpath);
188 exit 0;