source4/build/pidl/parser.pm

   1 ###################################################
   2 # C parser generator for IDL structures
   3 # Copyright tridge@samba.org 2000
   4 # released under the GNU GPL
   5
   6 package IdlParser;
   7
   8 use Data::Dumper;
   9
  10 my($res);
  11
  12 #####################################################################
  13 # dump a properties list
  14 sub DumpProperties($)
  15 {
  16     my($props) = shift;
  17     foreach my $d (@{$props}) {
  18         if (ref($d) ne "HASH") {
  19             $res .= "[$d] ";
  20         } else {
  21             foreach my $k (keys %{$d}) {
  22                 $res .= "[$k($d->{$k})] ";
  23             }
  24         }
  25     }
  26 }
  27
  28 #####################################################################
  29 # dump a structure element
  30 sub DumpElement($)
  31 {
  32     my($element) = shift;
  33     (defined $element->{PROPERTIES}) && DumpProperties($element->{PROPERTIES});
  34     DumpType($element->{TYPE});
  35     $res .= " ";
  36     if ($element->{POINTERS}) {
  37         for (my($i)=0; $i < $element->{POINTERS}; $i++) {
  38             $res .= "*";
  39         }
  40     }
  41     $res .= "$element->{NAME}";
  42     (defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]");
  43 }
  44
  45 #####################################################################
  46 # dump a struct
  47 sub DumpStruct($)
  48 {
  49     my($struct) = shift;
  50     $res .= "struct {\n";
  51     if (defined $struct->{ELEMENTS}) {
  52         foreach my $e (@{$struct->{ELEMENTS}}) {
  53             DumpElement($e);
  54             $res .= ";\n";
  55         }
  56     }
  57     $res .= "}";
  58 }
  59
  60
  61 #####################################################################
  62 # dump a union element
  63 sub DumpUnionElement($)
  64 {
  65     my($element) = shift;
  66     $res .= "[case($element->{CASE})] ";
  67     DumpElement($element->{DATA});
  68     $res .= ";\n";
  69 }
  70
  71 #####################################################################
  72 # dump a union
  73 sub DumpUnion($)
  74 {
  75     my($union) = shift;
  76     (defined $union->{PROPERTIES}) && DumpProperties($union->{PROPERTIES});
  77     $res .= "union {\n";
  78     foreach my $e (@{$union->{DATA}}) {
  79         DumpUnionElement($e);
  80     }
  81     $res .= "}";
  82 }
  83
  84 #####################################################################
  85 # dump a type
  86 sub DumpType($)
  87 {
  88     my($data) = shift;
  89     if (ref($data) eq "HASH") {
  90         ($data->{TYPE} eq "STRUCT") &&
  91             DumpStruct($data);
  92         ($data->{TYPE} eq "UNION") &&
  93             DumpUnion($data);
  94     } else {
  95         $res .= "$data";
  96     }
  97 }
  98
  99 #####################################################################
 100 # dump a typedef
 101 sub DumpTypedef($)
 102 {
 103     my($typedef) = shift;
 104     $res .= "typedef ";
 105     DumpType($typedef->{DATA});
 106     $res .= " $typedef->{NAME};\n\n";
 107 }
 108
 109 #####################################################################
 110 # dump a function
 111 sub DumpFunction($)
 112 {
 113     my($function) = shift;
 114     $res .= "/* ignoring function $function->{NAME} */\n";
 115 }
 116
 117 #####################################################################
 118 # dump the interface definitions
 119 sub DumpInterface($)
 120 {
 121     my($interface) = shift;
 122     my($data) = $interface->{DATA};
 123     foreach my $d (@{$data}) {
 124         ($d->{TYPE} eq "TYPEDEF") &&
 125             DumpTypedef($d);
 126         ($d->{TYPE} eq "FUNCTION") &&
 127             DumpFunction($d);
 128     }
 129 }
 130
 131
 132 #####################################################################
 133 # dump a parsed IDL structure back into an IDL file
 134 sub Dump($)
 135 {
 136     my($idl) = shift;
 137     $res = "/* parser auto-generated by pidl */\n\n";
 138     foreach my $x (@{$idl}) {
 139         ($x->{TYPE} eq "INTERFACE") &&
 140             DumpInterface($x);
 141     }
 142     return $res;
 143 }
 144
 145 1;