source4/build/pidl/dump.pm

   1 ###################################################
   2 # dump function for IDL structures
   3 # Copyright tridge@samba.org 2000
   4 # released under the GNU GPL
   5
   6 package IdlDump;
   7
   8 use strict;
   9
  10 my($res);
  11
  12 #####################################################################
  13 # dump a properties list
  14 sub DumpProperties($)
  15 {
  16     my($props) = shift;
  17     my($res);
  18
  19     foreach my $d ($props) {
  20         foreach my $k (keys %{$d}) {
  21             if ($k eq "in") {
  22                 $res .= "[in] ";
  23                 next;
  24             }
  25             if ($k eq "out") {
  26                 $res .= "[out] ";
  27                 next;
  28             }
  29             if ($k eq "ref") {
  30                 $res .= "[ref] ";
  31                 next;
  32             }
  33             $res .= "[$k($d->{$k})] ";
  34         }
  35     }
  36     return $res;
  37 }
  38
  39 #####################################################################
  40 # dump a structure element
  41 sub DumpElement($)
  42 {
  43     my($element) = shift;
  44     my($res);
  45
  46     (defined $element->{PROPERTIES}) &&
  47         ($res .= DumpProperties($element->{PROPERTIES}));
  48     $res .= DumpType($element->{TYPE});
  49     $res .= " ";
  50     if ($element->{POINTERS}) {
  51         for (my($i)=0; $i < $element->{POINTERS}; $i++) {
  52             $res .= "*";
  53         }
  54     }
  55     $res .= "$element->{NAME}";
  56     (defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]");
  57
  58     return $res;
  59 }
  60
  61 #####################################################################
  62 # dump a struct
  63 sub DumpStruct($)
  64 {
  65     my($struct) = shift;
  66     my($res);
  67
  68     $res .= "struct {\n";
  69     if (defined $struct->{ELEMENTS}) {
  70         foreach my $e (@{$struct->{ELEMENTS}}) {
  71             $res .= DumpElement($e);
  72             $res .= ";\n";
  73         }
  74     }
  75     $res .= "}";
  76
  77     return $res;
  78 }
  79
  80
  81 #####################################################################
  82 # dump a union element
  83 sub DumpUnionElement($)
  84 {
  85     my($element) = shift;
  86     my($res);
  87
  88     if ($element->{CASE} eq "default") {
  89         $res .= "[default] ;\n";
  90     } else {
  91         $res .= "[case($element->{CASE})] ";
  92         $res .= DumpElement($element->{DATA}), if defined($element->{DATA});
  93         $res .= ";\n";
  94     }
  95
  96     return $res;
  97 }
  98
  99 #####################################################################
 100 # dump a union
 101 sub DumpUnion($)
 102 {
 103     my($union) = shift;
 104     my($res);
 105
 106     (defined $union->{PROPERTIES}) &&
 107         ($res .= DumpProperties($union->{PROPERTIES}));
 108     $res .= "union {\n";
 109     foreach my $e (@{$union->{DATA}}) {
 110         $res .= DumpUnionElement($e);
 111     }
 112     $res .= "}";
 113
 114     return $res;
 115 }
 116
 117 #####################################################################
 118 # dump a type
 119 sub DumpType($)
 120 {
 121     my($data) = shift;
 122     my($res);
 123
 124     if (ref($data) eq "HASH") {
 125         ($data->{TYPE} eq "STRUCT") &&
 126             ($res .= DumpStruct($data));
 127         ($data->{TYPE} eq "UNION") &&
 128             ($res .= DumpUnion($data));
 129     } else {
 130         $res .= "$data";
 131     }
 132
 133     return $res;
 134 }
 135
 136 #####################################################################
 137 # dump a typedef
 138 sub DumpTypedef($)
 139 {
 140     my($typedef) = shift;
 141     my($res);
 142
 143     $res .= "typedef ";
 144     $res .= DumpType($typedef->{DATA});
 145     $res .= " $typedef->{NAME};\n\n";
 146
 147     return $res;
 148 }
 149
 150 #####################################################################
 151 # dump a typedef
 152 sub DumpFunction($)
 153 {
 154     my($function) = shift;
 155     my($first) = 1;
 156     my($res);
 157
 158     $res .= DumpType($function->{RETURN_TYPE});
 159     $res .= " $function->{NAME}(\n";
 160     for my $d (@{$function->{DATA}}) {
 161         $first || ($res .= ",\n"); $first = 0;
 162         $res .= DumpElement($d);
 163     }
 164     $res .= "\n);\n\n";
 165
 166     return $res;
 167 }
 168
 169 #####################################################################
 170 # dump a module header
 171 sub DumpModuleHeader($)
 172 {
 173     my($header) = shift;
 174     my($data) = $header->{DATA};
 175     my($first) = 1;
 176     my($res);
 177
 178     $res .= "[\n";
 179     foreach my $k (keys %{$data}) {
 180             $first || ($res .= ",\n"); $first = 0;
 181             $res .= "$k($data->{$k})";
 182     }
 183     $res .= "\n]\n";
 184
 185     return $res;
 186 }
 187
 188 #####################################################################
 189 # dump the interface definitions
 190 sub DumpInterface($)
 191 {
 192     my($interface) = shift;
 193     my($data) = $interface->{DATA};
 194     my($res);
 195
 196     $res .= "interface $interface->{NAME}\n{\n";
 197     foreach my $d (@{$data}) {
 198         ($d->{TYPE} eq "TYPEDEF") &&
 199             ($res .= DumpTypedef($d));
 200         ($d->{TYPE} eq "FUNCTION") &&
 201             ($res .= DumpFunction($d));
 202     }
 203     $res .= "}\n";
 204
 205     return $res;
 206 }
 207
 208
 209 #####################################################################
 210 # dump a parsed IDL structure back into an IDL file
 211 sub Dump($)
 212 {
 213     my($idl) = shift;
 214     my($res);
 215
 216     $res = "/* Dumped by pidl */\n\n";
 217     foreach my $x (@{$idl}) {
 218         ($x->{TYPE} eq "MODULEHEADER") &&
 219             ($res .= DumpModuleHeader($x));
 220         ($x->{TYPE} eq "INTERFACE") &&
 221             ($res .= DumpInterface($x));
 222     }
 223     return $res;
 224 }
 225
 226 1;