--- /dev/null
+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;
--- /dev/null
+{
+ 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: '#' /.*/
--- /dev/null
+#!/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);
+}
--- /dev/null
+###################################################
+# 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;
git.samba.org / kai / samba.git / commitdiff