mirror of
https://github.com/samba-team/samba.git
synced 2025-01-10 01:18:15 +03:00
Andrew Tridgell
commit
ce74988dc8
166
source4/build/pidl/dump.pm
Normal file
166
source4/build/pidl/dump.pm
Normal file
@ -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;
|
||||
135
source4/build/pidl/idl.gram
Normal file
135
source4/build/pidl/idl.gram
Normal file
@ -0,0 +1,135 @@
|
||||
{
|
||||
use util;
|
||||
}
|
||||
|
||||
idl: cpp_prefix(s?) module_header interface
|
||||
{ [$item{module_header}, $item{interface}] }
|
||||
| <error>
|
||||
|
||||
module_header: '[' <commit> module_param(s /,/) ']'
|
||||
{{
|
||||
"TYPE" => "MODULEHEADER",
|
||||
"DATA" => util::FlattenHash($item[3])
|
||||
}}
|
||||
| <error?>
|
||||
|
||||
module_param: identifier '(' text ')'
|
||||
{{ "$item{identifier}" => "$item{text}" }}
|
||||
| <error>
|
||||
|
||||
interface: 'interface' <commit> identifier '{' definition(s?) '}'
|
||||
{{
|
||||
"TYPE" => "INTERFACE",
|
||||
"NAME" => $item{identifier},
|
||||
"DATA" => $item[5]
|
||||
}}
|
||||
| <error?>
|
||||
|
||||
definition : typedef { $item[1] }
|
||||
| function { $item[1] }
|
||||
|
||||
typedef : 'typedef' <commit> type identifier array_len(?) ';'
|
||||
{{
|
||||
"TYPE" => "TYPEDEF",
|
||||
"NAME" => $item{identifier},
|
||||
"DATA" => $item{type},
|
||||
"ARRAY_LEN" => $item{array_len}[0]
|
||||
}}
|
||||
| <error?>
|
||||
|
||||
struct: 'struct' <commit> '{' element_list1(?) '}'
|
||||
{{
|
||||
"TYPE" => "STRUCT",
|
||||
"ELEMENTS" => util::FlattenArray($item{element_list1})
|
||||
}}
|
||||
| <error?>
|
||||
|
||||
union: property_list(s?) 'union' <commit> '{' union_element(s?) '}'
|
||||
{{
|
||||
"TYPE" => "UNION",
|
||||
"PROPERTIES" => util::FlattenArray($item[1]),
|
||||
"DATA" => $item{union_element}
|
||||
}}
|
||||
| <error?>
|
||||
|
||||
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]
|
||||
}}
|
||||
| <error>
|
||||
|
||||
array_len: '[' <commit> constant ']'
|
||||
{ $item{constant} }
|
||||
| <error?>
|
||||
|
||||
element_list1: base_element(s? /;/) ';'
|
||||
{ $item[1] }
|
||||
|
||||
element_list2: 'void'
|
||||
| base_element(s? /,/)
|
||||
{ $item[1] }
|
||||
|
||||
pointer: '*'
|
||||
|
||||
property_list: '[' <commit> property(s /,/) ']'
|
||||
{ $item[3] }
|
||||
| <error?>
|
||||
|
||||
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 '(' <commit> element_list2 ');'
|
||||
{{
|
||||
"TYPE" => "FUNCTION",
|
||||
"NAME" => $item{identifier},
|
||||
"RETURN_TYPE" => $item{type},
|
||||
"DATA" => $item{element_list2}
|
||||
}}
|
||||
| <error?>
|
||||
|
||||
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] }
|
||||
| <error>
|
||||
|
||||
text: /[\w\s.?-]*/
|
||||
|
||||
constant: /-?\d+/
|
||||
|
||||
cpp_prefix: '#' /.*/
|
||||
95
source4/build/pidl/pidl.pl
Executable file
95
source4/build/pidl/pidl.pl
Executable file
@ -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] <idlfile>
|
||||
|
||||
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);
|
||||
}
|
||||
128
source4/build/pidl/util.pm
Normal file
128
source4/build/pidl/util.pm
Normal file
@ -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) = <INPUTFILE>;
|
||||
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;
|
||||
Loading…
Reference in New Issue
Block a user