summaryrefslogtreecommitdiff
path: root/pidl/lib/Parse/Pidl/ODL.pm
diff options
context:
space:
mode:
Diffstat (limited to 'pidl/lib/Parse/Pidl/ODL.pm')
-rw-r--r--pidl/lib/Parse/Pidl/ODL.pm117
1 files changed, 117 insertions, 0 deletions
diff --git a/pidl/lib/Parse/Pidl/ODL.pm b/pidl/lib/Parse/Pidl/ODL.pm
new file mode 100644
index 0000000000..ad8c76f622
--- /dev/null
+++ b/pidl/lib/Parse/Pidl/ODL.pm
@@ -0,0 +1,117 @@
+##########################################
+# Converts ODL stuctures to IDL structures
+# (C) 2004-2005, 2008 Jelmer Vernooij <jelmer@samba.org>
+
+package Parse::Pidl::ODL;
+
+use Parse::Pidl qw(error);
+use Parse::Pidl::IDL;
+use Parse::Pidl::Util qw(has_property unmake_str);
+use Parse::Pidl::Typelist qw(hasType getType);
+use strict;
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+sub FunctionAddObjArgs($)
+{
+ my $e = shift;
+
+ unshift(@{$e->{ELEMENTS}}, {
+ 'NAME' => 'ORPCthis',
+ 'POINTERS' => 0,
+ 'PROPERTIES' => { 'in' => '1' },
+ 'TYPE' => 'ORPCTHIS',
+ 'FILE' => $e->{FILE},
+ 'LINE' => $e->{LINE}
+ });
+ unshift(@{$e->{ELEMENTS}}, {
+ 'NAME' => 'ORPCthat',
+ 'POINTERS' => 1,
+ 'PROPERTIES' => { 'out' => '1', 'ref' => '1' },
+ 'TYPE' => 'ORPCTHAT',
+ 'FILE' => $e->{FILE},
+ 'LINE' => $e->{LINE}
+ });
+}
+
+sub ReplaceInterfacePointers($)
+{
+ my ($e) = @_;
+ foreach my $x (@{$e->{ELEMENTS}}) {
+ next unless (hasType($x->{TYPE}));
+ next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
+
+ $x->{TYPE} = "MInterfacePointer";
+ }
+}
+
+# Add ORPC specific bits to an interface.
+sub ODL2IDL
+{
+ my ($odl, $basedir, $opt_incdirs) = (@_);
+ my $addedorpc = 0;
+ my $interfaces = {};
+
+ foreach my $x (@$odl) {
+ if ($x->{TYPE} eq "IMPORT") {
+ foreach my $idl_file (@{$x->{PATHS}}) {
+ $idl_file = unmake_str($idl_file);
+ my $podl = Parse::Pidl::IDL::parse_file("$basedir/$idl_file", $opt_incdirs);
+ if (defined(@$podl)) {
+ require Parse::Pidl::Typelist;
+
+ Parse::Pidl::Typelist::LoadIdl($podl);
+ my $pidl = ODL2IDL($podl, $basedir, $opt_incdirs);
+
+ foreach my $y (@$pidl) {
+ if ($y->{TYPE} eq "INTERFACE") {
+ $interfaces->{$y->{NAME}} = $y;
+ }
+ }
+ } else {
+ error($x, "Failed to parse $idl_file");
+ }
+ }
+ }
+
+ if ($x->{TYPE} eq "INTERFACE") {
+ $interfaces->{$x->{NAME}} = $x;
+ # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
+ # and replace interfacepointers with MInterfacePointer
+ # for 'object' interfaces
+ if (has_property($x, "object")) {
+ foreach my $e (@{$x->{DATA}}) {
+ ($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
+ ReplaceInterfacePointers($e);
+ }
+ $addedorpc = 1;
+ }
+
+ if ($x->{BASE}) {
+ my $base = $interfaces->{$x->{BASE}};
+
+ unless (defined($base)) {
+ error($x, "Undefined base interface `$x->{BASE}'");
+ } else {
+ foreach my $fn (reverse @{$base->{DATA}}) {
+ next unless ($fn->{TYPE} eq "FUNCTION");
+ push (@{$x->{INHERITED_FUNCTIONS}}, $fn);
+ }
+ }
+ }
+ }
+ }
+
+ unshift (@$odl, {
+ TYPE => "IMPORT",
+ PATHS => [ "\"orpc.idl\"" ],
+ FILE => undef,
+ LINE => undef
+ }) if ($addedorpc);
+
+
+ return $odl;
+}
+
+1;