source4/pidl/lib/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 Exporter;
   9
  10 @ISA = qw(Exporter);
  11 @EXPORT_OK = qw(DumpTypedef DumpStruct DumpEnum DumpBitmap DumpUnion DumpFunction);
  12
  13 use strict;
  14 use Parse::Pidl::Util qw(has_property);
  15
  16 my($res);
  17
  18 #####################################################################
  19 # dump a properties list
  20 sub DumpProperties($)
  21 {
  22     my($props) = shift;
  23     my($res);
  24
  25     foreach my $d ($props) {
  26         foreach my $k (keys %{$d}) {
  27             if ($k eq "in") {
  28                 $res .= "[in] ";
  29                 next;
  30             }
  31             if ($k eq "out") {
  32                 $res .= "[out] ";
  33                 next;
  34             }
  35             if ($k eq "ref") {
  36                 $res .= "[ref] ";
  37                 next;
  38             }
  39             $res .= "[$k($d->{$k})] ";
  40         }
  41     }
  42     return $res;
  43 }
  44
  45 #####################################################################
  46 # dump a structure element
  47 sub DumpElement($)
  48 {
  49     my($element) = shift;
  50     my($res);
  51
  52     (defined $element->{PROPERTIES}) &&
  53         ($res .= DumpProperties($element->{PROPERTIES}));
  54     $res .= DumpType($element->{TYPE});
  55     $res .= " ";
  56         for my $i (1..$element->{POINTERS}) {
  57             $res .= "*";
  58     }
  59     $res .= "$element->{NAME}";
  60         foreach (@{$element->{ARRAY_LEN}}) {
  61                 $res .= "[$_]";
  62         }
  63
  64     return $res;
  65 }
  66
  67 #####################################################################
  68 # dump a struct
  69 sub DumpStruct($)
  70 {
  71     my($struct) = shift;
  72     my($res);
  73
  74     $res .= "struct {\n";
  75     if (defined $struct->{ELEMENTS}) {
  76         foreach my $e (@{$struct->{ELEMENTS}}) {
  77             $res .= "\t" . DumpElement($e);
  78             $res .= ";\n";
  79         }
  80     }
  81     $res .= "}";
  82
  83     return $res;
  84 }
  85
  86
  87 #####################################################################
  88 # dump a struct
  89 sub DumpEnum($)
  90 {
  91     my($enum) = shift;
  92     my($res);
  93
  94     $res .= "enum {\n";
  95
  96     foreach (@{$enum->{ELEMENTS}}) {
  97         if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
  98                 $res .= "\t$1 = $2,\n";
  99         } else {
 100                 $res .= "\t$_,\n";
 101         }
 102     }
 103
 104     $res.= "}";
 105
 106     return $res;
 107 }
 108
 109 #####################################################################
 110 # dump a struct
 111 sub DumpBitmap($)
 112 {
 113     my($bitmap) = shift;
 114     my($res);
 115
 116     $res .= "bitmap {\n";
 117
 118     foreach (@{$bitmap->{ELEMENTS}}) {
 119         if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
 120                 $res .= "\t$1 = $2,\n";
 121         } else {
 122                 die ("Bitmap $bitmap->{NAME} has field $_ without proper value");
 123         }
 124     }
 125
 126     $res.= "}";
 127
 128     return $res;
 129 }
 130
 131
 132 #####################################################################
 133 # dump a union element
 134 sub DumpUnionElement($)
 135 {
 136     my($element) = shift;
 137     my($res);
 138
 139     if (has_property($element, "default")) {
 140         $res .= "[default] ;\n";
 141     } else {
 142         $res .= "[case($element->{PROPERTIES}->{case})] ";
 143         $res .= DumpElement($element), if defined($element);
 144         $res .= ";\n";
 145     }
 146
 147     return $res;
 148 }
 149
 150 #####################################################################
 151 # dump a union
 152 sub DumpUnion($)
 153 {
 154     my($union) = shift;
 155     my($res);
 156
 157     (defined $union->{PROPERTIES}) &&
 158         ($res .= DumpProperties($union->{PROPERTIES}));
 159     $res .= "union {\n";
 160     foreach my $e (@{$union->{ELEMENTS}}) {
 161         $res .= DumpUnionElement($e);
 162     }
 163     $res .= "}";
 164
 165     return $res;
 166 }
 167
 168 #####################################################################
 169 # dump a type
 170 sub DumpType($)
 171 {
 172     my($data) = shift;
 173     my($res);
 174
 175     if (ref($data) eq "HASH") {
 176         ($data->{TYPE} eq "STRUCT") && ($res .= DumpStruct($data));
 177         ($data->{TYPE} eq "UNION") && ($res .= DumpUnion($data));
 178         ($data->{TYPE} eq "ENUM") && ($res .= DumpEnum($data));
 179         ($data->{TYPE} eq "BITMAP") && ($res .= DumpBitmap($data));
 180     } else {
 181         $res .= "$data";
 182     }
 183
 184     return $res;
 185 }
 186
 187 #####################################################################
 188 # dump a typedef
 189 sub DumpTypedef($)
 190 {
 191     my($typedef) = shift;
 192     my($res);
 193
 194     $res .= "typedef ";
 195     $res .= DumpType($typedef->{DATA});
 196     $res .= " $typedef->{NAME};\n\n";
 197
 198     return $res;
 199 }
 200
 201 #####################################################################
 202 # dump a typedef
 203 sub DumpFunction($)
 204 {
 205     my($function) = shift;
 206     my($first) = 1;
 207     my($res);
 208
 209     $res .= DumpType($function->{RETURN_TYPE});
 210     $res .= " $function->{NAME}(\n";
 211     for my $d (@{$function->{ELEMENTS}}) {
 212                 unless ($first) { $res .= ",\n"; } $first = 0;
 213                 $res .= DumpElement($d);
 214     }
 215     $res .= "\n);\n\n";
 216
 217     return $res;
 218 }
 219
 220 #####################################################################
 221 # dump a module header
 222 sub DumpInterfaceProperties($)
 223 {
 224     my($header) = shift;
 225     my($data) = $header->{DATA};
 226     my($first) = 1;
 227     my($res);
 228
 229     $res .= "[\n";
 230     foreach my $k (keys %{$data}) {
 231             $first || ($res .= ",\n"); $first = 0;
 232             $res .= "$k($data->{$k})";
 233     }
 234     $res .= "\n]\n";
 235
 236     return $res;
 237 }
 238
 239 #####################################################################
 240 # dump the interface definitions
 241 sub DumpInterface($)
 242 {
 243     my($interface) = shift;
 244     my($data) = $interface->{DATA};
 245     my($res);
 246
 247         $res .= DumpInterfaceProperties($interface->{PROPERTIES});
 248
 249     $res .= "interface $interface->{NAME}\n{\n";
 250     foreach my $d (@{$data}) {
 251         ($d->{TYPE} eq "TYPEDEF") &&
 252             ($res .= DumpTypedef($d));
 253         ($d->{TYPE} eq "FUNCTION") &&
 254             ($res .= DumpFunction($d));
 255     }
 256     $res .= "}\n";
 257
 258     return $res;
 259 }
 260
 261
 262 #####################################################################
 263 # dump a parsed IDL structure back into an IDL file
 264 sub Dump($)
 265 {
 266     my($idl) = shift;
 267     my($res);
 268
 269     $res = "/* Dumped by pidl */\n\n";
 270     foreach my $x (@{$idl}) {
 271         ($x->{TYPE} eq "INTERFACE") &&
 272             ($res .= DumpInterface($x));
 273     }
 274     return $res;
 275 }
 276
 277 1;