#!/usr/bin/perl -w # # $Id: gendobj,v 1.1 2002/02/08 22:41:22 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 \n"; # get our options my $verbose; GetOptions("verbose" => \$verbose); 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/g; if ($dest !~ /.java$/) { warn "Unable to infer target file name from original: $source\n"; 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 () { 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 ($_ !~ /{/) { $_ = ; 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*$/) { push (@fields, [$1, $3]); } } } close(IN); print join("", @preamble); print join("", @classdecl); my $field; foreach $field (@fields) { print_dobj_constant($field->[0], $field->[1]); } print join("", @classbody); foreach $field (@fields) { print_dobj_setters($field->[0], $field->[1]); } print "}\n"; # generate the output file # if (!open(OUT, ">$dest")) { # warn "Unable to open $dest for writing: $!\n"; # next; # } # 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 <$field 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 eq "DSet") { print <$field set. */ public void addTo$cfield (DSet.Element elem) { requestElementAdd($fcode, elem); } /** * Requests that the element matching the supplied key be removed from * the $field set. */ public void removeFrom$cfield (Object key) { requestElementRemove($fcode, key); } /** * Requests that the specified element be updated in the * $field set. */ public void update$cfield (DSet.Element elem) { requestElementUpdate($fcode, elem); } EOF } elsif ($type eq "OidList") { print <$field oid list. */ public void addTo$cfield (int oid) { requestOidAdd($fcode, oid); } /** * Requests that the specified oid be removed from the * $field oid list. */ public void removeFrom$cfield (int oid) { requestOidRemove($fcode, oid); } EOF } else { print <$field field be set to the specified * value. */ public void set$cfield ($type $field) { requestAttributeChange($fcode, $field); } /** * Requests that the $field field be set to the * specified value and immediately updates the state of the object * to reflect the change. This should only 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, $field); } EOF } }