Ensure we enclose the enum values in brackets to make the cast work.
[ira/wip.git] / 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;