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