Nixed more old cruft.
git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@6785 542714f4-19e9-0310-aa3c-eee0fc999fb1
This commit is contained in:
Michael Bayne
@@ -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};
|
|
||||||
}
|
|
||||||
@@ -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;
|
|
||||||
}
|
|
||||||
@@ -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
|
|
||||||
-85
@@ -1,85 +0,0 @@
|
|||||||
#!/usr/bin/perl -w
|
|
||||||
|
|
||||||
use Getopt::Std;
|
|
||||||
|
|
||||||
my $usage = "Usage: $0 [-p pid_file] [-r root_directory] args\n";
|
|
||||||
|
|
||||||
# locations of stuff
|
|
||||||
chomp($location = `dirname $0`);
|
|
||||||
|
|
||||||
# get the server root by popping the /bin off of our parent directory
|
|
||||||
@parts = split(/\//, $location);
|
|
||||||
pop(@parts);
|
|
||||||
my $root = join("/", @parts);
|
|
||||||
|
|
||||||
# determine our machine architecture
|
|
||||||
my $ostype = `uname -s`;
|
|
||||||
my $machtype = `uname -m`;
|
|
||||||
chomp($ostype);
|
|
||||||
chomp($machtype);
|
|
||||||
my $arch = "$machtype-$ostype";
|
|
||||||
|
|
||||||
# add our native libraries to the runtime library path
|
|
||||||
my $libs = "$root/dist/lib/$arch";
|
|
||||||
my $libpath = $ENV{"LD_LIBRARY_PATH"};
|
|
||||||
|
|
||||||
if (defined $libpath) {
|
|
||||||
$ENV{"LD_LIBRARY_PATH"} = "$libs:$libpath";
|
|
||||||
} else {
|
|
||||||
$ENV{"LD_LIBRARY_PATH"} = $libs;
|
|
||||||
}
|
|
||||||
|
|
||||||
# put everything in our class path
|
|
||||||
my $classpath = "-classpath $root/dist/classes";
|
|
||||||
|
|
||||||
# add zip and jar files from our dist/lib/ directory
|
|
||||||
my @dirs = ( "$root/dist/lib" );
|
|
||||||
foreach $dir (@dirs) {
|
|
||||||
next unless (defined $dir);
|
|
||||||
if (opendir(DIR, $dir)) {
|
|
||||||
foreach $lib (grep { /.(zip|jar)/ && -f "$dir/$_" } readdir(DIR)) {
|
|
||||||
$classpath .= ":$dir/$lib";
|
|
||||||
}
|
|
||||||
closedir DIR;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# finally add the standard classes
|
|
||||||
$classpath = "$classpath";
|
|
||||||
|
|
||||||
# specify our resource root (the resource manager needs this)
|
|
||||||
my $rootarg = "-Dresource_dir=$root/tests/rsrc";
|
|
||||||
|
|
||||||
my $pid_file = undef;
|
|
||||||
my $i = 0;
|
|
||||||
|
|
||||||
# strip out the -p and -r args (we'd use getopt() but the damned thing
|
|
||||||
# provides no way of escaping arguments so that we can pass args to
|
|
||||||
# runjava that get passed down to the JVM)
|
|
||||||
for ($i = 0; $i < @ARGV; $i++) {
|
|
||||||
my $arg = $ARGV[$i];
|
|
||||||
|
|
||||||
# stop when we see -- (and strip it out because Java don't dig --)
|
|
||||||
if ($arg eq "--") {
|
|
||||||
splice(@ARGV, $i, 1);
|
|
||||||
last;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($arg eq "-p") {
|
|
||||||
$pid_file = $ARGV[$i+1];
|
|
||||||
splice(@ARGV, $i, 2);
|
|
||||||
$i -= 1; # decrement i so that things stay in sync
|
|
||||||
|
|
||||||
} elsif ($arg eq "-r") {
|
|
||||||
$rootarg = "-DDapplication.root=" . $ARGV[$i+1];
|
|
||||||
splice(@ARGV, $i, 2);
|
|
||||||
$i -= 1; # decrement i so that things stay in sync
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# log the pid file if requested to do so
|
|
||||||
print `echo $$ > $pid_file` if (defined $pid_file);
|
|
||||||
|
|
||||||
my $cmd = "java -mx256M $classpath $rootarg " . join(" ", @ARGV);
|
|
||||||
# print "$cmd\n";
|
|
||||||
exec($cmd);
|
|
||||||
Reference in New Issue
Block a user