API tools faq
paste
Guest User

Perl `class' generator for OOP on C

a guest
Jan 8th, 2012
178
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 15.73 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl -w
  2.  
  3. ##### !!!! Copyright !!!! #####
  4. # if you see this code        #
  5. #     you must kill yourself. #
  6. ###############################
  7.  
  8. ###  ## ## ### # # # #### ## #
  9. ##  Example of input file syntax
  10. # sourceinclude <malloc.h>
  11. # class MegaClass
  12. #       unsigned int lolol
  13. #       float vah = 1.4f, duh = ( 3+ 5), * doh, deh
  14. #       char *name = "hehehe", noname = 'k'
  15. #       float *** testptr
  16. #
  17. #       float method( int a, float b, char* c)
  18. #       int multimethod( float a), mmethod( int g )
  19. #
  20. #       void * retutn()
  21. #       {
  22. #         #this is comment?
  23. #         // this is commmnet
  24. #         return NULL;
  25. #       }
  26. #
  27. #
  28. # class llass
  29. #       int lolol
  30.  
  31. package KlassGen;
  32.  
  33. use strict;
  34. use warnings;
  35.  
  36. use Encode;
  37.  
  38. binmode STDOUT, ":utf8";
  39. binmode STDIN, ":utf8";
  40. binmode STDERR, ":utf8";
  41.  
  42.  
  43. if ( $#ARGV + 1 < 1 ) { die "you must specify the name of file as argument\n"; }
  44.  
  45. my $filename = $ARGV[0];
  46.  
  47. unless ( (-e "$filename") and (-r "$filename") and (not -d "$filename") and (-f "$filename") )
  48.   {
  49.     die "you must specify the name of file as argument\n";
  50.   }
  51.  
  52.  
  53. open( SOURCEF, "<:utf8", $filename ) or die "Can't open file $filename: $!\n";
  54.  
  55. # {
  56. #   my( $curpos, $chi );
  57.  
  58. #   while ( read SOURCEF, my $char, 1 )
  59. #   {
  60. #     $curpos = tell( SOURCEF );
  61. #   $chi    = ord( $char );
  62. #   print "$curpos $chi $char\n";
  63. #   }
  64.  
  65. #   seek( SOURCEF, -7, 1 );
  66.  
  67. #   while ( read SOURCEF, my $char, 1 )
  68. #     {
  69. #       $curpos = tell( SOURCEF );
  70. #       print "$curpos $char\n";
  71. #     }
  72. # }
  73.  
  74. {
  75.  
  76.   my $outfname = $filename;
  77.   $outfname =~ s/\..*//;
  78.  
  79.   my %classes = ();
  80.  
  81.   my @sourceincludes = ( '"' . $outfname . '.h' . '"',);
  82.   my @headerincludes = ();
  83.  
  84.   my $curclass = 0;
  85.   my $curmember = 0;
  86.   my $curmethod = 0;
  87.  
  88.   my $method_body = '';
  89.  
  90.   my %defvals = ('char' => '0', 'int' => '0', 'float' => '0.0f', 'double' => '0.0',
  91.                  'void' => '', );
  92.  
  93.   my @premods = ( 'unsigned', 'long' );
  94.  
  95.   my $indent = '    ';
  96.  
  97.   my $deftype = 'int';
  98.  
  99.   my $parsemode = 'file';
  100.  
  101.  
  102.   sub trim {
  103.     my($string)=@_;
  104.  
  105.     for ($string)
  106.       {
  107.         s/^\s+//;
  108.         s/\s+$//;
  109.       }
  110.  
  111.     return $string;
  112.   }
  113.  
  114.   sub escapebad {
  115.     my ($string) = @_;
  116.     $string =~ s/([\\\/\^\.\$\*\+\?\@\{\}\[\]\(\)\<\>])/\\$&/g;
  117.     #bad chars turned good
  118.     return ($string);
  119.   }
  120.  
  121.   sub add_class_byname {
  122.     my ($classname) = @_;
  123.     $curclass = $classes{ $classname } = {
  124.                                           'name' => $classname,
  125.                                           'members' => [],
  126.                                           'methods' => [],
  127.                                          };
  128.   }
  129.  
  130.   sub parse_methods {
  131.     my ($methodstring) = @_;
  132.     my @moutput = ();
  133.     my @methods = split( '\s*;\s*' , $methodstring );
  134.  
  135.     foreach my $method (@methods)
  136.       {
  137.         $method = trim($method);
  138.  
  139.         my ($methoddef,$params) = split( '\s*\(\s*', $method );
  140.         $params =~ s/\s*\)\s*//;
  141.         $params = trim( $params );
  142.  
  143.         my @methoda = parse_members( $methoddef );
  144.  
  145.         my @paramsa = parse_members( $params );
  146.         $methoda[0]->{'params'} = \@paramsa;
  147.  
  148.         $curmethod = $methoda[0];
  149.         push( @moutput, $methoda[0] );
  150.       }
  151.  
  152.     return @moutput;
  153.   }
  154.  
  155.   sub parse_members {
  156.     my ($memberstring) = @_;
  157.     my @members = split( '\s*,\s*' , $memberstring );
  158.     my @moutput = ();
  159.  
  160.     foreach my $member (@members)
  161.       {
  162.         $member = trim($member);
  163.         my $memberdef = '';
  164.         my $initval = '';
  165.  
  166.         my $membertype = '';
  167.         my $ptr = '';
  168.         my $membername = '';
  169.  
  170.         if ( $member =~ m/=/ )
  171.           {
  172.             ($memberdef, $initval) = split('\s*=\s*', $member);
  173.             $initval = trim($initval);
  174.             $memberdef = trim($memberdef);
  175.           }
  176.         else
  177.           {
  178.             $memberdef = $member;
  179.           }
  180.  
  181.         ($ptr) = $memberdef =~ m/(\*+)/;
  182.         if ( $ptr )
  183.           {
  184.             my $ptrescaped = escapebad($ptr);
  185.             $memberdef =~ s/\s*$ptrescaped\s*/ /;
  186.             $memberdef = trim($memberdef);
  187.           }
  188.  
  189.         my @memberparts = split( '\s+', $memberdef );
  190.  
  191.         if ( $#memberparts +1 < 1 )
  192.           {
  193.             die "WTF???: " . $memberstring;
  194.           }
  195.         elsif ( $#memberparts + 1 < 2 )
  196.           {
  197.             $membertype = $deftype;
  198.           }
  199.         elsif ( $#memberparts + 1 >= 2 )
  200.           {
  201.             for( my $i = 0, my $spc=''; $i < $#memberparts; $i++, $spc=' ' )
  202.               {
  203.                 $membertype .= $spc . $memberparts[$i];
  204.               }
  205.  
  206.             $deftype = $membertype;
  207.           }
  208.         else
  209.           {
  210.             die "WTF???: " . $memberstring;
  211.           }
  212.  
  213.         if ( $ptr )
  214.           {
  215.             $membertype = $membertype . " " . $ptr;
  216.             $initval = 'NULL';
  217.           }
  218.  
  219.         $membername = $memberparts[$#memberparts];
  220.  
  221.         if ( !$initval )
  222.           {
  223.             if (exists $defvals{$membertype} )
  224.               {
  225.                 $initval = $defvals{$membertype};
  226.               }
  227.             else
  228.               {
  229.                 for my $k (keys(%defvals))
  230.                   {
  231.                     if( $membertype =~ m/\b$k$/ )
  232.                       {
  233.                         $initval = $defvals{$k};
  234.                       }
  235.                   }
  236.               }
  237.           }
  238.  
  239.         $curmember = {
  240.                       'name' => $membername,
  241.                       'type' => $membertype,
  242.                       'initval' => $initval,
  243.                      };
  244.  
  245.         push( @moutput, $curmember );
  246.       }
  247.  
  248.     return @moutput;
  249.   }
  250.  
  251.   sub flush_method_body {
  252.     $curmethod->{'body'} = $method_body;
  253.     $method_body = '';
  254.   }
  255.  
  256.   sub parse_includes {
  257.     my $type = shift;
  258.     for my $inc (@_)
  259.       {
  260.         if ( $type eq 'sourceinclude' )
  261.           {
  262.             push(@sourceincludes, $inc);
  263.           }
  264.         elsif ( $type eq 'headerinclude' )
  265.           {
  266.             push(@headerincludes, $inc);
  267.           }
  268.       }
  269.   }
  270.  
  271.   while ( my $line = <SOURCEF> )
  272.     {
  273. #      my $rawline = $line;
  274.       $line = trim($line);
  275.  
  276.       if(!$line){ next; }
  277.       if(index($line, '#') == 0){ next; }
  278.       elsif($line eq ';'){ $parsemode = 'file'; next; }
  279.       elsif($line eq '{'){ $parsemode = 'methodbody'; next; }
  280.       elsif($line eq '}'){ flush_method_body(); $parsemode = 'class'; next; }
  281.       elsif($line =~ '^class'){ $parsemode = 'file'; }
  282.  
  283.       if ( $parsemode eq 'file' )
  284.         {
  285.           my @parts = split( '\s+', $line );
  286.  
  287.           if ( $parts[0] eq 'class' )
  288.             {
  289.               $parsemode = 'class';
  290.               add_class_byname( $parts[1] );
  291.             }
  292.           elsif ( $parts[0] =~ m/include/ )
  293.             {
  294.               parse_includes(@parts);
  295.             }
  296.           else
  297.             {
  298.               die 'here must go a defenition of class \'eg. class classname\''
  299.             }
  300.         }
  301.       elsif ( $parsemode eq 'class' )
  302.         {
  303.           if( ( $line =~ m/\(/ ) and ( $line !~ m/=/ ) )
  304.             {
  305.               $line =~ s/\)\s*,\s*/\);/;
  306.               my @new_methods = parse_methods($line);
  307.               push(@{$curclass->{'methods'}}, @new_methods);
  308.             }
  309.           else
  310.             {
  311.               my @new_members = parse_members($line);
  312.               push(@{$curclass->{'members'}}, @new_members);
  313.             }
  314.         }
  315.       elsif ( $parsemode eq 'methodbody' )
  316.         {
  317.           $method_body .= $line . "\n";
  318.         }
  319.     }
  320.  
  321.   sub add_gettersetters
  322.     {
  323.       for my $classname (keys(%classes))
  324.         {
  325.           for my $member (@{$classes{$classname}{'members'}})
  326.             {
  327.               my $methodstr = ${$member}{'type'} . ' ' . 'get' . ${$member}{'name'} . '()' ;
  328.               my @gsetter = parse_methods($methodstr);
  329.               $gsetter[0]{'body'} = 'return self->' . ${$member}{'name'} . ';';
  330.               push(@{$classes{$classname}{'methods'}}, @gsetter);
  331.  
  332.               $methodstr = 'void' . ' ' . 'set' . ${$member}{'name'} . '(' . ${$member}{'type'} . ' ' . ${$member}{'name'} . ')' ;
  333.               @gsetter = parse_methods($methodstr);
  334.               $gsetter[0]{'body'} = 'self->' . ${$member}{'name'} . ' = _' . ${$member}{'name'} . ';';
  335.               push(@{$classes{$classname}{'methods'}}, @gsetter);
  336.  
  337.             }
  338.         }
  339.     }
  340.  
  341.   sub gen_member_decl {
  342.     my ($member, $indent) = (@_);
  343.     return $indent . ${$member}{'type'} . " " . ${$member}{'name'};
  344.   }
  345.  
  346.   sub gen_members_decl {
  347.     my ($classname, $indent) = (@_);
  348.     my $ret = '';
  349.     for my $member (@{$classes{$classname}{'members'}})
  350.       {
  351.         $ret .= gen_member_decl( $member, $indent ) . ";\n";
  352.       }
  353.     return $ret;
  354.   }
  355.  
  356.   sub gen_member_def {
  357.     my ($member, $indent) = (@_);
  358.     return $indent . ${$member}{'type'} . " " . ${$member}{'name'} .
  359.       " = " . ${$member}{'initval'};
  360.   }
  361.  
  362.   sub gen_members_def {
  363.     my ($classname, $indent) = (@_);
  364.     my $ret = '';
  365.     for my $member (@{$classes{$classname}{'members'}})
  366.       {
  367.         $ret .= gen_member_def( $member, $indent ) . ";\n";
  368.       }
  369.     return $ret;
  370.   }
  371.  
  372.   sub gen_params_string {
  373.     my @paramsa = @_;
  374.     my $ret = '';
  375.     my $comma = '';
  376.     for my $param (@paramsa)
  377.       {
  378. #        print $param->{'name'};
  379.         if( $param->{'name'} )
  380.           {
  381.             $ret .= $comma . $param->{'type'} . " _" . $param->{'name'};
  382.             $comma = ', ';
  383.           }
  384.         else
  385.           {
  386.             $ret .= $comma . $param->{'type'};
  387.           }
  388.       }
  389.     return $ret;
  390.   }
  391.  
  392.   sub gen_method_params_string {
  393.     my ($classname, $params) = @_;
  394.     my @paramsa = @{$params};
  395.     my $ret = $classname . '_t * self';
  396.     for my $param (@paramsa)
  397.       {
  398.         $ret .= ', ' . $param->{'type'} . " _" . $param->{'name'};
  399.       }
  400.     return $ret;
  401.   }
  402.  
  403.  
  404.   sub gen_func_decl {
  405.     my($type,$name,$paramstring) = (@_);
  406.     return $type . " " . $name . "( " . $paramstring . " )";
  407.   }
  408.  
  409.   sub gen_func_def {
  410.     my($type,$name,$paramstring,$body) = (@_);
  411.     my $ret = gen_func_decl($type,$name,$paramstring);
  412.     $ret .= "\n{\n" . $body . "\n}\n";
  413.     return $ret;
  414.   }
  415.  
  416.   sub gen_std_funcs_decl {
  417.     my ($classname) = (@_);
  418.     my $classtype = $classname . '_t *';
  419.  
  420.     my $ret = gen_func_decl( 'void *', $classname . '_malloc', 'void' ) . ";\n";
  421.  
  422.     $ret .= gen_func_decl( $classtype , $classname . '_new', 'void' ) . ";\n";
  423.  
  424.     $ret .= gen_func_decl( $classtype, $classname . '_Init',
  425.                            gen_params_string(@{$classes{$classname}{'members'}} ) ) . ";\n";
  426.  
  427.     $ret .= gen_func_decl( 'void', $classname . '_Destroy', $classtype . " self" ) . ";\n";
  428.  
  429.     return $ret;
  430.   }
  431.  
  432.   sub gen_member_new_def {
  433.     my ($member, $indent) = (@_);
  434.     return $indent . 'self->' . ${$member}{'name'} . " = " . ${$member}{'initval'};
  435.   }
  436.  
  437.   sub gen_members_new_def {
  438.     my ($classname, $indent) = (@_);
  439.     my $ret = '';
  440.     for my $member (@{$classes{$classname}{'members'}})
  441.       {
  442.         $ret .= gen_member_new_def( $member, $indent ) . ";\n";
  443.       }
  444.     return $ret;
  445.   }
  446.  
  447.   sub gen_member_init_def {
  448.     my ($member, $indent) = (@_);
  449.     return $indent . 'self->' . ${$member}{'name'} . " = _" . ${$member}{'name'};
  450.   }
  451.  
  452.   sub gen_members_init_def {
  453.     my ($classname, $indent) = (@_);
  454.     my $ret = '';
  455.     for my $member (@{$classes{$classname}{'members'}})
  456.       {
  457.         $ret .= gen_member_init_def( $member, $indent ) . ";\n";
  458.       }
  459.     return $ret;
  460.   }
  461.  
  462.  
  463.   sub gen_std_funcs_def {
  464.     my ($classname, $indent) = (@_);
  465.     my $classt = $classname . '_t';
  466.     my $classtype = $classname . '_t *';
  467.  
  468.     my $ret = gen_func_def( 'void *', $classname . '_malloc', 'void',
  469.                             $indent . "return malloc( sizeof( " . $classt . " ) );" );
  470.  
  471.     $ret .= gen_func_def( $classtype, $classname . '_new', 'void',
  472.                           $indent . $classtype . ' self = '
  473.                           . $classname . "_malloc();\n"
  474.                           . gen_members_new_def( $classname, $indent )
  475.                           . $indent . "return self;" );
  476.  
  477.     $ret .= gen_func_def( $classtype, $classname . '_Init',
  478.                          gen_params_string(@{$classes{$classname}{'members'}}),
  479.                           $indent . $classtype . ' self = '
  480.                           . $classname . "_malloc();\n"
  481.                           . gen_members_init_def( $classname, $indent )
  482.                           . $indent . "return self;" );
  483.  
  484.     $ret .= gen_func_def( 'void', $classname . '_Destroy', $classtype . ' self',
  485.                           $indent . '//TODO: fix me. Destructors can\'t be properly autogenerated :-|'
  486.                           ."\n".$indent . 'free(self);');
  487.     return $ret;
  488.   }
  489.  
  490.   sub gen_method_decl {
  491.     my($method, $classname) = (@_);
  492.     my $classtype = $classname . "_t";
  493.     my $ret = gen_func_decl( ${$method}{'type'}, $classname ."_". ${$method}{'name'},
  494.                              gen_method_params_string($classname, ${$method}{'params'}) );
  495.     return $ret;
  496.   }
  497.  
  498.   sub gen_methods_decl {
  499.     my ($classname) = (@_);
  500.     my $ret = '';
  501.     for my $method (@{$classes{$classname}{'methods'}})
  502.       {
  503.         $ret .= gen_method_decl( $method, $classname ) . ";\n";
  504.       }
  505.     return $ret;
  506.   }
  507.  
  508.   sub gen_method_def {
  509.     my ($methodref, $classname, $indent) = @_;
  510.     my %method = %{$methodref};
  511.     my $ret = gen_method_decl( \%method, $classname ) . "\n{\n";
  512.     if ($method{'body'})
  513.       {
  514.         $method{'body'} =~ s/\n/\n$_[2]/g;
  515.         $method{'body'} =~ s/\s+$//;
  516.         $ret .= $indent . $method{'body'} . "\n}\n";
  517.       }
  518.     else
  519.       {
  520.         $ret .= $indent . "//TODO: I'm autogenerated, so make me do something useful\n";
  521.         $ret .= $indent . "return " . $method{'initval'} . ";\n}\n";
  522.       }
  523.     return $ret;
  524.   }
  525.  
  526.   sub gen_methods_def {
  527.     my $ret = '';
  528.     for my $method (@{$classes{$_[0]}{'methods'}})
  529.       {
  530.         $ret .= gen_method_def( $method, $_[0], $_[1] );
  531.       }
  532.     return $ret;
  533.   }
  534.  
  535.  
  536.   sub gen_class_decl {
  537.     my ($classname) = @_;
  538.     my $ret = 'typedef struct ';
  539.     $ret .= $classname . "_s\n{\n";
  540.     $ret .= gen_members_decl($classname, $indent) . "\n} " . $classname . "_t;\n\n";
  541.     $ret .= gen_std_funcs_decl($classname) . "\n";
  542.     $ret .= gen_methods_decl($classname) . "\n";
  543.     return $ret;
  544.   }
  545.  
  546.  
  547.   sub gen_classes_decl {
  548.     my $ret = '';
  549.     my $sep = '';
  550.     for my $classname (keys(%classes))
  551.       {
  552.         $ret .= $sep . gen_class_decl($classname);
  553.         $sep = "\n\n";
  554.       }
  555.     return $ret;
  556.   }
  557.  
  558.  
  559.   sub gen_class_def {
  560.     my ($classname) = @_;
  561.     my $ret = gen_std_funcs_def($classname, $indent) . "\n";
  562.     $ret .= gen_methods_def($classname, $indent);
  563.     return $ret;
  564.   }
  565.  
  566.   sub gen_classes_def {
  567.     my $ret = '';
  568.     my $sep = '';
  569.     for my $classname (keys(%classes))
  570.       {
  571.         $ret .= $sep . gen_class_def($classname);
  572.         $sep = "\n\n";
  573.       }
  574.     return $ret;
  575.   }
  576.  
  577.   sub gen_includes {
  578.     my $ret = '';
  579.     for my $inc (@_)
  580.       {
  581.         $ret .= '#include ' . $inc . "\n";
  582.       }
  583.     return $ret;
  584.   }
  585.  
  586.   open( HEADER, ">:utf8", $outfname . '.h' ) or die "Can't open file". $outfname. ".h for writing: $!\n";
  587.   open( SOURCE, ">:utf8", $outfname . '.c' ) or die "Can't open file". $outfname. ".c for writing: $!\n";
  588.  
  589.   print HEADER '#ifndef ' . uc($outfname) . '_H'."\n"
  590.     .'#define ' . uc($outfname) . '_H'."\n\n";
  591.  
  592.   print HEADER gen_includes(@headerincludes) . "\n\n";
  593.   print SOURCE gen_includes(@sourceincludes) . "\n\n";
  594.  
  595.   add_gettersetters();
  596.  
  597.   print HEADER gen_classes_decl();
  598.   print SOURCE gen_classes_def();
  599.  
  600.   print HEADER "\n#endif\n";
  601.  
  602.   close(HEADER);
  603.   close(SOURCE);
  604.  
  605. }
  606.  
  607. close(SOURCEF);
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!