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