1 files changed, 126 insertions, 0 deletions
diff --git a/CIAO/bin/PerlCIAO/generate_container.pl b/CIAO/bin/PerlCIAO/generate_container.pl
new file mode 100644
index 00000000000..c56c03ea300
--- /dev/null
+++ b/CIAO/bin/PerlCIAO/generate_container.pl
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+#
+# $Id$
+# 
+# The above line is for compatibility /w Linux. Windows uses the .pl extension.
+# Author: Stoyan Paunov
+# Purpose: Generate a container class with mutator/accessor methods
+#		The idea is to use this class as a base class in the 
+#		inheritance hierarchy. This way we can evolve the base 
+#		container independently from the rest of the code!
+#
+
+use strict;
+
+die "Usage: $0 <module name> <field description file>\n" 
+    if not defined $ARGV[0];
+
+die "Usage: $0 <module name> <field description file>\n" 
+    if not defined $ARGV[1];
+
+my $module_name = $ARGV[0];
+my $fields = $ARGV[1];
+
+open (FIELDS, $fields) or die "Failed opening $fields\n";
+
+my @fields = <FIELDS>;
+close FIELDS;
+
+my $field;
+
+print "\#File generated by $0.\n";
+print "\#Input file: $fields.\n";
+print "\#Code generator author: Stoyan Paunov\n\#\n\n";
+
+print "\#class $module_name\n";
+print "package $module_name;\n";
+print "use strict;\n\n";
+print "\#Class constructor :)\n";
+print "sub new {\n";
+print "    my (\$class) = \@_;\n\n";
+print "    \#Create a reference to an anonymous hash\n";
+print "    my \$self = {\n";
+
+my $count = 0;
+my $end = $#fields;
+
+#generate initialization code
+foreach $field (@fields)
+{
+    if ($field =~ /^$/ )   # empty line
+    {
+	next;
+    }
+
+    chomp ($field);
+
+    if ($count == $end)
+	{
+	    printf ("        _\%-14s   => undef\n", $field);
+	    next;
+	}
+    printf ("        _\%-14s   => undef,\n", $field);
+
+
+    $count++
+}
+
+print "     };\n\n";
+print "    \#Bless the hash.\n";
+print "    bless \$self, \$class;\n";
+print "    return \$self;\n";
+print "}\n\n";
+
+#Code to generate the accessor and mutator
+
+foreach $field (@fields)
+{
+    if ($field =~ /^$/ )   # empty line
+    {
+	next;
+    }
+
+    chomp ($field);
+
+    print "\#accessor/mutator method for $field\n";
+    print "sub $field {\n";
+    print "    my ( \$self, \$$field ) = \@_;\n\n";
+    print "    \$self->{_$field} = \$$field\n";
+    print "         if defined (\$$field);\n\n";
+    print "    return \$self->{_$field};\n";
+    print "}\n\n";
+
+}
+
+
+print "\#print method for the class\n";
+print "sub print {\n";
+print "    my (\$self) = \@_;\n\n";
+
+print "    my \$f;\n\n";
+
+#Code to generate a print method which dumps the object state
+foreach $field (@fields)
+{
+    if ($field =~ /^$/ )   # empty line
+    {
+	next;
+    }
+
+    chomp ($field);
+    print "    \$f = defined (\$self->{_$field}) \n";
+    print "          ? \$self->{_$field} : \"not defined\";\n";
+    print "    printf (\"$field: %s\\n\", \$f);\n\n";
+
+}
+
+
+
+print "}\n\n";
+
+print "\#class return value \n1;\n\n";
+
+
+
+
+