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 2008 Sun Microsystems, Inc. All rights reserved. 24 # Use is subject to license terms. 25 # 26 27 use strict; 28 use File::Find (); 29 require v5.8.4; 30 31 use vars qw/$f_flg *name *dir @execlist $basedir @opt_e @exclude/; 32 *name = *File::Find::name; 33 *dir = *File::Find::dir; 34 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 ""; 43 } 44 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; 53 } 54 foreach my $pat (@exclude) { 55 return undef if $str =~ /$pat/; 56 } 57 $str; 58 } 59 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); 65 66 $dname = $fname; 67 $dname =~ s+/[^/]*$++; 68 69 $isincflg = $fname =~ /inc.flg$/; 70 71 if (defined $incpath) { 72 $newpath = "$incpath, from $fname:"; 73 } else { 74 $newpath = "from $fname:"; 75 } 76 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 = $_; 89 } 90 if (/\\$/) { 91 $cont = 1; 92 $text =~ s/\\$//; 93 next; 94 } 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"; 109 } 110 } 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; 118 } 119 } else { 120 warn "$0: $fname:$firstline: unknown entry: $text\n"; 121 warn "included $incpath\n" if defined $incpath; 122 } 123 } 124 close INC; 125 } else { 126 warn "$0: $fname: $!\n"; 127 } 128 } 129 130 sub wanted { 131 process_file($_, undef) if /\/(inc|req)\.flg$/ && -f $_; 132 } 133 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; 139 } 140 $arg; 141 } 142 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; 158 } 159 print "$0: unknown option $_\n"; 160 usage(); 161 } 162 } 163 164 # compile the 'exclude' regexps 165 @exclude = map qr/$_/x, @opt_e; 166 167 $basedir = "usr"; 168 if ($#ARGV == 0) { 169 $basedir = shift @ARGV; 170 } elsif ($#ARGV > 0) { 171 die "$0: unexpected arguments\n"; 172 } 173 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"; 176 177 File::Find::find({wanted => \&wanted, no_chdir => 1}, $basedir); 178 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); 186 } 187 188 exit 0; 189