summaryrefslogtreecommitdiff
path: root/source4/pidl/lib/Parse/Pidl/Dump.pm
diff options
context:
space:
mode:
authorJelmer Vernooij <jelmer@samba.org>2005-08-21 23:30:17 +0000
committerGerald (Jerry) Carter <jerry@samba.org>2007-10-10 13:34:17 -0500
commit59b13f9a1d684a632c2c73352f0ec08a63bc0913 (patch)
tree14b0a564e4db3377f7ad2fa1f9671f8e04405962 /source4/pidl/lib/Parse/Pidl/Dump.pm
parentefc03df292aa84edb592c22191dbf86cdf8c32d0 (diff)
downloadsamba-59b13f9a1d684a632c2c73352f0ec08a63bc0913.tar.gz
samba-59b13f9a1d684a632c2c73352f0ec08a63bc0913.tar.bz2
samba-59b13f9a1d684a632c2c73352f0ec08a63bc0913.zip
r9460: - Move pidl to lib/. This fixes standalone installation of pidl.
- Update the README - Allow building the docs stand-alone (This used to be commit b56084ce251ab7a35dd1422f38de258e8e1e1477)
Diffstat (limited to 'source4/pidl/lib/Parse/Pidl/Dump.pm')
-rw-r--r--source4/pidl/lib/Parse/Pidl/Dump.pm277
1 files changed, 277 insertions, 0 deletions
diff --git a/source4/pidl/lib/Parse/Pidl/Dump.pm b/source4/pidl/lib/Parse/Pidl/Dump.pm
new file mode 100644
index 0000000000..bca599262a
--- /dev/null
+++ b/source4/pidl/lib/Parse/Pidl/Dump.pm
@@ -0,0 +1,277 @@
+###################################################
+# dump function for IDL structures
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+
+package Parse::Pidl::Dump;
+
+use Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(DumpTypedef DumpStruct DumpEnum DumpBitmap DumpUnion DumpFunction);
+
+use strict;
+use Parse::Pidl::Util qw(has_property);
+
+my($res);
+
+#####################################################################
+# dump a properties list
+sub DumpProperties($)
+{
+ my($props) = shift;
+ my($res);
+
+ foreach my $d ($props) {
+ foreach my $k (keys %{$d}) {
+ if ($k eq "in") {
+ $res .= "[in] ";
+ next;
+ }
+ if ($k eq "out") {
+ $res .= "[out] ";
+ next;
+ }
+ if ($k eq "ref") {
+ $res .= "[ref] ";
+ next;
+ }
+ $res .= "[$k($d->{$k})] ";
+ }
+ }
+ return $res;
+}
+
+#####################################################################
+# dump a structure element
+sub DumpElement($)
+{
+ my($element) = shift;
+ my($res);
+
+ (defined $element->{PROPERTIES}) &&
+ ($res .= DumpProperties($element->{PROPERTIES}));
+ $res .= DumpType($element->{TYPE});
+ $res .= " ";
+ for my $i (1..$element->{POINTERS}) {
+ $res .= "*";
+ }
+ $res .= "$element->{NAME}";
+ foreach (@{$element->{ARRAY_LEN}}) {
+ $res .= "[$_]";
+ }
+
+ return $res;
+}
+
+#####################################################################
+# dump a struct
+sub DumpStruct($)
+{
+ my($struct) = shift;
+ my($res);
+
+ $res .= "struct {\n";
+ if (defined $struct->{ELEMENTS}) {
+ foreach my $e (@{$struct->{ELEMENTS}}) {
+ $res .= "\t" . DumpElement($e);
+ $res .= ";\n";
+ }
+ }
+ $res .= "}";
+
+ return $res;
+}
+
+
+#####################################################################
+# dump a struct
+sub DumpEnum($)
+{
+ my($enum) = shift;
+ my($res);
+
+ $res .= "enum {\n";
+
+ foreach (@{$enum->{ELEMENTS}}) {
+ if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
+ $res .= "\t$1 = $2,\n";
+ } else {
+ $res .= "\t$_,\n";
+ }
+ }
+
+ $res.= "}";
+
+ return $res;
+}
+
+#####################################################################
+# dump a struct
+sub DumpBitmap($)
+{
+ my($bitmap) = shift;
+ my($res);
+
+ $res .= "bitmap {\n";
+
+ foreach (@{$bitmap->{ELEMENTS}}) {
+ if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
+ $res .= "\t$1 = $2,\n";
+ } else {
+ die ("Bitmap $bitmap->{NAME} has field $_ without proper value");
+ }
+ }
+
+ $res.= "}";
+
+ return $res;
+}
+
+
+#####################################################################
+# dump a union element
+sub DumpUnionElement($)
+{
+ my($element) = shift;
+ my($res);
+
+ if (has_property($element, "default")) {
+ $res .= "[default] ;\n";
+ } else {
+ $res .= "[case($element->{PROPERTIES}->{case})] ";
+ $res .= DumpElement($element), if defined($element);
+ $res .= ";\n";
+ }
+
+ return $res;
+}
+
+#####################################################################
+# dump a union
+sub DumpUnion($)
+{
+ my($union) = shift;
+ my($res);
+
+ (defined $union->{PROPERTIES}) &&
+ ($res .= DumpProperties($union->{PROPERTIES}));
+ $res .= "union {\n";
+ foreach my $e (@{$union->{ELEMENTS}}) {
+ $res .= DumpUnionElement($e);
+ }
+ $res .= "}";
+
+ return $res;
+}
+
+#####################################################################
+# dump a type
+sub DumpType($)
+{
+ my($data) = shift;
+ my($res);
+
+ if (ref($data) eq "HASH") {
+ ($data->{TYPE} eq "STRUCT") && ($res .= DumpStruct($data));
+ ($data->{TYPE} eq "UNION") && ($res .= DumpUnion($data));
+ ($data->{TYPE} eq "ENUM") && ($res .= DumpEnum($data));
+ ($data->{TYPE} eq "BITMAP") && ($res .= DumpBitmap($data));
+ } else {
+ $res .= "$data";
+ }
+
+ return $res;
+}
+
+#####################################################################
+# dump a typedef
+sub DumpTypedef($)
+{
+ my($typedef) = shift;
+ my($res);
+
+ $res .= "typedef ";
+ $res .= DumpType($typedef->{DATA});
+ $res .= " $typedef->{NAME};\n\n";
+
+ return $res;
+}
+
+#####################################################################
+# dump a typedef
+sub DumpFunction($)
+{
+ my($function) = shift;
+ my($first) = 1;
+ my($res);
+
+ $res .= DumpType($function->{RETURN_TYPE});
+ $res .= " $function->{NAME}(\n";
+ for my $d (@{$function->{DATA}}) {
+ $first || ($res .= ",\n"); $first = 0;
+ $res .= DumpElement($d);
+ }
+ $res .= "\n);\n\n";
+
+ return $res;
+}
+
+#####################################################################
+# dump a module header
+sub DumpInterfaceProperties($)
+{
+ my($header) = shift;
+ my($data) = $header->{DATA};
+ my($first) = 1;
+ my($res);
+
+ $res .= "[\n";
+ foreach my $k (keys %{$data}) {
+ $first || ($res .= ",\n"); $first = 0;
+ $res .= "$k($data->{$k})";
+ }
+ $res .= "\n]\n";
+
+ return $res;
+}
+
+#####################################################################
+# dump the interface definitions
+sub DumpInterface($)
+{
+ my($interface) = shift;
+ my($data) = $interface->{DATA};
+ my($res);
+
+ $res .= DumpInterfaceProperties($interface->{PROPERTIES});
+
+ $res .= "interface $interface->{NAME}\n{\n";
+ foreach my $d (@{$data}) {
+ ($d->{TYPE} eq "TYPEDEF") &&
+ ($res .= DumpTypedef($d));
+ ($d->{TYPE} eq "FUNCTION") &&
+ ($res .= DumpFunction($d));
+ }
+ $res .= "}\n";
+
+ return $res;
+}
+
+
+#####################################################################
+# dump a parsed IDL structure back into an IDL file
+sub Dump($)
+{
+ my($idl) = shift;
+ my($res);
+
+ $res = "/* Dumped by pidl */\n\n";
+ foreach my $x (@{$idl}) {
+ ($x->{TYPE} eq "INTERFACE") &&
+ ($res .= DumpInterface($x));
+ }
+ return $res;
+}
+
+1;