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