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
11 Parse::Pidl::Dump - Dump support
15 This module provides functions that can generate IDL code from
16 internal pidl data structures.
20 package Parse::Pidl::Dump;
24 use vars qw($VERSION);
27 @EXPORT_OK = qw(DumpType DumpTypedef DumpStruct DumpEnum DumpBitmap DumpUnion DumpFunction);
30 use Parse::Pidl::Util qw(has_property);
34 #####################################################################
35 # dump a properties list
41 foreach my $d ($props) {
42 foreach my $k (keys %{$d}) {
55 $res .= "[$k($d->{$k})] ";
61 #####################################################################
62 # dump a structure element
68 (defined $element->{PROPERTIES}) &&
69 ($res .= DumpProperties($element->{PROPERTIES}));
70 $res .= DumpType($element->{TYPE});
72 for my $i (1..$element->{POINTERS}) {
75 $res .= "$element->{NAME}";
76 foreach (@{$element->{ARRAY_LEN}}) {
83 #####################################################################
91 if ($struct->{NAME}) {
92 $res.="$struct->{NAME} ";
96 if (defined $struct->{ELEMENTS}) {
97 foreach (@{$struct->{ELEMENTS}}) {
98 $res .= "\t" . DumpElement($_) . ";\n";
107 #####################################################################
116 foreach (@{$enum->{ELEMENTS}}) {
117 if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
118 $res .= "\t$1 = $2,\n";
129 #####################################################################
136 $res .= "bitmap {\n";
138 foreach (@{$bitmap->{ELEMENTS}}) {
139 if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
140 $res .= "\t$1 = $2,\n";
142 die ("Bitmap $bitmap->{NAME} has field $_ without proper value");
152 #####################################################################
153 # dump a union element
154 sub DumpUnionElement($)
156 my($element) = shift;
159 if (has_property($element, "default")) {
160 $res .= "[default] ;\n";
162 $res .= "[case($element->{PROPERTIES}->{case})] ";
163 $res .= DumpElement($element), if defined($element);
170 #####################################################################
177 (defined $union->{PROPERTIES}) &&
178 ($res .= DumpProperties($union->{PROPERTIES}));
180 foreach my $e (@{$union->{ELEMENTS}}) {
181 $res .= DumpUnionElement($e);
188 #####################################################################
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");
204 #####################################################################
208 my($typedef) = shift;
212 $res .= DumpType($typedef->{DATA});
213 $res .= " $typedef->{NAME};\n\n";
218 #####################################################################
222 my($function) = shift;
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);
237 #####################################################################
238 # dump a module header
239 sub DumpInterfaceProperties($)
242 my($data) = $header->{DATA};
247 foreach my $k (keys %{$data}) {
248 $first || ($res .= ",\n"); $first = 0;
249 $res .= "$k($data->{$k})";
256 #####################################################################
257 # dump the interface definitions
260 my($interface) = shift;
261 my($data) = $interface->{DATA};
264 $res .= DumpInterfaceProperties($interface->{PROPERTIES});
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));
279 #####################################################################
280 # dump a parsed IDL structure back into an IDL file
286 $res = "/* Dumped by pidl */\n\n";
287 foreach my $x (@{$idl}) {
288 ($x->{TYPE} eq "INTERFACE") &&
289 ($res .= DumpInterface($x));