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 # parse a properties list
  21 sub HeaderProperties($)
  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 # parse a structure element
  40 sub HeaderElement($)
  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}) && HeaderProperties($element->{PROPERTIES});
  53     $res .= tabs();
  54     HeaderType($element, $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     if (defined $element->{ARRAY_LEN} && $element->{ARRAY_LEN} eq "*") {
  63             # conformant arrays are ugly! I choose to implement them with
  64             # pointers instead of the [1] method
  65             $res .= "*";
  66     }
  67     $res .= "$element->{NAME}";
  68     if (defined $element->{ARRAY_LEN} && $element->{ARRAY_LEN} ne "*") {
  69             $res .= "[$element->{ARRAY_LEN}]";
  70     }
  71     $res .= ";\n";
  72 }
  73
  74 #####################################################################
  75 # parse a struct
  76 sub HeaderStruct($$)
  77 {
  78     my($struct) = shift;
  79     my($name) = shift;
  80     $res .= "struct $name {\n";
  81     $tab_depth++;
  82     if (defined $struct->{ELEMENTS}) {
  83         foreach my $e (@{$struct->{ELEMENTS}}) {
  84             HeaderElement($e);
  85         }
  86     }
  87     $tab_depth--;
  88     $res .= "}";
  89 }
  90
  91
  92 #####################################################################
  93 # parse a union element
  94 sub HeaderUnionElement($)
  95 {
  96     my($element) = shift;
  97     $res .= "/* [case($element->{CASE})] */ ";
  98     HeaderElement($element->{DATA});
  99 }
 100
 101 #####################################################################
 102 # parse a union
 103 sub HeaderUnion($$)
 104 {
 105     my($union) = shift;
 106     my($name) = shift;
 107     (defined $union->{PROPERTIES}) && HeaderProperties($union->{PROPERTIES});
 108     $res .= "union $name {\n";
 109     foreach my $e (@{$union->{DATA}}) {
 110         HeaderUnionElement($e);
 111     }
 112     $res .= "}";
 113 }
 114
 115 #####################################################################
 116 # parse a type
 117 sub HeaderType($$$)
 118 {
 119         my $e = shift;
 120         my($data) = shift;
 121         my($name) = shift;
 122         if (ref($data) eq "HASH") {
 123                 ($data->{TYPE} eq "STRUCT") &&
 124                     HeaderStruct($data, $name);
 125                 ($data->{TYPE} eq "UNION") &&
 126                     HeaderUnion($data, $name);
 127                 return;
 128         }
 129         if ($data =~ "unistr") {
 130                 $res .= "const char";
 131         } elsif (util::is_scalar_type($data)) {
 132                 $res .= "$data";
 133         } elsif (util::has_property($e, "switch_is")) {
 134                 $res .= "union $data";
 135         } else {
 136                 $res .= "struct $data";
 137         }
 138 }
 139
 140 #####################################################################
 141 # parse a typedef
 142 sub HeaderTypedef($)
 143 {
 144     my($typedef) = shift;
 145     HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME});
 146     $res .= ";\n\n";
 147 }
 148
 149 #####################################################################
 150 # parse a function
 151 sub HeaderFunctionInOut($$)
 152 {
 153     my($fn) = shift;
 154     my($prop) = shift;
 155     foreach my $e (@{$fn->{DATA}}) {
 156             if (util::has_property($e, $prop)) {
 157                     HeaderElement($e);
 158             }
 159     }
 160 }
 161
 162
 163 #####################################################################
 164 # parse a function
 165 sub HeaderFunction($)
 166 {
 167     my($fn) = shift;
 168     $res .= "struct $fn->{NAME} {\n";
 169     $tab_depth++;
 170     tabs();
 171     $res .= "struct {\n";
 172     $tab_depth++;
 173     HeaderFunctionInOut($fn, "in");
 174     $tab_depth--;
 175     tabs();
 176     $res .= "} in;\n\n";
 177     tabs();
 178     $res .= "struct {\n";
 179     $tab_depth++;
 180     HeaderFunctionInOut($fn, "out");
 181     if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
 182             tabs();
 183             $res .= "$fn->{RETURN_TYPE} result;\n";
 184     }
 185     $tab_depth--;
 186     tabs();
 187     $res .= "} out;\n\n";
 188     $tab_depth--;
 189     $res .= "};\n\n";
 190 }
 191
 192 #####################################################################
 193 # parse the interface definitions
 194 sub HeaderInterface($)
 195 {
 196     my($interface) = shift;
 197     my($data) = $interface->{DATA};
 198     foreach my $d (@{$data}) {
 199         ($d->{TYPE} eq "TYPEDEF") &&
 200             HeaderTypedef($d);
 201         ($d->{TYPE} eq "FUNCTION") &&
 202             HeaderFunction($d);
 203     }
 204
 205     my $count = 0;
 206
 207     foreach my $d (@{$data}) {
 208             if ($d->{TYPE} eq "FUNCTION") {
 209                     $u_name = uc $d->{NAME};
 210                     $res .= "#define DCERPC_$u_name $count\n";
 211                     $count++;
 212             }
 213     }
 214 }
 215
 216
 217 #####################################################################
 218 # parse a parsed IDL into a C header
 219 sub Parse($)
 220 {
 221     my($idl) = shift;
 222     $tab_depth = 0;
 223
 224     $res = "/* header auto-generated by pidl */\n\n";
 225     foreach my $x (@{$idl}) {
 226         ($x->{TYPE} eq "INTERFACE") &&
 227             HeaderInterface($x);
 228     }
 229     return $res;
 230 }
 231
 232 1;