Move pidl to top-level directory.
[kai/samba-autobuild/.git] / pidl / lib / Parse / Pidl / Dump.pm
1 ###################################################
2 # dump function for IDL structures
3 # Copyright tridge@samba.org 2000
4 # Copyright jelmer@samba.org 2005
5 # released under the GNU GPL
6
7 =pod
8
9 =head1 NAME
10
11 Parse::Pidl::Dump - Dump support
12
13 =head1 DESCRIPTION
14
15 This module provides functions that can generate IDL code from 
16 internal pidl data structures.
17
18 =cut
19
20 package Parse::Pidl::Dump;
21
22 use Exporter;
23
24 use vars qw($VERSION);
25 $VERSION = '0.01';
26 @ISA = qw(Exporter);
27 @EXPORT_OK = qw(DumpType DumpTypedef DumpStruct DumpEnum DumpBitmap DumpUnion DumpFunction);
28
29 use strict;
30 use Parse::Pidl::Util qw(has_property);
31
32 my($res);
33
34 #####################################################################
35 # dump a properties list
36 sub DumpProperties($)
37 {
38     my($props) = shift;
39     my $res = "";
40
41     foreach my $d ($props) {
42         foreach my $k (keys %{$d}) {
43             if ($k eq "in") {
44                 $res .= "[in] ";
45                 next;
46             }
47             if ($k eq "out") {
48                 $res .= "[out] ";
49                 next;
50             }
51             if ($k eq "ref") {
52                 $res .= "[ref] ";
53                 next;
54             }
55             $res .= "[$k($d->{$k})] ";
56         }
57     }
58     return $res;
59 }
60
61 #####################################################################
62 # dump a structure element
63 sub DumpElement($)
64 {
65     my($element) = shift;
66     my $res = "";
67
68     (defined $element->{PROPERTIES}) && 
69         ($res .= DumpProperties($element->{PROPERTIES}));
70     $res .= DumpType($element->{TYPE});
71     $res .= " ";
72         for my $i (1..$element->{POINTERS}) {
73             $res .= "*";
74     }
75     $res .= "$element->{NAME}";
76         foreach (@{$element->{ARRAY_LEN}}) {
77                 $res .= "[$_]";
78         }
79
80     return $res;
81 }
82
83 #####################################################################
84 # dump a struct
85 sub DumpStruct($)
86 {
87     my($struct) = shift;
88     my($res);
89
90     $res .= "struct ";
91         if ($struct->{NAME}) {
92                 $res.="$struct->{NAME} ";
93         }
94         
95         $res.="{\n";
96     if (defined $struct->{ELEMENTS}) {
97                 foreach (@{$struct->{ELEMENTS}}) {
98                     $res .= "\t" . DumpElement($_) . ";\n";
99                 }
100     }
101     $res .= "}";
102     
103     return $res;
104 }
105
106
107 #####################################################################
108 # dump a struct
109 sub DumpEnum($)
110 {
111     my($enum) = shift;
112     my($res);
113
114     $res .= "enum {\n";
115
116     foreach (@{$enum->{ELEMENTS}}) {
117         if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
118                 $res .= "\t$1 = $2,\n";
119         } else {
120                 $res .= "\t$_,\n";
121         }
122     }
123
124     $res.= "}";
125     
126     return $res;
127 }
128
129 #####################################################################
130 # dump a struct
131 sub DumpBitmap($)
132 {
133     my($bitmap) = shift;
134     my($res);
135
136     $res .= "bitmap {\n";
137
138     foreach (@{$bitmap->{ELEMENTS}}) {
139         if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
140                 $res .= "\t$1 = $2,\n";
141         } else {
142                 die ("Bitmap $bitmap->{NAME} has field $_ without proper value");
143         }
144     }
145
146     $res.= "}";
147     
148     return $res;
149 }
150
151
152 #####################################################################
153 # dump a union element
154 sub DumpUnionElement($)
155 {
156     my($element) = shift;
157     my($res);
158
159     if (has_property($element, "default")) {
160         $res .= "[default] ;\n";
161     } else {
162         $res .= "[case($element->{PROPERTIES}->{case})] ";
163         $res .= DumpElement($element), if defined($element);
164         $res .= ";\n";
165     }
166
167     return $res;
168 }
169
170 #####################################################################
171 # dump a union
172 sub DumpUnion($)
173 {
174     my($union) = shift;
175     my($res);
176
177     (defined $union->{PROPERTIES}) && 
178         ($res .= DumpProperties($union->{PROPERTIES}));
179     $res .= "union {\n";
180     foreach my $e (@{$union->{ELEMENTS}}) {
181         $res .= DumpUnionElement($e);
182     }
183     $res .= "}";
184
185     return $res;
186 }
187
188 #####################################################################
189 # dump a type
190 sub DumpType($)
191 {
192     my($data) = shift;
193
194     if (ref($data) eq "HASH") {
195                 return DumpStruct($data) if ($data->{TYPE} eq "STRUCT");
196                 return DumpUnion($data) if ($data->{TYPE} eq "UNION");
197                 return DumpEnum($data) if ($data->{TYPE} eq "ENUM");
198                 return DumpBitmap($data) if ($data->{TYPE} eq "BITMAP");
199     } else {
200                 return $data;
201     }
202 }
203
204 #####################################################################
205 # dump a typedef
206 sub DumpTypedef($)
207 {
208     my($typedef) = shift;
209     my($res);
210
211     $res .= "typedef ";
212     $res .= DumpType($typedef->{DATA});
213     $res .= " $typedef->{NAME};\n\n";
214
215     return $res;
216 }
217
218 #####################################################################
219 # dump a typedef
220 sub DumpFunction($)
221 {
222     my($function) = shift;
223     my($first) = 1;
224     my($res);
225
226     $res .= DumpType($function->{RETURN_TYPE});
227     $res .= " $function->{NAME}(\n";
228     for my $d (@{$function->{ELEMENTS}}) {
229                 unless ($first) { $res .= ",\n"; } $first = 0;
230                 $res .= DumpElement($d);
231     }
232     $res .= "\n);\n\n";
233
234     return $res;
235 }
236
237 #####################################################################
238 # dump a module header
239 sub DumpInterfaceProperties($)
240 {
241     my($header) = shift;
242     my($data) = $header->{DATA};
243     my($first) = 1;
244     my($res);
245
246     $res .= "[\n";
247     foreach my $k (keys %{$data}) {
248             $first || ($res .= ",\n"); $first = 0;
249             $res .= "$k($data->{$k})";
250     }
251     $res .= "\n]\n";
252
253     return $res;
254 }
255
256 #####################################################################
257 # dump the interface definitions
258 sub DumpInterface($)
259 {
260     my($interface) = shift;
261     my($data) = $interface->{DATA};
262     my($res);
263
264         $res .= DumpInterfaceProperties($interface->{PROPERTIES});
265
266     $res .= "interface $interface->{NAME}\n{\n";
267     foreach my $d (@{$data}) {
268         ($d->{TYPE} eq "TYPEDEF") &&
269             ($res .= DumpTypedef($d));
270         ($d->{TYPE} eq "FUNCTION") &&
271             ($res .= DumpFunction($d));
272     }
273     $res .= "}\n";
274
275     return $res;
276 }
277
278
279 #####################################################################
280 # dump a parsed IDL structure back into an IDL file
281 sub Dump($)
282 {
283     my($idl) = shift;
284     my($res);
285
286     $res = "/* Dumped by pidl */\n\n";
287     foreach my $x (@{$idl}) {
288         ($x->{TYPE} eq "INTERFACE") && 
289             ($res .= DumpInterface($x));
290     }
291     return $res;
292 }
293
294 1;