diff options
author | Jelmer Vernooij <jelmer@samba.org> | 2005-08-21 23:30:17 +0000 |
---|---|---|
committer | Gerald (Jerry) Carter <jerry@samba.org> | 2007-10-10 13:34:17 -0500 |
commit | 59b13f9a1d684a632c2c73352f0ec08a63bc0913 (patch) | |
tree | 14b0a564e4db3377f7ad2fa1f9671f8e04405962 /source4/pidl/lib/Parse/Pidl/Dump.pm | |
parent | efc03df292aa84edb592c22191dbf86cdf8c32d0 (diff) | |
download | samba-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.pm | 277 |
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; |