xref: /titanic_41/usr/src/tools/scripts/validate_flg.pl (revision ed5289f91b9bf164dccd6c75398362be77a4478d) 
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 (the "License").
7# You may not use this file except in compliance with the License.
8#
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.
13#
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]
19#
20# CDDL HEADER END
21#
22
23# Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
24# Use is subject to license terms.
25#
26#ident	"%Z%%M%	%I%	%E% SMI"
27
28use strict;
29use File::Find ();
30require v5.6.1;
31
32use vars qw/$f_flg *name *dir @execlist $basedir @opt_e @exclude/;
33*name   = *File::Find::name;
34*dir    = *File::Find::dir;
35
36# Use the same mechanism as def.dir.flp to determine if there are any
37# SCCS files matching the pattern supplied for a "find_files"
38# statement.
39sub sccs_empty {
40    my ($pat, $dir) = @_;
41    return 0 if $f_flg;
42    my $foo = `find $dir -name "$pat" -print | grep /SCCS/s.`;
43    $foo eq "";
44}
45
46# Not pretty, but simple enough to work for the known cases.
47# Does not bother with curly braces or fancy substitutions.
48# Returns undef if this pattern is excluded.
49sub expand {
50    my ($str) = @_;
51    while ($str =~ /\$(\w+)/) {
52	my $newstr = $ENV{$1};
53	$str =~ s/\$$1/$newstr/g;
54    }
55    foreach my $pat (@exclude) {
56	return undef if $str =~ /$pat/;
57    }
58    $str;
59}
60
61# Process a single inc.flg or req.flg file.
62sub process_file {
63    my ($fname, $incpath) = @_;
64    my ($dname, $isincflg);
65    my ($expfile, $newpath, $line, $cont, $firstline, $text);
66
67    $dname = $fname;
68    $dname =~ s+/[^/]*$++;
69
70    $isincflg = $fname =~ /inc.flg$/;
71
72    if (defined $incpath) {
73	$newpath = "$incpath, from $fname:";
74    } else {
75	$newpath = "from $fname:";
76    }
77
78    if (open INC, "<$fname") {
79	$line = 0;
80	$cont = 0;
81	while (<INC>) {
82	    chomp;
83	    $line++;
84	    ( $cont = 0, next ) if /^\s*#/ || /^\s*$/;
85	    if ($cont) {
86		$text = $text . $_;
87	    } else {
88		$firstline = $line;
89		$text = $_;
90	    }
91	    if (/\\$/) {
92		$cont = 1;
93		$text =~ s/\\$//;
94		next;
95	    }
96	    $cont = 0;
97	    if ($text =~ /\s*echo_file\s+(\S+)/) {
98		next if !defined($expfile = expand($1));
99		warn "$fname:$firstline: $1 isn't a file\n" if ! -f $expfile;
100	    } elsif ($text =~ /\s*find_files\s+['"]([^'"]+)['"]\s+(.*)/) {
101		foreach my $dir (split(/\s+/, "$2")) {
102		    next if !defined($expfile = expand($dir));
103		    if (! -d $expfile) {
104			warn "$fname:$firstline: $dir isn't a directory\n";
105		    } elsif ($isincflg && $expfile eq $dname) {
106			warn "$fname:$firstline: $dir is unnecessary\n";
107		    } elsif (sccs_empty($1, $expfile)) {
108			warn "$fname:$firstline: $dir has no SCCS objects ",
109				"with '$1'\n";
110		    }
111		}
112	    } elsif ($text =~ /\s*exec_file\s+(\S+)/) {
113		next if !defined($expfile = expand($1));
114		if (-f $expfile) {
115		    push @execlist, $expfile, "$newpath:$firstline";
116		} else {
117		    warn "$fname:$firstline: $1 isn't a file\n";
118		    warn "included $incpath\n" if defined $incpath;
119		}
120	    } else {
121		warn "$0: $fname:$firstline: unknown entry: $text\n";
122		warn "included $incpath\n" if defined $incpath;
123	    }
124	}
125	close INC;
126    } else {
127	warn "$0: $fname: $!\n";
128    }
129}
130
131sub wanted {
132    process_file($_, undef) if /\/(inc|req)\.flg$/ && -f $_;
133}
134
135sub next_arg {
136    my ($arg) = @_;
137    if ($arg eq "") {
138	die "$0: missing argument for $_\n" if $#ARGV == -1;
139	$arg = shift @ARGV;
140    }
141    $arg;
142}
143
144# I'd like to use Perl's getopts here, but it doesn't handle repeated
145# options, and using comma separators is just too ugly.
146# This doesn't handle combined options (as in '-rm'), but I don't care.
147my $arg;
148while ($#ARGV >= 0) {
149    $_ = $ARGV[0];
150    last if /^[^-]/;
151    shift @ARGV;
152    last if /^--$/;
153    SWITCH: {
154	  /^-f/ && do { $f_flg = 1; last SWITCH; };
155	  if (/^-e(.*)$/) {
156	      $arg = next_arg($1);
157	      push @opt_e, $arg;
158	      last SWITCH;
159	  }
160	  print "$0: unknown option $_\n";
161	  usage();
162    }
163}
164
165# compile the 'exclude' regexps
166@exclude = map qr/$_/x, @opt_e;
167
168$basedir = "usr";
169if ($#ARGV == 0) {
170    $basedir = shift @ARGV;
171} elsif ($#ARGV > 0) {
172    die "$0: unexpected arguments\n";
173}
174
175die "$0: \$CODEMGR_WS must be set\n" if $ENV{CODEMGR_WS} eq "";
176chdir $ENV{CODEMGR_WS} or die "$0: chdir $ENV{CODEMGR_WS}: $!\n";
177
178File::Find::find({wanted => \&wanted, no_chdir => 1}, $basedir);
179
180# After passing through the tree, process all of the included files.
181# There aren't many of these, so don't bother trying to optimize the
182# traversal.  Just do them all.
183while (@execlist) {
184    my $file = shift @execlist;
185    my $incpath = shift @execlist;
186    process_file($file, $incpath);
187}
188
189exit 0;
190