ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/server/genacc
(Generate patch)

Comparing deliantra/server/server/genacc (file contents):
Revision 1.5 by root, Sat Dec 30 10:16:11 2006 UTC vs.
Revision 1.9 by root, Mon Aug 11 23:23:41 2008 UTC

1#! perl 1#! perl
2 2
3# actually geninterface 3# used to automatically create accessors/mutators and method interfaces
4# to C++ classes for Perl.
4 5
5my $class = shift; 6my $class = shift;
6my $curclass = ""; 7my $curclass = "";
7my (@scalar_member, @array_member); 8my (@scalar_member, @array_member);
9
10# convert c member name to perl
11sub c2perl($) {
12 local $_ = shift;
13
14 s/^([^.]+)\.\1_/$1\_/g; # tcpi.tcpi_xxx => tcpi_xxx
15
16 $_
17}
8 18
9for my $file (@ARGV) { 19for my $file (@ARGV) {
10 open my $fh, "<:utf8", $file 20 open my $fh, "<:utf8", $file
11 or die "$file: $!"; 21 or die "$file: $!";
12 22
13 while (<$fh>) { 23 while (<$fh>) {
24 next if /^\s*\//; # skip lines starting with /
14 if ($curclass eq $class) { 25 if ($curclass eq $class) {
15 while (/ACC\s*\(R([WO])\s*,\s*([^)\]]+)(?:\[(\S+)\])?\)/g) { 26 while (/ACC\s*\(R([WO])\s*,\s*([^)\]]+)(?:\[(\S+)\])?\)/g) {
16 if ($3) { 27 if ($3) {
17 push @array_member, [$1, $2, $3]; 28 push @array_member, [$1, $2, $3];
18 } else { 29 } else {
… …
57 print "\tPROTOTYPE: \$;\$\n"; 68 print "\tPROTOTYPE: \$;\$\n";
58 69
59 if (@scalar_member > 1) { 70 if (@scalar_member > 1) {
60 print "\tALIAS:\n"; 71 print "\tALIAS:\n";
61 for (1 .. $#scalar_member) { 72 for (1 .. $#scalar_member) {
62 print "\t\t$scalar_member[$_][1]\t= $_\n"; 73 print "\t\t" . (c2perl $scalar_member[$_][1]) . "\t= $_\n";
63 } 74 }
64 } 75 }
65 76
66 print "\tCODE:\n"; 77 print "\tCODE:\n";
67 78
79 my $ix = @scalar_member == 1 ? 0 : "ix";
80
68# read 81# read
69 print "\tif (GIMME_V == G_VOID)\n", 82 print "\tif (GIMME_V == G_VOID)\n",
70 "\t RETVAL = &PL_sv_undef;\n", 83 "\t RETVAL = &PL_sv_undef;\n",
71 "\telse\n", 84 "\telse\n",
72 "\t switch (ix)\n", 85 "\t switch ($ix)\n",
73 "\t {\n", 86 "\t {\n",
74 (map "\t case $_: RETVAL = to_sv (self->$scalar_member[$_][1]); break;\n", 87 (map "\t case $_: RETVAL = to_sv (self->$scalar_member[$_][1]); break;\n",
75 0 .. $#scalar_member), 88 0 .. $#scalar_member),
76 "\t default: croak (\"scalar_member is write-only\");\n", 89 "\t default: croak (\"scalar_member is write-only\");\n",
77 "\t };\n"; 90 "\t };\n";
78 91
79# write 92# write
80 print "\tif (newval)\n", 93 print "\tif (newval)\n",
81 "\t switch (ix)\n", 94 "\t switch ($ix)\n",
82 "\t {\n", 95 "\t {\n",
83 (map "\t case $_: sv_to (newval, self->$scalar_member[$_][1]); break;\n", 96 (map "\t case $_: sv_to (newval, self->$scalar_member[$_][1]); break;\n",
84 grep $scalar_member[$_][0] eq "W", 97 grep $scalar_member[$_][0] eq "W",
85 0 .. $#scalar_member), 98 0 .. $#scalar_member),
86 "\t default: croak (\"scalar_member is read-only\");\n", 99 "\t default: croak (\"scalar_member is read-only\");\n",
… …
94 print "\tPROTOTYPE: \$;\$\n"; 107 print "\tPROTOTYPE: \$;\$\n";
95 108
96 if (@array_member > 1) { 109 if (@array_member > 1) {
97 print "\tALIAS:\n"; 110 print "\tALIAS:\n";
98 for (1 .. $#array_member) { 111 for (1 .. $#array_member) {
99 print "\t\t$array_member[$_][1]\t= $_\n"; 112 print "\t\t" . (c2perl $array_member[$_][1]) . "\t= $_\n";
100 } 113 }
101 } 114 }
102 115
103 print "\tCODE:\n"; 116 print "\tCODE:\n";
104 117
105 print "\tif (idx < 0) croak (\"negative array index\");\n"; 118 print "\tif (idx < 0) croak (\"negative array index\");\n";
106 119
120 my $ix = @array_member == 1 ? 0 : "ix";
121
107# range 122# range
108 print "\t switch (ix)\n", 123 print "\t switch ($ix)\n",
109 "\t {\n", 124 "\t {\n",
110 (map "\t case $_: if (idx >= $array_member[$_][2]) croak (\"array index out of bounds\"); break;\n", 125 (map "\t case $_: if (idx >= $array_member[$_][2]) croak (\"array index out of bounds\"); break;\n",
111 0 .. $#array_member), 126 0 .. $#array_member),
112 "\t };\n"; 127 "\t };\n";
113 128
114# read 129# read
115 print "\tif (GIMME_V == G_VOID)\n", 130 print "\tif (GIMME_V == G_VOID)\n",
116 "\t RETVAL = &PL_sv_undef;\n", 131 "\t RETVAL = &PL_sv_undef;\n",
117 "\telse\n", 132 "\telse\n",
118 "\t switch (ix)\n", 133 "\t switch ($ix)\n",
119 "\t {\n", 134 "\t {\n",
120 (map "\t case $_: RETVAL = to_sv (self->$array_member[$_][1] [idx]); break;\n", 135 (map "\t case $_: RETVAL = to_sv (self->$array_member[$_][1] [idx]); break;\n",
121 0 .. $#array_member), 136 0 .. $#array_member),
122 "\t default: croak (\"array_member is write-only\");\n", 137 "\t default: croak (\"array_member is write-only\");\n",
123 "\t };\n"; 138 "\t };\n";
124 139
125# write 140# write
126 print "\tif (newval)\n", 141 print "\tif (newval)\n",
127 "\t switch (ix)\n", 142 "\t switch ($ix)\n",
128 "\t {\n", 143 "\t {\n",
129 (map "\t case $_: sv_to (newval, self->$array_member[$_][1] [idx]); break;\n", 144 (map "\t case $_: sv_to (newval, self->$array_member[$_][1] [idx]); break;\n",
130 grep $array_member[$_][0] eq "W", 145 grep $array_member[$_][0] eq "W",
131 0 .. $#array_member), 146 0 .. $#array_member),
132 "\t default: croak (\"array_member is read-only\");\n", 147 "\t default: croak (\"array_member is read-only\");\n",

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines