first version
[samba.git] / source4 / build / pidl / dump.pm
1 package IdlDump;
2
3 use Data::Dumper;
4
5 my($res);
6
7 #####################################################################
8 # dump a properties list
9 sub DumpProperties($)
10 {
11     my($props) = shift;
12     foreach my $d (@{$props}) {
13         if (ref($d) ne "HASH") {
14             $res .= "[$d] ";
15         } else {
16             foreach my $k (keys %{$d}) {
17                 $res .= "[$k($d->{$k})] ";
18             }
19         }
20     }
21 }
22
23 #####################################################################
24 # dump a structure element
25 sub DumpElement($)
26 {
27     my($element) = shift;
28     (defined $element->{PROPERTIES}) && DumpProperties($element->{PROPERTIES});
29     DumpType($element->{TYPE});
30     $res .= " ";
31     if ($element->{POINTERS}) {
32         for (my($i)=0; $i < $element->{POINTERS}; $i++) {
33             $res .= "*";
34         }
35     }
36     $res .= "$element->{NAME}";
37     (defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]");
38 }
39
40 #####################################################################
41 # dump a struct
42 sub DumpStruct($)
43 {
44     my($struct) = shift;
45     $res .= "struct {\n";
46     if (defined $struct->{ELEMENTS}) {
47         foreach my $e (@{$struct->{ELEMENTS}}) {
48             DumpElement($e);
49             $res .= ";\n";
50         }
51     }
52     $res .= "}";
53 }
54
55
56 #####################################################################
57 # dump a union element
58 sub DumpUnionElement($)
59 {
60     my($element) = shift;
61     $res .= "[case($element->{CASE})] ";
62     DumpElement($element->{DATA});
63     $res .= ";\n";
64 }
65
66 #####################################################################
67 # dump a union
68 sub DumpUnion($)
69 {
70     my($union) = shift;
71     (defined $union->{PROPERTIES}) && DumpProperties($union->{PROPERTIES});
72     $res .= "union {\n";
73     foreach my $e (@{$union->{DATA}}) {
74         DumpUnionElement($e);
75     }
76     $res .= "}";
77 }
78
79 #####################################################################
80 # dump a type
81 sub DumpType($)
82 {
83     my($data) = shift;
84     if (ref($data) eq "HASH") {
85         ($data->{TYPE} eq "STRUCT") &&
86             DumpStruct($data);
87         ($data->{TYPE} eq "UNION") &&
88             DumpUnion($data);
89     } else {
90         $res .= "$data";
91     }
92 }
93
94 #####################################################################
95 # dump a typedef
96 sub DumpTypedef($)
97 {
98     my($typedef) = shift;
99     $res .= "typedef ";
100     DumpType($typedef->{DATA});
101     $res .= " $typedef->{NAME};\n\n";
102 }
103
104 #####################################################################
105 # dump a typedef
106 sub DumpFunction($)
107 {
108     my($function) = shift;
109     my($first) = 1;
110     DumpType($function->{RETURN_TYPE});
111     $res .= " $function->{NAME}(\n";
112     for my $d (@{$function->{DATA}}) {
113         $first || ($res .= ",\n"); $first = 0;
114         DumpElement($d);
115     }
116     $res .= "\n);\n\n";
117 }
118
119 #####################################################################
120 # dump a module header
121 sub DumpModuleHeader($)
122 {
123     my($header) = shift;
124     my($data) = $header->{DATA};
125     my($first) = 1;
126     $res .= "[\n";
127     foreach my $k (keys %{$data}) {
128             $first || ($res .= ",\n"); $first = 0;
129             $res .= "$k($data->{$k})";
130     }
131     $res .= "\n]\n";
132 }
133
134 #####################################################################
135 # dump the interface definitions
136 sub DumpInterface($)
137 {
138     my($interface) = shift;
139     my($data) = $interface->{DATA};
140     $res .= "interface $interface->{NAME}\n{\n";
141     foreach my $d (@{$data}) {
142         ($d->{TYPE} eq "TYPEDEF") &&
143             DumpTypedef($d);
144         ($d->{TYPE} eq "FUNCTION") &&
145             DumpFunction($d);
146     }
147     $res .= "}\n";
148 }
149
150
151 #####################################################################
152 # dump a parsed IDL structure back into an IDL file
153 sub Dump($)
154 {
155     my($idl) = shift;
156     $res = "/* Dumped by pidl */\n\n";
157     foreach my $x (@{$idl}) {
158         ($x->{TYPE} eq "MODULEHEADER") && 
159             DumpModuleHeader($x);
160         ($x->{TYPE} eq "INTERFACE") && 
161             DumpInterface($x);
162     }
163     return $res;
164 }
165
166 1;