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));