summaryrefslogtreecommitdiff
path: root/apps/plugins/lua/rocklib_aux.pl
diff options
context:
space:
mode:
Diffstat (limited to 'apps/plugins/lua/rocklib_aux.pl')
-rwxr-xr-xapps/plugins/lua/rocklib_aux.pl291
1 files changed, 291 insertions, 0 deletions
diff --git a/apps/plugins/lua/rocklib_aux.pl b/apps/plugins/lua/rocklib_aux.pl
new file mode 100755
index 0000000000..b5de1e4544
--- /dev/null
+++ b/apps/plugins/lua/rocklib_aux.pl
@@ -0,0 +1,291 @@
1#!/usr/bin/env perl
2
3sub trim
4{
5 my $text = $_[0];
6 $text =~ s/^\s+//;
7 $text =~ s/\s+$//;
8 return $text;
9}
10
11sub rand_string
12{
13 my @chars=('a'..'z');
14 my $ret;
15 foreach (1..5)
16 {
17 $ret .= $chars[rand @chars];
18 }
19 return $ret;
20}
21
22
23my @functions;
24my @ported_functions;
25my @forbidden_functions = ('^open$',
26 '^close$',
27 '^read$',
28 '^write$',
29 '^lseek$',
30 '^ftruncate$',
31 '^filesize$',
32 '^fdprintf$',
33 '^read_line$',
34 '^[a-z]+dir$',
35 '^__.+$',
36 '^.+_(un)?cached$',
37 '^audio_play$');
38
39my $rocklib = sprintf("%s/rocklib.c", $ARGV[0]);
40open ROCKLIB, "<$rocklib" or die("Couldn't open $rocklib: $!");
41while(<ROCKLIB>)
42{
43 if(/^RB_WRAP\(([^)]+)\)/)
44 {
45 push(@ported_functions, $1);
46 }
47}
48close ROCKLIB;
49
50# Parse plugin.h
51my $start = 0;
52while(<STDIN>)
53{
54 if(/struct plugin_api \{/)
55 {
56 $start = 1;
57 }
58 elsif($start && /\};/)
59 {
60 $start = 0;
61 }
62
63 if($start == 1)
64 {
65 my $line = $_;
66 while($line !~ /;/)
67 {
68 $line .= <STDIN>;
69 }
70
71 $line =~ s/(\n|\r)//g;
72
73 if($line =~ /([a-zA-Z *_]+)?\s?\(\*([^)]+)?\)\(([^)]+)\).*?;/)
74 {
75 $return_type = $1;
76 $name = $2;
77 $arguments = $3;
78
79 $return_type = trim($return_type);
80 $arguments =~ s/\s{2,}/ /g;
81
82 if( !grep($_ eq $name, @ported_functions) &&
83 !grep($name =~ $_, @forbidden_functions))
84 {
85 push(@functions, {'name' => $name, 'return' => $return_type, 'arg' => $arguments});
86 }
87 }
88 }
89}
90
91my $svnrev = '$Revision$';
92
93# Print the header
94print <<EOF
95/* Automatically generated of $svnrev from rocklib.c & plugin.h */
96
97#define lrocklib_c
98#define LUA_LIB
99
100#define _ROCKCONF_H_ /* We don't need strcmp() etc. wrappers */
101#include "lua.h"
102#include "lauxlib.h"
103#include "plugin.h"
104
105EOF
106;
107
108my %in_types = ('void' => \&in_void,
109 'int' => \&in_int,
110 'unsigned' => \&in_int,
111 'unsignedint' => \&in_int,
112 'signed' => \&in_int,
113 'signedint' => \&in_int,
114 'short' => \&in_int,
115 'unsignedshort' => \&in_int,
116 'signedshort' => \&in_int,
117 'long' => \&in_int,
118 'unsignedlong' => \&in_int,
119 'signedlong' => \&in_int,
120 'char' => \&in_int,
121 'unsignedchar' => \&in_int,
122 'signedchar' => \&in_int,
123 'char*' => \&in_string,
124 'signedchar*' => \&in_string,
125 'unsignedchar*' => \&in_string,
126 'bool' => \&in_bool,
127 '_Bool' => \&in_bool
128), %out_types = ('void' => \&out_void,
129 'int' => \&out_int,
130 'unsigned' => \&out_int,
131 'unsignedint' => \&out_int,
132 'signed' => \&out_int,
133 'signedint' => \&out_int,
134 'short' => \&out_int,
135 'unsignedshort' => \&out_int,
136 'signedshort' => \&out_int,
137 'long' => \&out_int,
138 'unsignedlong' => \&out_int,
139 'signedlong' => \&out_int,
140 'char' => \&out_int,
141 'unsignedchar' => \&out_int,
142 'signedchar' => \&out_int,
143 'char*' => \&out_string,
144 'signedchar*' => \&out_string,
145 'unsignedchar*' => \&out_string,
146 'bool' => \&out_bool,
147 '_Bool' => \&out_bool
148);
149
150sub in_void
151{
152 return "\t(void)L;\n";
153}
154
155sub in_int
156{
157 my ($name, $type, $pos) = @_;
158 return sprintf("\t%s %s = (%s) luaL_checkint(L, %d);\n", $type, $name, $type, $pos);
159}
160
161sub in_string
162{
163 my ($name, $type, $pos) = @_;
164 return sprintf("\t%s %s = (%s) luaL_checkstring(L, %d);\n", $type, $name, $type, $pos)
165}
166
167sub in_bool
168{
169 my ($name, $type, $pos) = @_;
170 return sprintf("\tbool %s = luaL_checkboolean(L, %d);\n", $name, $pos)
171}
172
173sub out_void
174{
175 my $name = $_[0];
176 return sprintf("\t%s;\n\treturn 0;\n", $name);
177}
178
179sub out_int
180{
181 my ($name, $type) = @_;
182 return sprintf("\t%s result = %s;\n\tlua_pushinteger(L, result);\n\treturn 1;\n", $type, $name);
183}
184
185sub out_string
186{
187 my ($name, $type) = @_;
188 return sprintf("\t%s result = %s;\n\tlua_pushstring(L, result);\n\treturn 1;\n", $type, $name);
189}
190
191sub out_bool
192{
193 my ($name, $type) = @_;
194 return sprintf("\tbool result = %s;\n\tlua_pushboolean(L, result);\n\treturn 1;\n", $name);
195}
196
197# Print the functions
198my @valid_functions;
199foreach my $function (@functions)
200{
201 my $valid = 1, @arguments = ();
202 # Check for supported arguments
203 foreach my $argument (split(/,/, @$function{'arg'}))
204 {
205 $argument = trim($argument);
206 if($argument !~ /\[.+\]/ && ($argument =~ /^(.+[\s*])([^[*\s]*)/
207 || $argument eq "void"))
208 {
209 my $literal_type, $type, $name;
210 if($argument eq "void")
211 {
212 $literal_type = "void", $type = "void", $name = "";
213 }
214 else
215 {
216 $literal_type = trim($1), $name = trim($2), $type = trim($1);
217 $type =~ s/(\s|const)//g;
218
219 if($name eq "")
220 {
221 $name = rand_string();
222 }
223 }
224
225 #printf "/* %s: %s|%s */\n", @$function{'name'}, $type, $name;
226 if(!defined $in_types{$type})
227 {
228 $valid = 0;
229 break;
230 }
231
232 push(@arguments, {'name' => $name,
233 'type' => $type,
234 'literal_type' => $literal_type
235 });
236 }
237 else
238 {
239 $valid = 0;
240 break;
241 }
242 }
243
244 # Check for supported return value
245 my $return = @$function{'return'};
246 $return =~ s/(\s|const)//g;
247 #printf "/* %s: %s [%d] */\n", @$function{'name'}, $return, $valid;
248 if(!defined $out_types{$return})
249 {
250 $valid = 0;
251 }
252
253 if($valid == 1)
254 {
255 # Print the header
256 printf "static int rock_%s(lua_State *L)\n".
257 "{\n",
258 @$function{'name'};
259
260 # Print the arguments
261 my $i = 1;
262 foreach my $argument (@arguments)
263 {
264 print $in_types{@$argument{'type'}}->(@$argument{'name'}, @$argument{'literal_type'}, $i++);
265 }
266
267 # Generate the arguments string
268 my $func_args = $arguments[0]{'name'};
269 for(my $i = 1; $i < $#arguments + 1; $i++)
270 {
271 $func_args .= ", ".$arguments[$i]{'name'};
272 }
273
274 # Print the function call
275 my $func = sprintf("rb->%s(%s)", @$function{'name'}, $func_args);
276
277 # Print the footer
278 print $out_types{$return}->($func, @$function{'return'});
279 print "}\n\n";
280
281 push(@valid_functions, $function);
282 }
283}
284
285# Print the C array
286print "const luaL_Reg rocklib_aux[] =\n{\n";
287foreach my $function (@valid_functions)
288{
289 printf "\t{\"%s\", rock_%s},\n", @$function{'name'}, @$function{'name'};
290}
291print "\t{NULL, NULL}\n};\n\n";