Michael Bayne
3f1a21f76c
ends in Set as a DSet. This is not optimal, but writing a full blown parser so that we can analyze the inheritance hierarchy of the files we're processing to determine for sure that something extends DSet would be at least an order of magnitude greater pain in the ass than just doing simple textual processing. We'll leave that up to future people. git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@1232 542714f4-19e9-0310-aa3c-eee0fc999fb1
307 lines
8.6 KiB
Perl
Executable File
307 lines
8.6 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# $Id: gendobj,v 1.12 2002/04/11 19:11:07 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 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 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 (!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])/_$1/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])/_$1/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 (Object 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)
|
|
{
|
|
this.$field = $field;
|
|
requestAttributeChange($fcode, $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)
|
|
{
|
|
this.$field = $field;
|
|
requestAttributeChange($fcode, $value);
|
|
}
|
|
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)
|
|
{
|
|
this.$field\[index\] = value;
|
|
requestElementUpdate($fcode, $value, index);
|
|
}
|
|
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;
|
|
}
|