pidl: Move Generate*Env functions to Parse::Pidl::Samba4::Header because they only...
[ira/wip.git] / 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) = @_;
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 }
107
108 #####################################################################
109 # parse a enum
110 sub HeaderEnum($$)
111 {
112         my($enum,$name) = @_;
113         my $first = 1;
114
115         pidl "enum $name";
116         if (defined($enum->{ELEMENTS})) {
117                 pidl "\n#ifndef USE_UINT_ENUMS\n";
118                 pidl " {\n";
119                 $tab_depth++;
120                 foreach my $e (@{$enum->{ELEMENTS}}) {
121                         unless ($first) { pidl ",\n"; }
122                         $first = 0;
123                         pidl tabs();
124                         pidl $e;
125                 }
126                 pidl "\n";
127                 $tab_depth--;
128                 pidl "}";
129                 pidl "\n";
130                 pidl "#else\n";
131                 my $count = 0;
132                 my $with_val = 0;
133                 my $without_val = 0;
134                 if (defined($enum->{ELEMENTS})) {
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                 }
156                 pidl "#endif\n";
157         }
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) = @_;
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 }
199
200 #####################################################################
201 # parse a type
202 sub HeaderType($$$)
203 {
204         my($e,$data,$name) = @_;
205         if (ref($data) eq "HASH") {
206                 ($data->{TYPE} eq "ENUM") && HeaderEnum($data, $name);
207                 ($data->{TYPE} eq "BITMAP") && HeaderBitmap($data, $name);
208                 ($data->{TYPE} eq "STRUCT") && HeaderStruct($data, $name);
209                 ($data->{TYPE} eq "UNION") && HeaderUnion($data, $name);
210                 return;
211         }
212
213         if (has_property($e, "charset")) {
214                 pidl "const char";
215         } else {
216                 pidl mapTypeName($e->{TYPE});
217         }
218 }
219
220 #####################################################################
221 # parse a typedef
222 sub HeaderTypedef($)
223 {
224         my($typedef) = shift;
225         HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME}) if defined ($typedef->{DATA});
226 }
227
228 #####################################################################
229 # parse a const
230 sub HeaderConst($)
231 {
232         my($const) = shift;
233         if (!defined($const->{ARRAY_LEN}[0])) {
234                 pidl "#define $const->{NAME}\t( $const->{VALUE} )\n";
235         } else {
236                 pidl "#define $const->{NAME}\t $const->{VALUE}\n";
237         }
238 }
239
240 sub ElementDirection($)
241 {
242         my ($e) = @_;
243
244         return "inout" if (has_property($e, "in") and has_property($e, "out"));
245         return "in" if (has_property($e, "in"));
246         return "out" if (has_property($e, "out"));
247         return "inout";
248 }
249
250 #####################################################################
251 # parse a function
252 sub HeaderFunctionInOut($$)
253 {
254         my($fn,$prop) = @_;
255
256         return unless defined($fn->{ELEMENTS});
257
258         foreach my $e (@{$fn->{ELEMENTS}}) {
259                 HeaderElement($e) if (ElementDirection($e) eq $prop);
260         }
261 }
262
263 #####################################################################
264 # determine if we need an "in" or "out" section
265 sub HeaderFunctionInOut_needed($$)
266 {
267         my($fn,$prop) = @_;
268
269         return 1 if ($prop eq "out" && defined($fn->{RETURN_TYPE}));
270
271         return undef unless defined($fn->{ELEMENTS});
272
273         foreach my $e (@{$fn->{ELEMENTS}}) {
274                 return 1 if (ElementDirection($e) eq $prop);
275         }
276
277         return undef;
278 }
279
280 my %headerstructs;
281
282 #####################################################################
283 # parse a function
284 sub HeaderFunction($)
285 {
286         my($fn) = shift;
287
288         return if ($headerstructs{$fn->{NAME}});
289
290         $headerstructs{$fn->{NAME}} = 1;
291
292         pidl "\nstruct $fn->{NAME} {\n";
293         $tab_depth++;
294         my $needed = 0;
295
296         if (HeaderFunctionInOut_needed($fn, "in") or
297             HeaderFunctionInOut_needed($fn, "inout")) {
298                 pidl tabs()."struct {\n";
299                 $tab_depth++;
300                 HeaderFunctionInOut($fn, "in");
301                 HeaderFunctionInOut($fn, "inout");
302                 $tab_depth--;
303                 pidl tabs()."} in;\n\n";
304                 $needed++;
305         }
306
307         if (HeaderFunctionInOut_needed($fn, "out") or
308             HeaderFunctionInOut_needed($fn, "inout")) {
309                 pidl tabs()."struct {\n";
310                 $tab_depth++;
311                 HeaderFunctionInOut($fn, "out");
312                 HeaderFunctionInOut($fn, "inout");
313                 if (defined($fn->{RETURN_TYPE})) {
314                         pidl tabs().mapTypeName($fn->{RETURN_TYPE}) . " result;\n";
315                 }
316                 $tab_depth--;
317                 pidl tabs()."} out;\n\n";
318                 $needed++;
319         }
320
321         if (!$needed) {
322                 # sigh - some compilers don't like empty structures
323                 pidl tabs()."int _dummy_element;\n";
324         }
325
326         $tab_depth--;
327         pidl "};\n\n";
328 }
329
330 sub HeaderImport
331 {
332         my @imports = @_;
333         foreach (@imports) {
334                 s/\.idl\"$//;
335                 s/^\"//;
336                 pidl choose_header("librpc/gen_ndr/$_\.h", "gen_ndr/$_.h") . "\n";
337         }
338 }
339
340 sub HeaderInclude
341 {
342         my @includes = @_;
343         foreach (@includes) {
344                 pidl "#include $_\n";
345         }
346 }
347
348 #####################################################################
349 # parse the interface definitions
350 sub HeaderInterface($)
351 {
352         my($interface) = shift;
353
354         pidl "#ifndef _HEADER_$interface->{NAME}\n";
355         pidl "#define _HEADER_$interface->{NAME}\n\n";
356
357         foreach my $c (@{$interface->{CONSTS}}) {
358                 HeaderConst($c);
359         }
360
361         foreach my $t (@{$interface->{TYPES}}) {
362                 HeaderTypedef($t) if ($t->{TYPE} eq "TYPEDEF");
363                 HeaderStruct($t, $t->{NAME}) if ($t->{TYPE} eq "STRUCT");
364                 HeaderUnion($t, $t->{NAME}) if ($t->{TYPE} eq "UNION");
365                 HeaderEnum($t, $t->{NAME}) if ($t->{TYPE} eq "ENUM");
366                 HeaderBitmap($t, $t->{NAME}) if ($t->{TYPE} eq "BITMAP");
367                 pidl ";\n\n" if ($t->{TYPE} eq "BITMAP" or 
368                                  $t->{TYPE} eq "STRUCT" or 
369                                  $t->{TYPE} eq "TYPEDEF" or 
370                                  $t->{TYPE} eq "UNION" or 
371                                  $t->{TYPE} eq "ENUM");
372         }
373
374         foreach my $fn (@{$interface->{FUNCTIONS}}) {
375                 HeaderFunction($fn);
376         }
377
378         pidl "#endif /* _HEADER_$interface->{NAME} */\n";
379 }
380
381 sub HeaderQuote($)
382 {
383         my($quote) = shift;
384
385         pidl unmake_str($quote->{DATA}) . "\n";
386 }
387
388 #####################################################################
389 # parse a parsed IDL into a C header
390 sub Parse($)
391 {
392         my($ndr) = shift;
393         $tab_depth = 0;
394
395         $res = "";
396         %headerstructs = ();
397         pidl "/* header auto-generated by pidl */\n\n";
398         if (!is_intree()) {
399                 pidl "#include <util/data_blob.h>\n";
400         }
401         pidl "#include <stdint.h>\n";
402         pidl "\n";
403
404         foreach (@{$ndr}) {
405                 ($_->{TYPE} eq "CPP_QUOTE") && HeaderQuote($_);
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 sub GenerateStructEnv($$)
415 {
416         my ($x, $v) = @_;
417         my %env;
418
419         foreach my $e (@{$x->{ELEMENTS}}) {
420                 $env{$e->{NAME}} = "$v->$e->{NAME}";
421         }
422
423         $env{"this"} = $v;
424
425         return \%env;
426 }
427
428 sub EnvSubstituteValue($$)
429 {
430         my ($env,$s) = @_;
431
432         # Substitute the value() values in the env
433         foreach my $e (@{$s->{ELEMENTS}}) {
434                 next unless (defined(my $v = has_property($e, "value")));
435                 
436                 $env->{$e->{NAME}} = ParseExpr($v, $env, $e);
437         }
438
439         return $env;
440 }
441
442 sub GenerateFunctionInEnv($;$)
443 {
444         my ($fn, $base) = @_;
445         my %env;
446
447         $base = "r->" unless defined($base);
448
449         foreach my $e (@{$fn->{ELEMENTS}}) {
450                 if (grep (/in/, @{$e->{DIRECTION}})) {
451                         $env{$e->{NAME}} = $base."in.$e->{NAME}";
452                 }
453         }
454
455         return \%env;
456 }
457
458 sub GenerateFunctionOutEnv($;$)
459 {
460         my ($fn, $base) = @_;
461         my %env;
462
463         $base = "r->" unless defined($base);
464
465         foreach my $e (@{$fn->{ELEMENTS}}) {
466                 if (grep (/out/, @{$e->{DIRECTION}})) {
467                         $env{$e->{NAME}} = $base."out.$e->{NAME}";
468                 } elsif (grep (/in/, @{$e->{DIRECTION}})) {
469                         $env{$e->{NAME}} = $base."in.$e->{NAME}";
470                 }
471         }
472
473         return \%env;
474 }
475
476
477
478 1;