diff options
author | Andrew Tridgell <tridge@samba.org> | 2001-11-24 11:29:42 +0000 |
---|---|---|
committer | Andrew Tridgell <tridge@samba.org> | 2001-11-24 11:29:42 +0000 |
commit | 95baaba31c3f906d10fc8d67433b4cf10fa71d1d (patch) | |
tree | 4faedcedb8682b78a8cca8f16f63667f0f961257 /source4 | |
parent | a1cd69698f085dbbd630cf5b943d818af25c1dd4 (diff) | |
download | samba-95baaba31c3f906d10fc8d67433b4cf10fa71d1d.tar.gz samba-95baaba31c3f906d10fc8d67433b4cf10fa71d1d.tar.bz2 samba-95baaba31c3f906d10fc8d67433b4cf10fa71d1d.zip |
forgot a file
(This used to be commit 39e8894fb22da6c60cb8306d5ec4b1e868f0dd77)
Diffstat (limited to 'source4')
-rw-r--r-- | source4/build/pidl/parser.pm | 145 |
1 files changed, 145 insertions, 0 deletions
diff --git a/source4/build/pidl/parser.pm b/source4/build/pidl/parser.pm new file mode 100644 index 0000000000..cad4d10d42 --- /dev/null +++ b/source4/build/pidl/parser.pm @@ -0,0 +1,145 @@ +################################################### +# C parser generator for IDL structures +# Copyright tridge@samba.org 2000 +# released under the GNU GPL + +package IdlParser; + +use Data::Dumper; + +my($res); + +##################################################################### +# dump a properties list +sub DumpProperties($) +{ + my($props) = shift; + foreach my $d (@{$props}) { + if (ref($d) ne "HASH") { + $res .= "[$d] "; + } else { + foreach my $k (keys %{$d}) { + $res .= "[$k($d->{$k})] "; + } + } + } +} + +##################################################################### +# dump a structure element +sub DumpElement($) +{ + my($element) = shift; + (defined $element->{PROPERTIES}) && DumpProperties($element->{PROPERTIES}); + DumpType($element->{TYPE}); + $res .= " "; + if ($element->{POINTERS}) { + for (my($i)=0; $i < $element->{POINTERS}; $i++) { + $res .= "*"; + } + } + $res .= "$element->{NAME}"; + (defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]"); +} + +##################################################################### +# dump a struct +sub DumpStruct($) +{ + my($struct) = shift; + $res .= "struct {\n"; + if (defined $struct->{ELEMENTS}) { + foreach my $e (@{$struct->{ELEMENTS}}) { + DumpElement($e); + $res .= ";\n"; + } + } + $res .= "}"; +} + + +##################################################################### +# dump a union element +sub DumpUnionElement($) +{ + my($element) = shift; + $res .= "[case($element->{CASE})] "; + DumpElement($element->{DATA}); + $res .= ";\n"; +} + +##################################################################### +# dump a union +sub DumpUnion($) +{ + my($union) = shift; + (defined $union->{PROPERTIES}) && DumpProperties($union->{PROPERTIES}); + $res .= "union {\n"; + foreach my $e (@{$union->{DATA}}) { + DumpUnionElement($e); + } + $res .= "}"; +} + +##################################################################### +# dump a type +sub DumpType($) +{ + my($data) = shift; + if (ref($data) eq "HASH") { + ($data->{TYPE} eq "STRUCT") && + DumpStruct($data); + ($data->{TYPE} eq "UNION") && + DumpUnion($data); + } else { + $res .= "$data"; + } +} + +##################################################################### +# dump a typedef +sub DumpTypedef($) +{ + my($typedef) = shift; + $res .= "typedef "; + DumpType($typedef->{DATA}); + $res .= " $typedef->{NAME};\n\n"; +} + +##################################################################### +# dump a function +sub DumpFunction($) +{ + my($function) = shift; + $res .= "/* ignoring function $function->{NAME} */\n"; +} + +##################################################################### +# dump the interface definitions +sub DumpInterface($) +{ + my($interface) = shift; + my($data) = $interface->{DATA}; + foreach my $d (@{$data}) { + ($d->{TYPE} eq "TYPEDEF") && + DumpTypedef($d); + ($d->{TYPE} eq "FUNCTION") && + DumpFunction($d); + } +} + + +##################################################################### +# dump a parsed IDL structure back into an IDL file +sub Dump($) +{ + my($idl) = shift; + $res = "/* parser auto-generated by pidl */\n\n"; + foreach my $x (@{$idl}) { + ($x->{TYPE} eq "INTERFACE") && + DumpInterface($x); + } + return $res; +} + +1; |