[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Moss-devel] CVS: moss/rmc/src/rmcgen ArgumentBuffer.pm,NONE,1.1 Argumen
|
From: |
Alexander Feder <address@hidden> |
|
Subject: |
[Moss-devel] CVS: moss/rmc/src/rmcgen ArgumentBuffer.pm,NONE,1.1 ArgumentBufferP.pm,NONE,1.1 ArgumentBufferR.pm,NONE,1.1 ArgumentInfo.pm,NONE,1.1 ArgumentTransport.pm,NONE,1.1 ArgumentTransportDefault.pm,NONE,1.1 ArgumentTransportFromBuffer.pm,NONE,1.1 ArgumentTransportFromPBuffer.pm,NONE,1.1 ArgumentTransportFromRBuffer.pm,NONE,1.1 ArgumentTransportObject.pm,NONE,1.1 ArgumentTransportString.pm,NONE,1.1 ArgumentTransportToBuffer.pm,NONE,1.1 ArgumentTransportToPBuffer.pm,NONE,1.1 ArgumentTransportToRBuffer.pm,NONE,1.1 ArgumentTransportVoid.pm,NONE,1.1 ClassGen.pm,NONE,1.1 ClassGenC.pm,NONE,1.1 ClassGenF.pm,NONE,1.1 ClassGenS.pm,NONE,1.1 ClassInfo.pm,NONE,1.1 Formatter.pm,NONE,1.1 Makefile.am,NONE,1.1 MethodGen.pm,NONE,1.1 MethodGenC.pm,NONE,1.1 MethodGenS.pm,NONE,1.1 MethodInfo.pm,NONE,1.1 NamingConvention.pm,NONE,1.1 README,NONE,1.1 TODO,NONE,1.1 TextEditing.pm,NONE,1.1 rmcgen.pl,NONE,1.1 rmctest.rmc,NONE,1.1 |
|
Date: |
Sun, 23 Jun 2002 09:27:53 -0400 |
Update of /cvsroot/moss/moss/rmc/src/rmcgen
In directory subversions:/tmp/cvs-serv2212/src/rmcgen
Added Files:
ArgumentBuffer.pm ArgumentBufferP.pm ArgumentBufferR.pm
ArgumentInfo.pm ArgumentTransport.pm
ArgumentTransportDefault.pm ArgumentTransportFromBuffer.pm
ArgumentTransportFromPBuffer.pm
ArgumentTransportFromRBuffer.pm ArgumentTransportObject.pm
ArgumentTransportString.pm ArgumentTransportToBuffer.pm
ArgumentTransportToPBuffer.pm ArgumentTransportToRBuffer.pm
ArgumentTransportVoid.pm ClassGen.pm ClassGenC.pm ClassGenF.pm
ClassGenS.pm ClassInfo.pm Formatter.pm Makefile.am
MethodGen.pm MethodGenC.pm MethodGenS.pm MethodInfo.pm
NamingConvention.pm README TODO TextEditing.pm rmcgen.pl
rmctest.rmc
Log Message:
added rmc
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentBuffer.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thu Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentBuffer;
use strict;
use warnings;
# Facilities for buffer r/w acces with offset.
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = {};
$self->{Buffer} = ""; #the buffer name (rpcdata or pcdata)
$self->{Offset} = ""; #the offset string
bless($self,$class);
return $self;
}
sub buffer
{
my $self = shift;
if (@_) {$self->{Buffer} = $_[0];}
return $self->{Buffer};
}
sub offset
{
my $self = shift;
if (@_) {$self->{Offset} = $_[0];}
return $self->{Offset};
}
# Returns the buffers value on the offset.
sub getBuffer
{
my $self = shift;
return $self->buffer."[".$self->offset."]";
}
# Returns the address of the buffer on the offset
sub getBufferAddress
{
my $self = shift;
return "&(".$self->getBuffer.")";
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentBufferP.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thu Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentBufferP;
use warnings;
use strict;
use ArgumentBuffer;
use NamingConvention;
our @ISA =("ArgumentBuffer");
# Facilities for buffer r/w acces with offset.
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new;
bless($self,$class);
$self->buffer(RmcVar."pcData");
return $self;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentBufferR.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thu Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentBufferR;
use warnings;
use strict;
use ArgumentBuffer;
use NamingConvention;
our @ISA =("ArgumentBuffer");
# Facilities for buffer r/w acces with offset.
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new;
bless($self,$class);
$self->buffer(RmcVar."rpcData");
return $self;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentInfo.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Wed July 4 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentInfo;
use strict;
use warnings;
use TextEditing;
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self ={};
$self->{Type} = undef; #string
$self->{Name} = undef; #string
$self->{Const} = ""; #the word
$self->{Default} = undef;#string/number
$self->{Reference} = ""; # * or ** or & or ""
$self->{in} = 0;
$self->{out} = 0;
$self->{transport_as} = undef;
$self->{assign_as} = undef;
$self->{object} = 0;
$self->{size} = undef;
$self->{size_get} = undef;
$self->{ArgNbr} = 0;
$self->{argComment} =""; # /*[in, out] */ etc
bless($self,$class);
if (@_) {$self->argumentAnalyser( shift );}
return $self;
}
sub type {
my $self = shift;
if (@_) {$self->{Type} = $_[0]}
return $self->{Type};
}
sub name {
my $self = shift;
if (@_) {$self->{Name} = $_[0]}
return $self->{Name};
}
sub defaultValue {
my $self = shift;
if (@_) {$self->{Default} = $_[0]}
return $self->{Default};
}
sub const {
my $self = shift;
if (@_) {$self->{Const} = $_[0]}
return $self->{Const};
}
sub pureIn {
my $self = shift;
if (@_) {$self->{in} = $_[0]}
return $self->{in};
}
sub pureOut {
my $self = shift;
if (@_) {$self->{out} = $_[0]}
return $self->{out};
}
sub object {
my $self = shift;
if (@_) {$self->{object} = $_[0]}
return $self->{object};
}
sub transportType {
my $self = shift;
if (@_) {$self->{transport_as} = $_[0]}
return $self->{transport_as};
}
sub assignType {
my $self = shift;
if (@_) {$self->{assign_as} = $_[0]}
return $self->{assign_as};
}
sub sizeFixed {
my $self = shift;
if (@_) {$self->{size} = $_[0]}
return $self->{size};
}
sub sizeVariable {
my $self = shift;
if (@_) {$self->{size_get} = $_[0]}
return $self->{size_get};
}
sub reference {
my $self = shift;
if (@_) {$self->{Reference} = $_[0]}
return $self->{Reference};
}
sub argNbr{
my $self = shift;
if (@_) {$self->{ArgNbr} = $_[0]}
return $self->{ArgNbr};
}
sub comment{
my $self = shift;
if (@_) {$self->{argComment} = $_[0]}
return $self->{argComment};
}
sub toClient {
my $self = shift;
# ENUMERATION : pureOut, call by reference, resolved pointers,
# UNLESS : const arguments and pureIn arguments (overrides the first )
return ($self->pureOut || $self->reference eq "&" || $self->reference eq
"*")
&& !$self->const && !$self->pureIn ;
}
sub toServer {
my $self = shift;
# move allways to server unless it's a pure out.
# This is when [out] exists and for the return value. (only two cases)
return !$self->pureOut;
}
# returns a value if "= Value" occurs in the argument list
# otherwise returns "nothing"
# !! removes that occurence !!
sub argumentDefault
{
if ($_[0] =~ s/=\s*(.*)//) {
return $1;
}
else {
return ;
}
}
sub argumentAnalyser
{
my $self = shift;
my $Argument = shift;
#print "\nArgumentAnalyser called with ",$Argument,"\n";
TextEditing::removeSpaces($Argument);
$self->const( isConstArgument($Argument) );
# save the Transport flags
my @TPList = $self->transportOptions ($Argument) ;
$self->pureOut( isOutArgument(@TPList) );
$self->pureIn ( isInArgument (@TPList) );
$self->object ( isObject (@TPList) );
$self->defaultValue( argumentDefault($Argument) );
$self->reference( $self->argumentReference($Argument) );
if ($Argument =~ /\s*(.+?)\s+(.+)/) {
$self->type( $1 );
my $n = $2;
TextEditing::removeSpaces($n);
$self->name( $n );
}
else {
# if the argument contains only one word, it must be the type
$self->type( $Argument );
$self->name( "UnNamed" );;
}
# if all went well, this is empty
return $Argument;
}
# true if const occurs as a single word in the argument list
# !! removes that occurence !!
sub isConstArgument
{
if ($_[0] =~s/\bconst\b//) {
return "const";
}
else {
return "";
}
}
# removes the Argument Transport Options
# and returns them in a list.
sub transportOptions
{
my $self = shift;
#print "\nTransport: ",$_[0];
if ($_[0] =~ s/\[(.*)\]//) {
#print "\nAfter:",$1;
$self->comment($1);
my @transOpt = split ":", $1;
#foreach (@transOpt) {print $_,",";}
return @transOpt;
}
#foreach (@transOpt) {print $_,",,";}
return (0);
}
# true if [out] occurs as a single word in the argument list
#
sub isOutArgument
{
foreach (@_) {
if ($_ =~ /out/) {return 1;}
}
return 0;
}
# true if [in] occurs as a single word in the argument list
#
sub isInArgument
{
foreach (@_) {
if ($_ =~ /in/) {return 1;}
}
return 0;
}
sub isObject
{
foreach (@_) {
#print $_,",";
if ($_ =~ /object/) {return 1;}
}
return 0;
}
# Tries to determine pointer/reference/pointertopointer etc
# !! removes that occurence !!
# set the transport flags
sub argumentReference
{
my $self = shift;
# first look for pointer to function
if ($_[0] =~ s/\s*\(\s*\*\s*(\w+)\s*\)/$1 /) {
return "PtF"; # not yet fully supported
}
# The matching order is important try ** before *
if ($_[0] =~ s/(\*\*|\&|\*)// ) {
SWITCH: for($1) {
/\&/ and return "&"; # a reference will be transported to and from
/\*\*/ and return "**"; # ptp not really supported
/\*/ and return "*"; # pointer is resolved and transported to and from
}
}
return "";
}
sub getDef
{
my $self = shift;
my $ref ="";
my $def ="";
if (!($self->reference =~ /&/) ){
$ref = $self->reference;
}
if ($self->reference =~ /\*/ ) {
$def = "= new ".$self->type;
}
my $fancy = $self->type. $ref. " " .$self->name. $def. ";";
return $fancy. " " x (32-length($fancy)) ."// Argument for the local, real
method call\n";
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransport.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Wed Aug 1 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
#
# CLASS FOR TRANSPORTING ARGUMENTS OF RMC'ED METHDOS
# contains an argumentInfo object as current argument
package ArgumentTransport;
use warnings;
use strict;
use ArgumentInfo;
use Formatter;
use NamingConvention;
our @ISA = ("Formatter");
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = {};
$self->{Argument} = shift; # ArgumentInfo object REQUIRED
$self->{Transporter} = shift; #Object that will transport this type
$self->{BufferClass} = undef;
bless($self,$class);
$self->transport->exec($self); # inform the Transporter
return $self;
}
sub current
{
my $self = shift;
if (@_) {$self->{Argument} = $_[0];}
return $self->{Argument};
}
sub transport
{
my $self = shift;
if (@_) {$self->{Transporter} = $_[0];}
return $self->{Transporter};
}
sub bc
{
my $self = shift;
if (@_) {$self->{BufferClass} = $_[0];}
return $self->{BufferClass};
}
#declares the TRmcSize transport size for this argument
#this could be zero, in which case the memcpy copies zero bytes
# or even better, is not inserted.
sub declareSize
{
my $self = shift;
my $size = $self->ind ."TRmcSize ". $self->getSizeName;
return $size."; // byte size of ".$self->current->name."\n";
}
#unused
sub defineSize
{
my $self = shift;
my $size = $self->ind ."TRmcSize ". $self->getSizeName." = ".
$self->transport->extractSize;
return $size.";\n";
}
#sets the size of an argument to its real size
sub setSize
{
my $self = shift;
my $size = $self->ind . $self->getSizeName ." = ";
# Here could be put a virtual function filled in by the
# specific derived classes
$size .= $self->transport->extractSize;
return $size.";\n";
}
#sets the size to zero of an argument, because it will not be transported
#unused
sub setZeroSize
{
my $self = shift;
my $size = $self->ind . $self->getSizeName ." = 0;\n";
return $size;
}
# return the actual name of the transport size variable
sub getSizeName
{
my $self = shift;
return RmcVar."nSize_" . $self->current->argNbr();
}
# used in the ArgumentTransportDefault module
# does it belong here ??? maybe, if others will use the memcpy too
sub doMemCopy
{
my $self = shift;
my $src = shift;
my $dest = shift;
my $ln = shift;
my $buffer = $self->ind ."memcpy((void*)".$dest.", ".$src. ", ". $ln.
");\n";
return $buffer;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportDefault.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportDefault;
use strict;
use warnings;
# This package shows how the default arguments are transported
# Any other type (like string) kan be transported using this as
# a template and changing these methods
# The Factory will then create the correct end-user objects
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = {};
$self->{Executor} = undef; # ArgumentTransport object
bless($self,$class);
return $self;
}
sub exec
{
my $self = shift;
if (@_) {$self->{Executor} = $_[0];}
return $self->{Executor};
}
# Resolve the argument.
# Return the result for example : Argument char* c would give (*c)
# Better way to code this ??
sub resolve
{
my $self = shift;
my $prefix = $self->exec->current->reference;
if ($self->exec->current->reference =~ /&/) {
$prefix ="";
}
return "(".$prefix.$self->exec->current->name.")";
}
# return the address of the argument
sub address
{
my $self = shift;
# standard symbol for address of is "&"
my $prefix = "&";
# when it's a pointer, don't add the & sign
if ($self->exec->current->reference =~ /\*/) {
$prefix="";
}
return "(".$prefix.$self->exec->current->name.")";
}
# the Exact size the transported object has in the buffer
sub extractSize
{
my $self = shift;
return "sizeof".$self->resolve;
}
#not used, use initCopyFrom and initCopyTo
sub initialize
{
my $self = shift;
return $self->exec->setSize;
}
#### XXX #####
#how on earth will i ever solve this ???
sub initCopyFrom
{
my $self = shift;
return $self->exec->setSize; #AARGH this is specific for server
}
sub initCopyTo
#DIRTY
{
my $self = shift;
return $self->exec->setSize; #AARGH this is specific for client
}
sub copyToBuffer
{
my $self = shift;
return $self->exec->doMemCopy($self->address,
$self->exec->bc->getBufferAddress,
$self->exec->getSizeName );
}
sub copyFromBuffer
{
my $self = shift;
return $self->exec->doMemCopy($self->exec->bc->getBufferAddress,
$self->address,
$self->exec->getSizeName );
}
sub postCopyFrom
{
my $self = shift;
return $self->exec->ind .$self->exec->bc->offset." +=
".$self->exec->getSizeName.";\n";
}
sub postCopyTo
{
my $self = shift;
return $self->exec->ind .$self->exec->bc->offset." +=
".$self->exec->getSizeName.";\n";
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportFromBuffer.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportFromBuffer;
use strict;
use warnings;
use ArgumentTransport;
use NamingConvention;
# Maybe the Buffer is not needed (virtual))
our @ISA = ("ArgumentTransport");
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
bless($self,$class);
return $self;
}
sub copy
{
my $self = shift;
$self->bc->offset(RmcVar."nOutPos");
my $buffer = $self->transport->initCopyFrom;
$buffer .= $self->transport->copyFromBuffer;
$buffer .= $self->transport->postCopyFrom;
return $buffer;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportFromPBuffer.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportFromPBuffer;
use strict;
use warnings;
use ArgumentTransportFromBuffer;
use ArgumentBufferP;
our @ISA = ( "ArgumentTransportFromBuffer");
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
$self->bc(ArgumentBufferP->new);
bless($self,$class);
return $self;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportFromRBuffer.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportFromRBuffer;
use strict;
use warnings;
use ArgumentTransportFromBuffer;
use ArgumentBufferR;
our @ISA = ( "ArgumentTransportFromBuffer");
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
$self->bc(ArgumentBufferR->new);
bless($self,$class);
return $self;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportObject.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday September 6 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportObject;
use strict;
use warnings;
use ArgumentTransportDefault;
our @ISA=("ArgumentTransportDefault");
sub extractSize
{
my $self = shift;
return $self->resolve . "._RMC_size()";
}
sub copyToBuffer
{
my $self = shift;
my $buffer =
$self->exec->ind.$self->resolve."._RMC_put(".$self->exec->bc->getBufferAddress.");\n";
return $buffer;
}
sub copyFromBuffer
{
my $self = shift;
return $self->exec->ind. $self->resolve.
"._RMC_get(".$self->exec->bc->getBufferAddress.");\n"
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportString.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday September 6 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportString;
use strict;
use warnings;
use ArgumentTransportDefault;
our @ISA=("ArgumentTransportDefault");
sub extractSize
{
my $self = shift;
return $self->resolve . ".length() + 1";
}
sub initCopyFrom
{
my $self = shift;
return "";
}
sub initialize
{
my $self = shift;
return "";
}
sub copyToBuffer
{
my $self = shift;
my $buffer = $self->exec->ind
."strncpy((char*)".$self->exec->bc->getBufferAddress. ","
.$self->resolve.".c_str(), "
.$self->exec->getSizeName.");\n";
return $buffer;
}
sub copyFromBuffer
{
my $self = shift;
return $self->exec->ind. $self->resolve. "=
".$self->exec->bc->getBufferAddress.";\n"
}
sub postCopyFrom
{
my $self = shift;
my $post = $self->exec->setSize();
$post .= $self->exec->ind .$self->exec->bc->offset." += ".
$self->exec->getSizeName .";\n";
return $post;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportToBuffer.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportToBuffer;
use strict;
use warnings;
use ArgumentTransport;
use NamingConvention;
our @ISA = ("ArgumentTransport");
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
bless($self,$class);
return $self;
}
sub copy
{
my $self = shift;
# Rudimentary, but i couldn't find any better.....
$self->bc->offset(RmcVar."nInsPos");
#my $buffer = $self->transport->initCopyTo;
my $buffer = $self->transport->copyToBuffer;
$buffer .= $self->transport->postCopyTo;
return $buffer;
}
sub init
{
my $self = shift;
return $self->transport->initCopyTo;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportToPBuffer.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportToPBuffer;
use strict;
use warnings;
use ArgumentTransportToBuffer;
use ArgumentBufferP;
our @ISA = ( "ArgumentTransportToBuffer" );
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
bless($self,$class);
$self->bc(ArgumentBufferP->new);
return $self;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportToRBuffer.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday Aug 30 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportToRBuffer;
use strict;
use warnings;
use ArgumentTransportToBuffer;
use ArgumentBufferR;
our @ISA = ("ArgumentTransportToBuffer");
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(@_);
bless($self,$class);
$self->bc(ArgumentBufferR->new);
return $self;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ArgumentTransportVoid.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Thursday September 6 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ArgumentTransportVoid;
use strict;
use warnings;
use ArgumentTransportDefault;
our @ISA=("ArgumentTransportDefault");
sub extractSize
{
my $self = shift;
return "0";
}
sub initCopyFrom
{
my $self = shift;
return "";
}
#sub initialize
#{
# my $self = shift;
# return "";
#}
sub copyToBuffer
{
my $self = shift;
return "";
}
sub copyFromBuffer
{
my $self = shift;
return "";
}
sub postCopyFrom
{
my $self = shift;
return "";
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ClassGen.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Wed Aug 1 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
# generates the class body, calls the method generators
package ClassGen;
use strict;
use warnings;
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
# i am a hash table
my $self ={};
# hash of ClassInfo stuff
$self->{ClassesToBuild} = {};
$self->{CurrentClass} = undef;
if (@_) {$self->{CurrentClass} = shift;}
$self->{MethodGenerator} = undef;
$self->{Header} = "";
$self->{Source} = "";
bless($self,$class);
return $self;
}
sub currentClass
{
my $self = shift;
if (@_) {$self->{CurrentClass} = shift;}
return $self->{CurrentClass};
}
sub addClass
{
my $self = shift;
if (! $self->{ClassesToBuild}{$_[0]->name})
{
$self->{ClassesToBuild}{$_[0]->name} = $_[0];
}
}
sub write
{
my $self = shift;
my $file= shift;
if ($self->{Header} ne "")
{
open HFILE,">$file" . $self->addHExt();
print HFILE $self->{Header};
close HFILE;
}
if ($self->{Source} ne "")
{
open SFILE,">$file" . $self->addSExt();
print SFILE $self->{Source};
close SFILE;
}
}
sub addToH {
my $self = shift;
$self->addTo(\$self->{Header}, @_ );
}
sub addToS {
my $self = shift;
$self->addTo(\$self->{Source}, @_ );
}
sub addTo {
my $self = shift;
my $of = shift;
${$of} = join "",${$of}, @_;
}
sub MGen {
my $self = shift;
if (@_) { $self->{MethodGenerator} = shift; }
return $self->{MethodGenerator};
}
# MAIN Method to generate everything
sub HeaderGenerator {
my $self = shift;
$self->headerWriteHead;
$self->headerWriteMethods;
$self->headerWriteMembers;
$self->headerClose;
}
# For each method :
# init the method generator with the methodInfo
# call the method writer which uses our method generator
sub headerWriteMethods {
my $self = shift;
foreach ($self->currentClass->allMethods)
{
$self->MGen->Method($_);
$self->headerWriteMethod();
}
}
sub headerWriteMembers {
my $self = shift;
# still have to do, NOT YET SUPPORTED
# this will be the remote object writer
}
sub headerClose {
my $self = shift;
$self->addToH("\n};\n#endif\n");
}
sub headerWriteRMCInfo {
#hmm
}
#generate the .cpp source
sub SourceGenerator {
my $self = shift;
# DO NOTHING !?
}
sub SourceRTTI {
my $self = shift;
#my $rtti = "// RTTI\n";
#$rtti .= "TRmcClass ". $self->currentClass->name ."::s_nRtti = RTTI_".
# uc($self->currentClass->name). ";\n\n";
#return $rtti;
return "";
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ClassGenC.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Fri Aug 1 2001
# copyright : (C) 2001 Peter Soetens"
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ClassGenC;
use strict;
use warnings;
use ClassGen;
use MethodGenC;
use NamingConvention;
our @ISA = ("ClassGen");
sub new
{
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(shift);
$self->{MethodGenerator}= MethodGenC->new();
bless($self,$class);
return $self;
}
sub addHExt
{
return "_c.h";
}
sub addSExt
{
return "_c.cpp";
}
sub headerWriteHead {
my $self = shift;
$self->addToH( $self->headerInfoGen );
}
# use the standard method generator provided in the base class
sub headerWriteMethod {
my $self = shift;
$self->addToH( $self->MGen->getPrototype ."\n" );
$self->addToH( $self->MGen->getCBody );
}
# generate the client header info and determine
# RTTI and MID
sub headerInfoGen {
my $self = shift;
my $MID = 0;
my $RTTI = 0;
my $RMCInfo = "#ifndef __" . uc($self->currentClass->fileName) .
"_CLIENT_CLASS_H\n".
"#define __" . uc($self->currentClass->fileName) .
"_CLIENT_CLASS_H\n\n".
"#include \"RmcClient.h\"\n";
# "#include \"generic.h\"\n\n";
$RMCInfo .= $self->headerMIDs("define");
$RMCInfo .= "using namespace rmc;";
$RMCInfo .= "\n#define RTTI_" . uc($self->currentClass->name) ."
0xdeadbeef\n";
$RMCInfo .= "\nclass " . $self->currentClass->name;
foreach ($self->currentClass->supers) {
$RMCInfo .= " : " . $_;
}
$RMCInfo = join "\n",$RMCInfo,"{",
" // RTTI (runtime type information)",
" private:",
" // implemented in the CXX file",
" static ".nRttiClass." ".nRtti.";",
"",
" public:",
" //the method to get the RTTI from an instance",
" virtual ".nRttiClass." RttiGet() { return ".nRtti."; }",
" // the method to get the RTTI from the class",
" static ".nRttiClass." RTTI() { return ".nRtti."; }",
"",
" // RMC distribution",
" private:",
" ".RmcClientClass." ".RmcMeth.RmcClient.";",
" TRmcResult ".RpcMeth."nLastCallResult;";
return $RMCInfo;
}
sub headerClose {
my $self = shift;
$self->addToH("\n};\n");
$self->addToH($self->headerMIDs("undef"));
$self->addToH("\n#endif\n");
}
sub headerMIDs {
my $self = shift;
my $directive = shift; # 'define' or 'undef'
my $MID=0;
my $MIDInfo="";
foreach ($self->currentClass->allMethods) {
$MIDInfo .= "#".$directive." MID_" . $_->name . "_" . $MID;
if ($directive eq "define") #dirty dirty dirty
{ $MIDInfo .= " " . $MID . "L";}
$MIDInfo .= "\n";
$_->mid($MID);
++$MID;
}
return $MIDInfo;
}
#generate the .cpp source
sub SourceGenerator {
my $self = shift;
my $source = "// RMC generated ->\n"
."#include \"".$self->currentClass->name."_c.h\"\n";
$source .= $self->SourceRTTI . $self->SourceInterface
."// <- RMC generated";
$self->addToS($source);
}
sub SourceInterface
{
my $self = shift;
my $int = "/* RMC - interface:\n";
foreach ($self->currentClass->allMethods) {
$self->MGen->Method($_);
$int .= $self->MGen->getPrototype .";\n";
}
$int .= "*/\n";
return $int;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ClassGenF.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Sun Okt 28 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ClassGenF;
use strict;
use warnings;
use ClassGen;
use NamingConvention;
our @ISA = ("ClassGen");
sub new
{
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(shift);
#$self->{MethodGenerator}= MethodGenF->new();
bless($self,$class);
# init: load file from disk
$self->loadHistory();
return $self;
}
sub addHExt
{
return ".h";
}
sub addSExt
{
return ".cpp";
}
sub headerWriteHead {
my $self = shift;
}
# do nothing
sub headerWriteMethods {
}
# do nothing
sub headerWriteMethod {
my $self = shift;
}
#generate the .cpp source
sub SourceGenerator {
my $self = shift;
my $source = join "\n","// RMC generated - don't change ---> START",
"// This file was generated from factory.hist and
the rmcgen .rmc input file",
"// Any changes you do will be overwritten when
rmcgen is run again !",
"#include \"RmcServer.h\"\n",
"#include \"RmcObject.h\"\n";
foreach (keys %{$self->{ClassesToBuild}})
{
$source .= "#include \"".$_ ."_s.h\""."\n\n";
}
$source .= "using namespace rmc;\n";
$source .= "TRmcResult ".ObjectFactory."::ObjectMake(TRmcClass
nClass,TRmcObject &rnObject,TRmcVisum &rnVisum)";
$source .= join "\n",
"{",
" switch (nClass)",
" {\n";
foreach (keys %{$self->{ClassesToBuild}})
{
$source .= join "\n",
" case RTTI_".uc($_).":",
" {",
" $_ *pObject = new $_;",
" rnVisum = pObject->m_rmc_s_nVisum;",
" rnObject = ObjectAdd(nClass, pObject);",
" return RMC_SUCCESS;",
" }\n";
}
$source .= join "\n",
" default:",
" {",
" return RMC_E_NO_STUB;",
" }",
" }",
" return RMC_FAILURE;",
"}\n";
$source .= join "\n",
"// methode routing",
"TRmcResult CRmcObjectFactory::Call(TRmcClass nClass, void
*pObject,TRmcMethode nMethode,",
"TRmcSize &rnSize,",
"TRmcData *&rpcData,",
"TRmcVisum &rnVisum )",
"{",
" switch (nClass)",
" {\n";
foreach (keys %{$self->{ClassesToBuild}})
{
$source .= join "\n",
" case RTTI_".uc($_).":",
" {",
" return (($_*)pObject)->RmcWrapperCall(nMethode,
rnSize, rpcData, rnVisum);",
" }\n";
}
$source .= join "\n",
" default:",
" {",
" return RMC_E_NO_STUB;",
" }",
" }",
" return RMC_FAILURE;",
"}\n";
$source .= " // RMC generated - don't change <--- END\n\n";
$self->addToS($source);
$self->saveHistory();
}
#
# Load history of all classes if any exists
#
sub loadHistory {
my $self = shift;
open FACTFILE,"<factory.hist"
or return;
while (<FACTFILE>)
{
chomp;
if (!($_ eq ""))
{
my $tclass = ClassInfo->new();
$tclass->name($_);
$self->addClass( $tclass );
}
}
close FACTFILE;
}
sub saveHistory {
my $self = shift;
open FACTFILE,">factory.hist"
or die "Factory generator : could not save history to disk\n";
foreach (keys (%{$self->{ClassesToBuild}}) )
{
print FACTFILE $_."\n";
}
close FACTFILE;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ClassGenS.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Fri Aug 1 2001
# copyright : (C) 2001 Peter Soetens"
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ClassGenS;
use strict;
use warnings;
use ClassGen;
use MethodGenS;
use NamingConvention;
our @ISA = ("ClassGen");
sub new
{
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = $class->SUPER::new(shift);
$self->{MethodGenerator}= MethodGenS->new();
bless($self,$class);
return $self;
}
sub addHExt
{
return "_s.h";
}
sub addSExt
{
return "_s.cpp";
}
sub headerWriteHead {
my $self = shift;
$self->addToH( $self->headerInfoGen );
}
# For THIS Method :
# write the Official prototype
# write the RMC Wrapped Method
sub headerWriteMethod {
my $self = shift;
$self->addToH( $self->MGen->getPrototype . ";\n" );
$self->addToH( $self->MGen->genRMCMethodWrapper );
}
sub headerInfoGen {
my $self = shift;
my $MID = 0;
my $RTTI = 0;
my $RMCInfo = "#ifndef __" . uc($self->currentClass->fileName) .
"_SERVER_CLASS_H\n".
"#define __" . uc($self->currentClass->fileName) .
"_SERVER_CLASS_H\n\n".
"#include \"RmcServer.h\"\n".
"#include \"RmcObject.h\"\n";
# "#include \"generic.h\"\n\n";
$RMCInfo .= "#warning Please replace \"0xdeadbeef\" with an appropriate
hexadecimal class identifier\n";
$RMCInfo .= "\n#define RTTI_" . uc($self->currentClass->name) ."
0xdeadbeef\n";
$RMCInfo .= "#define " . uc($self->currentClass->name) ."_RMT_SIZE
".$self->currentClass->RMTSize ."\n";
$RMCInfo .= "\nusing namespace rmc;\n";
$RMCInfo .= "\nclass " . $self->currentClass->name;
foreach ($self->currentClass->supers) {
$RMCInfo = $RMCInfo ." : " . $_;
}
$RMCInfo .= " : CRmcObject\n";
$RMCInfo = join "\n", $RMCInfo, "{",
" friend ".ObjectFactory.";",
# " private:",
# " static ".nRttiClass." ".nRtti.";",
# " public:",
# " virtual ".nRttiClass." RttiGet() { return ".nRtti."; }",
# " static ".nRttiClass." RTTI() { return ".nRtti."; }",
" protected:",
" static long (".
$self->currentClass->name."::*".$self->currentClass->name
."::s_apmRmt[])(TRmcSize&, TRmcData*&);",
" TRmcResult RmcWrapperCall(TRmcMethode nMethode, TRmcSize &rnSize,
TRmcData *&rpcData)",
" {",
" if ( (nMethode < 0) || (nMethode >= ". uc($self->currentClass->name)
."_RMT_SIZE) )",
" {",
" return RMC_E_RMT_IDX;",
" }",
" return (this->*s_apmRmt[nMethode])(rnSize, rpcData);",
" } // TRmcResult RmcWrapperCall(nMethode, rnSize, rpcData)";
return $RMCInfo;
}
#generate the .cpp source
sub SourceGenerator {
my $self = shift;
my $source = join "\n","// RMC generated - don't change ---> START",
"#include \"".$self->currentClass->name
."_s.h\"","\n";
$source .= $self->SourceRTTI . $self->SourceRMT .
" // RMC generated - don't change <--- END";
$self->addToS($source);
}
sub SourceRMT {
my $self = shift;
my $rmt = "// the RMT (remote methode table)\n"
."long (".$self->currentClass->name."::*"
.$self->currentClass->name. "::s_apmRmt[])(TRmcSize&, TRmcData*&)
=\n"
." {";
foreach ($self->currentClass->allMethods) {
$rmt .= "\n &". $self->currentClass->name."::Rmc";
$rmt .= $_->name. $_->mid. ",";
}
chop $rmt;
$rmt .= "\n };\n";
return $rmt;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# ClassInfo.pl, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Wed July 4 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package ClassInfo;
use warnings;
use strict;
use TextEditing;
#do 'TextEditing.pl' or die "could not open TextEditing.pl";
#constructor
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self ={};
$self->{ClassName} = undef;
$self->{Rtti} = undef;
$self->{RMCMethods} = undef;
$self->{PrivateMethods} = [];
$self->{PublicMethods } = [];
$self->{ProtectedMethods} = [];
$self->{Includes} = [];
$self->{SuperClasses} = [];
bless($self,$class);
if (@_ ) {$self->extractClass(shift);} # the class string is optional
return $self;
}
sub name {
my $self = shift;
if(@_) {$self->{ClassName} = shift}
return $self->{ClassName};
}
sub RTTI {
my $self = shift;
if(@_) {$self->{Rtti} = shift}
return $self->{Rtti};
}
sub RMTSize {
my $self = shift;
my $cnt;
foreach($self->privateMethod, $self->publicMethod, $self->protectedMethod){
$cnt++;
}
return $cnt;
}
sub privateMethod {
my $self = shift;
foreach (@_) {
push @{$self->{PrivateMethods}},$_;
}
return @{$self->{PrivateMethods}};
}
sub publicMethod {
my $self = shift;
foreach (@_) {
#print "Storing ",$_,". ";
push @{$self->{PublicMethods}},$_;
}
#print " Return.\n";
return @{$self->{PublicMethods}};
}
sub protectedMethod {
my $self = shift;
foreach (@_) {
push @{$self->{ProtectedMethods}},$_;
}
return @{$self->{ProtectedMethods}};
}
sub allMethods {
my $self = shift;
return ($self->publicMethod, $self->protectedMethod, $self->privateMethod);
}
sub includes {
my $self = shift;
foreach (@_) {
push @{$self->{Includes}},$_;
}
return @{$self->{Includes}};
}
sub supers {
my $self = shift;
foreach (@_) {
push @{$self->{SuperClasses}}, $_;
}
return @{$self->{SuperClasses}};
}
sub extractClass
{
my $self = shift;
my $line = shift;
# should contain only one class
$line =~ /class\s+(.*?){/;
my $classes = $1;
my @classLst = split ":", $classes;
my $extrClass = shift @classLst;
$self->supers(@classLst);
removeSpaces($extrClass);
$self->name($extrClass);
$self->publicMethod( publicMethodsGet($line) );
$self->protectedMethod( protectedMethodsGet($line) );
$self->privateMethod( privateMethodsGet($line) );
return $extrClass;
}
sub publicMethodsGet
{
my $line = shift;
my @allPublicRMC = $line =~ /public.*?:(.*?)(?:}|private|protected)/g;
my @allM;
foreach ( RMCMethods(@allPublicRMC) ){
$_->scope("public:");
push @allM, $_;
#print ">>>",$_;
}
return @allM;
}
sub privateMethodsGet
{
my $line = shift;
my @allPrivateRMC = $line =~ /private.*?:(.*?)(?:}|public|protected)/g;
my @allM;
foreach ( RMCMethods(@allPrivateRMC) ){
$_->scope("private:");
push @allM, $_;
}
return @allM;
}
sub protectedMethodsGet
{
my $line = shift;
my @allProtectedRMC = $line =~ /protected.*?:(.*?)(?:}|public|private)/g;
my @allM;
foreach ( RMCMethods(@allProtectedRMC) ){
$_->scope("protected:");
push @allM, $_;
}
return @allM;
}
sub RMCMethods
{
my @allRMC = @_;
#foreach (@allRMC) {print "|>|",$_,"|<|\n";}
my @RMC;
my $tmpMethod;
foreach (@allRMC) {
push @RMC, $_=~/\sRMC\s(.*?);/g;
}
foreach (@RMC) {print "|>|",$_,"|<|\n";}
my @finalRMC;
foreach (@RMC) {
$tmpMethod = MethodInfo->new();
$tmpMethod->methodAnalyser($_);
push @finalRMC, $tmpMethod;
}
return @finalRMC;
}
# CChat --> "Chat"
sub fileName
{
my $self = shift;
return substr($self->name, length($self->name)-1 );
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# Formatter.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Fri Aug 24 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package Formatter;
use strict;
use warnings;
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self = {};
$self->{Indent} = 0;
bless($self,$class);
return $self;
}
#increases indentation with 2 spaces or N*2 spaces
sub tab
{
my $self = shift;
if (@_) {$self->{Indent} += shift;}
else {$self->{Indent}++;}
return "";
}
#decreases indentation with 2 spaces or N*2 spaces
sub untab
{
my $self = shift;
if (@_) {$self->{Indent} -= shift;}
else {$self->{Indent}--;}
return "";
}
#generates spaces according to current indentation
sub ind
{
my $self = shift;
return " " x $self->{Indent};
}
# return indentation level.
sub getInd
{
my $self = shift;
return $self->{Indent};
}
# room for textediting, like a cleanup that removes
# spaces but keeps indentation
1;
--- NEW FILE ---
bin_PROGRAMS = rmcgen
rmcgen_SOURCES = rmcgen.pl
rmcgen: rmcgen.pl
$(RM) rmcgen
@echo "-*- !! This can take some time !! -*-"
perlcc -o rmcgen rmcgen.pl
install-data-local:
@echo "Will work only on Linux, porting it later"
$(INSTALL_DATA) rmcgen $(prefix)/bin/rmcgen
--- NEW FILE ---
#!/usr/bin/perl -w
# MethodGen.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Tue July 10 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# * This program is distributed in the hope that it will be useful, *
# * but WITHOUT ANY WARRANTY; without even the implied warranty of *
# * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
# * GNU General Public License for more details. *
# * *
# * You should have received a copy of the GNU General Public License *
# * along with this program; if not, write to the *
# * *
# * Free Software Foundation, Inc., *
# * 59 Temple Place Suite 330, *
# * Boston, MA 02111-1307, USA. *
# * *
# ***************************************************************************/
package MethodGen;
use strict;
use warnings;
use MethodInfo;
use ArgumentTransportFromPBuffer;
use ArgumentTransportFromRBuffer;
use ArgumentTransportToPBuffer;
use ArgumentTransportToRBuffer;
use ArgumentTransportDefault;
use ArgumentTransportString;
use ArgumentTransportVoid;
use ArgumentTransportObject;
use Formatter;
use NamingConvention;
use TextEditing;
#use vars qw(@ISA);
our @ISA = ("Formatter");
# Constructor
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self ={};
$self->{Method} = undef;
if (@_) { $self->{Method} = shift;}
bless($self,$class);
return $self;
}
sub Method
{
my $self = shift;
if (@_) { $self->{Method} = $_[0];}
return $self->{Method};
}
# generate scope
# plus prototype
sub getPrototype {
my $self = shift;
$self->tab;
my $scope = "\n" .$self->ind. $self->Method->scope ."\n";
$self->tab;
my $proto = join " ", $self->Method->virtual , $self->Method->static,
${$self->Method->returnType}->type,
${$self->Method->returnType}->reference,$self->Method->name,
"( ";
foreach ($self->Method->argument) {
if ($_->comment ne "") {$proto .="/* [".$_->comment."] */";}
$proto = join " ",$proto, $_->const, $_->type,$_->reference, $_->name;
if ($_->defaultValue) {$proto .= "=".$_->defaultValue;}
$proto .=",";
}
chop $proto;
$proto .= ") ". $self->Method->const;
removeSpaces($proto); # yep only the beginning and end spaces
replaceSpaces($proto); # all double spaces gone
my $result = $scope. $self->ind.$proto;
$self->untab(2);
return $result;
}
# I recognize three types now : string, object, default
sub createTransport
{
my $self = shift;
my $arg = shift;
my $argT = undef;
if ($arg->type =~ /string/) {$argT = ArgumentTransportString->new;}
elsif ($arg->type =~ /void/) {$argT = ArgumentTransportVoid->new;}
elsif ($arg->object) {$argT = ArgumentTransportObject->new;}
else {$argT = ArgumentTransportDefault->new;}
return $argT;
}
sub createTransportFromRBuffer
{
my $self = shift;
my $arg = shift;
my $argT = $self->createTransport($arg);
return ArgumentTransportFromRBuffer->new($arg,$argT);
}
sub createTransportToRBuffer
{
my $self = shift;
my $arg = shift;
my $argT = $self->createTransport($arg);
return ArgumentTransportToRBuffer->new($arg,$argT);
}
sub createTransportFromPBuffer
{
my $self = shift;
my $arg = shift;
my $argT = $self->createTransport($arg);
return ArgumentTransportFromPBuffer->new($arg,$argT);
}
sub createTransportToPBuffer
{
my $self = shift;
my $arg = shift;
my $argT = $self->createTransport($arg);
return ArgumentTransportToPBuffer->new($arg,$argT);
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# MethodGenC.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Tue Aug 22 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# * This program is distributed in the hope that it will be useful, *
# * but WITHOUT ANY WARRANTY; without even the implied warranty of *
# * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
# * GNU General Public License for more details. *
# * *
# * You should have received a copy of the GNU General Public License *
# * along with this program; if not, write to the *
# * *
# * Free Software Foundation, Inc., *
# * 59 Temple Place Suite 330, *
# * Boston, MA 02111-1307, USA. *
# * *
# ***************************************************************************/
package MethodGenC;
use strict;
use warnings;
use MethodGen;
use NamingConvention;
our @ISA = ("MethodGen");
###################################
### CLIENTSIDE ####
###################################
# Generate client Methods code
sub getCBody
{
my $self = shift;
$self->tab(2);
my $body = $self->ind."{\n".$self->tab.
$self->genTransportVars .
$self->genMakeCall .
$self->genReadResults .
$self->genFreeMem .
$self->genReturn .$self->untab.
$self->ind."}\n";
$self->untab(2);
return $body;
}
sub genTransportVars
{
my $self = shift;
my $transVars = $self->ind."TRmcMemPos ".RmcVar."nInsPos = 0; // Buffer
insert position\n".
$self->ind."TRmcSize ".RmcVar."nSize; // Total
transport size\n";
my $transSize = "";
my $transData = $self->ind."TRmcData *".RmcVar."pcData = new char[0";
my $transCopy = "";
# ${$self->Method->returnType},
foreach (${$self->Method->returnType},$self->Method->argument ) {
my $ArgTrans = $self->createTransportToPBuffer($_);
$ArgTrans->tab($self->getInd);
$transSize .= $ArgTrans->declareSize; # declare the sizes
if ($_->toServer) {
chop($transData);
$transSize .= $ArgTrans->setSize; # init them
(eventually)
$transCopy .= $ArgTrans->copy;
$transData .= " ". $ArgTrans->getSizeName. " +0";
}
# else {
# # so that there is a value in this variable.
# $transSize .= $ArgTrans->setZeroSize;
# }
}
$transData .= "];\n";
return join "", $transVars, $transSize, $transData, $transCopy,
$self->ind.RmcVar."nSize = ".RmcVar."nInsPos;\n";
}
sub genMakeCall
{
my $self = shift;
my $call = $self->ind."TRmcResult ".RmcRes."nResult = ".
RmcMeth.RmcClient.".Call( MID_".
$self->Method->name."_".$self->Method->mid. ", ".
RmcVar."nSize, ".
RmcVar."pcData);\n";
return $call;
}
sub genReadResults
{
my $self = shift;
#my $transSize ="";
# return value
my $Result="";
if (!(${$self->Method->returnType}->type eq "void"))
{
$Result = $self->ind. ${$self->Method->returnType}->type." ".
${$self->Method->returnType}->name.";\n";
}
$Result .= $self->ind."if ( (".RmcRes."nResult == RMC_SUCCESS) &&
(".RmcVar."nSize > 0 ) )\n" .
$self->ind."{\n" .$self->tab.
$self->ind."TRmcMemPos ".RmcVar."nOutPos = 0;\n";
# copy return value
#my $ArgTrans = $self->createTransport(${$self->Method->returnType});
#$ArgTrans->tab($self->getInd);
#$Result .= $ArgTrans->copyFromPBuffer;
foreach (${$self->Method->returnType},$self->Method->argument) {
my $ArgTrans = $self->createTransportFromPBuffer($_);
$ArgTrans->tab($self->getInd);
if ($_->toClient) {
$Result .= $ArgTrans->copy;
}
}
$Result .= $self->untab.$self->ind."}\n";
}
sub genFreeMem
{
my $self = shift;
my $free = "#ifndef WIN32\n".$self->ind."delete
".RmcVar."pcData;\n"."#endif\n";
return $free;
}
sub genReturn
{
my $self = shift;
if (${$self->Method->returnType}->type eq "void") {
return "";
}
return $self->ind."return ".${$self->Method->returnType}->name. ";\n";
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# MethodGenS.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Tue Aug 22 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# * This program is distributed in the hope that it will be useful, *
# * but WITHOUT ANY WARRANTY; without even the implied warranty of *
# * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
# * GNU General Public License for more details. *
# * *
# * You should have received a copy of the GNU General Public License *
# * along with this program; if not, write to the *
# * *
# * Free Software Foundation, Inc., *
# * 59 Temple Place Suite 330, *
# * Boston, MA 02111-1307, USA. *
# * *
# ***************************************************************************/
package MethodGenS;
use strict;
use warnings;
use MethodGen;
use NamingConvention;
our @ISA = ("MethodGen");
##############################
#### SERVERSIDE #####
##############################
# generate server side wrapper method
sub genRMCMethodWrapper
{
my $self = shift;
$self->tab(2);
my $Wrapper = $self->ind."TTransResult Rmc".$self->Method->name .
$self->Method->mid.
"(TRmcSize& ".RmcVar."rnSize, TRmcData*& ".RmcVar."rpcData)\n";
$Wrapper .= $self->ind."{\n".$self->tab;
$Wrapper .= $self->genExtractArguments .
$self->genCallRealMethod .
$self->genPrepareTransport .
$self->genSReturn;
$self->untab(2);
return $Wrapper;
}
sub genExtractArguments
{
my $self = shift;
my $argList = "";
# Generate argument definitions to make real call later
# some problem when argument is call by reference.....
# i need the & for the prototype def but not here.....
foreach ($self->Method->argument) {
$argList .=$self->ind. $_->getDef;
}
# Inverse from genTransportVars
# this should also go into the ArgumentTransport modules
my $transVars = $self->ind."TRmcMemPos ".RmcVar."nOutPos = 0; // buffer
read position\n".
$self->ind."TRmcSize ".RmcVar."nSize; // Total
packet size\n";
my $transSize = "";
my $transCopy = "";
foreach (${$self->Method->returnType},$self->Method->argument) {
my $ArgTrans = $self->createTransportFromRBuffer($_);
$ArgTrans->tab($self->getInd);
$transSize .= $ArgTrans->declareSize;
if ($_->toServer) {
$transCopy .= $ArgTrans->copy;
}
}
return join "", $transVars,$argList, $transSize, $transCopy,
$self->ind.RmcVar."nSize = ".RmcVar."nOutPos;\n";
}
sub genCallRealMethod
{
my $self = shift;
my $callM = $self->ind;
# don't expect a return value from a void.
if ( !(${$self->Method->returnType}->type eq "void") ) {
$callM .= ${$self->Method->returnType}->type ." ".
${$self->Method->returnType}->name ." = ";
}
$callM .= $self->Method->name ." ( ";
foreach ($self->Method->argument) {
$callM .= $_->name . " ,";
}
chop $callM;
$callM .= ");\n";
return $callM;
}
sub genPrepareTransport
{
my $self = shift;
my $transVars = $self->ind. "TRmcMemPos ".RmcVar."nInsPos = 0; //buffer
insert position\n";
#$self->ind. ${$self->Method->returnType}->type ." ".
${$self->Method->returnType}->name;
my $transSize = ""; #$self->ind."nInsPos = sizeof(nResult);\n";
my $transCopy = "";
my $transData = "#ifndef WIN32\n". $self->ind."delete
".RmcVar."rpcData;\n"."#endif\n".
$self->ind.RmcVar."rpcData = new char[0";
# transport other arguments
foreach ( ${$self->Method->returnType}, $self->Method->argument) {
my $ArgTrans = $self->createTransportToRBuffer($_);
$ArgTrans->tab($self->getInd);
if ($_->toClient) {
chop($transData);
$transSize .= $ArgTrans->setSize;
$transCopy .= $ArgTrans->copy;
$transData .= " ". $ArgTrans->getSizeName. " +0";
}
# else {
# # so that there is a value in this variable.
# $transSize .= $ArgTrans->setZeroSize;
# }
}
$transData .= "];\n";
$transCopy .= $self->ind.RmcVar."rnSize = ".RmcVar."nInsPos;\n"; # == size
of buffer
return join "", $transVars, $transSize, $transData, $transCopy;
}
sub genSReturn
{
my $self = shift;
return $self->ind."return RMC_SUCCESS;\n".$self->untab.
$self->ind."}\n";
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# MethodInfo.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Wed July 4 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# * This program is distributed in the hope that it will be useful, *
# * but WITHOUT ANY WARRANTY; without even the implied warranty of *
# * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
# * GNU General Public License for more details. *
# * *
# * You should have received a copy of the GNU General Public License *
# * along with this program; if not, write to the *
# * *
# * Free Software Foundation, Inc., *
# * 59 Temple Place Suite 330, *
# * Boston, MA 02111-1307, USA. *
# * *
# ***************************************************************************/
package MethodInfo;
use warnings;
use strict;
use ArgumentInfo;
use TextEditing;
use NamingConvention;
# Constructor
sub new {
my $proto = shift;
my $class =ref($proto) || $proto;
my $self ={};
$self->{MethodName} = undef;
$self->{MethodID} = undef;
$self->{Scope} = undef;
$self->{MethodType} = undef; # I suggest this is also ArgumentInfo
$self->{MethodArguments } = []; # list of ArgumentInfo
$self->{Virtual} = "";
$self->{Static} = "";
$self->{Const} = "";
bless($self,$class);
return $self;
}
sub name {
my $self = shift;
if(@_) {$self->{MethodName} = shift;}
return $self->{MethodName};
}
sub mid {
my $self = shift;
if(@_) {$self->{MethodID} = shift;}
return $self->{MethodID};
}
sub scope {
my $self = shift;
if(@_) {$self->{Scope} = shift;}
return $self->{Scope};
}
sub returnType {
my $self = shift;
if(@_) {$self->{MethodType} = $_[0];}
return $self->{MethodType};
}
sub argument {
my $self = shift;
foreach (@_) {
push @{$self->{MethodArguments}}, $_;
}
return @{$self->{MethodArguments}};
}
sub virtual {
my $self = shift;
if (@_) {$self->{Virtual} = $_[0];}
return $self->{Virtual};
}
sub static {
my $self = shift;
if (@_) {$self->{Static} = $_[0];}
return $self->{Static};
}
sub const {
my $self = shift;
if(@_) {$self->{Const} = shift;}
return $self->{Const};
}
sub methodAnalyser
{
my $self = shift;
my $Method = shift;
#print "->",$Method,"<-";
#my %methodHash;
$self->virtual( isVirtual($Method) );
$self->const( isConstMethod($Method));
$self->returnType( \(ArgumentInfo->new()) );
#${$self->returnType}->const( isConstethod($Method) );
# until the opening bracket
$Method =~ s/\s*(.+?\s+.+?)\(/\(/;
my $NameAndType = $1;
# method from ArgumentInfo, it's a semi-hack, but i could defend it
# (i think:-)
${$self->returnType}->reference(
${$self->returnType}->argumentReference($NameAndType) );
${$self->returnType}->name(RmcVar."ReturnValue");
${$self->returnType}->pureIn(0); # ReturnValue is never an [in] argument
$NameAndType =~ /\s*(.+?)\s+(.+)/;
${$self->returnType}->type( $1 );
$self->name( $2 );
# returnValue is pureOut unless its a void.
${$self->returnType}->pureOut( ${$self->returnType}->type eq "void" ? 0 : 1
);
# is needed for argument extraction (closed bracket at the end)
TextEditing::removeSpaces($Method);
#print "<<$Method";
# Extract arguments
my $arguments;
if ( $Method =~ /\(\s*(.*?)\s*\)/ ) {
$arguments = $1;
#print ">>$Method and $arguments";
}
#print "\n",$arguments,"\n";
$arguments =~ s/\[(.+)\,(.+)\]/\[$1:$2\]/g;
#print $arguments,"\n";
my @argList = split "," , $arguments;
my @argHashList;
foreach (@argList) {
my $newArg = ArgumentInfo->new($_);
# assign the argument a number, return value is number zero
$newArg->argNbr(1 + scalar @argHashList);
push @argHashList, $newArg;
}
$self->argument( @argHashList );
# $methodHash{"Type"} = $typeInfo;
# $methodHash{"Name"} = $methodName;
# $methodHash{"Args"} = address@hidden;
return ;
}
# true if virtual occurs in the method as a single word
# !! removes that occurence !!
sub isVirtual
{
if ($_[0] =~s/\bvirtual\b//) {
return "virtual";
}
else {
return "";
}
}
# true if const occurs as a single word after the argument list
# !! removes that occurence !!
sub isConstMethod
{
if ($_[0] =~s/const(\s*)$//) {
return "const";
}
else {
return "";
}
}
# true if static occurs as a single word at the beginning
# !! removes that occurence !!
sub isStaticMethod
{
if ($_[0] =~s/^static\s*//) {
return "static";
}
else {
return "";
}
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# NamingConvention.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Wed September 5 2001
# copyright : (C) 2001 Peter Soetens
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package NamingConvention;
use strict;
use warnings;
BEGIN {
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(nRtti nRttiClass RmcClient RmcClientClass ObjectFactory
RmcVar RmcRes RmcMeth RpcMeth RmcObjectClass);
}
our @EXPORT;
sub nRtti
{
return "s_nRtti";
}
sub nRttiClass
{
return "TRmcClass";
}
sub RmcClient
{
return "oRmcClient";
}
sub RmcClientClass
{
return "CRmcClient";
}
sub RmcObjectClass
{
return "CRmcObject";
}
sub ObjectFactory
{
return "CRmcObjectFactory";
}
sub RmcVar
{
return "rmc_c_v_";
}
sub RmcRes
{
return "rmc_c_r_";
}
sub RmcMeth
{
return "rmc_c_m_";
}
sub RpcMeth
{
return "rpc_c_m_";
}
1;
--- NEW FILE ---
*********
rmcgen.pl
*********
This file gives some basic introduction to rmcgen.pl,
the RMC Code Generator.
Requirements :
* Perl v5.005 or higher
Command line :
./rmcgen -help
Will give the commandline options
./rmcgen myFile.rmc
Will analyse a rmc file and output its findings
Further, it will write 6 files:
* ClassName_[s|c].[h|cpp]
* RmcObjectFactory.cpp
* factory.hist
factory.hist contains a list of all classes that
were once processed by rmcgen and that should be
in the RmcObjectFactory.cpp
Use :
Code generation for testing purposes of rmc.2
Tested platforms :
Debian GNU/Linux
Windows 98Se with perl from ActiveState (ActivePerl , v5.6.1)
(c) by Peter Soetens (address@hidden)
--- NEW FILE ---
TODO List
---------
If you think something is missing here, mail me or put it here yourself
if you have CVS acces.
A. Interpreting :
* static methods/members
* RMC members tout court
* #define recognition
B. Generating :
* client side/server side
* generic/specific code for standard types ?
* code for custom types (pointers resolving)
--- NEW FILE ---
#!/usr/bin/perl -w
# TextEditing.pm, version 0.0.1
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Wed July 4 2001
# copyright : (C) 2001 Peter Soetens"
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
package TextEditing;
use strict;
use warnings;
BEGIN {
use Exporter;
our @ISA= qw(Exporter);
our @EXPORT = qw(removeTabs delSingleLineComments removeSpaces
replaceSpaces);
}
our @EXPORT;
sub removeTabs
{
$_[0] =~ s/\t/ /g;
}
#removes comments from a line
sub delSingleLineComments
{
#first remove (superior) /*..*/
$_[0] =~ s/\/\*.*?\*\///g;
#second remove remaining //....
$_[0] =~ s/\/\/.*//;
}
# removes spaces at beginning and end of a string
sub removeSpaces
{
$_[0] =~ s/^\s+//;
$_[0] =~ s/\s+$//;
}
# replace all occurences of 2 or more spaces in a row
# with a single space
sub replaceSpaces
{
$_[0] =~ s/(\s\s*)/ /g;
}
1;
--- NEW FILE ---
#!/usr/bin/perl -w
# rmcgen.pl, version 0.1.0
#/***************************************************************************
# gen.header - description
# -------------------
# begin : Fri June 15 2001
# copyright : (C) 2001 Peter Soetens"
# email : address@hidden
#
# ***************************************************************************
# * *
# * This program is free software; you can redistribute it and/or modify *
# * it under the terms of the GNU General Public License as published by *
# * the Free Software Foundation; either version 2 of the License, or *
# * (at your option) any later version. *
# * *
# ***************************************************************************/
#use Getopt::Declare;
use warnings;
#use strict;
use MethodInfo;
use ClassInfo;
use ArgumentInfo;
use TextEditing;
use ClassGenC;
use ClassGenS;
use ClassGenF;
#$args =new Getopt::Declare <<'ENDARG';
#General Options :
# <file1> RMC file [required]
# {print "RMC file : $file1\n"; $::rmcInput = $file1;}
# -s <file2> Server file
# {print "Server : $file2\n";}
#ENDARG
#exit(-1) unless $rmcInput;
#$client = $args->{-c};
#$server = $args->{-s};
#print $server if $server;
main(@ARGV);
sub main
{
print "rmcgen v0.1.0 (c) 2001 Peter Soetens\n";
if (@ARGV && $ARGV[0] =~ /[^(-help)|^(-h)|^(--help)]/) {$rmcInput = shift;}
else {
print "usage : rmcgen <file.rmc>\n";
exit (-1);
}
print "
***************************************************************************
*
*
* This program is free software; you can redistribute it and/or
modify *
* it under the terms of the GNU General Public License as
published by *
* the Free Software Foundation; either version 2 of the License,
or *
* (at your option) any later version.
*
*
*
***************************************************************************\n";
open RMCFILE,"<$rmcInput"
or die "could not open $rmcInput : $!";
$program = "";
while (<RMCFILE>)
{
delSingleLineComments ($_);
chomp;
$program = $program . $_ . " ";
#print $stripedLine;
}
# remove remaining /*...*/
delSingleLineComments( $program );
removeTabs( $program );
@allClasses = $program =~ /(class.*?{.*?(?:{.*?})*.*};)/g;
#print "---",@allClasses,"*";
# factory generator
my $gFClass = ClassGenF->new();
my $gCClass = ClassGenC->new();
my $gSClass = ClassGenS->new();
foreach (@allClasses) {
$class = ClassInfo->new($_);
$gCClass->addClass($class);
$gSClass->addClass($class);
$gFClass->addClass($class);
print "\nI found class:>", $class->name, "<.\n";
if ( $class->publicMethod() ) {
print "\nI found following public functions:\n";
foreach ( $class->publicMethod() ) {
print $_->name(),". with :\n";
print "Type : ",${$_->returnType}->type," ";
print "Reference : ",${$_->returnType}->reference," ";
print "Name : ",$_->name," ";
print "-Virtual- " if ($_->virtual);
print "-Const- " if ($_->const);
print "Arguments : \n";
foreach ($_->argument) {
print "Type: ",$_->type," Name: ";print $_->name;
}
print "\n\n";
}
}
# my $gCClass = ClassGenC->new($class);
# my $gSClass = ClassGenS->new($class);
$gCClass->currentClass($class);
$gSClass->currentClass($class);
$gCClass->HeaderGenerator;
$gCClass->SourceGenerator;
$gSClass->HeaderGenerator;
$gSClass->SourceGenerator;
$gFClass->SourceGenerator;
$gCClass->write($gCClass->currentClass->name);
$gSClass->write($gSClass->currentClass->name);
} # foreach (allClasses)
# Do this only once ! It writes for all classes one file
$gFClass->write("RmcObjectFactory");
close RMCFILE;
}
--- NEW FILE ---
/***************************************************************************
Chat.rmc - description
-------------------
begin : Wed June 13 2001
copyright : (C) 2001 Manfred Morgner
email : address@hidden
***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************
*
* The RMC source header/script to generate RMC class implementations.
*
*/
class CChat // : public BasicClass
{
public:
// Sends the given string to the chat server
// Returns the success code (RMC_SUCCESS or other)
// RMC: The argument is an IN parameter. What means, the data
// will be sent to the server but don't come back.
// There is no explaination needed, bacause
// "const" arguments can't receive any data.
RMC string Send(string s, string *ps );
public:
private:
// RMC long privateMethod( xxx ); RMC short privateMethod2(ssss);
private:
public:
long RMC_MethodNotHere( dddd); // yes the word RMC is in it !!
long thisIsAlsoNo_RMC ( ccccc);
public:
// Receives a string from the chat server
// Returns the success code (RMC_SUCCESS or other)
// RMC: The argument is an OUT parameter. What means, the data
// will only be received from the server but nothings is to send
// We should declare this, because otherwise the code generator
// has to generate code to send the parameter to the server
// There is no other way to show, that no data is to send.
RMC long Receive([out] string &s, int *nMyLuckyNumber);
/* RMC ( * void) DoVoid();
RMC
string
rmcIsCoolMethod
(xxxx**,
yyy*,
zzz&)
;*/
private:
public:
}; // class CChat
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Moss-devel] CVS: moss/rmc/src/rmcgen ArgumentBuffer.pm,NONE,1.1 ArgumentBufferP.pm,NONE,1.1 ArgumentBufferR.pm,NONE,1.1 ArgumentInfo.pm,NONE,1.1 ArgumentTransport.pm,NONE,1.1 ArgumentTransportDefault.pm,NONE,1.1 ArgumentTransportFromBuffer.pm,NONE,1.1 ArgumentTransportFromPBuffer.pm,NONE,1.1 ArgumentTransportFromRBuffer.pm,NONE,1.1 ArgumentTransportObject.pm,NONE,1.1 ArgumentTransportString.pm,NONE,1.1 ArgumentTransportToBuffer.pm,NONE,1.1 ArgumentTransportToPBuffer.pm,NONE,1.1 ArgumentTransportToRBuffer.pm,NONE,1.1 ArgumentTransportVoid.pm,NONE,1.1 ClassGen.pm,NONE,1.1 ClassGenC.pm,NONE,1.1 ClassGenF.pm,NONE,1.1 ClassGenS.pm,NONE,1.1 ClassInfo.pm,NONE,1.1 Formatter.pm,NONE,1.1 Makefile.am,NONE,1.1 MethodGen.pm,NONE,1.1 MethodGenC.pm,NONE,1.1 MethodGenS.pm,NONE,1.1 MethodInfo.pm,NONE,1.1 NamingConvention.pm,NONE,1.1 README,NONE,1.1 TODO,NONE,1.1 TextEditing.pm,NONE,1.1 rmcgen.pl,NONE,1.1 rmctest.rmc,NONE,1.1,
Alexander Feder <address@hidden> <=
- Prev by Date:
[Moss-devel] CVS: moss/rmc/src/rmcgen/Getopt-Declare-1.08 Changes,NONE,1.1 MANIFEST,NONE,1.1 Makefile.PL,NONE,1.1 README,NONE,1.1 demo_cmdline,NONE,1.1 demo_csv,NONE,1.1 demo_interp,NONE,1.1 demo_shell,NONE,1.1 test.pl,NONE,1.1
- Next by Date:
[Moss-devel] CVS: moss/rmc/src/rmcgen/Getopt-Declare-1.08/lib/Getopt Declare.pm,NONE,1.1 Declare.pod,NONE,1.1
- Previous by thread:
[Moss-devel] CVS: moss/rmc/src/rmcgen/Getopt-Declare-1.08 Changes,NONE,1.1 MANIFEST,NONE,1.1 Makefile.PL,NONE,1.1 README,NONE,1.1 demo_cmdline,NONE,1.1 demo_csv,NONE,1.1 demo_interp,NONE,1.1 demo_shell,NONE,1.1 test.pl,NONE,1.1
- Next by thread:
[Moss-devel] CVS: moss/rmc/src/rmcgen/Getopt-Declare-1.08/lib/Getopt Declare.pm,NONE,1.1 Declare.pod,NONE,1.1
- Index(es):