diff options
Diffstat (limited to 'pidl/lib/Parse/Pidl/Dump.pm')
| -rw-r--r-- | pidl/lib/Parse/Pidl/Dump.pm | 294 |
1 files changed, 294 insertions, 0 deletions
diff --git a/pidl/lib/Parse/Pidl/Dump.pm b/pidl/lib/Parse/Pidl/Dump.pm new file mode 100644 index 0000000000..bf5811c116 --- /dev/null +++ b/pidl/lib/Parse/Pidl/Dump.pm @@ -0,0 +1,294 @@ +################################################### +# dump function for IDL structures +# Copyright tridge@samba.org 2000 +# Copyright jelmer@samba.org 2005 +# released under the GNU GPL + +=pod + +=head1 NAME + +Parse::Pidl::Dump - Dump support + +=head1 DESCRIPTION + +This module provides functions that can generate IDL code from +internal pidl data structures. + +=cut + +package Parse::Pidl::Dump; + +use Exporter; + +use vars qw($VERSION); +$VERSION = '0.01'; +@ISA = qw(Exporter); +@EXPORT_OK = qw(DumpType 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 "; + if ($struct->{NAME}) { + $res.="$struct->{NAME} "; + } + + $res.="{\n"; + if (defined $struct->{ELEMENTS}) { + foreach (@{$struct->{ELEMENTS}}) { + $res .= "\t" . DumpElement($_) . ";\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; + + if (ref($data) eq "HASH") { + return DumpStruct($data) if ($data->{TYPE} eq "STRUCT"); + return DumpUnion($data) if ($data->{TYPE} eq "UNION"); + return DumpEnum($data) if ($data->{TYPE} eq "ENUM"); + return DumpBitmap($data) if ($data->{TYPE} eq "BITMAP"); + } else { + return $data; + } +} + +##################################################################### +# 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->{ELEMENTS}}) { + unless ($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; |