Move tdr to top-level.
[ira/wip.git] / pidl / lib / Parse / Pidl / Samba4 / TDR.pm
1 ###################################################
2 # Trivial Parser Generator
3 # Copyright jelmer@samba.org 2005-2007
4 # released under the GNU GPL
5
6 package Parse::Pidl::Samba4::TDR;
7 use Parse::Pidl qw(fatal);
8 use Parse::Pidl::Util qw(has_property ParseExpr is_constant);
9 use Parse::Pidl::Samba4 qw(is_intree choose_header);
10
11 use Exporter;
12 @ISA = qw(Exporter);
13 @EXPORT_OK = qw(ParserType $ret $ret_hdr);
14
15 use vars qw($VERSION);
16 $VERSION = '0.01';
17
18 use strict;
19
20 sub new($) {
21         my ($class) = shift;
22         my $self = { ret => "", ret_hdr => "", tabs => "" };
23         bless($self, $class);
24 }
25
26 sub indent($) { my $self = shift; $self->{tabs}.="\t"; }
27 sub deindent($) { my $self = shift; $self->{tabs} = substr($self->{tabs}, 1); }
28 sub pidl($$) { my $self = shift; $self->{ret} .= $self->{tabs}.(shift)."\n"; }
29 sub pidl_hdr($$) { my $self = shift; $self->{ret_hdr} .= (shift)."\n"; }
30 sub typearg($) { 
31         my $t = shift; 
32         return(", const char *name") if ($t eq "print");
33         return(", TALLOC_CTX *mem_ctx") if ($t eq "pull");
34         return("");
35 }
36
37 sub fn_declare($$$)
38 {
39         my ($self, $p, $d) = @_;
40         if ($p) { 
41                 $self->pidl($d); $self->pidl_hdr("$d;"); 
42         } else { 
43                 $self->pidl("static $d"); 
44         }
45 }
46
47 sub ContainsArray($)
48 {
49         my $e = shift;
50         foreach (@{$e->{ELEMENTS}}) {
51                 next if (has_property($_, "charset") and
52                         scalar(@{$_->{ARRAY_LEN}}) == 1);
53                 return 1 if (defined($_->{ARRAY_LEN}) and 
54                                 scalar(@{$_->{ARRAY_LEN}}) > 0);
55         }
56         return 0;
57 }
58
59 sub ParserElement($$$$)
60 {
61         my ($self, $e,$t,$env) = @_;
62         my $switch = "";
63         my $array = "";
64         my $name = "";
65         my $mem_ctx = "mem_ctx";
66
67         fatal($e,"Pointers not supported in TDR") if ($e->{POINTERS} > 0);
68         fatal($e,"size_is() not supported in TDR") if (has_property($e, "size_is"));
69         fatal($e,"length_is() not supported in TDR") if (has_property($e, "length_is"));
70
71         if ($t eq "print") {
72                 $name = ", \"$e->{NAME}\"$array";
73         }
74
75         if (has_property($e, "flag")) {
76                 $self->pidl("{");
77                 $self->indent;
78                 $self->pidl("uint32_t saved_flags = tdr->flags;");
79                 $self->pidl("tdr->flags |= $e->{PROPERTIES}->{flag};");
80         }
81
82         if (has_property($e, "charset")) {
83                 fatal($e,"charset() on non-array element") unless (defined($e->{ARRAY_LEN}) and scalar(@{$e->{ARRAY_LEN}}) > 0);
84                 
85                 my $len = ParseExpr(@{$e->{ARRAY_LEN}}[0], $env, $e);
86                 if ($len eq "*") { $len = "-1"; }
87                 $name = ", mem_ctx" if ($t eq "pull");
88                 $self->pidl("TDR_CHECK(tdr_$t\_charset(tdr$name, &v->$e->{NAME}, $len, sizeof($e->{TYPE}_t), CH_$e->{PROPERTIES}->{charset}));");
89                 return;
90         }
91
92         if (has_property($e, "switch_is")) {
93                 $switch = ", " . ParseExpr($e->{PROPERTIES}->{switch_is}, $env, $e);
94         }
95
96         if (defined($e->{ARRAY_LEN}) and scalar(@{$e->{ARRAY_LEN}}) > 0) {
97                 my $len = ParseExpr($e->{ARRAY_LEN}[0], $env, $e);
98
99                 if ($t eq "pull" and not is_constant($len)) {
100                         $self->pidl("TDR_ALLOC(mem_ctx, v->$e->{NAME}, $len);");
101                         $mem_ctx = "v->$e->{NAME}";
102                 }
103
104                 $self->pidl("for (i = 0; i < $len; i++) {");
105                 $self->indent;
106                 $array = "[i]";
107         }
108
109         if ($t eq "pull") {
110                 $name = ", $mem_ctx";
111         }
112
113         if (has_property($e, "value") && $t eq "push") {
114                 $self->pidl("v->$e->{NAME} = ".ParseExpr($e->{PROPERTIES}->{value}, $env, $e).";");
115         }
116
117         $self->pidl("TDR_CHECK(tdr_$t\_$e->{TYPE}(tdr$name$switch, &v->$e->{NAME}$array));");
118
119         if ($array) { $self->deindent; $self->pidl("}"); }
120
121         if (has_property($e, "flag")) {
122                 $self->pidl("tdr->flags = saved_flags;");
123                 $self->deindent;
124                 $self->pidl("}");
125         }
126 }
127
128 sub ParserStruct($$$$$)
129 {
130         my ($self, $e,$t,$p) = @_;
131
132         $self->fn_declare($p,"NTSTATUS tdr_$t\_$e->{NAME} (struct tdr_$t *tdr".typearg($t).", struct $e->{NAME} *v)");
133         $self->pidl("{"); $self->indent;
134         $self->pidl("int i;") if (ContainsArray($e));
135
136         if ($t eq "print") {
137                 $self->pidl("tdr->print(tdr, \"\%-25s: struct $e->{NAME}\", name);");
138                 $self->pidl("tdr->level++;");
139         }
140
141         my %env = map { $_->{NAME} => "v->$_->{NAME}" } @{$e->{ELEMENTS}};
142         $env{"this"} = "v";
143         $self->ParserElement($_, $t, \%env) foreach (@{$e->{ELEMENTS}});
144         
145         if ($t eq "print") {
146                 $self->pidl("tdr->level--;");
147         }
148
149         $self->pidl("return NT_STATUS_OK;");
150
151         $self->deindent; $self->pidl("}");
152 }
153
154 sub ParserUnion($$$$)
155 {
156         my ($self, $e,$t,$p) = @_;
157
158         $self->fn_declare($p,"NTSTATUS tdr_$t\_$e->{NAME}(struct tdr_$t *tdr".typearg($t).", int level, union $e->{NAME} *v)");
159         $self->pidl("{"); $self->indent;
160         $self->pidl("int i;") if (ContainsArray($e));
161
162         if ($t eq "print") {
163                 $self->pidl("tdr->print(tdr, \"\%-25s: union $e->{NAME}\", name);");
164                 $self->pidl("tdr->level++;");
165         }
166         
167         $self->pidl("switch (level) {"); $self->indent;
168         foreach (@{$e->{ELEMENTS}}) {
169                 if (has_property($_, "case")) {
170                         $self->pidl("case " . $_->{PROPERTIES}->{case} . ":");
171                 } elsif (has_property($_, "default")) {
172                         $self->pidl("default:");
173                 }
174                 $self->indent; $self->ParserElement($_, $t, {}); $self->deindent;
175                 $self->pidl("break;");
176         }
177         $self->deindent; $self->pidl("}");
178
179         if ($t eq "print") {
180                 $self->pidl("tdr->level--;");
181         }
182         
183         $self->pidl("return NT_STATUS_OK;\n");
184         $self->deindent; $self->pidl("}");
185 }
186
187 sub ParserBitmap($$$$)
188 {
189         my ($self,$e,$t,$p) = @_;
190         return if ($p);
191         $self->pidl("#define tdr_$t\_$e->{NAME} tdr_$t\_" . Parse::Pidl::Typelist::bitmap_type_fn($e));
192 }
193
194 sub ParserEnum($$$$)
195 {
196         my ($self,$e,$t,$p) = @_;
197         my $bt = Parse::Pidl::Typelist::enum_type_fn($e);
198
199         $self->fn_declare($p, "NTSTATUS tdr_$t\_$e->{NAME} (struct tdr_$t *tdr".typearg($t).", enum $e->{NAME} *v)");
200         $self->pidl("{");
201         if ($t eq "pull") {
202                 $self->pidl("\t$bt\_t r;");
203                 $self->pidl("\tTDR_CHECK(tdr_$t\_$bt(tdr, mem_ctx, \&r));");
204                 $self->pidl("\t*v = r;");
205         } elsif ($t eq "push") {
206                 $self->pidl("\tTDR_CHECK(tdr_$t\_$bt(tdr, ($bt\_t *)v));");
207         } elsif ($t eq "print") {
208                 $self->pidl("\t/* FIXME */");
209         }
210         $self->pidl("\treturn NT_STATUS_OK;");
211         $self->pidl("}");
212 }
213
214 sub ParserTypedef($$$$)
215 {
216         my ($self, $e,$t,$p) = @_;
217
218         $self->ParserType($e->{DATA},$t);
219 }
220
221 sub ParserType($$$)
222 {
223         my ($self, $e,$t) = @_;
224
225         return if (has_property($e, "no$t"));
226
227         my $handlers = { 
228                 STRUCT => \&ParserStruct, UNION => \&ParserUnion, 
229                 ENUM => \&ParserEnum, BITMAP => \&ParserBitmap,
230                 TYPEDEF => \&ParserTypedef
231         };
232         
233         $handlers->{$e->{TYPE}}->($self, $e, $t, has_property($e, "public")) 
234                 if (defined($handlers->{$e->{TYPE}}));
235
236         $self->pidl("");
237 }
238
239 sub ParserInterface($$)
240 {
241         my ($self,$x) = @_;
242         
243         $self->pidl_hdr("#ifndef __TDR_$x->{NAME}_HEADER__");
244         $self->pidl_hdr("#define __TDR_$x->{NAME}_HEADER__");
245
246         foreach (@{$x->{DATA}}) {
247                 $self->ParserType($_, "pull");
248                 $self->ParserType($_, "push");
249                 $self->ParserType($_, "print");
250         }
251
252         $self->pidl_hdr("#endif /* __TDR_$x->{NAME}_HEADER__ */");
253 }
254
255 sub Parser($$$$)
256 {
257         my ($self,$idl,$hdrname,$baseheader) = @_;
258         $self->pidl("/* autogenerated by pidl */");
259         if (is_intree()) {
260                 $self->pidl("#include \"includes.h\"");
261         } else {
262                 $self->pidl("#include <stdio.h>");
263                 $self->pidl("#include <stdbool.h>");
264                 $self->pidl("#include <stdlib.h>");
265                 $self->pidl("#include <stdint.h>");
266                 $self->pidl("#include <stdarg.h>");
267                 $self->pidl("#include <string.h>");
268                 $self->pidl("#include <core/ntstatus.h>");
269         }
270         $self->pidl("#include \"$hdrname\"");
271         $self->pidl("");
272         $self->pidl_hdr("/* autogenerated by pidl */");
273         $self->pidl_hdr("#include \"$baseheader\"");
274         $self->pidl_hdr(choose_header("lib/tdr/tdr.h", "tdr.h"));
275         $self->pidl_hdr("");
276
277         foreach (@$idl) { $self->ParserInterface($_) if ($_->{TYPE} eq "INTERFACE"); }  
278         return ($self->{ret_hdr}, $self->{ret});
279 }
280
281 1;