Michael Bayne
5f18acd3d8
*always* set immediately because after some deliberation, we decided that doing that led to less unexpectedly annoying behavior than having to wait for the event to propagate to see the new value. git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@1062 542714f4-19e9-0310-aa3c-eee0fc999fb1
275 lines
7.6 KiB
Perl
Executable File
275 lines
7.6 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# $Id: gendobj,v 1.7 2002/02/20 23:35:42 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/;
|
|
|
|
# we may need to wrap the field for certain types
|
|
my $dobjval = $field;
|
|
if ($type eq "boolean") {
|
|
$dobjval = "new Boolean($field)";
|
|
} elsif ($type eq "byte") {
|
|
$dobjval = "new Byte($field)";
|
|
} elsif ($type eq "short") {
|
|
$dobjval = "new Short($field)";
|
|
} elsif ($type eq "int") {
|
|
$dobjval = "new Integer($field)";
|
|
} elsif ($type eq "long") {
|
|
$dobjval = "new Long($field)";
|
|
} elsif ($type eq "float") {
|
|
$dobjval = "new Float($field)";
|
|
} elsif ($type eq "double") {
|
|
$dobjval = "new Double($field)";
|
|
}
|
|
|
|
# some known types have special setters
|
|
if ($type eq "DSet") {
|
|
print OUT <<EOF;
|
|
|
|
/**
|
|
* Requests that the specified element 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.Element elem)
|
|
{
|
|
requestElementAdd($fcode, elem);
|
|
}
|
|
|
|
/**
|
|
* Requests that the element 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)
|
|
{
|
|
requestElementRemove($fcode, key);
|
|
}
|
|
|
|
/**
|
|
* Requests that the specified element 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.Element elem)
|
|
{
|
|
requestElementUpdate($fcode, elem);
|
|
}
|
|
|
|
/**
|
|
* Requests that the <code>$field</code> field be set to the
|
|
* specified value. Generally one only adds, updates and removes
|
|
* elements 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 (DSet value)
|
|
{
|
|
this.$field = $field;
|
|
requestAttributeChange($fcode, value);
|
|
}
|
|
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 {
|
|
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, $dobjval);
|
|
}
|
|
EOF
|
|
}
|
|
}
|