From ce74988dc831d856a94b341d7df3501932b1c43c Mon Sep 17 00:00:00 2001 From: Andrew Tridgell Date: Thu, 14 Dec 2000 04:09:29 +0000 Subject: first version (This used to be commit 14135ed6bbff54d7b493f9be7748c2ad7440a97b) --- source4/build/pidl/dump.pm | 166 ++++++++++++++++++++++++++++++++++++++++++++ source4/build/pidl/idl.gram | 135 +++++++++++++++++++++++++++++++++++ source4/build/pidl/pidl.pl | 95 +++++++++++++++++++++++++ source4/build/pidl/util.pm | 128 ++++++++++++++++++++++++++++++++++ 4 files changed, 524 insertions(+) create mode 100644 source4/build/pidl/dump.pm create mode 100644 source4/build/pidl/idl.gram create mode 100755 source4/build/pidl/pidl.pl create mode 100644 source4/build/pidl/util.pm (limited to 'source4/build/pidl') diff --git a/source4/build/pidl/dump.pm b/source4/build/pidl/dump.pm new file mode 100644 index 0000000000..4d679c0653 --- /dev/null +++ b/source4/build/pidl/dump.pm @@ -0,0 +1,166 @@ +package IdlDump; + +use Data::Dumper; + +my($res); + +##################################################################### +# dump a properties list +sub DumpProperties($) +{ + my($props) = shift; + 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; + (defined $element->{PROPERTIES}) && DumpProperties($element->{PROPERTIES}); + DumpType($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}]"); +} + +##################################################################### +# dump a struct +sub DumpStruct($) +{ + my($struct) = shift; + $res .= "struct {\n"; + if (defined $struct->{ELEMENTS}) { + foreach my $e (@{$struct->{ELEMENTS}}) { + DumpElement($e); + $res .= ";\n"; + } + } + $res .= "}"; +} + + +##################################################################### +# dump a union element +sub DumpUnionElement($) +{ + my($element) = shift; + $res .= "[case($element->{CASE})] "; + DumpElement($element->{DATA}); + $res .= ";\n"; +} + +##################################################################### +# dump a union +sub DumpUnion($) +{ + my($union) = shift; + (defined $union->{PROPERTIES}) && DumpProperties($union->{PROPERTIES}); + $res .= "union {\n"; + foreach my $e (@{$union->{DATA}}) { + DumpUnionElement($e); + } + $res .= "}"; +} + +##################################################################### +# dump a type +sub DumpType($) +{ + my($data) = shift; + if (ref($data) eq "HASH") { + ($data->{TYPE} eq "STRUCT") && + DumpStruct($data); + ($data->{TYPE} eq "UNION") && + DumpUnion($data); + } else { + $res .= "$data"; + } +} + +##################################################################### +# dump a typedef +sub DumpTypedef($) +{ + my($typedef) = shift; + $res .= "typedef "; + DumpType($typedef->{DATA}); + $res .= " $typedef->{NAME};\n\n"; +} + +##################################################################### +# dump a typedef +sub DumpFunction($) +{ + my($function) = shift; + my($first) = 1; + DumpType($function->{RETURN_TYPE}); + $res .= " $function->{NAME}(\n"; + for my $d (@{$function->{DATA}}) { + $first || ($res .= ",\n"); $first = 0; + DumpElement($d); + } + $res .= "\n);\n\n"; +} + +##################################################################### +# dump a module header +sub DumpModuleHeader($) +{ + my($header) = shift; + my($data) = $header->{DATA}; + my($first) = 1; + $res .= "[\n"; + foreach my $k (keys %{$data}) { + $first || ($res .= ",\n"); $first = 0; + $res .= "$k($data->{$k})"; + } + $res .= "\n]\n"; +} + +##################################################################### +# dump the interface definitions +sub DumpInterface($) +{ + my($interface) = shift; + my($data) = $interface->{DATA}; + $res .= "interface $interface->{NAME}\n{\n"; + foreach my $d (@{$data}) { + ($d->{TYPE} eq "TYPEDEF") && + DumpTypedef($d); + ($d->{TYPE} eq "FUNCTION") && + DumpFunction($d); + } + $res .= "}\n"; +} + + +##################################################################### +# dump a parsed IDL structure back into an IDL file +sub Dump($) +{ + my($idl) = shift; + $res = "/* Dumped by pidl */\n\n"; + foreach my $x (@{$idl}) { + ($x->{TYPE} eq "MODULEHEADER") && + DumpModuleHeader($x); + ($x->{TYPE} eq "INTERFACE") && + DumpInterface($x); + } + return $res; +} + +1; diff --git a/source4/build/pidl/idl.gram b/source4/build/pidl/idl.gram new file mode 100644 index 0000000000..00b3952ba2 --- /dev/null +++ b/source4/build/pidl/idl.gram @@ -0,0 +1,135 @@ +{ + use util; +} + +idl: cpp_prefix(s?) module_header interface + { [$item{module_header}, $item{interface}] } + | + +module_header: '[' module_param(s /,/) ']' + {{ + "TYPE" => "MODULEHEADER", + "DATA" => util::FlattenHash($item[3]) + }} + | + +module_param: identifier '(' text ')' + {{ "$item{identifier}" => "$item{text}" }} + | + +interface: 'interface' identifier '{' definition(s?) '}' + {{ + "TYPE" => "INTERFACE", + "NAME" => $item{identifier}, + "DATA" => $item[5] + }} + | + +definition : typedef { $item[1] } + | function { $item[1] } + +typedef : 'typedef' type identifier array_len(?) ';' + {{ + "TYPE" => "TYPEDEF", + "NAME" => $item{identifier}, + "DATA" => $item{type}, + "ARRAY_LEN" => $item{array_len}[0] + }} + | + +struct: 'struct' '{' element_list1(?) '}' + {{ + "TYPE" => "STRUCT", + "ELEMENTS" => util::FlattenArray($item{element_list1}) + }} + | + +union: property_list(s?) 'union' '{' union_element(s?) '}' + {{ + "TYPE" => "UNION", + "PROPERTIES" => util::FlattenArray($item[1]), + "DATA" => $item{union_element} + }} + | + +union_element: '[case(' constant ')]' base_element ';' + {{ + "TYPE" => "UNION_ELEMENT", + "CASE" => $item{constant}, + "DATA" => $item{base_element} + }} + | 'case(' constant ')' base_element ';' + {{ + "TYPE" => "UNION_ELEMENT", + "CASE" => $item{constant}, + "DATA" => $item{base_element} + }} + +base_element: property_list(s?) type pointer(s?) identifier array_len(?) + {{ + "NAME" => $item{identifier}, + "TYPE" => $item{type}, + "PROPERTIES" => util::FlattenArray($item[1]), + "POINTERS" => $#{$item{pointer}}==-1?undef:$#{$item{pointer}}+1, + "ARRAY_LEN" => $item{array_len}[0] + }} + | + +array_len: '[' constant ']' + { $item{constant} } + | + +element_list1: base_element(s? /;/) ';' + { $item[1] } + +element_list2: 'void' + | base_element(s? /,/) + { $item[1] } + +pointer: '*' + +property_list: '[' property(s /,/) ']' + { $item[3] } + | + +property: 'unique' + | 'in,out' + | 'in' + | 'out' + | 'ref' + | 'context_handle' + | 'string' + | 'byte_count_pointer' '(' expression ')' {{ "$item[1]" => "$item{expression}" }} + | 'size_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }} + | 'length_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }} + | 'switch_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }} + | 'switch_type' '(' type ')' {{ "$item[1]" => $item{type} }} + +identifier: /[\w?]+/ + +expression: /[\w?\/+*-]+/ + +function : type identifier '(' element_list2 ');' + {{ + "TYPE" => "FUNCTION", + "NAME" => $item{identifier}, + "RETURN_TYPE" => $item{type}, + "DATA" => $item{element_list2} + }} + | + +type : + 'unsigned' type { "$item[1] $item[2]" } + | 'long' { $item[1] } + | 'string' { $item[1] } + | 'wchar_t' { $item[1] } + | struct { $item[1] } + | union { $item[1] } + | identifier { $item[1] } + | + +text: /[\w\s.?-]*/ + +constant: /-?\d+/ + +cpp_prefix: '#' /.*/ diff --git a/source4/build/pidl/pidl.pl b/source4/build/pidl/pidl.pl new file mode 100755 index 0000000000..45aec06c02 --- /dev/null +++ b/source4/build/pidl/pidl.pl @@ -0,0 +1,95 @@ +#!/usr/bin/perl -w + +################################################### +# package to parse IDL files and generate code for +# rpc functions in Samba +# Copyright tridge@samba.org 2000 +# released under the GNU GPL + +use strict; +use Getopt::Long; +use Data::Dumper; +use Parse::RecDescent; +use dump; +use util; + +my($opt_help) = 0; +my($opt_parse) = 0; +my($opt_dump) = 0; +my($opt_diff) = 0; + +##################################################################### +# parse an IDL file returning a structure containing all the data +sub IdlParse($) +{ + # this autoaction allows us to handle simple nodes without an action +# $::RD_TRACE = 1; + $::RD_AUTOACTION = q { + $#item==1 && ref($item[1]) eq "" ? + $item[1] : + "XX_" . $item[0] . "_XX[$#item]" }; + my($filename) = shift; + my($grammer) = util::FileLoad("idl.gram"); + my($parser) = Parse::RecDescent->new($grammer); + undef $/; + my($idl) = $parser->idl(`cpp $filename`); + util::CleanData($idl); + return $idl; +} + + +######################################### +# display help text +sub ShowHelp() +{ + print " + perl IDL parser and code generator + Copyright tridge\@samba.org + + Usage: pidl.pl [options] + + Options: + --help this help page + --parse parse a idl file to a .pidl file + --dump dump a pidl file back to idl + --diff run diff on the idl and dumped output + "; + exit(0); +} + +# main program +GetOptions ( + 'help|h|?' => \$opt_help, + 'parse' => \$opt_parse, + 'dump' => \$opt_dump, + 'diff' => \$opt_diff + ); + +my($idl_file) = shift; +die "ERROR: You must specify an idl file to process" unless ($idl_file); + +my($pidl_file) = util::ChangeExtension($idl_file, "pidl"); + +if ($opt_help) { + ShowHelp(); +} + +if ($opt_parse) { + print "Parsing $idl_file\n"; + my($idl) = IdlParse($idl_file); + print "Saving $pidl_file\n"; + util::SaveStructure($pidl_file, $idl) || die "Failed to save $pidl_file"; +} + +if ($opt_dump) { + my($idl) = util::LoadStructure($pidl_file); + print IdlDump::Dump($idl); +} + +if ($opt_diff) { + my($idl) = util::LoadStructure($pidl_file); + my($tempfile) = util::ChangeExtension($idl_file, "tmp"); + util::FileSave($tempfile, IdlDump::Dump($idl)); + system("diff -wu $idl_file $tempfile"); + unlink($tempfile); +} diff --git a/source4/build/pidl/util.pm b/source4/build/pidl/util.pm new file mode 100644 index 0000000000..c0182bb79e --- /dev/null +++ b/source4/build/pidl/util.pm @@ -0,0 +1,128 @@ +################################################### +# utility functions to support pidl +# Copyright tridge@samba.org 2000 +# released under the GNU GPL +package util; + +use Data::Dumper; + + +##################################################################### +# flatten an array of arrays into a single array +sub FlattenArray($) +{ + my $a = shift; + my @b; + for my $d (@{$a}) { + for my $d1 (@{$d}) { + push(@b, $d1); + } + } + return \@b; +} + +##################################################################### +# flatten an array of hashes into a single hash +sub FlattenHash($) +{ + my $a = shift; + my %b; + for my $d (@{$a}) { + for my $k (%{$d}) { + $b{$k} = $d->{$k}; + } + } + return \%b; +} + + +##################################################################### +# traverse a perl data structure removing any empty arrays or +# hashes and any hash elements that map to undef +sub CleanData($) +{ + sub CleanData($); + my($v) = shift; + if (ref($v) eq "ARRAY") { + foreach my $i (0 .. $#{$v}) { + CleanData($v->[$i]); + if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { delete($v->[$i]); next; } + } + # this removes any undefined elements from the array + @{$v} = grep { defined $_ } @{$v}; + } elsif (ref($v) eq "HASH") { + foreach my $x (keys %{$v}) { + CleanData($v->{$x}); + if (!defined $v->{$x}) { delete($v->{$x}); next; } + if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; } + } + } +} + + +##################################################################### +# return the modification time of a file +sub FileModtime($) +{ + my($filename) = shift; + return (stat($filename))[9]; +} + + +##################################################################### +# read a file into a string +sub FileLoad($) +{ + my($filename) = shift; + local(*INPUTFILE); + open(INPUTFILE, $filename) || die "can't open $filename"; + my($saved_delim) = $/; + undef $/; + my($data) = ; + close(INPUTFILE); + $/ = $saved_delim; + return $data; +} + +##################################################################### +# write a string into a file +sub FileSave($$) +{ + my($filename) = shift; + my($v) = shift; + local(*FILE); + open(FILE, ">$filename") || die "can't open $filename"; + print FILE $v; + close(FILE); +} + +##################################################################### +# return a filename with a changed extension +sub ChangeExtension($$) +{ + my($fname) = shift; + my($ext) = shift; + if ($fname =~ /^(.*?)\.(.*?)$/) { + return "$1.$ext"; + } + return "$fname.$ext"; +} + +##################################################################### +# save a data structure into a file +sub SaveStructure($$) +{ + my($filename) = shift; + my($v) = shift; + FileSave($filename, Dumper($v)); +} + +##################################################################### +# load a data structure from a file (as saved with SaveStructure) +sub LoadStructure($) +{ + return eval FileLoad(shift); +} + + +1; -- cgit