htooc.pl

   1 #!/usr/bin/env perl
   2
   3 # convert C or D (suggested, since "preprocessed") headerfile to ooc
   4 # author: rofl0r
   5 #
   6 # why not use babbisch ? well i dont want to use python and figure out
   7 # how its package management system works.
   8
   9 use strict;
  10 use warnings;
  11 #use re 'debugcolor';
  12
  13 sub converttype {
  14         my ($type) = @_;
  15         $type =~ s/uint/UInt/;
  16         $type =~ s/int/Int/;
  17         $type =~ s/char/Char/;
  18         $type =~ s/void/Void/;
  19         $type =~ s/Void\*/Pointer/;
  20         $type =~ s/ushort/UShort/;
  21         $type =~ s/short/Short/;
  22         $type =~ s/size_t/SizeT/;
  23         $type =~ s/ssize_t/SSizeT/;
  24         $type =~ s/ptrdiff_t/SSizeT/;
  25
  26         return $type;
  27 }
  28
  29 sub trim{
  30    my $string = shift;
  31    $string =~ s/^\s+|\s+$//g;
  32    return $string;
  33 }
  34
  35 sub myjoin {
  36         my @a = @_;
  37         my $res = "";
  38         foreach my $char(@a) {
  39                 $res .= $char if($char);
  40         }
  41         return $res
  42 }
  43
  44 sub fixpointers {
  45         my $string = shift;
  46         $string =~ s/(\w+)\s+\*\s*/$1* /g;
  47         return $string;
  48 }
  49
  50 sub check_all_upper {
  51         $_ = shift;
  52         my @a = split //;
  53         foreach (@a) {
  54                 return 0 if /^[a-z]/;
  55         }
  56         return 1;
  57 }
  58
  59 sub ooccase {
  60         my $string = shift;
  61         return ($string, "") if check_all_upper($string);
  62         my @a = split(//, $string);
  63         my $lastChar = 0;
  64         my $makeBig = 0;
  65         my @del = ();
  66         for(my $i=0;$i<@a;$i++) {
  67                 if($lastChar && $a[$i] eq "_") {
  68                         push @del, $i;
  69                         $lastChar = 0;
  70                         $makeBig = 1;
  71                 } else {
  72                         if ($makeBig) {
  73                                 $a[$i] = uc($a[$i]);
  74                                 $makeBig = 0;
  75                         }
  76                         $lastChar = 1
  77                 }
  78         }
  79         foreach my $item(@del) {
  80                 delete $a[$item];
  81         }
  82         my $new = myjoin(@a);
  83         return ($new, "(" . $string . ")") if ($new ne $string);
  84         return ($string, "");
  85 }
  86
  87 #exit check_all_upper("SOME_COaNST_NAME");
  88
  89 while(<>){
  90         chomp;
  91         $_=fixpointers($_);
  92         if (/^\s*\/\//) {
  93                 #skipping comments.
  94                 print("$_\n");
  95         } elsif (/^\s*(\w+\**)\s+(\w*)\s*\(([\w|\*| |,|\.]*)\)\s*;/) {
  96                 #searching function declararions
  97                 my $return = converttype($1);
  98                 #no need to declare void return type in ooc
  99                 if($return eq "Void") {
 100                         $return = ""
 101                 } else {
 102                         $return = "-> " . $return
 103                 }
 104                 my ($funcname, $externname) = ooccase($2);
 105
 106                 my $args = $3;
 107                 my $args_braced = "";
 108                 if($args) {
 109                         $args_braced = "(";
 110                         my @arga = split /,/, $args;
 111                         my $counter = 0;
 112                         foreach my $item(@arga) {
 113                                 my $expr = trim($item);
 114                                 if ($expr =~ / /) {
 115                                         my @exprel = split / /, $expr;
 116                                         $expr = $exprel[1] . ": " . converttype($exprel[0])
 117                                 } else {
 118                                         $expr = converttype($expr);
 119                                 }
 120                                 $args_braced .= $expr;
 121                                 $args_braced .= ", " if($counter != @arga -1);
 122                                 $counter++;
 123                         }
 124                         $args_braced .= ")";
 125                 }
 126                 print("$funcname: extern$externname func$args_braced $return\n");
 127         } elsif (/^\s*const\s+(\w+\**)\s+(\w+)\s*=\s*.+?;/) {
 128                 #searching const's
 129                 my $type = converttype($1);
 130                 my ($name, $externname) = ooccase($2);
 131                 print("$name: extern$externname $type\n");
 132         } elsif (/^\s*(alias|typedef)\s+?(\w+\**)\s+?(\w+)\s*;/) {
 133                 #searching simple typedef. we dont cover function pointers and arrays.
 134                 my $type = converttype($2);
 135                 my $name = $3;
 136                 print("$name: cover from $type\n");
 137         } else {
 138                 #not handled
 139                 print("// $_\n");
 140         }
 141 }