narya/bin/gendobj

#!/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 <dobj_decl_files>\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 (<IN>) {
        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*$/) {
                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 <<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 eq "DSet") {
    print <<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);
    }
EOF

    } elsif ($type eq "OidList") {
    print <<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 <<EOF;

    /**
     * Requests that the <code>$field</code> field be set to the specified
     * value.
     */
    public void set$cfield ($type $field)
    {
        requestAttributeChange($fcode, $field);
    }

    /**
     * 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, $field);
    }
EOF
    }
}