AfflictionNetworks/narya
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merry Christmas to the server CPUs. It occurred to me that we could

Browse Source 
accomplish our "previous value" support in the distributed object system
without using reflection and could also avoid using reflection in the case
where we have already applied the event on the server (which is generally
the case on the server).

Rather than hacking up the gendobj script, I took this opportunity also to
rewrite the DObject generation script as an Ant task and in doing so,
implemented another recent idea which is that we can just augment the
FooObject.java file instead of having a separate .dobj and .java file.

You'd think it was spring there's so much cleaning going on.


git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@3284 542714f4-19e9-0310-aa3c-eee0fc999fb1
This commit is contained in:
Michael Bayne
2004-12-28 03:48:07 +00:00
parent bd80c348eb
commit 1d976ceaf8
13 changed files with 818 additions and 741 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/gendobj
-306
View File
@@ -1,306 +0,0 @@
#!/usr/bin/perl -w
#
# $Id: gendobj,v 1.16 2003/04/30 22:44:48 mdb Exp $
#
# gendobj is used to generate DObject source file definitons basded on
# abbreviated declarations. Because DObject fields all have standard
# setter methods which automatically generate events in the distributed
# object system, it is convenient to generate these methods rather than
# implement them by hand.
use strict;
use Getopt::Long;
my $usage = "Usage: $0 [--verbose] [--force] <dobj_decl_files>\n";
# get our options
my $verbose;
my $force;
GetOptions("verbose" => \$verbose,
"force" => \$force);
die $usage unless (@ARGV);
my $source;
while ($source = shift) {
# massage the source file name into the destination file name
my $dest = $source;
$dest =~ s/.dobj$/.java/;
if ($dest !~ /.java$/) {
warn "Unable to infer target file name from original: $source\n";
next;
}
# if the destination file is newer than the source file, do nothing
my $dmtime = (stat($dest))[9];
my $smtime = (stat($source))[9];
if (!$force && (defined $dmtime) && ($dmtime > $smtime)) {
warn "Skipping $source as source is newer.\n" if ($verbose);
next;
}
# if the destination file already exists, slurp the existing CVS Id
# information out of it so that we can slip that into the new one
my $idstr;
if (-f $dest && open(IN, "$dest")) {
while (<IN>) {
if (/(\$[I][d]: .*\$)/) {
$idstr = $1;
}
}
close(IN);
}
if (!open(IN, "$source")) {
warn "Unable to open $source for reading: $!\n";
next;
}
print "Processing $source...\n" if ($verbose);
my @preamble;
my @classdecl;
my @classbody;
my @fields;
my $mode = "preamble";
while (<IN>) {
# swap in the parsed Id string if we have one
$_ =~ s/(\$[I][d]: .*\$)/$idstr/ if (defined $idstr);
if ($mode eq "preamble") {
# look to see if we're transitioning from the preamble to the
# class declaration
if (/^public class [A-Za-z]*/) {
$mode = "classbody";
# keep adding to classdecl until we find a line that
# contains a {
push(@classdecl, $_);
while ($_ !~ /{/) {
$_ = <IN>;
last if (! defined $_);
push(@classdecl, $_);
}
} else {
push (@preamble, $_);
}
} elsif ($mode eq "classbody") {
# if we've reached a line with just a } at the beginning, we
# stop reading the file
last if (/^}\s*$/);
# everything goes into the body
push (@classbody, $_);
# check to see if we're seeing a DObject field declaration
if (/^\s*public ([A-Za-z]+(\[\])*) ([A-Za-z]+)( = .*)?;\s*$/) {
print "Matched field [type=$1, field=$3]\n" if ($verbose);
push (@fields, [$1, $3]);
}
}
}
close(IN);
# generate the output file
if (!open(OUT, ">$dest")) {
warn "Unable to open $dest for writing: $!\n";
next;
}
print "Writing output to $dest...\n" if ($verbose);
print OUT join("", @preamble);
print OUT join("", @classdecl);
my $field;
foreach $field (@fields) {
print_dobj_constant($field->[0], $field->[1]);
}
print OUT join("", @classbody);
foreach $field (@fields) {
print_dobj_setters($field->[0], $field->[1]);
}
print OUT "}\n";
close(OUT);
}
sub print_dobj_constant
{
my ($type, $field) = @_;
# convert mixed case to upper with underscores
my $fcode = $field;
$fcode =~ s/([a-z])([A-Z])/$1_$2/g;
$fcode =~ tr/a-z/A-Z/;
print OUT <<EOF;
/** The field name of the <code>$field</code> field. */
public static final String $fcode = "$field";
EOF
}
sub print_dobj_setters
{
my ($type, $field) = @_;
# convert mixed case to upper with underscores
my $fcode = $field;
$fcode =~ s/([a-z])([A-Z])/$1_$2/g;
$fcode =~ tr/a-z/A-Z/;
my $cfield = $field;
$cfield =~ s/(\w)/\U$1/;
# some known types have special setters
if ($type =~ ".*Set") {
print OUT <<EOF;
/**
* Requests that the specified entry be added to the
* <code>$field</code> set. The set will not change until the event is
* actually propagated through the system.
*/
public void addTo$cfield (DSet.Entry elem)
{
requestEntryAdd($fcode, elem);
}
/**
* Requests that the entry matching the supplied key be removed from
* the <code>$field</code> set. The set will not change until the
* event is actually propagated through the system.
*/
public void removeFrom$cfield (Comparable key)
{
requestEntryRemove($fcode, key);
}
/**
* Requests that the specified entry be updated in the
* <code>$field</code> set. The set will not change until the event is
* actually propagated through the system.
*/
public void update$cfield (DSet.Entry elem)
{
requestEntryUpdate($fcode, elem);
}
/**
* Requests that the <code>$field</code> field be set to the
* specified value. Generally one only adds, updates and removes
* entries of a distributed set, but certain situations call for a
* complete replacement of the set value. The local value will be
* updated immediately and an event will be propagated through the
* system to notify all listeners that the attribute did
* change. Proxied copies of this object (on clients) will apply the
* value change when they received the attribute changed notification.
*/
public void set$cfield ($type $field)
{
requestAttributeChange($fcode, $field);
this.$field = $field;
}
EOF
} elsif ($type eq "OidList") {
print OUT <<EOF;
/**
* Requests that the specified oid be added to the
* <code>$field</code> oid list. The list will not change until the
* event is actually propagated through the system.
*/
public void addTo$cfield (int oid)
{
requestOidAdd($fcode, oid);
}
/**
* Requests that the specified oid be removed from the
* <code>$field</code> oid list. The list will not change until the
* event is actually propagated through the system.
*/
public void removeFrom$cfield (int oid)
{
requestOidRemove($fcode, oid);
}
EOF
} else {
my $value = wrap($type, $field);
print OUT <<EOF;
/**
* Requests that the <code>$field</code> field be set to the specified
* value. The local value will be updated immediately and an event
* will be propagated through the system to notify all listeners that
* the attribute did change. Proxied copies of this object (on
* clients) will apply the value change when they received the
* attribute changed notification.
*/
public void set$cfield ($type $field)
{
requestAttributeChange($fcode, $value);
this.$field = $field;
}
EOF
# add an element setter if this field is an array
if ($type =~ m:\[\]$:) {
my $etype = $type;
$etype =~ s:\[\]$::g;
my $value = wrap($etype, "value");
# this is perl; we're allowed to hack
my $cfieldat = $cfield . "At";
print OUT <<EOF;
/**
* Requests that the <code>index</code>th element of
* <code>$field</code> field be set to the specified value. The local
* value will be updated immediately and an event will be propagated
* through the system to notify all listeners that the attribute did
* change. Proxied copies of this object (on clients) will apply the
* value change when they received the attribute changed notification.
*/
public void set$cfieldat ($etype value, int index)
{
requestElementUpdate($fcode, $value, index);
this.$field\[index\] = value;
}
EOF
}
}
}
# we may need to wrap the field for certain types
sub wrap
{
my ($type, $field) = @_;
if ($type eq "boolean") {
return "new Boolean($field)";
} elsif ($type eq "byte") {
return "new Byte($field)";
} elsif ($type eq "short") {
return "new Short($field)";
} elsif ($type eq "int") {
return "new Integer($field)";
} elsif ($type eq "long") {
return "new Long($field)";
} elsif ($type eq "float") {
return "new Float($field)";
} elsif ($type eq "double") {
return "new Double($field)";
}
return $field;
}