r15260: Don't dereference NULL pointers to obtain array lengths - found by
[samba.git] / source / 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(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 {\n";
91     if (defined $struct->{ELEMENTS}) {
92         foreach my $e (@{$struct->{ELEMENTS}}) {
93             $res .= "\t" . DumpElement($e);
94             $res .= ";\n";
95         }
96     }
97     $res .= "}";
98     
99     return $res;
100 }
101
102
103 #####################################################################
104 # dump a struct
105 sub DumpEnum($)
106 {
107     my($enum) = shift;
108     my($res);
109
110     $res .= "enum {\n";
111
112     foreach (@{$enum->{ELEMENTS}}) {
113         if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
114                 $res .= "\t$1 = $2,\n";
115         } else {
116                 $res .= "\t$_,\n";
117         }
118     }
119
120     $res.= "}";
121     
122     return $res;
123 }
124
125 #####################################################################
126 # dump a struct
127 sub DumpBitmap($)
128 {
129     my($bitmap) = shift;
130     my($res);
131
132     $res .= "bitmap {\n";
133
134     foreach (@{$bitmap->{ELEMENTS}}) {
135         if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
136                 $res .= "\t$1 = $2,\n";
137         } else {
138                 die ("Bitmap $bitmap->{NAME} has field $_ without proper value");
139         }
140     }
141
142     $res.= "}";
143     
144     return $res;
145 }
146
147
148 #####################################################################
149 # dump a union element
150 sub DumpUnionElement($)
151 {
152     my($element) = shift;
153     my($res);
154
155     if (has_property($element, "default")) {
156         $res .= "[default] ;\n";
157     } else {
158         $res .= "[case($element->{PROPERTIES}->{case})] ";
159         $res .= DumpElement($element), if defined($element);
160         $res .= ";\n";
161     }
162
163     return $res;
164 }
165
166 #####################################################################
167 # dump a union
168 sub DumpUnion($)
169 {
170     my($union) = shift;
171     my($res);
172
173     (defined $union->{PROPERTIES}) && 
174         ($res .= DumpProperties($union->{PROPERTIES}));
175     $res .= "union {\n";
176     foreach my $e (@{$union->{ELEMENTS}}) {
177         $res .= DumpUnionElement($e);
178     }
179     $res .= "}";
180
181     return $res;
182 }
183
184 #####################################################################
185 # dump a type
186 sub DumpType($)
187 {
188     my($data) = shift;
189     my($res);
190
191     if (ref($data) eq "HASH") {
192         ($data->{TYPE} eq "STRUCT") && ($res .= DumpStruct($data));
193         ($data->{TYPE} eq "UNION") && ($res .= DumpUnion($data));
194         ($data->{TYPE} eq "ENUM") && ($res .= DumpEnum($data));
195         ($data->{TYPE} eq "BITMAP") && ($res .= DumpBitmap($data));
196     } else {
197         $res .= "$data";
198     }
199
200     return $res;
201 }
202
203 #####################################################################
204 # dump a typedef
205 sub DumpTypedef($)
206 {
207     my($typedef) = shift;
208     my($res);
209
210     $res .= "typedef ";
211     $res .= DumpType($typedef->{DATA});
212     $res .= " $typedef->{NAME};\n\n";
213
214     return $res;
215 }
216
217 #####################################################################
218 # dump a typedef
219 sub DumpFunction($)
220 {
221     my($function) = shift;
222     my($first) = 1;
223     my($res);
224
225     $res .= DumpType($function->{RETURN_TYPE});
226     $res .= " $function->{NAME}(\n";
227     for my $d (@{$function->{ELEMENTS}}) {
228                 unless ($first) { $res .= ",\n"; } $first = 0;
229                 $res .= DumpElement($d);
230     }
231     $res .= "\n);\n\n";
232
233     return $res;
234 }
235
236 #####################################################################
237 # dump a module header
238 sub DumpInterfaceProperties($)
239 {
240     my($header) = shift;
241     my($data) = $header->{DATA};
242     my($first) = 1;
243     my($res);
244
245     $res .= "[\n";
246     foreach my $k (keys %{$data}) {
247             $first || ($res .= ",\n"); $first = 0;
248             $res .= "$k($data->{$k})";
249     }
250     $res .= "\n]\n";
251
252     return $res;
253 }
254
255 #####################################################################
256 # dump the interface definitions
257 sub DumpInterface($)
258 {
259     my($interface) = shift;
260     my($data) = $interface->{DATA};
261     my($res);
262
263         $res .= DumpInterfaceProperties($interface->{PROPERTIES});
264
265     $res .= "interface $interface->{NAME}\n{\n";
266     foreach my $d (@{$data}) {
267         ($d->{TYPE} eq "TYPEDEF") &&
268             ($res .= DumpTypedef($d));
269         ($d->{TYPE} eq "FUNCTION") &&
270             ($res .= DumpFunction($d));
271     }
272     $res .= "}\n";
273
274     return $res;
275 }
276
277
278 #####################################################################
279 # dump a parsed IDL structure back into an IDL file
280 sub Dump($)
281 {
282     my($idl) = shift;
283     my($res);
284
285     $res = "/* Dumped by pidl */\n\n";
286     foreach my $x (@{$idl}) {
287         ($x->{TYPE} eq "INTERFACE") && 
288             ($res .= DumpInterface($x));
289     }
290     return $res;
291 }
292
293 1;