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 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         return if (not defined($struct->{ELEMENTS}));
  90         pidl " {\n";
  91         $tab_depth++;
  92         my $el_count=0;
  93         foreach (@{$struct->{ELEMENTS}}) {
  94                 HeaderElement($_);
  95                 $el_count++;
  96         }
  97         if ($el_count == 0) {
  98                 # some compilers can't handle empty structures
  99                 pidl tabs()."char _empty_;\n";
 100         }
 101         $tab_depth--;
 102         pidl tabs()."}";
 103         if (defined $struct->{PROPERTIES}) {
 104                 HeaderProperties($struct->{PROPERTIES}, []);
 105         }
 106         pidl $tail if defined($tail);
 107 }
 108
 109 #####################################################################
 110 # parse a enum
 111 sub HeaderEnum($$;$)
 112 {
 113         my($enum,$name,$tail) = @_;
 114         my $first = 1;
 115
 116         pidl "enum $name";
 117         if (defined($enum->{ELEMENTS})) {
 118                 pidl "\n#ifndef USE_UINT_ENUMS\n";
 119                 pidl " {\n";
 120                 $tab_depth++;
 121                 foreach my $e (@{$enum->{ELEMENTS}}) {
 122                         unless ($first) { pidl ",\n"; }
 123                         $first = 0;
 124                         pidl tabs();
 125                         pidl $e;
 126                 }
 127                 pidl "\n";
 128                 $tab_depth--;
 129                 pidl "}";
 130                 pidl "\n";
 131                 pidl "#else\n";
 132                 my $count = 0;
 133                 my $with_val = 0;
 134                 my $without_val = 0;
 135                 pidl " { __donnot_use_enum_$name=0x7FFFFFFF}\n";
 136                 foreach my $e (@{$enum->{ELEMENTS}}) {
 137                         my $t = "$e";
 138                         my $name;
 139                         my $value;
 140                         if ($t =~ /(.*)=(.*)/) {
 141                                 $name = $1;
 142                                 $value = $2;
 143                                 $with_val = 1;
 144                                 fatal($e->{ORIGINAL}, "you can't mix enum member with values and without values!")
 145                                         unless ($without_val == 0);
 146                         } else {
 147                                 $name = $t;
 148                                 $value = $count++;
 149                                 $without_val = 1;
 150                                 fatal($e->{ORIGINAL}, "you can't mix enum member with values and without values!")
 151                                         unless ($with_val == 0);
 152                         }
 153                         pidl "#define $name ( $value )\n";
 154                 }
 155                 pidl "#endif\n";
 156         }
 157         pidl $tail if defined($tail);
 158 }
 159
 160 #####################################################################
 161 # parse a bitmap
 162 sub HeaderBitmap($$)
 163 {
 164         my($bitmap,$name) = @_;
 165
 166         return unless defined($bitmap->{ELEMENTS});
 167
 168         pidl "/* bitmap $name */\n";
 169         pidl "#define $_\n" foreach (@{$bitmap->{ELEMENTS}});
 170         pidl "\n";
 171 }
 172
 173 #####################################################################
 174 # parse a union
 175 sub HeaderUnion($$;$)
 176 {
 177         my($union,$name,$tail) = @_;
 178         my %done = ();
 179
 180         pidl "union $name";
 181         return if (not defined($union->{ELEMENTS}));
 182         pidl " {\n";
 183         $tab_depth++;
 184         foreach my $e (@{$union->{ELEMENTS}}) {
 185                 if ($e->{TYPE} ne "EMPTY") {
 186                         if (! defined $done{$e->{NAME}}) {
 187                                 HeaderElement($e);
 188                         }
 189                         $done{$e->{NAME}} = 1;
 190                 }
 191         }
 192         $tab_depth--;
 193         pidl "}";
 194
 195         if (defined $union->{PROPERTIES}) {
 196                 HeaderProperties($union->{PROPERTIES}, []);
 197         }
 198         pidl $tail if defined($tail);
 199 }
 200
 201 #####################################################################
 202 # parse a type
 203 sub HeaderType($$$;$)
 204 {
 205         my($e,$data,$name,$tail) = @_;
 206         if (ref($data) eq "HASH") {
 207                 ($data->{TYPE} eq "ENUM") && HeaderEnum($data, $name, $tail);
 208                 ($data->{TYPE} eq "BITMAP") && HeaderBitmap($data, $name);
 209                 ($data->{TYPE} eq "STRUCT") && HeaderStruct($data, $name, $tail);
 210                 ($data->{TYPE} eq "UNION") && HeaderUnion($data, $name, $tail);
 211                 return;
 212         }
 213
 214         if (has_property($e, "charset")) {
 215                 pidl "const char";
 216         } else {
 217                 pidl mapTypeName($e->{TYPE});
 218         }
 219         pidl $tail if defined($tail);
 220 }
 221
 222 #####################################################################
 223 # parse a typedef
 224 sub HeaderTypedef($;$)
 225 {
 226         my($typedef,$tail) = @_;
 227         HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME}, $tail) if defined ($typedef->{DATA});
 228 }
 229
 230 #####################################################################
 231 # parse a const
 232 sub HeaderConst($)
 233 {
 234         my($const) = shift;
 235         if (!defined($const->{ARRAY_LEN}[0])) {
 236                 pidl "#define $const->{NAME}\t( $const->{VALUE} )\n";
 237         } else {
 238                 pidl "#define $const->{NAME}\t $const->{VALUE}\n";
 239         }
 240 }
 241
 242 sub ElementDirection($)
 243 {
 244         my ($e) = @_;
 245
 246         return "inout" if (has_property($e, "in") and has_property($e, "out"));
 247         return "in" if (has_property($e, "in"));
 248         return "out" if (has_property($e, "out"));
 249         return "inout";
 250 }
 251
 252 #####################################################################
 253 # parse a function
 254 sub HeaderFunctionInOut($$)
 255 {
 256         my($fn,$prop) = @_;
 257
 258         return unless defined($fn->{ELEMENTS});
 259
 260         foreach my $e (@{$fn->{ELEMENTS}}) {
 261                 HeaderElement($e) if (ElementDirection($e) eq $prop);
 262         }
 263 }
 264
 265 #####################################################################
 266 # determine if we need an "in" or "out" section
 267 sub HeaderFunctionInOut_needed($$)
 268 {
 269         my($fn,$prop) = @_;
 270
 271         return 1 if ($prop eq "out" && defined($fn->{RETURN_TYPE}));
 272
 273         return undef unless defined($fn->{ELEMENTS});
 274
 275         foreach my $e (@{$fn->{ELEMENTS}}) {
 276                 return 1 if (ElementDirection($e) eq $prop);
 277         }
 278
 279         return undef;
 280 }
 281
 282 my %headerstructs;
 283
 284 #####################################################################
 285 # parse a function
 286 sub HeaderFunction($)
 287 {
 288         my($fn) = shift;
 289
 290         return if ($headerstructs{$fn->{NAME}});
 291
 292         $headerstructs{$fn->{NAME}} = 1;
 293
 294         pidl "\nstruct $fn->{NAME} {\n";
 295         $tab_depth++;
 296         my $needed = 0;
 297
 298         if (HeaderFunctionInOut_needed($fn, "in") or
 299             HeaderFunctionInOut_needed($fn, "inout")) {
 300                 pidl tabs()."struct {\n";
 301                 $tab_depth++;
 302                 HeaderFunctionInOut($fn, "in");
 303                 HeaderFunctionInOut($fn, "inout");
 304                 $tab_depth--;
 305                 pidl tabs()."} in;\n\n";
 306                 $needed++;
 307         }
 308
 309         if (HeaderFunctionInOut_needed($fn, "out") or
 310             HeaderFunctionInOut_needed($fn, "inout")) {
 311                 pidl tabs()."struct {\n";
 312                 $tab_depth++;
 313                 HeaderFunctionInOut($fn, "out");
 314                 HeaderFunctionInOut($fn, "inout");
 315                 if (defined($fn->{RETURN_TYPE})) {
 316                         pidl tabs().mapTypeName($fn->{RETURN_TYPE}) . " result;\n";
 317                 }
 318                 $tab_depth--;
 319                 pidl tabs()."} out;\n\n";
 320                 $needed++;
 321         }
 322
 323         if (!$needed) {
 324                 # sigh - some compilers don't like empty structures
 325                 pidl tabs()."int _dummy_element;\n";
 326         }
 327
 328         $tab_depth--;
 329         pidl "};\n\n";
 330 }
 331
 332 sub HeaderImport
 333 {
 334         my @imports = @_;
 335         foreach (@imports) {
 336                 s/\.idl\"$//;
 337                 s/^\"//;
 338                 pidl choose_header("librpc/gen_ndr/$_\.h", "gen_ndr/$_.h") . "\n";
 339         }
 340 }
 341
 342 sub HeaderInclude
 343 {
 344         my @includes = @_;
 345         foreach (@includes) {
 346                 pidl "#include $_\n";
 347         }
 348 }
 349
 350 #####################################################################
 351 # parse the interface definitions
 352 sub HeaderInterface($)
 353 {
 354         my($interface) = shift;
 355
 356         pidl "#ifndef _HEADER_$interface->{NAME}\n";
 357         pidl "#define _HEADER_$interface->{NAME}\n\n";
 358
 359         foreach my $c (@{$interface->{CONSTS}}) {
 360                 HeaderConst($c);
 361         }
 362
 363         foreach my $t (@{$interface->{TYPES}}) {
 364                 HeaderTypedef($t, ";\n\n") if ($t->{TYPE} eq "TYPEDEF");
 365                 HeaderStruct($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "STRUCT");
 366                 HeaderUnion($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "UNION");
 367                 HeaderEnum($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "ENUM");
 368                 HeaderBitmap($t, $t->{NAME}) if ($t->{TYPE} eq "BITMAP");
 369         }
 370
 371         foreach my $fn (@{$interface->{FUNCTIONS}}) {
 372                 HeaderFunction($fn);
 373         }
 374
 375         pidl "#endif /* _HEADER_$interface->{NAME} */\n";
 376 }
 377
 378 sub HeaderQuote($)
 379 {
 380         my($quote) = shift;
 381
 382         pidl unmake_str($quote->{DATA}) . "\n";
 383 }
 384
 385 #####################################################################
 386 # parse a parsed IDL into a C header
 387 sub Parse($)
 388 {
 389         my($ndr) = shift;
 390         $tab_depth = 0;
 391
 392         $res = "";
 393         %headerstructs = ();
 394         pidl "/* header auto-generated by pidl */\n\n";
 395         if (!is_intree()) {
 396                 pidl "#include <util/data_blob.h>\n";
 397         }
 398         pidl "#include <stdint.h>\n";
 399         pidl "\n";
 400
 401         foreach (@{$ndr}) {
 402                 ($_->{TYPE} eq "CPP_QUOTE") && HeaderQuote($_);
 403                 ($_->{TYPE} eq "INTERFACE") && HeaderInterface($_);
 404                 ($_->{TYPE} eq "IMPORT") && HeaderImport(@{$_->{PATHS}});
 405                 ($_->{TYPE} eq "INCLUDE") && HeaderInclude(@{$_->{PATHS}});
 406         }
 407
 408         return $res;
 409 }
 410
 411 sub GenerateStructEnv($$)
 412 {
 413         my ($x, $v) = @_;
 414         my %env;
 415
 416         foreach my $e (@{$x->{ELEMENTS}}) {
 417                 $env{$e->{NAME}} = "$v->$e->{NAME}";
 418         }
 419
 420         $env{"this"} = $v;
 421
 422         return \%env;
 423 }
 424
 425 sub EnvSubstituteValue($$)
 426 {
 427         my ($env,$s) = @_;
 428
 429         # Substitute the value() values in the env
 430         foreach my $e (@{$s->{ELEMENTS}}) {
 431                 next unless (defined(my $v = has_property($e, "value")));
 432
 433                 $env->{$e->{NAME}} = ParseExpr($v, $env, $e);
 434         }
 435
 436         return $env;
 437 }
 438
 439 sub GenerateFunctionInEnv($;$)
 440 {
 441         my ($fn, $base) = @_;
 442         my %env;
 443
 444         $base = "r->" unless defined($base);
 445
 446         foreach my $e (@{$fn->{ELEMENTS}}) {
 447                 if (grep (/in/, @{$e->{DIRECTION}})) {
 448                         $env{$e->{NAME}} = $base."in.$e->{NAME}";
 449                 }
 450         }
 451
 452         return \%env;
 453 }
 454
 455 sub GenerateFunctionOutEnv($;$)
 456 {
 457         my ($fn, $base) = @_;
 458         my %env;
 459
 460         $base = "r->" unless defined($base);
 461
 462         foreach my $e (@{$fn->{ELEMENTS}}) {
 463                 if (grep (/out/, @{$e->{DIRECTION}})) {
 464                         $env{$e->{NAME}} = $base."out.$e->{NAME}";
 465                 } elsif (grep (/in/, @{$e->{DIRECTION}})) {
 466                         $env{$e->{NAME}} = $base."in.$e->{NAME}";
 467                 }
 468         }
 469
 470         return \%env;
 471 }
 472
 473 1;