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