Michael Bayne
664c4ff062
CVS was taking it upon itself to expand my regular expression into a proper $Id$ string. Whee! git-svn-id: svn+ssh://src.earth.threerings.net/narya/trunk@974 542714f4-19e9-0310-aa3c-eee0fc999fb1
270 lines
6.9 KiB
Perl
Executable File
270 lines
6.9 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#
|
|
# $Id: gendobj,v 1.5 2002/02/08 23:59:36 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 "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.
|
|
*/
|
|
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.
|
|
*/
|
|
public void removeFrom$cfield (Object key)
|
|
{
|
|
requestElementRemove($fcode, key);
|
|
}
|
|
|
|
/**
|
|
* Requests that the specified element be updated in the
|
|
* <code>$field</code> set.
|
|
*/
|
|
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.
|
|
*/
|
|
public void set$cfield (DSet value)
|
|
{
|
|
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.
|
|
*/
|
|
public void addTo$cfield (int oid)
|
|
{
|
|
requestOidAdd($fcode, oid);
|
|
}
|
|
|
|
/**
|
|
* Requests that the specified oid be removed from the
|
|
* <code>$field</code> oid list.
|
|
*/
|
|
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.
|
|
*/
|
|
public void set$cfield ($type $field)
|
|
{
|
|
requestAttributeChange($fcode, $dobjval);
|
|
}
|
|
|
|
/**
|
|
* Requests that the <code>$field</code> field be set to the
|
|
* specified value and immediately updates the state of the object
|
|
* to reflect the change. This should <em>only</em> be called on the
|
|
* server and only then if you know what you're doing.
|
|
*/
|
|
public void set${cfield}Immediate ($type $field)
|
|
{
|
|
this.$field = $field;
|
|
requestAttributeChange($fcode, $dobjval);
|
|
}
|
|
EOF
|
|
}
|
|
}
|