More god damned fiddling to make this work with 1.4.2's javap output.

git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@2723 542714f4-19e9-0310-aa3c-eee0fc999fb1
This commit is contained in:
Michael Bayne
2003-07-24 23:19:26 +00:00
parent aced4d2fe9
commit e43f7c0de8
+15 -13
View File
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w #!/usr/bin/perl -w
# #
# $Id: matchclasses,v 1.4 2003/07/24 22:12:52 mdb Exp $ # $Id: matchclasses,v 1.5 2003/07/24 23:19:26 mdb Exp $
# #
# A script which inspects a hierarchy of classes and generates lists of # A script which inspects a hierarchy of classes and generates lists of
# classes that match specified criterion. The criterion are that a class # classes that match specified criterion. The criterion are that a class
@@ -53,7 +53,7 @@ foreach $jar (@ARGV) {
# wants them all as Parent$Inner, so we keep a mapping which # wants them all as Parent$Inner, so we keep a mapping which
# we use to report the $ version when generating our output # we use to report the $ version when generating our output
my $orig = $_; my $orig = $_;
if ($_ =~ s:\$([^0-9]):.$1:g) { if ($_ =~ s:\$:.:g) {
$orig{$_} = $orig; $orig{$_} = $orig;
} }
@@ -109,29 +109,21 @@ while (@gclasses) {
# interfaces are now at the end of the line # interfaces are now at the end of the line
my @ifaces; my @ifaces;
if ($goods =~ s: implements (.*)$::g) { if ($goods =~ s: implements (.*)$::g) {
my $idefs = $1; my $idefs = clean_class($1);
$idefs =~ s:\s+$::g;
$idefs =~ s:\. :\$:g;
$idefs =~ s: ::g;
$idefs =~ s:\$([^0-9]):.$1:g;
@ifaces = split(/,/, $idefs); @ifaces = split(/,/, $idefs);
} }
# now the parent class or parent interfaces are at the end # now the parent class or parent interfaces are at the end
my @parents; my @parents;
if ($goods =~ s: extends (.*)$::g) { if ($goods =~ s: extends (.*)$::g) {
my $pdefs = $1; my $pdefs = clean_class($1);
$pdefs =~ s:\s+$::g;
$pdefs =~ s:\. :\$:g;
$pdefs =~ s: ::g;
$pdefs =~ s:\$([^0-9]):.$1:g;
@parents = split(/,/, $pdefs); @parents = split(/,/, $pdefs);
} }
# last is the class name # last is the class name
my $class; my $class;
if ($goods =~ s: class ([A-Za-z0-9.\$]+)::g) { if ($goods =~ s: class ([A-Za-z0-9.\$]+)::g) {
$class = $1; $class = clean_class($1);
$class =~ s: ::g; $class =~ s: ::g;
} elsif ($goods =~ s: interface ([A-Za-z0-9.\$]+)::g) { } elsif ($goods =~ s: interface ([A-Za-z0-9.\$]+)::g) {
$class = $1; $class = $1;
@@ -194,6 +186,16 @@ sub min {
return ($a < $b) ? $a : $b; return ($a < $b) ? $a : $b;
} }
# Cleans up class n ames as reported by javap
sub clean_class {
my ($class) = @_;
$class =~ s:\s+$::g;
$class =~ s:\. :\$:g;
$class =~ s: ::g;
$class =~ s:\$:.:g;
return $class;
}
# Reports whether or not the specified class is an instanceof the # Reports whether or not the specified class is an instanceof the
# specified target interface. # specified target interface.
sub implements { sub implements {