1
0
mirror of https://github.com/samba-team/samba.git synced 2025-01-12 09:18:10 +03:00

r589: Fix IDL dump module so --dump and --diff options to pidl.pl work

again.  Still a few problems left though.
(This used to be commit e921a5879f)
This commit is contained in:
Tim Potter 2004-05-08 23:51:23 +00:00 committed by Gerald (Jerry) Carter
parent 35ffc46454
commit a10936532e

View File

@ -3,7 +3,7 @@
# Copyright tridge@samba.org 2000 # Copyright tridge@samba.org 2000
# released under the GNU GPL # released under the GNU GPL
package dump; package IdlDump;
use strict; use strict;
@ -14,15 +14,14 @@ my($res);
sub DumpProperties($) sub DumpProperties($)
{ {
my($props) = shift; my($props) = shift;
foreach my $d (@{$props}) { my($res);
if (ref($d) ne "HASH") {
$res .= "[$d] "; foreach my $d ($props) {
} else { foreach my $k (keys %{$d}) {
foreach my $k (keys %{$d}) { $res .= "[$k($d->{$k})] ";
$res .= "[$k($d->{$k})] ";
}
} }
} }
return $res;
} }
##################################################################### #####################################################################
@ -30,8 +29,11 @@ sub DumpProperties($)
sub DumpElement($) sub DumpElement($)
{ {
my($element) = shift; my($element) = shift;
(defined $element->{PROPERTIES}) && DumpProperties($element->{PROPERTIES}); my($res);
DumpType($element->{TYPE});
(defined $element->{PROPERTIES}) &&
($res .= DumpProperties($element->{PROPERTIES}));
$res .= DumpType($element->{TYPE});
$res .= " "; $res .= " ";
if ($element->{POINTERS}) { if ($element->{POINTERS}) {
for (my($i)=0; $i < $element->{POINTERS}; $i++) { for (my($i)=0; $i < $element->{POINTERS}; $i++) {
@ -40,6 +42,8 @@ sub DumpElement($)
} }
$res .= "$element->{NAME}"; $res .= "$element->{NAME}";
(defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]"); (defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]");
return $res;
} }
##################################################################### #####################################################################
@ -47,14 +51,18 @@ sub DumpElement($)
sub DumpStruct($) sub DumpStruct($)
{ {
my($struct) = shift; my($struct) = shift;
my($res);
$res .= "struct {\n"; $res .= "struct {\n";
if (defined $struct->{ELEMENTS}) { if (defined $struct->{ELEMENTS}) {
foreach my $e (@{$struct->{ELEMENTS}}) { foreach my $e (@{$struct->{ELEMENTS}}) {
DumpElement($e); $res .= DumpElement($e);
$res .= ";\n"; $res .= ";\n";
} }
} }
$res .= "}"; $res .= "}";
return $res;
} }
@ -63,9 +71,13 @@ sub DumpStruct($)
sub DumpUnionElement($) sub DumpUnionElement($)
{ {
my($element) = shift; my($element) = shift;
my($res);
$res .= "[case($element->{CASE})] "; $res .= "[case($element->{CASE})] ";
DumpElement($element->{DATA}); $res .= DumpElement($element->{DATA});
$res .= ";\n"; $res .= ";\n";
return $res;
} }
##################################################################### #####################################################################
@ -73,12 +85,17 @@ sub DumpUnionElement($)
sub DumpUnion($) sub DumpUnion($)
{ {
my($union) = shift; my($union) = shift;
(defined $union->{PROPERTIES}) && DumpProperties($union->{PROPERTIES}); my($res);
(defined $union->{PROPERTIES}) &&
($res .= DumpProperties($union->{PROPERTIES}));
$res .= "union {\n"; $res .= "union {\n";
foreach my $e (@{$union->{DATA}}) { foreach my $e (@{$union->{DATA}}) {
DumpUnionElement($e); $res .= DumpUnionElement($e);
} }
$res .= "}"; $res .= "}";
return $res;
} }
##################################################################### #####################################################################
@ -86,14 +103,18 @@ sub DumpUnion($)
sub DumpType($) sub DumpType($)
{ {
my($data) = shift; my($data) = shift;
my($res);
if (ref($data) eq "HASH") { if (ref($data) eq "HASH") {
($data->{TYPE} eq "STRUCT") && ($data->{TYPE} eq "STRUCT") &&
DumpStruct($data); ($res .= DumpStruct($data));
($data->{TYPE} eq "UNION") && ($data->{TYPE} eq "UNION") &&
DumpUnion($data); ($res .= DumpUnion($data));
} else { } else {
$res .= "$data"; $res .= "$data";
} }
return $res;
} }
##################################################################### #####################################################################
@ -101,9 +122,13 @@ sub DumpType($)
sub DumpTypedef($) sub DumpTypedef($)
{ {
my($typedef) = shift; my($typedef) = shift;
my($res);
$res .= "typedef "; $res .= "typedef ";
DumpType($typedef->{DATA}); $res .= DumpType($typedef->{DATA});
$res .= " $typedef->{NAME};\n\n"; $res .= " $typedef->{NAME};\n\n";
return $res;
} }
##################################################################### #####################################################################
@ -112,13 +137,17 @@ sub DumpFunction($)
{ {
my($function) = shift; my($function) = shift;
my($first) = 1; my($first) = 1;
DumpType($function->{RETURN_TYPE}); my($res);
$res .= DumpType($function->{RETURN_TYPE});
$res .= " $function->{NAME}(\n"; $res .= " $function->{NAME}(\n";
for my $d (@{$function->{DATA}}) { for my $d (@{$function->{DATA}}) {
$first || ($res .= ",\n"); $first = 0; $first || ($res .= ",\n"); $first = 0;
DumpElement($d); $res .= DumpElement($d);
} }
$res .= "\n);\n\n"; $res .= "\n);\n\n";
return $res;
} }
##################################################################### #####################################################################
@ -128,12 +157,16 @@ sub DumpModuleHeader($)
my($header) = shift; my($header) = shift;
my($data) = $header->{DATA}; my($data) = $header->{DATA};
my($first) = 1; my($first) = 1;
my($res);
$res .= "[\n"; $res .= "[\n";
foreach my $k (keys %{$data}) { foreach my $k (keys %{$data}) {
$first || ($res .= ",\n"); $first = 0; $first || ($res .= ",\n"); $first = 0;
$res .= "$k($data->{$k})"; $res .= "$k($data->{$k})";
} }
$res .= "\n]\n"; $res .= "\n]\n";
return $res;
} }
##################################################################### #####################################################################
@ -142,14 +175,18 @@ sub DumpInterface($)
{ {
my($interface) = shift; my($interface) = shift;
my($data) = $interface->{DATA}; my($data) = $interface->{DATA};
my($res);
$res .= "interface $interface->{NAME}\n{\n"; $res .= "interface $interface->{NAME}\n{\n";
foreach my $d (@{$data}) { foreach my $d (@{$data}) {
($d->{TYPE} eq "TYPEDEF") && ($d->{TYPE} eq "TYPEDEF") &&
DumpTypedef($d); ($res .= DumpTypedef($d));
($d->{TYPE} eq "FUNCTION") && ($d->{TYPE} eq "FUNCTION") &&
DumpFunction($d); ($res .= DumpFunction($d));
} }
$res .= "}\n"; $res .= "}\n";
return $res;
} }
@ -158,12 +195,14 @@ sub DumpInterface($)
sub Dump($) sub Dump($)
{ {
my($idl) = shift; my($idl) = shift;
my($res);
$res = "/* Dumped by pidl */\n\n"; $res = "/* Dumped by pidl */\n\n";
foreach my $x (@{$idl}) { foreach my $x (@{$idl}) {
($x->{TYPE} eq "MODULEHEADER") && ($x->{TYPE} eq "MODULEHEADER") &&
DumpModuleHeader($x); ($res .= DumpModuleHeader($x));
($x->{TYPE} eq "INTERFACE") && ($x->{TYPE} eq "INTERFACE") &&
DumpInterface($x); ($res .= DumpInterface($x));
} }
return $res; return $res;
} }