Permalink
Browse files

Nixed more old cruft.

git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@6785 542714f4-19e9-0310-aa3c-eee0fc999fb1
  • Loading branch information...
1 parent c3e08f4 commit ffba2a1e2062fb1e3114087ccb07da057944ca85 @samskivert samskivert committed Feb 14, 2012
Showing with 0 additions and 412 deletions.
  1. +0 −63 bin/configpp
  2. +0 −245 bin/matchclasses
  3. +0 −19 bin/preflist
  4. +0 −85 bin/runjava
View
@@ -1,63 +0,0 @@
-#!/usr/bin/perl -w
-#
-# $Id$
-#
-# Preprocesses a configuration file (a .dop file, for instance), executing
-# any include directives located in the file.
-
-use File::Basename;
-
-my %files = ();
-my $file = shift or die "Usage: $0 file [key=value key=value...]\n";
-
-my %subs;
-while ($pair = shift) {
- if ($pair =~ m/(\S+)=(\S+)/) {
- $subs{$1} = $2;
- } else {
- warn "Unable to parse substitution '$pair'.\n";
- }
-}
-my $scount = keys %subs;
-
-# change into the directory occupied by the file
-chdir(dirname($file));
-$file = basename($file);
-
-# process this file
-read_file($file, "");
-
-sub read_file {
- my ($path, $parent) = @_;
-
- # do circular reference checking
- if (defined $files{$path}) {
- die "Detected circular inclusion [file=$parent, incl=$path].\n";
- }
- $files{$path} = 1;
-
- # read the file
- my $FILE;
- open($FILE, "$path") or die "Can't read include file '$path': $!\n";
- while (<$FILE>) {
- if (m/^.include \"([^\"]*)\"/) {
- # process the inclusion
- read_file($1, $path);
-
- } elsif ($scount > 0 && m/\@[\S]+\@/) {
- # handle any substitutions
- while (m/\@([-A-Za-z_.]+)\@/) {
- my $key = $1;
- my $value = $subs{$key};
- $value = $key unless (defined $value);
- $_ =~ s/\@$key\@/$value/;
- }
- print $_;
-
- } else {
- print $_;
- }
- }
- close($FILE);
- undef $files{$path};
-}
View
@@ -1,245 +0,0 @@
-#!/usr/bin/perl -w
-#
-# $Id$
-#
-# A script which inspects a hierarchy of classes and generates lists of
-# classes that match specified criterion. The criterion are that a class
-# or one if its parent classes extend a certain class or implement a
-# certain interface.
-
-use strict;
-use Getopt::Long;
-
-my $usage = "Usage: $0 [--verbose] [--prefix prefix] [--prune regexp]xN" .
- "[--implements interface]xN [--extends class --extends]xN jar_file ...\n";
-
-# get our options
-my $debug;
-my $verbose;
-my $prefix = "";
-my @tifaces = ();
-my @tclasses = ();
-my @prunes = ();
-GetOptions("debug" => \$debug,
- "verbose" => \$verbose,
- "prefix=s" => \$prefix,
- "prune=s" => \@prunes,
- "implements=s" => \@tifaces,
- "extends=s" => \@tclasses);
-
-# create a classpath with all supplied jar files
-my $classpath = join(":", @ARGV);
-
-# enumerate all of the java classes in the supplied jar files
-my %orig = ();
-my @classes = ();
-my $jar;
-foreach $jar (@ARGV) {
- if (!open(JAR, "jar tvf $jar|")) {
- warn "Can't list contents of '$jar': $!\n";
- next;
- }
-
- while (<JAR>) {
- if (/\.class$/) {
- chomp;
- $_ =~ s:.* ([^ ]+\.class)$:$1:;
- $_ =~ s:\.class$::g;
- $_ =~ s:/:.:g;
-
- # keerist. for some reason javap insists that named inner
- # classes be referenced as Parent.Inner but anonymous inner
- # classes be referenced as Parent$Inner, but fucking DashO
- # wants them all as Parent$Inner, so we keep a mapping which
- # we use to report the $ version when generating our output
- my $orig = $_;
- if ($_ =~ s:\$:.:g) {
- $orig{$_} = $orig;
- }
-
- # make sure it matches our prefix
- next unless ($_ =~ /^$prefix/);
-
- # make sure it doesn't match any prunes
- my $matched = 0;
- my $prune;
- foreach $prune (@prunes) {
- if ($_ =~ /$prune/) {
- $matched = 1;
- last;
- }
- }
- next if ($matched != 0);
-
- print STDERR "Including $_\n" if $verbose;
- push @classes, $_;
- }
- }
- close(JAR);
-}
-
-# run javap on all of these classes and calculate the inheritence and
-# interface implementation metadata
-my %ptable = ();
-my %itable = ();
-my @gclasses = @classes;
-while (@gclasses) {
- # roll off twenty classes or so at a time
- my $ccount = @gclasses;
- my @cargs = splice(@gclasses, 0, min($ccount, 100));
- my $carg = "'" . join("' '", @cargs) . "'";
-
- # print STDERR "javap -classpath $classpath $carg\n";
-
- if (!open(JAVAP, "javap -classpath $classpath $carg|")) {
- warn "Can't inspect $carg: $!\n";
- next;
- }
-
- # look for a line that identifies a class or interface
- while (<JAVAP>) {
- chomp;
- my $goods = $_;
- my $class;
- next unless ($class = match_class($goods));
-
- # strip off the close brace
- $goods =~ s:\s*{\s*$::g;
-
- # interfaces are now at the end of the line
- my @ifaces;
- if ($goods =~ s: implements (.*)$::g) {
- my $idefs = clean_class($1);
- @ifaces = split(/,/, $idefs);
- }
-
- if (@ifaces) {
- $itable{$class} = \@ifaces;
- print STDERR "-> $class I[" . join(":", @ifaces) . "]\n"
- if ($debug);
- }
-
- # now the parent class or parent interfaces are at the end
- my @parents;
- if ($goods =~ s: extends (.*)$::g) {
- my $pdefs = clean_class($1);
- @parents = split(/,/, $pdefs);
- }
-
- if (@parents) {
- $ptable{$class} = \@parents;
- print STDERR "-> $class E[" . join(":", @parents) . "]\n"
- if ($debug);
- }
- }
- close(JAVAP);
-}
-
-my %matches = ();
-# now blow through the classes looking for matches
-my $class;
-foreach $class (@classes) {
- # check for an interface match
- my $tiface;
- foreach $tiface (@tifaces) {
- print STDERR "Checking $class implements $tiface\n" if ($debug);
- if (implements($class, $tiface)) {
- print STDERR "$class implements $tiface\n" if ($verbose);
- $matches{$class} = 1;
- }
- }
- # check for a class match
- my $tclass;
- foreach $tclass (@tclasses) {
- print STDERR "Checking $class extends $tclass\n" if ($debug);
- if (extends($class, $tclass)) {
- print STDERR "$class extends $tclass\n" if ($verbose);
- $matches{$class} = 1;
- }
- }
-}
-
-# print out the results
-foreach $class (sort keys %matches) {
- print defined $orig{$class} ? "$orig{$class}\n" : "$class\n";
-}
-# print STDERR join("\n", ) . "\n";
-
-# Guess what this does.
-sub min {
- my ($a, $b) = @_;
- return ($a < $b) ? $a : $b;
-}
-
-# Matches a class declaration on the supplied line
-sub match_class {
- my ($line) = @_;
- # print STDERR "Matching $line\n";
- if ($line !~ m:[a-z ]*(class|interface) ([A-Za-z0-9.\$]+):) {
- return undef;
- }
- # print STDERR "Matched $2\n";
- my $class = clean_class($2);
- $class =~ s: ::g;
- return $class;
-}
-
-# 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
-# specified target interface.
-sub implements {
- my ($class, $target) = @_;
-
- # scan up this classes parent hierarchy looking to see if it or any
- # parent class implements the specified interface (or a derived
- # interface)
- my $crecord = $ptable{$class};
- if (defined $crecord) {
- # check the interfaces implemented by this class
- my $irecord = $itable{$class};
- if (defined $irecord) {
- my $iface;
- foreach $iface (@{$irecord}) {
- return 1 if (extends($iface, $target));
- }
- }
-
- # check our parents
- my $pclass;
- foreach $pclass (@{$crecord}) {
- return 1 if (implements($pclass, $target));
- }
- }
-
- return 0;
-}
-
-# Reports whether or not the specified class is an instanceof the
-# specified target class.
-sub extends {
- 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
- # (recursing as necessary up the hierarchy)
- my $crecord = $ptable{$class};
- if (defined $crecord) {
- my $pclass;
- foreach $pclass (@{$crecord}) {
- return 1 if (extends($pclass, $target));
- }
- }
-
- return 0;
-}
View
@@ -1,19 +0,0 @@
-#!/bin/sh
-#
-# $Id$
-#
-
-# Fucking ant. This simple script exists so that I can prefix a list of
-# jar files with a directory and stick them all on the same line so that
-# they can be passed on the command line to scripts that need a list of
-# jar files.
-
-LIBDIR=$1
-JARLIST=$2
-
-if [ -z "$LIBDIR" -o -z "$JARLIST" ]; then
- echo "Usage: $0 libdir jarsfile"
- exit -1
-fi
-
-awk "{ print \"$LIBDIR/\" \$1 }" < $JARLIST | xargs
Oops, something went wrong.

0 comments on commit ffba2a1

Please sign in to comment.