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