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