blob: c56c03ea3002f441694e06d4f1fdd4222195868c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
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";
|
