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:
+15
-13
@@ -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 {
|
||||||
|
|||||||
Reference in New Issue
Block a user