r4468: Don't be a slacker and leave out parameter names when generating
[samba.git] / source4 / build / pidl / header.pm
1 ###################################################
2 # create C header files for an IDL structure
3 # Copyright tridge@samba.org 2000
4 # released under the GNU GPL
5
6 package IdlHeader;
7
8 use strict;
9 use needed;
10
11 my($res);
12 my($tab_depth);
13
14 sub tabs()
15 {
16         for (my($i)=0; $i < $tab_depth; $i++) {
17                 $res .= "\t";
18         }
19 }
20
21 #####################################################################
22 # parse a properties list
23 sub HeaderProperties($)
24 {
25     my($props) = shift;
26
27     return;
28
29     foreach my $d (@{$props}) {
30         if (ref($d) ne "HASH") {
31             $res .= "/* [$d] */ ";
32         } else {
33             foreach my $k (keys %{$d}) {
34                 $res .= "/* [$k($d->{$k})] */ ";
35             }
36         }
37     }
38 }
39
40 #####################################################################
41 # parse a structure element
42 sub HeaderElement($)
43 {
44     my($element) = shift;
45
46     (defined $element->{PROPERTIES}) && HeaderProperties($element->{PROPERTIES});
47     $res .= tabs();
48     HeaderType($element, $element->{TYPE}, "");
49     $res .= " ";
50     if ($element->{POINTERS} && 
51         $element->{TYPE} ne "string") {
52             my($n) = $element->{POINTERS};
53             for (my($i)=$n; $i > 0; $i--) {
54                     $res .= "*";
55             }
56     }
57     if (defined $element->{ARRAY_LEN} && 
58         !util::is_constant($element->{ARRAY_LEN}) &&
59         !$element->{POINTERS}) {
60             # conformant arrays are ugly! I choose to implement them with
61             # pointers instead of the [1] method
62             $res .= "*";
63     }
64     $res .= "$element->{NAME}";
65     if (defined $element->{ARRAY_LEN} && util::is_constant($element->{ARRAY_LEN})) {
66             $res .= "[$element->{ARRAY_LEN}]";
67     }
68     $res .= ";\n";
69 }
70
71 #####################################################################
72 # parse a struct
73 sub HeaderStruct($$)
74 {
75     my($struct) = shift;
76     my($name) = shift;
77     $res .= "\nstruct $name {\n";
78     $tab_depth++;
79     my $el_count=0;
80     if (defined $struct->{ELEMENTS}) {
81         foreach my $e (@{$struct->{ELEMENTS}}) {
82             HeaderElement($e);
83             $el_count++;
84         }
85     }
86     if ($el_count == 0) {
87             # some compilers can't handle empty structures
88             $res .= "\tchar _empty_;\n";
89     }
90     $tab_depth--;
91     $res .= "}";
92 }
93
94 #####################################################################
95 # parse a struct
96 sub HeaderEnum($$)
97 {
98     my($enum) = shift;
99     my($name) = shift;
100     $res .= "\nenum $name {\n";
101     $tab_depth++;
102     my $els = \@{$enum->{ELEMENTS}};
103     foreach my $i (0 .. $#{$els}-1) {
104             my $e = ${$els}[$i];
105             tabs();
106             chomp $e;
107             $res .= "$e,\n";
108     }
109
110     my $e = ${$els}[$#{$els}];
111     tabs();
112     chomp $e;
113     if ($e !~ /^(.*?)\s*$/) {
114             die "Bad enum $name\n";
115     }
116     $res .= "$1\n";
117     $tab_depth--;
118     $res .= "}";
119 }
120
121
122 #####################################################################
123 # parse a union
124 sub HeaderUnion($$)
125 {
126         my($union) = shift;
127         my($name) = shift;
128         my %done = ();
129
130         (defined $union->{PROPERTIES}) && HeaderProperties($union->{PROPERTIES});
131         $res .= "\nunion $name {\n";
132         $tab_depth++;
133         foreach my $e (@{$union->{DATA}}) {
134                 if ($e->{TYPE} eq "UNION_ELEMENT") {
135                         if (! defined $done{$e->{DATA}->{NAME}}) {
136                                 HeaderElement($e->{DATA});
137                         }
138                         $done{$e->{DATA}->{NAME}} = 1;
139                 }
140         }
141         $tab_depth--;
142         $res .= "}";
143 }
144
145 #####################################################################
146 # parse a type
147 sub HeaderType($$$)
148 {
149         my $e = shift;
150         my($data) = shift;
151         my($name) = shift;
152         if (ref($data) eq "HASH") {
153                 ($data->{TYPE} eq "ENUM") &&
154                     HeaderEnum($data, $name);
155                 ($data->{TYPE} eq "STRUCT") &&
156                     HeaderStruct($data, $name);
157                 ($data->{TYPE} eq "UNION") &&
158                     HeaderUnion($data, $name);
159                 return;
160         }
161         if ($data =~ "string") {
162                 $res .= "const char *";
163         } elsif (util::is_scalar_type($data)) {
164                 $res .= "$data";
165         } elsif (util::has_property($e, "switch_is")) {
166                 $res .= "union $data";
167         } else {
168                 $res .= "struct $data";
169         }
170 }
171
172 #####################################################################
173 # parse a typedef
174 sub HeaderTypedef($)
175 {
176     my($typedef) = shift;
177     HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME});
178     $res .= ";\n";
179 }
180
181 #####################################################################
182 # prototype a typedef
183 sub HeaderTypedefProto($)
184 {
185     my($d) = shift;
186     if (!util::has_property($d->{DATA}, "public")) {
187             return;
188     }
189
190     if ($d->{DATA}{TYPE} eq "STRUCT") {
191             $res .= "NTSTATUS ndr_push_$d->{NAME}(struct ndr_push *ndr, int ndr_flags, struct $d->{NAME} *r);\n";
192             $res .= "NTSTATUS ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, struct $d->{NAME} *r);\n";
193             if (!util::has_property($d->{DATA}, "noprint")) {
194                     $res .= "void ndr_print_$d->{NAME}(struct ndr_print *ndr, const char *name, struct $d->{NAME} *r);\n";
195             }
196
197         if (needed::is_needed("ndr_size_$d->{NAME}")) {
198                 $res .= "size_t ndr_size_$d->{NAME}(int ret, const struct $d->{NAME} *r, int flags);\n";
199         }
200     }
201     if ($d->{DATA}{TYPE} eq "UNION") {
202             $res .= "NTSTATUS ndr_push_$d->{NAME}(struct ndr_push *ndr, int ndr_flags, int level, union $d->{NAME} *r);\n";
203             $res .= "NTSTATUS ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, int level, union $d->{NAME} *r);\n";
204             if (!util::has_property($d->{DATA}, "noprint")) {
205                     $res .= "void ndr_print_$d->{NAME}(struct ndr_print *ndr, const char *name, int level, union $d->{NAME} *r);\n";
206             }
207     }
208 }
209
210 #####################################################################
211 # parse a const
212 sub HeaderConst($)
213 {
214     my($const) = shift;
215     if (!defined($const->{ARRAY_LEN})) {
216         $res .= "#define $const->{NAME}\t( $const->{VALUE} )\n";
217     } else {
218         $res .= "#define $const->{NAME}\t $const->{VALUE}\n";
219     }
220 }
221
222 #####################################################################
223 # parse a function
224 sub HeaderFunctionInOut($$)
225 {
226     my($fn) = shift;
227     my($prop) = shift;
228
229     foreach my $e (@{$fn->{DATA}}) {
230             if (util::has_property($e, $prop)) {
231                     HeaderElement($e);
232             }
233     }
234 }
235
236 #####################################################################
237 # determine if we need an "in" or "out" section
238 sub HeaderFunctionInOut_needed($$)
239 {
240     my($fn) = shift;
241     my($prop) = shift;
242
243     if ($prop eq "out" && $fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
244             return 1;
245     }
246
247     foreach my $e (@{$fn->{DATA}}) {
248             if (util::has_property($e, $prop)) {
249                     return 1;
250             }
251     }
252
253     return undef;
254 }
255
256
257 #####################################################################
258 # parse a function
259 sub HeaderFunction($)
260 {
261     my($fn) = shift;
262
263     $res .= "\nstruct $fn->{NAME} {\n";
264     $tab_depth++;
265     my $needed = 0;
266
267     if (HeaderFunctionInOut_needed($fn, "in")) {
268             tabs();
269             $res .= "struct {\n";
270             $tab_depth++;
271             HeaderFunctionInOut($fn, "in");
272             $tab_depth--;
273             tabs();
274             $res .= "} in;\n\n";
275             $needed++;
276     }
277
278     if (HeaderFunctionInOut_needed($fn, "out")) {
279             tabs();
280             $res .= "struct {\n";
281             $tab_depth++;
282             HeaderFunctionInOut($fn, "out");
283             if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
284                     tabs();
285                     $res .= "$fn->{RETURN_TYPE} result;\n";
286             }
287             $tab_depth--;
288             tabs();
289             $res .= "} out;\n\n";
290             $needed++;
291     }
292
293     if (! $needed) {
294             # sigh - some compilers don't like empty structures
295             tabs();
296             $res .= "int _dummy_element;\n";
297     }
298
299     $tab_depth--;
300     $res .= "};\n\n";
301 }
302
303 #####################################################################
304 # output prototypes for a IDL function
305 sub HeaderFnProto($$)
306 {
307         my $interface = shift;
308     my $fn = shift;
309     my $name = $fn->{NAME};
310         
311     $res .= "void ndr_print_$name(struct ndr_print *ndr, const char *name, int flags, struct $name *r);\n";
312
313         if (util::has_property($interface, "object")) {
314                 $res .= "NTSTATUS dcom_$interface->{NAME}_$name (struct dcom_interface_p *d, TALLOC_CTX *mem_ctx, struct $name *r);\n";
315         } else {
316             $res .= "NTSTATUS dcerpc_$name(struct dcerpc_pipe *p, TALLOC_CTX *mem_ctx, struct $name *r);\n";
317         $res .= "struct rpc_request *dcerpc_$name\_send(struct dcerpc_pipe *p, TALLOC_CTX *mem_ctx, struct $name *r);\n";
318         }
319     $res .= "\n";
320 }
321
322
323 #####################################################################
324 # generate vtable structure for DCOM interface
325 sub HeaderVTable($)
326 {
327         my $interface = shift;
328         $res .= "struct dcom_$interface->{NAME}_vtable {\n";
329         if (defined($interface->{BASE})) {
330                 $res .= "\tstruct dcom_$interface->{BASE}\_vtable base;\n";
331         }
332
333         my $data = $interface->{DATA};
334         foreach my $d (@{$data}) {
335                 $res .= "\tNTSTATUS (*$d->{NAME}) (struct dcom_interface_p *d, TALLOC_CTX *mem_ctx, struct $d->{NAME} *r);\n" if ($d->{TYPE} eq "FUNCTION");
336         }
337         $res .= "};\n\n";
338 }
339
340
341 #####################################################################
342 # parse the interface definitions
343 sub HeaderInterface($)
344 {
345     my($interface) = shift;
346     my($data) = $interface->{DATA};
347
348     my $count = 0;
349
350     $res .= "#ifndef _HEADER_NDR_$interface->{NAME}\n";
351     $res .= "#define _HEADER_NDR_$interface->{NAME}\n\n";
352
353     if (defined $interface->{PROPERTIES}->{depends}) {
354             my @d = split / /, $interface->{PROPERTIES}->{depends};
355             foreach my $i (@d) {
356                     $res .= "#include \"librpc/gen_ndr/ndr_$i\.h\"\n";
357             }
358     }
359
360     if (defined $interface->{PROPERTIES}->{uuid}) {
361             my $name = uc $interface->{NAME};
362             $res .= "#define DCERPC_$name\_UUID " . 
363                 util::make_str($interface->{PROPERTIES}->{uuid}) . "\n";
364
365                 if(!defined $interface->{PROPERTIES}->{version}) { $interface->{PROPERTIES}->{version} = "0.0"; }
366             $res .= "#define DCERPC_$name\_VERSION $interface->{PROPERTIES}->{version}\n";
367
368             $res .= "#define DCERPC_$name\_NAME \"$interface->{NAME}\"\n";
369
370                 if(!defined $interface->{PROPERTIES}->{helpstring}) { $interface->{PROPERTIES}->{helpstring} = "NULL"; }
371                 $res .= "#define DCERPC_$name\_HELPSTRING $interface->{PROPERTIES}->{helpstring}\n";
372
373             $res .= "\nextern const struct dcerpc_interface_table dcerpc_table_$interface->{NAME};\n";
374             $res .= "NTSTATUS dcerpc_server_$interface->{NAME}_init(void);\n\n";
375     }
376
377     foreach my $d (@{$data}) {
378             if ($d->{TYPE} eq "FUNCTION") {
379                     my $u_name = uc $d->{NAME};
380                         $res .= "#define DCERPC_$u_name (";
381                 
382                         if (defined($interface->{BASE})) {
383                                 $res .= "DCERPC_" . uc $interface->{BASE} . "_CALL_COUNT + ";
384                         }
385                         
386                     $res .= sprintf("0x%02x", $count) . ")\n";
387                     $count++;
388             }
389     }
390
391         $res .= "\n#define DCERPC_" . uc $interface->{NAME} . "_CALL_COUNT (";
392         
393         if (defined($interface->{BASE})) {
394                 $res .= "DCERPC_" . uc $interface->{BASE} . "_CALL_COUNT + ";
395         }
396         
397         $res .= "$count)\n\n";
398
399     foreach my $d (@{$data}) {
400         ($d->{TYPE} eq "CONST") &&
401             HeaderConst($d);
402         ($d->{TYPE} eq "TYPEDEF") &&
403             HeaderTypedef($d);
404         ($d->{TYPE} eq "TYPEDEF") &&
405             HeaderTypedefProto($d);
406         ($d->{TYPE} eq "FUNCTION") &&
407             HeaderFunction($d);
408         ($d->{TYPE} eq "FUNCTION") &&
409                         HeaderFnProto($interface, $d);
410     }
411         
412         (util::has_property($interface, "object")) &&
413                 HeaderVTable($interface);
414
415     $res .= "#endif /* _HEADER_NDR_$interface->{NAME} */\n";
416 }
417
418 #####################################################################
419 # parse a parsed IDL into a C header
420 sub Parse($)
421 {
422     my($idl) = shift;
423     $tab_depth = 0;
424
425     $res = "/* header auto-generated by pidl */\n\n";
426     foreach my $x (@{$idl}) {
427             if ($x->{TYPE} eq "INTERFACE") {
428                     needed::BuildNeeded($x);
429                     HeaderInterface($x);
430             }
431     }
432     return $res;
433 }
434
435 1;