From 78f48f2add9f7581ccf54c1995d9a9a5400276ec Mon Sep 17 00:00:00 2001
From: Michael Bayne <mdb@threerings.net>
Date: Fri, 9 Aug 2002 03:33:16 +0000
Subject: [PATCH] Script for generating marshaller and dispatcher classes based
 on an invocation service interface definition.

git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@1633 542714f4-19e9-0310-aa3c-eee0fc999fb1
---
 bin/genservice | 441 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 441 insertions(+)
 create mode 100755 bin/genservice

diff --git a/bin/genservice b/bin/genservice
new file mode 100755
index 000000000..1e4cc0c09
--- /dev/null
+++ b/bin/genservice
@@ -0,0 +1,441 @@
+#!/usr/bin/perl -w
+#
+# $Id: genservice,v 1.1 2002/08/09 03:33:16 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/sdispatcher.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 (\S+)/) {
+            $ifcname = $1;
+            $imports{$ifcname} = 1;
+            my $sname = $2;
+
+            # if this interface does not extend InvocationService, we
+            # don't want to do nothin'
+            die "$script: Service interface 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
+        };
+    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 = ( "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 = ( "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/\./);
+
+        # stuff the class into our import table
+        $imports{$class} = 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 ($class =~ m/Listener$/ &&
+            $class !~ m/^$spackage/ &&
+            $class !~ $ISVC_CNAME) {
+            my $mclass = $class;
+            $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;
+}