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         $type =~ s/bool/Bool/;
  26         $type =~ s/ubyte/Octet/;
  27         $type =~ s/Char\*/CString/;
  28
  29         return $type;
  30 }
  31
  32 sub trim{
  33    my $string = shift;
  34    $string =~ s/^\s+|\s+$//g;
  35    return $string;
  36 }
  37
  38 sub myjoin {
  39         my @a = @_;
  40         my $res = "";
  41         foreach my $char(@a) {
  42                 $res .= $char if($char);
  43         }
  44         return $res
  45 }
  46
  47 sub fixpointers {
  48         my $string = shift;
  49         $string =~ s/(\w+)\s+\*\s*/$1* /g;
  50         return $string;
  51 }
  52
  53 sub check_all_upper {
  54         $_ = shift;
  55         my @a = split //;
  56         foreach (@a) {
  57                 return 0 if /^[a-z]/;
  58         }
  59         return 1;
  60 }
  61
  62 sub ooccase {
  63         my $string = shift;
  64         return ($string, "") if check_all_upper($string);
  65         my @a = split(//, $string);
  66         my $lastChar = 0;
  67         my $makeBig = 0;
  68         my @del = ();
  69         for(my $i=0;$i<@a;$i++) {
  70                 if($lastChar && $a[$i] eq "_") {
  71                         push @del, $i;
  72                         $lastChar = 0;
  73                         $makeBig = 1;
  74                 } else {
  75                         if ($makeBig) {
  76                                 $a[$i] = uc($a[$i]);
  77                                 $makeBig = 0;
  78                         }
  79                         $lastChar = 1
  80                 }
  81         }
  82         foreach my $item(@del) {
  83                 delete $a[$item];
  84         }
  85         my $new = myjoin(@a);
  86         return ($new, "(" . $string . ")") if ($new ne $string);
  87         return ($string, "");
  88 }
  89
  90 #exit check_all_upper("SOME_COaNST_NAME");
  91
  92 while(<>){
  93         chomp;
  94         $_=fixpointers($_);
  95         if (/^\s*\/\//) {
  96                 #skipping comments.
  97                 print("$_\n");
  98         } elsif (/^\s*(\w+\**)\s+(\w*)\s*\(([\w|\*| |,|\.]*)\)\s*;/) {
  99                 #searching function declararions
 100                 my $return = converttype($1);
 101                 #no need to declare void return type in ooc
 102                 if($return eq "Void") {
 103                         $return = ""
 104                 } else {
 105                         $return = "-> " . $return
 106                 }
 107                 my ($funcname, $externname) = ooccase($2);
 108
 109                 my $args = $3;
 110                 my $args_braced = "";
 111                 if($args) {
 112                         $args_braced = "(";
 113                         my @arga = split /,/, $args;
 114                         my $counter = 0;
 115                         foreach my $item(@arga) {
 116                                 my $expr = trim($item);
 117                                 if ($expr =~ / /) {
 118                                         my @exprel = split / /, $expr;
 119                                         $expr = $exprel[1] . ": " . converttype($exprel[0])
 120                                 } else {
 121                                         $expr = converttype($expr);
 122                                 }
 123                                 $args_braced .= $expr;
 124                                 $args_braced .= ", " if($counter != @arga -1);
 125                                 $counter++;
 126                         }
 127                         $args_braced .= ")";
 128                         $args_braced = "" if($args_braced eq "(Void)");
 129                 }
 130                 print("$funcname: extern$externname func$args_braced $return\n");
 131         } elsif (/^\s*const\s+(\w+\**)\s+(\w+)\s*=\s*.+?;/) {
 132                 #searching const's
 133                 my $type = converttype($1);
 134                 my ($name, $externname) = ooccase($2);
 135                 print("$name: extern$externname $type\n");
 136         } elsif (/^\s*(alias|typedef)\s+?(\w+\**)\s+?(\w+)\s*;/) {
 137                 #searching simple typedef. we dont cover function pointers and arrays.
 138                 my $type = converttype($2);
 139                 my $name = $3;
 140                 print("$name: cover from $type\n");
 141         } else {
 142                 #not handled
 143                 print("// $_\n");
 144         }
 145 }