summaryrefslogtreecommitdiff
path: root/source4
diff options
context:
space:
mode:
authorAndrew Tridgell <tridge@samba.org>2001-11-24 11:29:42 +0000
committerAndrew Tridgell <tridge@samba.org>2001-11-24 11:29:42 +0000
commit95baaba31c3f906d10fc8d67433b4cf10fa71d1d (patch)
tree4faedcedb8682b78a8cca8f16f63667f0f961257 /source4
parenta1cd69698f085dbbd630cf5b943d818af25c1dd4 (diff)
downloadsamba-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.pm145
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;