source/pidl/lib/Parse/Pidl/Samba4/Header.pm

   1 ###################################################
   2 # create C header files for an IDL structure
   3 # Copyright tridge@samba.org 2000
   4 # Copyright jelmer@samba.org 2005
   5 # released under the GNU GPL
   6
   7 package Parse::Pidl::Samba4::Header;
   8
   9 use strict;
  10 use Parse::Pidl::Typelist qw(mapTypeName);
  11 use Parse::Pidl::Util qw(has_property is_constant);
  12 use Parse::Pidl::Samba4 qw(is_intree);
  13
  14 use vars qw($VERSION);
  15 $VERSION = '0.01';
  16
  17 my($res);
  18 my($tab_depth);
  19
  20 sub pidl($) { $res .= shift; }
  21
  22 sub tabs()
  23 {
  24         my $res = "";
  25         $res .="\t" foreach (1..$tab_depth);
  26         return $res;
  27 }
  28
  29 #####################################################################
  30 # parse a properties list
  31 sub HeaderProperties($$)
  32 {
  33     my($props,$ignores) = @_;
  34         my $ret = "";
  35
  36     foreach my $d (keys %{$props}) {
  37                 next if (grep(/^$d$/, @$ignores));
  38                 if($props->{$d} ne "1") {
  39                         $ret.= "$d($props->{$d}),";
  40                 } else {
  41                         $ret.="$d,";
  42                 }
  43         }
  44
  45         if ($ret) {
  46                 pidl "/* [" . substr($ret, 0, -1) . "] */";
  47         }
  48 }
  49
  50 #####################################################################
  51 # parse a structure element
  52 sub HeaderElement($)
  53 {
  54         my($element) = shift;
  55
  56         pidl tabs();
  57         if (has_property($element, "represent_as")) {
  58                 pidl mapTypeName($element->{PROPERTIES}->{represent_as})." ";
  59         } else {
  60                 HeaderType($element, $element->{TYPE}, "");
  61                 pidl " ";
  62                 my $numstar = $element->{POINTERS};
  63                 if ($numstar >= 1) {
  64                         $numstar-- if Parse::Pidl::Typelist::scalar_is_reference($element->{TYPE});
  65                 }
  66                 foreach (@{$element->{ARRAY_LEN}})
  67                 {
  68                         next if is_constant($_) and
  69                                 not has_property($element, "charset");
  70                         $numstar++;
  71                 }
  72                 pidl "*" foreach (1..$numstar);
  73         }
  74         pidl $element->{NAME};
  75         foreach (@{$element->{ARRAY_LEN}}) {
  76                 next unless (is_constant($_) and
  77                         not has_property($element, "charset"));
  78                 pidl "[$_]";
  79         }
  80
  81         pidl ";";
  82         if (defined $element->{PROPERTIES}) {
  83                 HeaderProperties($element->{PROPERTIES}, ["in", "out"]);
  84         }
  85         pidl "\n";
  86 }
  87
  88 #####################################################################
  89 # parse a struct
  90 sub HeaderStruct($$)
  91 {
  92     my($struct,$name) = @_;
  93         pidl "struct $name {\n";
  94     $tab_depth++;
  95     my $el_count=0;
  96     if (defined $struct->{ELEMENTS}) {
  97                 foreach (@{$struct->{ELEMENTS}}) {
  98                     HeaderElement($_);
  99                     $el_count++;
 100                 }
 101     }
 102     if ($el_count == 0) {
 103             # some compilers can't handle empty structures
 104             pidl tabs()."char _empty_;\n";
 105     }
 106     $tab_depth--;
 107     pidl tabs()."}";
 108         if (defined $struct->{PROPERTIES}) {
 109                 HeaderProperties($struct->{PROPERTIES}, []);
 110         }
 111 }
 112
 113 #####################################################################
 114 # parse a enum
 115 sub HeaderEnum($$)
 116 {
 117     my($enum,$name) = @_;
 118     my $first = 1;
 119
 120         pidl "#ifndef USE_UINT_ENUMS\n";
 121         pidl "enum $name {\n";
 122         $tab_depth++;
 123         foreach my $e (@{$enum->{ELEMENTS}}) {
 124             unless ($first) { pidl ",\n"; }
 125             $first = 0;
 126             pidl tabs();
 127             pidl $e;
 128         }
 129         pidl "\n";
 130         $tab_depth--;
 131         pidl "};\n";
 132         pidl "#else\n";
 133         my $count = 0;
 134         pidl "enum $name { __donnot_use_enum_$name=0x7FFFFFFF};\n";
 135         my $with_val = 0;
 136         my $without_val = 0;
 137         foreach my $e (@{$enum->{ELEMENTS}}) {
 138             my $t = "$e";
 139             my $name;
 140             my $value;
 141             if ($t =~ /(.*)=(.*)/) {
 142                 $name = $1;
 143                 $value = $2;
 144                 $with_val = 1;
 145                 die ("you can't mix enum member with values and without values when using --uint-enums!")
 146                         unless ($without_val == 0);
 147             } else {
 148                 $name = $t;
 149                 $value = $count++;
 150                 $without_val = 1;
 151                 die ("you can't mix enum member with values and without values when using --uint-enums!")
 152                         unless ($with_val == 0);
 153             }
 154             pidl "#define $name ( $value )\n";
 155         }
 156         pidl "#endif\n";
 157         pidl "\n";
 158 }
 159
 160 #####################################################################
 161 # parse a bitmap
 162 sub HeaderBitmap($$)
 163 {
 164     my($bitmap,$name) = @_;
 165
 166     pidl "/* bitmap $name */\n";
 167     pidl "#define $_\n" foreach (@{$bitmap->{ELEMENTS}});
 168     pidl "\n";
 169 }
 170
 171 #####################################################################
 172 # parse a union
 173 sub HeaderUnion($$)
 174 {
 175         my($union,$name) = @_;
 176         my %done = ();
 177
 178         pidl "union $name {\n";
 179         $tab_depth++;
 180         foreach my $e (@{$union->{ELEMENTS}}) {
 181                 if ($e->{TYPE} ne "EMPTY") {
 182                         if (! defined $done{$e->{NAME}}) {
 183                                 HeaderElement($e);
 184                         }
 185                         $done{$e->{NAME}} = 1;
 186                 }
 187         }
 188         $tab_depth--;
 189         pidl "}";
 190
 191         if (defined $union->{PROPERTIES}) {
 192                 HeaderProperties($union->{PROPERTIES}, []);
 193         }
 194 }
 195
 196 #####################################################################
 197 # parse a type
 198 sub HeaderType($$$)
 199 {
 200         my($e,$data,$name) = @_;
 201         if (ref($data) eq "HASH") {
 202                 ($data->{TYPE} eq "ENUM") && HeaderEnum($data, $name);
 203                 ($data->{TYPE} eq "BITMAP") && HeaderBitmap($data, $name);
 204                 ($data->{TYPE} eq "STRUCT") && HeaderStruct($data, $name);
 205                 ($data->{TYPE} eq "UNION") && HeaderUnion($data, $name);
 206                 return;
 207         }
 208
 209         if (has_property($e, "charset")) {
 210                 pidl "const char";
 211         } else {
 212                 pidl mapTypeName($e->{TYPE});
 213         }
 214 }
 215
 216 #####################################################################
 217 # parse a typedef
 218 sub HeaderTypedef($)
 219 {
 220     my($typedef) = shift;
 221     HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME});
 222 }
 223
 224 #####################################################################
 225 # parse a const
 226 sub HeaderConst($)
 227 {
 228     my($const) = shift;
 229     if (!defined($const->{ARRAY_LEN}[0])) {
 230         pidl "#define $const->{NAME}\t( $const->{VALUE} )\n";
 231     } else {
 232         pidl "#define $const->{NAME}\t $const->{VALUE}\n";
 233     }
 234 }
 235
 236 sub ElementDirection($)
 237 {
 238         my ($e) = @_;
 239
 240         return "inout" if (has_property($e, "in") and has_property($e, "out"));
 241         return "in" if (has_property($e, "in"));
 242         return "out" if (has_property($e, "out"));
 243         return "inout";
 244 }
 245
 246 #####################################################################
 247 # parse a function
 248 sub HeaderFunctionInOut($$)
 249 {
 250     my($fn,$prop) = @_;
 251
 252         foreach (@{$fn->{ELEMENTS}}) {
 253                 HeaderElement($_) if (ElementDirection($_) eq $prop);
 254         }
 255 }
 256
 257 #####################################################################
 258 # determine if we need an "in" or "out" section
 259 sub HeaderFunctionInOut_needed($$)
 260 {
 261     my($fn,$prop) = @_;
 262
 263     return 1 if ($prop eq "out" && $fn->{RETURN_TYPE} ne "void");
 264
 265         foreach (@{$fn->{ELEMENTS}}) {
 266                 return 1 if (ElementDirection($_) eq $prop);
 267     }
 268
 269     return undef;
 270 }
 271
 272 my %headerstructs;
 273
 274 #####################################################################
 275 # parse a function
 276 sub HeaderFunction($)
 277 {
 278     my($fn) = shift;
 279
 280     return if ($headerstructs{$fn->{NAME}});
 281
 282     $headerstructs{$fn->{NAME}} = 1;
 283
 284     pidl "\nstruct $fn->{NAME} {\n";
 285     $tab_depth++;
 286     my $needed = 0;
 287
 288     if (HeaderFunctionInOut_needed($fn, "in") or
 289             HeaderFunctionInOut_needed($fn, "inout")) {
 290             pidl tabs()."struct {\n";
 291             $tab_depth++;
 292             HeaderFunctionInOut($fn, "in");
 293             HeaderFunctionInOut($fn, "inout");
 294             $tab_depth--;
 295             pidl tabs()."} in;\n\n";
 296             $needed++;
 297     }
 298
 299     if (HeaderFunctionInOut_needed($fn, "out") or
 300             HeaderFunctionInOut_needed($fn, "inout")) {
 301             pidl tabs()."struct {\n";
 302             $tab_depth++;
 303             HeaderFunctionInOut($fn, "out");
 304             HeaderFunctionInOut($fn, "inout");
 305             if ($fn->{RETURN_TYPE} ne "void") {
 306                     pidl tabs().mapTypeName($fn->{RETURN_TYPE}) . " result;\n";
 307             }
 308             $tab_depth--;
 309             pidl tabs()."} out;\n\n";
 310             $needed++;
 311     }
 312
 313     if (!$needed) {
 314             # sigh - some compilers don't like empty structures
 315             pidl tabs()."int _dummy_element;\n";
 316     }
 317
 318     $tab_depth--;
 319     pidl "};\n\n";
 320 }
 321
 322 sub HeaderImport
 323 {
 324         my @imports = @_;
 325         foreach (@imports) {
 326                 s/\.idl\"$//;
 327                 s/^\"//;
 328                 pidl "#include \"librpc/gen_ndr/$_\.h\"\n";
 329         }
 330 }
 331
 332 sub HeaderInclude
 333 {
 334         my @includes = @_;
 335         foreach (@includes) {
 336                 pidl "#include $_\n";
 337         }
 338 }
 339
 340 #####################################################################
 341 # parse the interface definitions
 342 sub HeaderInterface($)
 343 {
 344         my($interface) = shift;
 345
 346         pidl "#ifndef _HEADER_$interface->{NAME}\n";
 347         pidl "#define _HEADER_$interface->{NAME}\n\n";
 348
 349         foreach my $d (@{$interface->{DATA}}) {
 350                 next if ($d->{TYPE} ne "CONST");
 351                 HeaderConst($d);
 352         }
 353
 354         foreach my $d (@{$interface->{DATA}}) {
 355                 HeaderTypedef($d) if ($d->{TYPE} eq "TYPEDEF");
 356                 HeaderStruct($d, $d->{NAME}) if ($d->{TYPE} eq "STRUCT");
 357                 HeaderUnion($d, $d->{NAME}) if ($d->{TYPE} eq "UNION");
 358                 HeaderEnum($d, $d->{NAME}) if ($d->{TYPE} eq "ENUM");
 359                 HeaderBitmap($d, $d->{NAME}) if ($d->{TYPE} eq "BITMAP");
 360                 pidl ";\n\n";
 361         }
 362
 363         foreach my $d (@{$interface->{DATA}}) {
 364                 next if ($d->{TYPE} ne "FUNCTION");
 365
 366                 HeaderFunction($d);
 367         }
 368
 369         pidl "#endif /* _HEADER_$interface->{NAME} */\n";
 370 }
 371
 372 #####################################################################
 373 # parse a parsed IDL into a C header
 374 sub Parse($)
 375 {
 376     my($idl) = shift;
 377     $tab_depth = 0;
 378
 379         $res = "";
 380         %headerstructs = ();
 381     pidl "/* header auto-generated by pidl */\n\n";
 382         if (!is_intree()) {
 383                 pidl "#include <core.h>\n";
 384         }
 385         pidl "#include <stdint.h>\n";
 386         pidl "\n";
 387
 388     foreach (@{$idl}) {
 389             ($_->{TYPE} eq "INTERFACE") && HeaderInterface($_);
 390             ($_->{TYPE} eq "IMPORT") && HeaderImport(@{$_->{PATHS}});
 391             ($_->{TYPE} eq "INCLUDE") && HeaderInclude(@{$_->{PATHS}});
 392     }
 393     return $res;
 394 }
 395
 396 1;