apps/plugins/lua/rocklib_aux.pl

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