source4/build/pidl/header.pm

   1 ###################################################
   2 # create C header files for an IDL structure
   3 # Copyright tridge@samba.org 2000
   4 # released under the GNU GPL
   5 package IdlHeader;
   6
   7 use Data::Dumper;
   8
   9 my($res);
  10 my($tab_depth);
  11
  12 sub tabs()
  13 {
  14         for (my($i)=0; $i < $tab_depth; $i++) {
  15                 $res .= "\t";
  16         }
  17 }
  18
  19 #####################################################################
  20 # dump a properties list
  21 sub DumpProperties($)
  22 {
  23     my($props) = shift;
  24
  25     return;
  26
  27     foreach my $d (@{$props}) {
  28         if (ref($d) ne "HASH") {
  29             $res .= "/* [$d] */ ";
  30         } else {
  31             foreach my $k (keys %{$d}) {
  32                 $res .= "/* [$k($d->{$k})] */ ";
  33             }
  34         }
  35     }
  36 }
  37
  38 #####################################################################
  39 # dump a structure element
  40 sub DumpElement($)
  41 {
  42     my($element) = shift;
  43
  44     if (util::has_property($element, "struct_len")) {
  45             # a struct_len is an internal artifact - it is put on the
  46             # wire but not exposed via the api, which means it does
  47             # not appear in the header file
  48             return;
  49     }
  50
  51
  52     (defined $element->{PROPERTIES}) && DumpProperties($element->{PROPERTIES});
  53     $res .= tabs();
  54     DumpType($element->{TYPE}, "");
  55     $res .= " ";
  56     if ($element->{POINTERS}) {
  57             my($n) = $element->{POINTERS};
  58             for (my($i)=$n; $i > 0; $i--) {
  59                     $res .= "*";
  60             }
  61     }
  62     $res .= "$element->{NAME}";
  63     (defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]");
  64     $res .= ";\n";
  65 }
  66
  67 #####################################################################
  68 # dump a struct
  69 sub DumpStruct($$)
  70 {
  71     my($struct) = shift;
  72     my($name) = shift;
  73     $res .= "struct $name {\n";
  74     $tab_depth++;
  75     if (defined $struct->{ELEMENTS}) {
  76         foreach my $e (@{$struct->{ELEMENTS}}) {
  77             DumpElement($e);
  78         }
  79     }
  80     $tab_depth--;
  81     $res .= "}";
  82 }
  83
  84
  85 #####################################################################
  86 # dump a union element
  87 sub DumpUnionElement($)
  88 {
  89     my($element) = shift;
  90     $res .= "/* [case($element->{CASE})] */ ";
  91     DumpElement($element->{DATA});
  92 }
  93
  94 #####################################################################
  95 # dump a union
  96 sub DumpUnion($$)
  97 {
  98     my($union) = shift;
  99     my($name) = shift;
 100     (defined $union->{PROPERTIES}) && DumpProperties($union->{PROPERTIES});
 101     $res .= "union $name {\n";
 102     foreach my $e (@{$union->{DATA}}) {
 103         DumpUnionElement($e);
 104     }
 105     $res .= "}";
 106 }
 107
 108 #####################################################################
 109 # dump a type
 110 sub DumpType($$)
 111 {
 112     my($data) = shift;
 113     my($name) = shift;
 114     if (ref($data) eq "HASH") {
 115         ($data->{TYPE} eq "STRUCT") &&
 116             DumpStruct($data, $name);
 117         ($data->{TYPE} eq "UNION") &&
 118             DumpUnion($data, $name);
 119         return;
 120     }
 121     if ($data =~ "unistr") {
 122             $res .= "const char";
 123     } elsif (util::is_scalar_type($data)) {
 124             $res .= "$data";
 125     } else {
 126             $res .= "struct $data";
 127     }
 128 }
 129
 130 #####################################################################
 131 # dump a typedef
 132 sub DumpTypedef($)
 133 {
 134     my($typedef) = shift;
 135     DumpType($typedef->{DATA}, $typedef->{NAME});
 136     $res .= ";\n\n";
 137 }
 138
 139 #####################################################################
 140 # dump a function
 141 sub DumpFunctionInOut($$)
 142 {
 143     my($fn) = shift;
 144     my($prop) = shift;
 145     foreach my $e (@{$fn->{DATA}}) {
 146             if (util::has_property($e, $prop)) {
 147                     DumpElement($e);
 148             }
 149     }
 150 }
 151
 152
 153 #####################################################################
 154 # dump a function
 155 sub DumpFunction($)
 156 {
 157     my($fn) = shift;
 158     $res .= "struct $fn->{NAME} {\n";
 159     $tab_depth++;
 160     tabs();
 161     $res .= "struct {\n";
 162     $tab_depth++;
 163     DumpFunctionInOut($fn, "in");
 164     $tab_depth--;
 165     tabs();
 166     $res .= "} in;\n\n";
 167     tabs();
 168     $res .= "struct {\n";
 169     $tab_depth++;
 170     DumpFunctionInOut($fn, "out");
 171     if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
 172             tabs();
 173             $res .= "$fn->{RETURN_TYPE} result;\n";
 174     }
 175     $tab_depth--;
 176     tabs();
 177     $res .= "} out;\n\n";
 178     $tab_depth--;
 179     $res .= "};\n\n";
 180 }
 181
 182 #####################################################################
 183 # dump the interface definitions
 184 sub DumpInterface($)
 185 {
 186     my($interface) = shift;
 187     my($data) = $interface->{DATA};
 188     foreach my $d (@{$data}) {
 189         ($d->{TYPE} eq "TYPEDEF") &&
 190             DumpTypedef($d);
 191         ($d->{TYPE} eq "FUNCTION") &&
 192             DumpFunction($d);
 193     }
 194
 195     my $count = 0;
 196
 197     foreach my $d (@{$data}) {
 198             if ($d->{TYPE} eq "FUNCTION") {
 199                     $u_name = uc $d->{NAME};
 200                     $res .= "#define DCERPC_$u_name $count\n";
 201                     $count++;
 202             }
 203     }
 204 }
 205
 206
 207 #####################################################################
 208 # dump a parsed IDL structure back into an IDL file
 209 sub Dump($)
 210 {
 211     my($idl) = shift;
 212     $tab_depth = 0;
 213
 214     $res = "/* header auto-generated by pidl */\n\n";
 215     foreach my $x (@{$idl}) {
 216         ($x->{TYPE} eq "INTERFACE") &&
 217             DumpInterface($x);
 218     }
 219     return $res;
 220 }
 221
 222 1;