1#!/usr/bin/perl 2##!~_~perlpath~_~ 3# 4# findtags - Find ITL tags in Interchange catalogs and directories 5# 6# $Id: findtags.PL,v 1.8 2007-08-09 13:40:57 pajamian Exp $ 7# 8# Copyright (C) 2002-2007 Interchange Development Group 9# Copyright (C) 1996-2002 Red Hat, Inc. 10# 11# This program is free software; you can redistribute it and/or modify 12# it under the terms of the GNU General Public License as published by 13# the Free Software Foundation; either version 2 of the License, or 14# (at your option) any later version. 15# 16# This program is distributed in the hope that it will be useful, 17# but WITHOUT ANY WARRANTY; without even the implied warranty of 18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19# GNU General Public License for more details. 20# 21# You should have received a copy of the GNU General Public 22# License along with this program; if not, write to the Free 23# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, 24# MA 02110-1301 USA. 25 26use lib '/work/interchange/lib'; 27#use lib '~_~INSTALLPRIVLIB~_~'; 28use lib '/work/interchange'; 29#use lib '~_~INSTALLARCHLIB~_~'; 30 31use strict; 32 33 34BEGIN { 35 ($Global::VendRoot = $ENV{MINIVEND_ROOT}) 36 if defined $ENV{MINIVEND_ROOT}; 37 38 $Global::VendRoot = $Global::VendRoot || '/work/interchange'; 39# $Global::VendRoot = $Global::VendRoot || '~_~INSTALLARCHLIB~_~'; 40 41 if(-f "$Global::VendRoot/interchange.cfg") { 42 $Global::ExeName = 'interchange'; 43 $Global::ConfigFile = 'interchange.cfg'; 44 } 45 elsif(-f "$Global::VendRoot/minivend.cfg") { 46 $Global::ExeName = 'minivend'; 47 $Global::ConfigFile = 'minivend.cfg'; 48 } 49 elsif(-f "$Global::VendRoot/interchange.cfg.dist") { 50 $Global::ExeName = 'interchange'; 51 $Global::ConfigFile = 'interchange.cfg'; 52 } 53} 54 55### END CONFIGURATION VARIABLES 56 57my $prog = $0; 58$prog =~ s:.*/::; 59 60my $USAGE = <<EOF; 61usage: $prog [-r] [-f file] 62 63 -a Look in all catalogs 64 -c CAT Only look in catalog CAT 65 -d "dir1 dir2 .." Look in dirs 66 -f Alternate interchange.cfg file 67 -h Print this message and exit 68 -n Don't report SystemTag 69 -t "TagInclude" directive output 70 -u Report unseen tags 71 -v Slightly verbose, report directories scanned 72 -x "dirs" Don't look for tags in dir (default "session tmp") 73 74Find tags in Interchange catalogs and directories -- intended to develop 75a list for TagInclude. 76 77WARNING: This is not 100%, for developing tag names from Variable definitions 78and other sources can fool it. If you include all directories, make sure you 79don't include documentation files or the usertags themselves. 80 81With the standard distribution, this should find just about all 82tags needed: 83 84 findtags -a -d lib/UI 85 86To develop a TagInclude statement which excludes unused tags, try: 87 88 findtags -a -d lib/UI -t -u 89 90If you don't want to use the UI, then do: 91 92 findtags -a -u -t 93 94EOF 95 96use Vend::Config; 97 98$Vend::ExternalProgram = 1; 99$Vend::Quiet = 1; 100 101use Getopt::Std; 102use vars qw/ 103 $opt_a 104 $opt_c 105 $opt_d 106 $opt_f 107 $opt_h 108 $opt_n 109 $opt_t 110 $opt_u 111 $opt_v 112 $opt_x 113/; 114 115if($ARGV[0] eq '--help') { 116 print $USAGE; 117 exit 2; 118} 119 120getopts('ac:d:f:hntuvx') or die "$@\n$USAGE\n"; 121 122if($opt_h) { 123 print $USAGE; 124 exit 2; 125} 126 127sub logGlobal { shift(@_) if ref $_[0]; printf @_; print "\n" } 128sub logError { } 129sub logDebug { } 130 131my $flag = ''; 132 133if($opt_f) { 134 $Global::ConfigFile = $opt_f; 135 $flag .= qq{ -f "$opt_f"}; 136} 137else { 138 $Global::ConfigFile = "$Global::VendRoot/$Global::ConfigFile"; 139} 140 141# Parse the interchange.cfg file to look for script/catalog info 142# but don't read in the core tags 143$Vend::ControllingInterchange = 1; 144chdir $Global::VendRoot or die "Couldn't change to $Global::VendRoot: $!\n"; 145global_config(); 146 147my @cats; 148 149if($opt_a) { 150 while( my($name, $cat) = each %Global::Catalog ) { 151 next if $cat->{base}; 152 push @cats, $name; 153 } 154} 155elsif($opt_c) { 156 @cats = split /[\s,]+/, $opt_c; 157} 158 159my @exclude = qw/session tmp/; 160my %exclude; 161 162if($opt_x) { 163 @exclude = split /[\s,]+/, $opt_x; 164} 165 166@exclude{@exclude} = @exclude; 167 168my @dirs; 169 170for(@$Global::TagDir) { 171 push @dirs, glob("$_/*"); 172} 173 174#warn "Dirs are " . join (" ", @dirs) . "\n"; 175 176if ($opt_n) { 177 @dirs = grep $_ !~ '/SystemTag$', @dirs; 178} 179 180my %tag; 181 182use File::Find; 183 184GETTAGS: { 185 my @tags; 186 my $wanted = sub { 187 return unless -f $_; 188 return unless /^(\w[-\w]*)\.[a-z_]*tag$/; 189 my $tname = $1; 190 $tname = lc $tname; 191 $tname =~ tr/-/_/; 192 push @tags, $tname; 193 }; 194 File::Find::find($wanted, @dirs); 195 my %seen; 196 @tags = grep !$seen{$_}++, @tags; 197 @tag{@tags} = @tags; 198} 199 200my @targdirs; 201 202if($opt_d) { 203 my @d = split /[\s,]+/, $opt_d; 204 for(@d) { 205warn "Doing directory $_\n" if $opt_v; 206 push @targdirs, $_; 207 } 208} 209 210my @tags; 211 212foreach my $catname (@cats) { 213warn "Doing catalog $catname\n" if $opt_v; 214 my $dir = $Global::Catalog{$catname}->{dir}; 215 if(! $dir) { 216 warn errmsg("Unknown catalog '%s', skipping.\n", $catname); 217 } 218 push @targdirs, $dir; 219} 220 221if(! @targdirs) { 222 die "no directories to scan!\n"; 223} 224 225foreach my $dir (@targdirs) { 226 chdir $dir 227 or die errmsg("chdir to directory %s: $!\n", $dir); 228 my @files; 229 my @binaries; 230 my $wanted = sub { 231 return unless -f $_; 232 if (-B $_) { 233 push @binaries, $File::Find::name; 234 } 235 push @files, $File::Find::name; 236 }; 237 238 my @d = glob('*'); 239 @d = grep !$exclude{$_}, @d; 240 File::Find::find($wanted, @d); 241 242 undef $/; 243 foreach my $f (@files) { 244#print "Checking file $f\n"; 245 open IT, "< $f" or die errmsg("open %s: %s", $f, $!); 246 $_ = <IT>; 247 close IT or die errmsg("close %s: %s", $f, $!); 248 while (m{(?:\[(\w[-\w]*)[\s\]]|\$Tag->(\w+))}g) { 249 my $tmp = $1 || $2; 250 next if $tmp =~ /^\d+$/; 251 $tmp =~ s/-/_/g; 252 $tmp = lc $tmp; 253 next unless $tag{$tmp}; 254 if($opt_u) { 255 delete $tag{$tmp}; 256 } 257 else { 258 push @tags, $tmp; 259 } 260 } 261 } 262} 263 264my %seen; 265 266if($opt_u) { 267 @tags = keys %tag; 268 if($opt_t) { 269 @tags = map { "!$_" } @tags; 270 } 271} 272else { 273 @tags = grep !$seen{$_}++, @tags; 274} 275 276@tags = sort grep /\w/, @tags; 277 278if($opt_t) { 279 print "TagInclude <<EOTI\n\t"; 280 print join("\n\t", @tags); 281 print "\nEOTI\n"; 282} 283else { 284 print join("\n", @tags); 285} 286__END__ 287 288=head1 NAME 289 290findtags - find tags in Interchange catalogs and directories 291 292=head1 SYNOPSIS 293 294 findtags -a -d lib/UI 295 findtags -a -d lib/UI -t -u 296 findtags -a -u -t 297 298=head1 DESCRIPTION 299 300Find tags in Interchange catalogs and directories -- intended to develop 301a list for TagInclude. 302 303WARNING: This is not 100%, for developing tag names from Variable definitions 304and other sources can fool it. If you include all directories, make sure you 305don't include documentation files or the usertags themselves. 306 307With the standard distribution, this should find just about all 308tags needed: 309 310 findtags -a -d lib/UI 311 312To develop a TagInclude statement which excludes unused tags, try: 313 314 findtags -a -d lib/UI -t -u 315 316If you don't want to use the UI, then do: 317 318 findtags -a -u -t 319 320=head1 OPTIONS 321 322=over 4 323 324=item -a 325 326Look in all catalogs. 327 328=item -c CAT 329 330Only look in catalog CAT. 331 332=item -d DIR1 DIR2 .... 333 334Look in given directories. 335 336=item -f FILE 337 338Use alternate interchange.cfg file FILE. 339 340=item -h 341 342Display help. 343 344=item -n 345 346Don't report system tags. 347 348=item -t 349 350Output suitable for TagInclude directive. 351 352=item -u 353 354Report unseen tags. 355 356=item -v 357 358Slightly verbose, report directories scanned. 359 360=item -x DIR1 DIR2 .... 361 362Exclude given directories from scanning. Default is session and tmp. 363 364