samba-mirror/source/build/pidl/header.pm

###################################################
# create C header files for an IDL structure
# Copyright tridge@samba.org 2000
# released under the GNU GPL
package IdlHeader;

use Data::Dumper;

my($res);
my($tab_depth);

sub tabs()
{
	for (my($i)=0; $i < $tab_depth; $i++) {
		$res .= "\t";
	}
}

#####################################################################
# dump a properties list
sub DumpProperties($)
{
    my($props) = shift;

    return;

    foreach my $d (@{$props}) {
	if (ref($d) ne "HASH") {
	    $res .= "/* [$d] */ ";
	} else {
	    foreach my $k (keys %{$d}) {
		$res .= "/* [$k($d->{$k})] */ ";
	    }
	}
    }
}

#####################################################################
# dump a structure element
sub DumpElement($)
{
    my($element) = shift;

    if (util::has_property($element, "struct_len")) {
	    # a struct_len is an internal artifact - it is put on the 
	    # wire but not exposed via the api, which means it does 
	    # not appear in the header file
	    return;
    }


    (defined $element->{PROPERTIES}) && DumpProperties($element->{PROPERTIES});
    $res .= tabs();
    DumpType($element->{TYPE}, "");
    $res .= " ";
    if ($element->{POINTERS}) {
	    my($n) = $element->{POINTERS};
	    for (my($i)=$n; $i > 0; $i--) {
		    $res .= "*";
	    }
    }
    if (defined $element->{ARRAY_LEN} &&
	$element->{ARRAY_LEN} eq "*") {
	    $res .= "*";
    }
    $res .= "$element->{NAME}";
    if (defined $element->{ARRAY_LEN} &&
	$element->{ARRAY_LEN} ne "*") {
	    $res .= "[$element->{ARRAY_LEN}]";
    }
    $res .= ";\n";
}

#####################################################################
# dump a struct
sub DumpStruct($$)
{
    my($struct) = shift;
    my($name) = shift;
    $res .= "struct $name {\n";
    $tab_depth++;
    if (defined $struct->{ELEMENTS}) {
	foreach my $e (@{$struct->{ELEMENTS}}) {
	    DumpElement($e);
	}
    }
    $tab_depth--;
    $res .= "}";
}


#####################################################################
# dump a union element
sub DumpUnionElement($)
{
    my($element) = shift;
    $res .= "/* [case($element->{CASE})] */ ";
    DumpElement($element->{DATA});
}

#####################################################################
# dump a union
sub DumpUnion($$)
{
    my($union) = shift;
    my($name) = shift;
    (defined $union->{PROPERTIES}) && DumpProperties($union->{PROPERTIES});
    $res .= "union $name {\n";
    foreach my $e (@{$union->{DATA}}) {
	DumpUnionElement($e);
    }
    $res .= "}";
}

#####################################################################
# dump a type
sub DumpType($$)
{
    my($data) = shift;
    my($name) = shift;
    if (ref($data) eq "HASH") {
	($data->{TYPE} eq "STRUCT") &&
	    DumpStruct($data, $name);
	($data->{TYPE} eq "UNION") &&
	    DumpUnion($data, $name);
	return;
    }
    if ($data =~ "unistr") {
	    $res .= "const char";
    } elsif (util::is_scalar_type($data)) {
	    $res .= "$data";
    } else {
	    $res .= "struct $data";
    }
}

#####################################################################
# dump a typedef
sub DumpTypedef($)
{
    my($typedef) = shift;
    DumpType($typedef->{DATA}, $typedef->{NAME});
    $res .= ";\n\n";
}

#####################################################################
# dump a function
sub DumpFunctionInOut($$)
{
    my($fn) = shift;
    my($prop) = shift;
    foreach my $e (@{$fn->{DATA}}) {
	    if (util::has_property($e, $prop)) {
		    DumpElement($e);
	    }
    }
}


#####################################################################
# dump a function
sub DumpFunction($)
{
    my($fn) = shift;
    $res .= "struct $fn->{NAME} {\n";
    $tab_depth++;
    tabs();
    $res .= "struct {\n";
    $tab_depth++;
    DumpFunctionInOut($fn, "in");
    $tab_depth--;
    tabs();
    $res .= "} in;\n\n";
    tabs();
    $res .= "struct {\n";
    $tab_depth++;
    DumpFunctionInOut($fn, "out");
    if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
	    tabs();
	    $res .= "$fn->{RETURN_TYPE} result;\n";
    }
    $tab_depth--;
    tabs();
    $res .= "} out;\n\n";
    $tab_depth--;
    $res .= "};\n\n";
}

#####################################################################
# dump the interface definitions
sub DumpInterface($)
{
    my($interface) = shift;
    my($data) = $interface->{DATA};
    foreach my $d (@{$data}) {
	($d->{TYPE} eq "TYPEDEF") &&
	    DumpTypedef($d);
	($d->{TYPE} eq "FUNCTION") && 
	    DumpFunction($d);
    }

    my $count = 0;

    foreach my $d (@{$data}) {
	    if ($d->{TYPE} eq "FUNCTION") {
		    $u_name = uc $d->{NAME};
		    $res .= "#define DCERPC_$u_name $count\n";
		    $count++;
	    }
    }
}


#####################################################################
# dump a parsed IDL structure back into an IDL file
sub Dump($)
{
    my($idl) = shift;
    $tab_depth = 0;

    $res = "/* header auto-generated by pidl */\n\n";
    foreach my $x (@{$idl}) {
	($x->{TYPE} eq "INTERFACE") && 
	    DumpInterface($x);
    }
    return $res;
}

1;