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 28 use strict; 29 use File::Find (); 30 require v5.6.1; 31 32 use 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. 39 sub 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. 49 sub 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. 62 sub 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 131 sub wanted { 132 process_file($_, undef) if /\/(inc|req)\.flg$/ && -f $_; 133 } 134 135 sub 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. 147 my $arg; 148 while ($#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"; 169 if ($#ARGV == 0) { 170 $basedir = shift @ARGV; 171 } elsif ($#ARGV > 0) { 172 die "$0: unexpected arguments\n"; 173 } 174 175 die "$0: \$CODEMGR_WS must be set\n" if $ENV{CODEMGR_WS} eq ""; 176 chdir $ENV{CODEMGR_WS} or die "$0: chdir $ENV{CODEMGR_WS}: $!\n"; 177 178 File::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. 183 while (@execlist) { 184 my $file = shift @execlist; 185 my $incpath = shift @execlist; 186 process_file($file, $incpath); 187 } 188 189 exit 0; 190