source4/build/pidl/Parse/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 Parse::Pidl::Dump;
   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         for my $i (1..$element->{POINTERS}) {
  51             $res .= "*";
  52     }
  53     $res .= "$element->{NAME}";
  54         foreach (@{$element->{ARRAY_LEN}}) {
  55                 $res .= "[$_]";
  56         }
  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 struct
  83 sub DumpEnum($)
  84 {
  85     my($enum) = shift;
  86     my($res);
  87
  88     $res .= "enum";
  89
  90     return $res;
  91 }
  92
  93
  94 #####################################################################
  95 # dump a union element
  96 sub DumpUnionElement($)
  97 {
  98     my($element) = shift;
  99     my($res);
 100
 101     if (util::has_property($element, "default")) {
 102         $res .= "[default] ;\n";
 103     } else {
 104         $res .= "[case($element->{PROPERTIES}->{case})] ";
 105         $res .= DumpElement($element), if defined($element);
 106         $res .= ";\n";
 107     }
 108
 109     return $res;
 110 }
 111
 112 #####################################################################
 113 # dump a union
 114 sub DumpUnion($)
 115 {
 116     my($union) = shift;
 117     my($res);
 118
 119     (defined $union->{PROPERTIES}) &&
 120         ($res .= DumpProperties($union->{PROPERTIES}));
 121     $res .= "union {\n";
 122     foreach my $e (@{$union->{ELEMENTS}}) {
 123         $res .= DumpUnionElement($e);
 124     }
 125     $res .= "}";
 126
 127     return $res;
 128 }
 129
 130 #####################################################################
 131 # dump a type
 132 sub DumpType($)
 133 {
 134     my($data) = shift;
 135     my($res);
 136
 137     if (ref($data) eq "HASH") {
 138         ($data->{TYPE} eq "STRUCT") &&
 139             ($res .= DumpStruct($data));
 140         ($data->{TYPE} eq "UNION") &&
 141             ($res .= DumpUnion($data));
 142         ($data->{TYPE} eq "ENUM") &&
 143             ($res .= DumpEnum($data));
 144     } else {
 145         $res .= "$data";
 146     }
 147
 148     return $res;
 149 }
 150
 151 #####################################################################
 152 # dump a typedef
 153 sub DumpTypedef($)
 154 {
 155     my($typedef) = shift;
 156     my($res);
 157
 158     $res .= "typedef ";
 159     $res .= DumpType($typedef->{DATA});
 160     $res .= " $typedef->{NAME};\n\n";
 161
 162     return $res;
 163 }
 164
 165 #####################################################################
 166 # dump a typedef
 167 sub DumpFunction($)
 168 {
 169     my($function) = shift;
 170     my($first) = 1;
 171     my($res);
 172
 173     $res .= DumpType($function->{RETURN_TYPE});
 174     $res .= " $function->{NAME}(\n";
 175     for my $d (@{$function->{DATA}}) {
 176         $first || ($res .= ",\n"); $first = 0;
 177         $res .= DumpElement($d);
 178     }
 179     $res .= "\n);\n\n";
 180
 181     return $res;
 182 }
 183
 184 #####################################################################
 185 # dump a module header
 186 sub DumpInterfaceProperties($)
 187 {
 188     my($header) = shift;
 189     my($data) = $header->{DATA};
 190     my($first) = 1;
 191     my($res);
 192
 193     $res .= "[\n";
 194     foreach my $k (keys %{$data}) {
 195             $first || ($res .= ",\n"); $first = 0;
 196             $res .= "$k($data->{$k})";
 197     }
 198     $res .= "\n]\n";
 199
 200     return $res;
 201 }
 202
 203 #####################################################################
 204 # dump the interface definitions
 205 sub DumpInterface($)
 206 {
 207     my($interface) = shift;
 208     my($data) = $interface->{DATA};
 209     my($res);
 210
 211         $res .= DumpInterfaceProperties($interface->{PROPERTIES});
 212
 213     $res .= "interface $interface->{NAME}\n{\n";
 214     foreach my $d (@{$data}) {
 215         ($d->{TYPE} eq "TYPEDEF") &&
 216             ($res .= DumpTypedef($d));
 217         ($d->{TYPE} eq "FUNCTION") &&
 218             ($res .= DumpFunction($d));
 219     }
 220     $res .= "}\n";
 221
 222     return $res;
 223 }
 224
 225
 226 #####################################################################
 227 # dump a parsed IDL structure back into an IDL file
 228 sub Dump($)
 229 {
 230     my($idl) = shift;
 231     my($res);
 232
 233     $res = "/* Dumped by pidl */\n\n";
 234     foreach my $x (@{$idl}) {
 235         ($x->{TYPE} eq "INTERFACE") &&
 236             ($res .= DumpInterface($x));
 237     }
 238     return $res;
 239 }
 240
 241 1;