Michael Bayne
d7b2c3de87
git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@1658 542714f4-19e9-0310-aa3c-eee0fc999fb1
468 lines
14 KiB
Perl
Executable File
468 lines
14 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# $Id: genservice,v 1.5 2002/08/20 19:36:43 mdb Exp $
|
|
#
|
|
# This script is used to generate invocation service marshaller and
|
|
# unmarshaller classes based on invocation service interface definitions.
|
|
|
|
use strict;
|
|
use Getopt::Long;
|
|
use Template;
|
|
use File::Basename;
|
|
use POSIX qw(strftime);
|
|
|
|
# use Dumpvalue;
|
|
|
|
my $usage = "Usage: $0 [--verbose] [--force] [--classpath classpath] " .
|
|
"[--sourcedir sourcedir] <sourcedir/foo/bar/FooService.java> [...]\n";
|
|
|
|
# get our options
|
|
my $verbose;
|
|
my $force;
|
|
my $classpath;
|
|
my $sourcedir = ".";
|
|
GetOptions("verbose" => \$verbose,
|
|
"force" => \$force,
|
|
"classpath=s" => \$classpath,
|
|
"sourcedir=s" => \$sourcedir,
|
|
);
|
|
|
|
# some standard business
|
|
my $ISVC_CNAME = "com.threerings.presents.client.InvocationService";
|
|
|
|
# make sure we have at least one source file argument
|
|
die $usage unless (@ARGV);
|
|
|
|
# locate a few necessary other files
|
|
my $script = basename($0);
|
|
my $rootdir = dirname($0); $rootdir =~ s:bin$:.:g;
|
|
my $marshtmpl = "$rootdir/lib/marshaller.tmpl";
|
|
my $disptmpl = "$rootdir/lib/dispatcher.tmpl";
|
|
|
|
# now process our source files
|
|
my %imports;
|
|
my $srcfile;
|
|
my $spackage;
|
|
|
|
while ($srcfile = shift) {
|
|
# do a quick check to see if the marshaller file is newer than the
|
|
# service file in which case we can stop now
|
|
my $tpath = $srcfile;
|
|
$tpath =~ s/Service/Marshaller/;
|
|
$tpath =~ s:/client/:/data/:;
|
|
my $dmtime = (stat($tpath))[9];
|
|
my $smtime = (stat($srcfile))[9];
|
|
if (!$force && (defined $dmtime) && ($dmtime > $smtime)) {
|
|
my @foo = split(/\//, $srcfile);
|
|
my $rfile = pop @foo;
|
|
warn "Skipping ...$rfile as generated files are up to date.\n"
|
|
if ($verbose);
|
|
next;
|
|
}
|
|
|
|
# convert the source file given on the command line to a class name
|
|
open(SRC, "$srcfile") or die "$script: Unable to read '$srcfile': $!\n";
|
|
while (<SRC>) {
|
|
if (/^package (\S+);/) {
|
|
$spackage = $1;
|
|
}
|
|
}
|
|
$srcfile =~ m:/([^/]+)\.java$:;
|
|
my $class = "$spackage.$1";
|
|
|
|
# run javap on the interface class
|
|
my $jpcp = (defined $classpath) ? "-classpath $classpath" : "";
|
|
my $jpcmd = "javap $jpcp $class";
|
|
|
|
# clear out the imports table
|
|
%imports = ();
|
|
|
|
my $ifcname;
|
|
my @methods;
|
|
my @listeners;
|
|
my $listener;
|
|
|
|
my $methcount = 1;
|
|
my $lmethcount = 0;
|
|
|
|
open(JPO, "$jpcmd|") or die "$script: Can't invoke '$jpcmd': $!\n";
|
|
while (<JPO>) {
|
|
if (/^public interface (\S+) extends ([^, ]+)/) {
|
|
$ifcname = $1;
|
|
$imports{$ifcname} = 1;
|
|
my $sname = $2;
|
|
|
|
# if this interface does not extend InvocationService, we
|
|
# don't want to do nothin'
|
|
die "$script: $ifcname does not extend " .
|
|
"InvocationService\n (extends $sname).\n"
|
|
if ($sname ne $ISVC_CNAME);
|
|
|
|
} elsif (/^ public abstract void (\S+)\(([^\)]*)\)/) {
|
|
my $methname = $1;
|
|
my $rawargs = $2; $rawargs =~ s:\$:.:g;
|
|
my @methargs = split(/, /, $rawargs);
|
|
grab_imports(@methargs);
|
|
my @trimmed_args = trim_args(@methargs);
|
|
my @unwrap_args = @trimmed_args;
|
|
shift @unwrap_args;
|
|
push @methods, {
|
|
"mname" => $methname,
|
|
"mcode" => to_caps($methname),
|
|
"mcodeval" => $methcount++,
|
|
"arglist" => gen_arglist(@trimmed_args),
|
|
"wrapped_args" => wrap_arglist(1, @trimmed_args),
|
|
"unwrapped_args" => unwrap_arglist(@unwrap_args),
|
|
"listener_args" => gen_listener_args(@trimmed_args),
|
|
};
|
|
|
|
} elsif (/^\s+public static interface \S+\. (\S+) extends (\S+)\. (\S+)/) {
|
|
my $inner = $1;
|
|
my $eouter = $2;
|
|
my $einner = $3;
|
|
|
|
if ($eouter ne $ISVC_CNAME) {
|
|
warn "Unrecognized inner interface $inner (extends $2.$3). " .
|
|
"Skipping.\n";
|
|
undef $listener;
|
|
next;
|
|
}
|
|
|
|
die "$script: Invalid callback interface name $inner.\n" .
|
|
"Must be of the form <foo>Listener\n"
|
|
if ($inner !~ m/Listener$/);
|
|
|
|
# create a new listener table to hold info on this listener class
|
|
$inner =~ s:Listener$::;
|
|
my @lmethods = ();
|
|
$listener = {
|
|
"name" => $inner,
|
|
"methods" => \@lmethods,
|
|
};
|
|
push @listeners, $listener;
|
|
$lmethcount = 0;
|
|
|
|
} elsif (/^ public abstract void (\S+)\(([^\)]*)\)/) {
|
|
my $methname = $1;
|
|
my $rawargs = $2; $rawargs =~ s:\$:.:g;
|
|
my @methargs = split(/, /, $rawargs);
|
|
|
|
# skip this method declaration if we're not parsing a valid
|
|
# listener inner interface declaration
|
|
next unless (defined $listener);
|
|
|
|
grab_imports(@methargs);
|
|
my @trimmed_args = trim_args(@methargs);
|
|
my $lmethod = {
|
|
"mname" => $methname,
|
|
"mcode" => to_caps($methname),
|
|
"mcodeval" => ++$lmethcount,
|
|
"arglist" => gen_arglist(@trimmed_args),
|
|
"wrapped_args" => wrap_arglist(0, @trimmed_args),
|
|
"unwrapped_args" => unwrap_arglist(@trimmed_args),
|
|
};
|
|
push @{$listener->{"methods"}}, $lmethod;
|
|
|
|
} elsif (/^Compiled from/ ||
|
|
/ACC_SUPER/ ||
|
|
/^\s*[{}]\s*$/) {
|
|
# skip it
|
|
|
|
} else {
|
|
warn "$script: ?: $_";
|
|
}
|
|
}
|
|
|
|
die "$script: Unable to parse primary interface definition.\n"
|
|
unless (defined $ifcname);
|
|
|
|
print "$script: Processing $ifcname...\n";
|
|
|
|
# extract the package name
|
|
my $ifcpkg = $ifcname;
|
|
$ifcpkg =~ s/\.[^.]*$//g;
|
|
|
|
# extract the service name
|
|
my $svcname = substr($ifcname, length($ifcpkg)+1);
|
|
$svcname =~ s/Service$//g;
|
|
die "$script: Unable to discern service name from $ifcname.\n".
|
|
"Service interface definitions should be named <foo>Service.\n"
|
|
if ($svcname eq $ifcname);
|
|
|
|
# assume everything's in the same package to start
|
|
my $marshpkg = $ifcpkg;
|
|
my $disppkg = $ifcpkg;
|
|
|
|
# if the interface is in a 'client' package, we'll put the marshaller
|
|
# in the associated 'data' package and the dispatcher in the 'server'
|
|
# package
|
|
if ($ifcpkg =~ m/\.client$/) {
|
|
$marshpkg =~ s/\.client$/.data/g;
|
|
$disppkg =~ s/\.client$/.server/g;
|
|
}
|
|
|
|
# create a template processor
|
|
my $ttconfig = {
|
|
RELATIVE => 1,
|
|
ABSOLUTE => 1,
|
|
};
|
|
my $tt = Template->new($ttconfig);
|
|
my $genstamp = strftime("%T %D", localtime);
|
|
|
|
# now we generate the <foo>Marshaller class definition
|
|
my $marshpath = $marshpkg;
|
|
$marshpath =~ s:\.:/:g;
|
|
$marshpath = "$sourcedir/$marshpath/$svcname" . "Marshaller.java";
|
|
|
|
print "$script: Generating marshaller:\n" .
|
|
" $marshpkg.${svcname}Marshaller in\n" .
|
|
" $marshpath\n" if ($verbose);
|
|
|
|
# populate a data table with all the data we'll need to fill out our
|
|
# marshaller template file
|
|
my %mimports = %imports;
|
|
$mimports{"com.threerings.presents.client.Client"} = 1;
|
|
$mimports{"com.threerings.presents.data.InvocationMarshaller"} = 1;
|
|
$mimports{"com.threerings.presents.dobj.InvocationResponseEvent"} = 1;
|
|
my @mimportsl = sort keys %mimports;
|
|
my %mdata = ( "idstr" => slurp_idstr($marshpath),
|
|
"imports" => \@mimportsl,
|
|
"name" => $svcname,
|
|
"package" => $marshpkg,
|
|
"listeners" => \@listeners,
|
|
"methods" => \@methods,
|
|
"genstamp" => $genstamp,
|
|
);
|
|
|
|
# my $dumper = Dumpvalue->new;
|
|
# $dumper->dumpValue(\%mdata);
|
|
|
|
$tt->process($marshtmpl, \%mdata, $marshpath) or
|
|
die "$script: Unable to process template file '$marshtmpl': " .
|
|
$tt->error() . "\n";
|
|
|
|
# now we generate the <foo>Dispatcher class definition
|
|
my $disppath = $disppkg;
|
|
$disppath =~ s:\.:/:g;
|
|
$disppath = "$sourcedir/$disppath/$svcname" . "Dispatcher.java";
|
|
|
|
print "$script: Generating dispatcher:\n" .
|
|
" $disppkg.${svcname}Dispatcher in\n" .
|
|
" $disppath\n" if ($verbose);
|
|
|
|
# populate a data table with all the data we'll need to fill out our
|
|
# dispatcher template file
|
|
my %dimports = %imports;
|
|
$dimports{"com.threerings.presents.data.ClientObject"} = 1;
|
|
$dimports{"com.threerings.presents.data.InvocationMarshaller"} = 1;
|
|
$dimports{"com.threerings.presents.server.InvocationDispatcher"} = 1;
|
|
$dimports{"com.threerings.presents.server.InvocationException"} = 1;
|
|
$dimports{"$marshpkg.${svcname}Marshaller"} = 1;
|
|
my @dimportsl = sort keys %dimports;
|
|
my %ddata = ( "idstr" => slurp_idstr($disppath),
|
|
"imports" => \@dimportsl,
|
|
"name" => $svcname,
|
|
"package" => $disppkg,
|
|
"listeners" => \@listeners,
|
|
"methods" => \@methods,
|
|
"genstamp" => $genstamp,
|
|
);
|
|
|
|
# my $dumper = Dumpvalue->new;
|
|
# $dumper->dumpValue(\%ddata);
|
|
|
|
$tt->process($disptmpl, \%ddata, $disppath) or
|
|
die "$script: Unable to process template file '$disptmpl': " .
|
|
$tt->error() . "\n";
|
|
}
|
|
|
|
#
|
|
# Extracts the imports from the supplied list of arguments.
|
|
#
|
|
sub grab_imports {
|
|
my $class;
|
|
foreach $class (@_) {
|
|
# skip classes in java.lang
|
|
next if ($class =~ m/^java\.lang\.[^.]+$/);
|
|
# skip primitive types
|
|
next unless ($class =~ m/\./);
|
|
|
|
# trim array delimiters
|
|
my $tclass = $class;
|
|
$tclass =~ s:[\[\]]::g;
|
|
|
|
# stuff the class into our import table
|
|
$imports{$tclass} = 1;
|
|
|
|
# if this class is a listener and not in the same package as the
|
|
# service class we're currently processing, we need to import its
|
|
# marshaller as well
|
|
if ($tclass =~ m/Listener$/ &&
|
|
$tclass !~ m/^$spackage/ &&
|
|
$tclass !~ $ISVC_CNAME) {
|
|
my $mclass = $tclass;
|
|
$mclass =~ s:\.client\.:.data.:g;
|
|
$mclass =~ s:Listener:Marshaller:g;
|
|
$mclass =~ s:Service:Marshaller:g;
|
|
$imports{$mclass} = 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
#
|
|
# Strips the package name from the method argument types.
|
|
#
|
|
sub trim_args {
|
|
my @targs;
|
|
my $arg;
|
|
foreach $arg (@_) {
|
|
$arg =~ s/^.*\.([^.]+)$/$1/;
|
|
push @targs, $arg;
|
|
}
|
|
return @targs;
|
|
}
|
|
|
|
#
|
|
# Converts a mixed case name to uppercase with underscores.
|
|
#
|
|
sub to_caps {
|
|
my ($fcode) = @_;
|
|
$fcode =~ s/([a-z])([A-Z])/$1_$2/g;
|
|
$fcode =~ tr/a-z/A-Z/;
|
|
return $fcode;
|
|
}
|
|
|
|
#
|
|
# Generates an argument list with argument names from a list of argument
|
|
# types.
|
|
#
|
|
sub gen_arglist {
|
|
my $arg;
|
|
my $arglist = "";
|
|
my $i = 1;
|
|
foreach $arg (@_) {
|
|
$arglist .= ", " if (length($arglist) > 0);
|
|
$arglist .= "$arg arg$i";
|
|
$i++;
|
|
}
|
|
return $arglist;
|
|
}
|
|
|
|
#
|
|
# Converts the supplied argument type list into a list of values suitable
|
|
# for use in an Object array initializer (meaning object types are used as
|
|
# is and primitive types are wrapped).
|
|
#
|
|
sub wrap_arglist {
|
|
my $skip = shift @_;
|
|
my $argvals = "";
|
|
my $i = 0;
|
|
my $arg;
|
|
foreach $arg (@_) {
|
|
$i++;
|
|
next if ($i <= $skip);
|
|
$argvals .= ", " if (length($argvals) > 0);
|
|
if ($arg eq "boolean") {
|
|
$argvals .= "new Boolean(arg$i)";
|
|
} elsif ($arg eq "byte") {
|
|
$argvals .= "new Byte(arg$i)";
|
|
} elsif ($arg eq "short") {
|
|
$argvals .= "new Short(arg$i)";
|
|
} elsif ($arg eq "char") {
|
|
$argvals .= "new Char(arg$i)";
|
|
} elsif ($arg eq "int") {
|
|
$argvals .= "new Integer(arg$i)";
|
|
} elsif ($arg eq "long") {
|
|
$argvals .= "new Long(arg$i)";
|
|
} elsif ($arg eq "float") {
|
|
$argvals .= "new Float(arg$i)";
|
|
} elsif ($arg eq "double") {
|
|
$argvals .= "new Double(arg$i)";
|
|
} elsif ($arg =~ /Listener$/) {
|
|
$argvals .= "listener$i";
|
|
} else {
|
|
$argvals .= "arg$i";
|
|
}
|
|
}
|
|
return $argvals;
|
|
}
|
|
|
|
#
|
|
# Converts the supplied argument type list into a list of values which
|
|
# represent the unwrapped value of each element.
|
|
#
|
|
sub unwrap_arglist {
|
|
my $argvals = "";
|
|
my $i = 0;
|
|
my $arg;
|
|
foreach $arg (@_) {
|
|
$argvals .= ", " if (length($argvals) > 0);
|
|
if ($arg eq "boolean") {
|
|
$argvals .= "((Boolean)args[$i]).booleanValue()";
|
|
} elsif ($arg eq "byte") {
|
|
$argvals .= "((Byte)args[$i]).byteValue()";
|
|
} elsif ($arg eq "short") {
|
|
$argvals .= "((Short)args[$i]).shortValue()";
|
|
} elsif ($arg eq "char") {
|
|
$argvals .= "((Char)args[$i]).charValue()";
|
|
} elsif ($arg eq "int") {
|
|
$argvals .= "((Integer)args[$i]).intValue()";
|
|
} elsif ($arg eq "long") {
|
|
$argvals .= "((Long)args[$i]).longValue()";
|
|
} elsif ($arg eq "float") {
|
|
$argvals .= "((Float)args[$i]).floatValue()";
|
|
} elsif ($arg eq "double") {
|
|
$argvals .= "((Double)args[$i]).doubleValue()";
|
|
} else {
|
|
$argvals .= "($arg)args[$i]";
|
|
}
|
|
$i++;
|
|
}
|
|
return $argvals;
|
|
}
|
|
|
|
#
|
|
# Generates the necessary data to wrap listeners in listener marshaller
|
|
# instances.
|
|
#
|
|
sub gen_listener_args {
|
|
my $arg;
|
|
my @listener_args = ();
|
|
my $i = 0;
|
|
foreach $arg (@_) {
|
|
$i++;
|
|
next unless ($arg =~ /Listener$/);
|
|
|
|
my $mtype = $arg;
|
|
if ($mtype eq "InvocationListener") {
|
|
$mtype = "ListenerMarshaller";
|
|
} else {
|
|
$mtype =~ s:Listener$:Marshaller:;
|
|
}
|
|
|
|
push (@listener_args, { "mtype" => $mtype,
|
|
"aname" => "listener$i",
|
|
"oaname" => "arg$i" });
|
|
}
|
|
return \@listener_args;
|
|
}
|
|
|
|
#
|
|
# If the specified file exists, it is opened and its RCS Id string is read
|
|
# and returned.
|
|
#
|
|
sub slurp_idstr {
|
|
my ($path) = @_;
|
|
my $idstr = "\$Id\$";
|
|
if (-f $path && open(IN, "$path")) {
|
|
while (<IN>) {
|
|
if (/(\$[I][d]: .*\$)/) {
|
|
$idstr = $1;
|
|
last;
|
|
}
|
|
}
|
|
close(IN);
|
|
}
|
|
return $idstr;
|
|
}
|