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
   6 package IdlHeader;
   7
   8 use strict;
   9
  10 my($res);
  11 my($tab_depth);
  12 my $if_uuid;
  13 my $if_version;
  14
  15 sub tabs()
  16 {
  17         for (my($i)=0; $i < $tab_depth; $i++) {
  18                 $res .= "\t";
  19         }
  20 }
  21
  22 #####################################################################
  23 # parse a properties list
  24 sub HeaderProperties($)
  25 {
  26     my($props) = shift;
  27
  28     return;
  29
  30     foreach my $d (@{$props}) {
  31         if (ref($d) ne "HASH") {
  32             $res .= "/* [$d] */ ";
  33         } else {
  34             foreach my $k (keys %{$d}) {
  35                 $res .= "/* [$k($d->{$k})] */ ";
  36             }
  37         }
  38     }
  39 }
  40
  41 #####################################################################
  42 # parse a structure element
  43 sub HeaderElement($)
  44 {
  45     my($element) = shift;
  46
  47     (defined $element->{PROPERTIES}) && HeaderProperties($element->{PROPERTIES});
  48     $res .= tabs();
  49     HeaderType($element, $element->{TYPE}, "");
  50     $res .= " ";
  51     if ($element->{POINTERS} &&
  52         $element->{TYPE} ne "string") {
  53             my($n) = $element->{POINTERS};
  54             for (my($i)=$n; $i > 0; $i--) {
  55                     $res .= "*";
  56             }
  57     }
  58     if (defined $element->{ARRAY_LEN} &&
  59         !util::is_constant($element->{ARRAY_LEN}) &&
  60         !$element->{POINTERS}) {
  61             # conformant arrays are ugly! I choose to implement them with
  62             # pointers instead of the [1] method
  63             $res .= "*";
  64     }
  65     $res .= "$element->{NAME}";
  66     if (defined $element->{ARRAY_LEN} && util::is_constant($element->{ARRAY_LEN})) {
  67             $res .= "[$element->{ARRAY_LEN}]";
  68     }
  69     $res .= ";\n";
  70 }
  71
  72 #####################################################################
  73 # parse a struct
  74 sub HeaderStruct($$)
  75 {
  76     my($struct) = shift;
  77     my($name) = shift;
  78     $res .= "\nstruct $name {\n";
  79     $tab_depth++;
  80     if (defined $struct->{ELEMENTS}) {
  81         foreach my $e (@{$struct->{ELEMENTS}}) {
  82             HeaderElement($e);
  83         }
  84     }
  85     $tab_depth--;
  86     $res .= "}";
  87 }
  88
  89 #####################################################################
  90 # parse a struct
  91 sub HeaderEnum($$)
  92 {
  93     my($enum) = shift;
  94     my($name) = shift;
  95     $res .= "\nenum $name {\n";
  96     $tab_depth++;
  97     my $els = \@{$enum->{ELEMENTS}};
  98     foreach my $i (0 .. $#{$els}-1) {
  99             my $e = ${$els}[$i];
 100             tabs();
 101             chomp $e;
 102             $res .= "$e,\n";
 103     }
 104
 105     my $e = ${$els}[$#{$els}];
 106     tabs();
 107     chomp $e;
 108     if ($e !~ /^(.*?)\s*$/) {
 109             die "Bad enum $name\n";
 110     }
 111     $res .= "$1\n";
 112     $tab_depth--;
 113     $res .= "}";
 114 }
 115
 116
 117 #####################################################################
 118 # parse a union
 119 sub HeaderUnion($$)
 120 {
 121         my($union) = shift;
 122         my($name) = shift;
 123         my %done = ();
 124
 125         (defined $union->{PROPERTIES}) && HeaderProperties($union->{PROPERTIES});
 126         $res .= "\nunion $name {\n";
 127         $tab_depth++;
 128         foreach my $e (@{$union->{DATA}}) {
 129                 if ($e->{TYPE} eq "UNION_ELEMENT") {
 130                         if (! defined $done{$e->{DATA}->{NAME}}) {
 131                                 HeaderElement($e->{DATA});
 132                         }
 133                         $done{$e->{DATA}->{NAME}} = 1;
 134                 }
 135         }
 136         $tab_depth--;
 137         $res .= "}";
 138 }
 139
 140 #####################################################################
 141 # parse a type
 142 sub HeaderType($$$)
 143 {
 144         my $e = shift;
 145         my($data) = shift;
 146         my($name) = shift;
 147         if (ref($data) eq "HASH") {
 148                 ($data->{TYPE} eq "ENUM") &&
 149                     HeaderEnum($data, $name);
 150                 ($data->{TYPE} eq "STRUCT") &&
 151                     HeaderStruct($data, $name);
 152                 ($data->{TYPE} eq "UNION") &&
 153                     HeaderUnion($data, $name);
 154                 return;
 155         }
 156         if ($data =~ "string") {
 157                 $res .= "const char *";
 158         } elsif (util::is_scalar_type($data)) {
 159                 $res .= "$data";
 160         } elsif (util::has_property($e, "switch_is")) {
 161                 $res .= "union $data";
 162         } else {
 163                 $res .= "struct $data";
 164         }
 165 }
 166
 167 #####################################################################
 168 # parse a typedef
 169 sub HeaderTypedef($)
 170 {
 171     my($typedef) = shift;
 172     HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME});
 173     $res .= ";\n";
 174 }
 175
 176 #####################################################################
 177 # parse a typedef
 178 sub HeaderConst($)
 179 {
 180     my($const) = shift;
 181     $res .= "#define $const->{NAME}\t( $const->{VALUE} )\n";
 182 }
 183
 184 #####################################################################
 185 # parse a function
 186 sub HeaderFunctionInOut($$)
 187 {
 188     my($fn) = shift;
 189     my($prop) = shift;
 190     foreach my $e (@{$fn->{DATA}}) {
 191             if (util::has_property($e, $prop)) {
 192                     HeaderElement($e);
 193             }
 194     }
 195 }
 196
 197 #####################################################################
 198 # determine if we need an "in" or "out" section
 199 sub HeaderFunctionInOut_needed($$)
 200 {
 201     my($fn) = shift;
 202     my($prop) = shift;
 203
 204     if ($prop eq "out" && $fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
 205             return 1;
 206     }
 207
 208     foreach my $e (@{$fn->{DATA}}) {
 209             if (util::has_property($e, $prop)) {
 210                     return 1;
 211             }
 212     }
 213
 214     return undef;
 215 }
 216
 217
 218 #####################################################################
 219 # parse a function
 220 sub HeaderFunction($)
 221 {
 222     my($fn) = shift;
 223     $res .= "\nstruct $fn->{NAME} {\n";
 224     $tab_depth++;
 225     my $needed = 0;
 226
 227     if (HeaderFunctionInOut_needed($fn, "in")) {
 228             tabs();
 229             $res .= "struct {\n";
 230             $tab_depth++;
 231             HeaderFunctionInOut($fn, "in");
 232             $tab_depth--;
 233             tabs();
 234             $res .= "} in;\n\n";
 235             $needed++;
 236     }
 237
 238     if (HeaderFunctionInOut_needed($fn, "out")) {
 239             tabs();
 240             $res .= "struct {\n";
 241             $tab_depth++;
 242             HeaderFunctionInOut($fn, "out");
 243             if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
 244                     tabs();
 245                     $res .= "$fn->{RETURN_TYPE} result;\n";
 246             }
 247             $tab_depth--;
 248             tabs();
 249             $res .= "} out;\n\n";
 250             $needed++;
 251     }
 252
 253     if (! $needed) {
 254             # sigh - some compilers don't like empty structures
 255             tabs();
 256             $res .= "int _dummy_element;\n";
 257     }
 258
 259     $tab_depth--;
 260     $res .= "};\n\n";
 261 }
 262
 263 #####################################################################
 264 # parse the interface definitions
 265 sub HeaderInterface($)
 266 {
 267     my($interface) = shift;
 268     my($data) = $interface->{DATA};
 269
 270     my $count = 0;
 271
 272     $res .= "#ifndef _HEADER_NDR_$interface->{NAME}\n";
 273     $res .= "#define _HEADER_NDR_$interface->{NAME}\n\n";
 274
 275     if (defined $if_uuid) {
 276             my $name = uc $interface->{NAME};
 277             $res .= "#define DCERPC_$name\_UUID \"$if_uuid\"\n";
 278             $res .= "#define DCERPC_$name\_VERSION $if_version\n";
 279             $res .= "#define DCERPC_$name\_NAME \"$interface->{NAME}\"\n\n";
 280             $res .= "extern const struct dcerpc_interface_table dcerpc_table_$interface->{NAME};\n";
 281             $res .= "void rpc_$interface->{NAME}_init(void *);\n\n";
 282     }
 283
 284     foreach my $d (@{$data}) {
 285             if ($d->{TYPE} eq "FUNCTION") {
 286                     my $u_name = uc $d->{NAME};
 287                     $res .= "#define DCERPC_$u_name " . sprintf("0x%02x", $count) . "\n";
 288                     $count++;
 289             }
 290     }
 291
 292     $res .= "\n\n";
 293
 294     foreach my $d (@{$data}) {
 295         ($d->{TYPE} eq "CONST") &&
 296             HeaderConst($d);
 297         ($d->{TYPE} eq "TYPEDEF") &&
 298             HeaderTypedef($d);
 299         ($d->{TYPE} eq "FUNCTION") &&
 300             HeaderFunction($d);
 301     }
 302
 303     $res .= "#endif /* _HEADER_NDR_$interface->{NAME} */\n";
 304 }
 305
 306 #####################################################################
 307 # parse the interface definitions
 308 sub ModuleHeader($)
 309 {
 310     my($h) = shift;
 311
 312     $if_uuid = $h->{PROPERTIES}->{uuid};
 313     $if_version = $h->{PROPERTIES}->{version};
 314 }
 315
 316
 317 #####################################################################
 318 # parse a parsed IDL into a C header
 319 sub Parse($)
 320 {
 321     my($idl) = shift;
 322     $tab_depth = 0;
 323
 324     $res = "/* header auto-generated by pidl */\n\n";
 325     foreach my $x (@{$idl}) {
 326         ($x->{TYPE} eq "MODULEHEADER") &&
 327             ModuleHeader($x);
 328
 329         ($x->{TYPE} eq "INTERFACE") &&
 330             HeaderInterface($x);
 331     }
 332     return $res;
 333 }
 334
 335 1;