For our purposes we want A and all derived classes, rather than all
classes that extend A. Other perlformattengruven. git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@1790 542714f4-19e9-0310-aa3c-eee0fc999fb1
This commit is contained in:
+8
-15
@@ -1,6 +1,6 @@
|
|||||||
#!/usr/bin/perl -w
|
#!/usr/bin/perl -w
|
||||||
#
|
#
|
||||||
# $Id: matchclasses,v 1.1 2002/10/08 18:46:02 mdb Exp $
|
# $Id: matchclasses,v 1.2 2002/10/08 22:02:13 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
|
||||||
@@ -182,11 +182,7 @@ foreach $class (@classes) {
|
|||||||
|
|
||||||
# print out the results
|
# print out the results
|
||||||
foreach $class (sort keys %matches) {
|
foreach $class (sort keys %matches) {
|
||||||
if (defined $orig{$class}) {
|
print defined $orig{$class} ? "$orig{$class}\n" : "$class\n";
|
||||||
print "$orig{$class}\n";
|
|
||||||
} else {
|
|
||||||
print "$class\n";
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
# print join("\n", ) . "\n";
|
# print join("\n", ) . "\n";
|
||||||
|
|
||||||
@@ -211,18 +207,14 @@ sub implements {
|
|||||||
if (defined $irecord) {
|
if (defined $irecord) {
|
||||||
my $iface;
|
my $iface;
|
||||||
foreach $iface (@{$irecord}) {
|
foreach $iface (@{$irecord}) {
|
||||||
if ($iface eq $target || extends($iface, $target)) {
|
return 1 if (extends($iface, $target));
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
# check our parents
|
# check our parents
|
||||||
my $pclass;
|
my $pclass;
|
||||||
foreach $pclass (@{$crecord}) {
|
foreach $pclass (@{$crecord}) {
|
||||||
if (implements($pclass, $target)) {
|
return 1 if (implements($pclass, $target));
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -234,15 +226,16 @@ sub implements {
|
|||||||
sub extends {
|
sub extends {
|
||||||
my ($class, $target) = @_;
|
my ($class, $target) = @_;
|
||||||
|
|
||||||
|
# if we are the class, we're good
|
||||||
|
return 1 if ($class eq $target);
|
||||||
|
|
||||||
# look to see if any of our parent classes extend the target class
|
# look to see if any of our parent classes extend the target class
|
||||||
# (recursing as necessary up the hierarchy)
|
# (recursing as necessary up the hierarchy)
|
||||||
my $crecord = $ptable{$class};
|
my $crecord = $ptable{$class};
|
||||||
if (defined $crecord) {
|
if (defined $crecord) {
|
||||||
my $pclass;
|
my $pclass;
|
||||||
foreach $pclass (@{$crecord}) {
|
foreach $pclass (@{$crecord}) {
|
||||||
if ($target eq $pclass || extends($pclass, $target)) {
|
return 1 if (extends($pclass, $target));
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user