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 my $if_uuid;
  12 my $if_version;
  13
  14 sub tabs()
  15 {
  16         for (my($i)=0; $i < $tab_depth; $i++) {
  17                 $res .= "\t";
  18         }
  19 }
  20
  21 #####################################################################
  22 # parse a properties list
  23 sub HeaderProperties($)
  24 {
  25     my($props) = shift;
  26
  27     return;
  28
  29     foreach my $d (@{$props}) {
  30         if (ref($d) ne "HASH") {
  31             $res .= "/* [$d] */ ";
  32         } else {
  33             foreach my $k (keys %{$d}) {
  34                 $res .= "/* [$k($d->{$k})] */ ";
  35             }
  36         }
  37     }
  38 }
  39
  40 #####################################################################
  41 # parse a structure element
  42 sub HeaderElement($)
  43 {
  44     my($element) = shift;
  45
  46     (defined $element->{PROPERTIES}) && HeaderProperties($element->{PROPERTIES});
  47     $res .= tabs();
  48     HeaderType($element, $element->{TYPE}, "");
  49     $res .= " ";
  50     if ($element->{POINTERS}) {
  51             my($n) = $element->{POINTERS};
  52             for (my($i)=$n; $i > 0; $i--) {
  53                     $res .= "*";
  54             }
  55     }
  56     if (defined $element->{ARRAY_LEN} &&
  57         !util::is_constant($element->{ARRAY_LEN})) {
  58             # conformant arrays are ugly! I choose to implement them with
  59             # pointers instead of the [1] method
  60             $res .= "*";
  61     }
  62     $res .= "$element->{NAME}";
  63     if (defined $element->{ARRAY_LEN} && util::is_constant($element->{ARRAY_LEN})) {
  64             $res .= "[$element->{ARRAY_LEN}]";
  65     }
  66     $res .= ";\n";
  67 }
  68
  69 #####################################################################
  70 # parse a struct
  71 sub HeaderStruct($$)
  72 {
  73     my($struct) = shift;
  74     my($name) = shift;
  75     $res .= "struct $name {\n";
  76     $tab_depth++;
  77     if (defined $struct->{ELEMENTS}) {
  78         foreach my $e (@{$struct->{ELEMENTS}}) {
  79             HeaderElement($e);
  80         }
  81     }
  82     $tab_depth--;
  83     $res .= "}";
  84 }
  85
  86
  87 #####################################################################
  88 # parse a union element
  89 sub HeaderUnionElement($)
  90 {
  91     my($element) = shift;
  92     $res .= "/* [case($element->{CASE})] */ ";
  93     if ($element->{TYPE} eq "UNION_ELEMENT") {
  94             HeaderElement($element->{DATA});
  95     }
  96 }
  97
  98 #####################################################################
  99 # parse a union
 100 sub HeaderUnion($$)
 101 {
 102     my($union) = shift;
 103     my($name) = shift;
 104     (defined $union->{PROPERTIES}) && HeaderProperties($union->{PROPERTIES});
 105     $res .= "union $name {\n";
 106     foreach my $e (@{$union->{DATA}}) {
 107         HeaderUnionElement($e);
 108     }
 109     $res .= "}";
 110 }
 111
 112 #####################################################################
 113 # parse a type
 114 sub HeaderType($$$)
 115 {
 116         my $e = shift;
 117         my($data) = shift;
 118         my($name) = shift;
 119         if (ref($data) eq "HASH") {
 120                 ($data->{TYPE} eq "STRUCT") &&
 121                     HeaderStruct($data, $name);
 122                 ($data->{TYPE} eq "UNION") &&
 123                     HeaderUnion($data, $name);
 124                 return;
 125         }
 126         if ($data =~ "unistr") {
 127                 $res .= "const char";
 128         } elsif ($data =~ "nstring") {
 129                 $res .= "const char *";
 130         } elsif ($data =~ "lstring") {
 131                 $res .= "const char *";
 132         } elsif (util::is_scalar_type($data)) {
 133                 $res .= "$data";
 134         } elsif (util::has_property($e, "switch_is")) {
 135                 $res .= "union $data";
 136         } else {
 137                 $res .= "struct $data";
 138         }
 139 }
 140
 141 #####################################################################
 142 # parse a typedef
 143 sub HeaderTypedef($)
 144 {
 145     my($typedef) = shift;
 146     HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME});
 147     $res .= ";\n\n";
 148 }
 149
 150 #####################################################################
 151 # parse a function
 152 sub HeaderFunctionInOut($$)
 153 {
 154     my($fn) = shift;
 155     my($prop) = shift;
 156     foreach my $e (@{$fn->{DATA}}) {
 157             if (util::has_property($e, $prop)) {
 158                     HeaderElement($e);
 159             }
 160     }
 161 }
 162
 163
 164 #####################################################################
 165 # parse a function
 166 sub HeaderFunction($)
 167 {
 168     my($fn) = shift;
 169     $res .= "struct $fn->{NAME} {\n";
 170     $tab_depth++;
 171     tabs();
 172     $res .= "struct {\n";
 173     $tab_depth++;
 174     HeaderFunctionInOut($fn, "in");
 175     $tab_depth--;
 176     tabs();
 177     $res .= "} in;\n\n";
 178     tabs();
 179     $res .= "struct {\n";
 180     $tab_depth++;
 181     HeaderFunctionInOut($fn, "out");
 182     if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
 183             tabs();
 184             $res .= "$fn->{RETURN_TYPE} result;\n";
 185     }
 186     $tab_depth--;
 187     tabs();
 188     $res .= "} out;\n\n";
 189     $tab_depth--;
 190     $res .= "};\n\n";
 191 }
 192
 193 #####################################################################
 194 # parse the interface definitions
 195 sub HeaderInterface($)
 196 {
 197     my($interface) = shift;
 198     my($data) = $interface->{DATA};
 199
 200     my $count = 0;
 201
 202     if (defined $if_uuid) {
 203             my $name = uc $interface->{NAME};
 204             $res .= "#define DCERPC_$name\_UUID \"$if_uuid\"\n";
 205             $res .= "#define DCERPC_$name\_VERSION $if_version\n";
 206             $res .= "#define DCERPC_$name\_NAME \"$interface->{NAME}\"\n\n";
 207     }
 208
 209     foreach my $d (@{$data}) {
 210             if ($d->{TYPE} eq "FUNCTION") {
 211                     $u_name = uc $d->{NAME};
 212                     $res .= "#define DCERPC_$u_name $count\n";
 213                     $count++;
 214             }
 215     }
 216
 217     $res .= "\n\n";
 218
 219     foreach my $d (@{$data}) {
 220         ($d->{TYPE} eq "TYPEDEF") &&
 221             HeaderTypedef($d);
 222         ($d->{TYPE} eq "FUNCTION") &&
 223             HeaderFunction($d);
 224     }
 225
 226 }
 227
 228 #####################################################################
 229 # parse the interface definitions
 230 sub ModuleHeader($)
 231 {
 232     my($h) = shift;
 233
 234     $if_uuid = $h->{PROPERTIES}->{uuid};
 235     $if_version = $h->{PROPERTIES}->{version};
 236 }
 237
 238
 239 #####################################################################
 240 # parse a parsed IDL into a C header
 241 sub Parse($)
 242 {
 243     my($idl) = shift;
 244     $tab_depth = 0;
 245
 246     $res = "/* header auto-generated by pidl */\n\n";
 247     foreach my $x (@{$idl}) {
 248         ($x->{TYPE} eq "MODULEHEADER") &&
 249             ModuleHeader($x);
 250
 251         ($x->{TYPE} eq "INTERFACE") &&
 252             HeaderInterface($x);
 253     }
 254     return $res;
 255 }
 256
 257 1;