sin/samba-mirror
1
0
Fork 0
mirror of https://github.com/samba-team/samba.git synced 2025-02-18 17:57:55 +03:00
Code

Initial version of ethereal parser generator. Works with test.idl

Browse Source 
but not much else!
This commit is contained in:
Tim Potter -
parent e1f191a9dc
commit 84fe4a000c
1 changed files with 216 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

216
source/build/pidl/eparser.pm Normal file
View File

@ -0,0 +1,216 @@
###################################################
# Ethereal parser generator for IDL structures
# Copyright tpot@samba.org 2001
# Copyright tridge@samba.org 2000
# released under the GNU GPL
package IdlEParser;
use Data::Dumper;
my($res);
#####################################################################
# parse a properties list
sub ParseProperties($)
{
my($props) = shift;
foreach my $d (@{$props}) {
if (ref($d) ne "HASH") {
$res .= "[$d] ";
} else {
foreach my $k (keys %{$d}) {
$res .= "[$k($d->{$k})] ";
}
}
}
}
#####################################################################
# parse a structure element
sub ParseElement($)
{
my($element) = shift;
(defined $element->{PROPERTIES}) && ParseProperties($element->{PROPERTIES});
ParseType($element->{TYPE});
$res .= " ";
if ($element->{POINTERS}) {
for (my($i)=0; $i < $element->{POINTERS}; $i++) {
$res .= "*";
}
}
$res .= "$element->{NAME}";
(defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]");
}
#####################################################################
# parse a struct
sub ParseStruct($)
{
my($struct) = shift;
if (defined $struct->{ELEMENTS}) {
# Parse scalars
$res .= "\t/* Parse scalars */\n\n";
foreach my $e (@{$struct->{ELEMENTS}}) {
if (defined $e->{POINTERS}) {
$res .= "\tptr_$e->{NAME} = prs_$e->{TYPE}_ptr(); /* $e->{NAME} */\n";
} else {
$res .= "\tprs_$e->{TYPE}(); /* $e->{NAME} */\n";
}
}
# Parse buffers
$res .= "\n\t/* Parse buffers */\n\n";
foreach my $e (@{$struct->{ELEMENTS}}) {
$res .= "\tif (ptr_$e->{NAME})\n\t\tprs_$e->{TYPE}(); /* $e->{NAME} */\n\n",
if (defined $e->{POINTERS});
}
}
}
#####################################################################
# parse a union element
sub ParseUnionElement($)
{
my($element) = shift;
$res .= "[case($element->{CASE})] ";
ParseElement($element->{DATA});
$res .= ";\n";
}
#####################################################################
# parse a union
sub ParseUnion($)
{
my($union) = shift;
(defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
$res .= "union {\n";
foreach my $e (@{$union->{DATA}}) {
ParseUnionElement($e);
}
$res .= "}";
}
#####################################################################
# parse a type
sub ParseType($)
{
my($data) = shift;
if (ref($data) eq "HASH") {
($data->{TYPE} eq "STRUCT") &&
ParseStruct($data);
($data->{TYPE} eq "UNION") &&
ParseUnion($data);
} else {
$res .= "$data";
}
}
#####################################################################
# parse a typedef
sub ParseTypedef($)
{
my($typedef) = shift;
$res .= "void prs_$typedef->{NAME}(void)\n{\n";
ParseType($typedef->{DATA});
$res .= "}\n\n";
}
#####################################################################
# parse a function
sub ParseFunctionArg($$)
{
my($arg) = shift;
my($io) = shift; # "in" or "out"
if (@{$arg->{PROPERTIES}}[0] =~ /$io/) {
my $is_pol = 0;
# Arg is a policy handle - no pointer
foreach my $prop (@{$arg->{PROPERTIES}}) {
if ($prop =~ /context_handle/) {
$res .= "\tprs_policy_hnd();";
$is_pol = 1;
}
}
if (!$is_pol) {
if ($arg->{POINTERS}) {
$res .= "\tptr_$arg->{NAME} = prs_ptr();\n";
$res .= "\tif (ptr_$arg->{NAME})\n\t\tprs_$arg->{TYPE}();";
} else {
$res .= "\tprs_$arg->{TYPE}();";
}
}
$res .= "\t/* $arg->{NAME} */\n";
}
}
#####################################################################
# parse a function
sub ParseFunction($)
{
my($function) = shift;
# Input function
$res .= "void $function->{NAME}_q(void)\n{\n";
foreach my $arg (@{$function->{DATA}}) {
ParseFunctionArg($arg, "in");
}
$res .= "}\n\n";
# Output function
$res .= "void $function->{NAME}_r(void)\n{\n";
foreach my $arg (@{$function->{DATA}}) {
ParseFunctionArg($arg, "out");
}
$res .= "\tprs_$function->{RETURN_TYPE}();\t/* Return value */\n";
$res .= "}\n\n";
}
#####################################################################
# parse the interface definitions
sub ParseInterface($)
{
my($interface) = shift;
my($data) = $interface->{DATA};
foreach my $d (@{$data}) {
($d->{TYPE} eq "TYPEDEF") &&
ParseTypedef($d);
($d->{TYPE} eq "FUNCTION") &&
ParseFunction($d);
}
}
#####################################################################
# parse a parsed IDL structure back into an IDL file
sub Parse($)
{
my($idl) = shift;
$res = "/* parser auto-generated by pidl */\n\n";
foreach my $x (@{$idl}) {
($x->{TYPE} eq "INTERFACE") &&
ParseInterface($x);
}
return $res;
}
1;