← Back to branch summary

~zulcss/samba/server-dailies-3.4

« back to all changes in this revision

Viewing changes to pidl/lib/Parse/Pidl/Samba4/Header.pm

  • Committer: Chuck Short
  • Date: 2010-09-28 20:38:39 UTC
  • Revision ID: zulcss@ubuntu.com-20100928203839-pgjulytsi9ue63x1
Initial version

Show diffs side-by-side

added added

removed removed

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