Also check include dirs for IDL files.
[kai/samba-autobuild/.git] / pidl / lib / Parse / Pidl / ODL.pm
1 ##########################################
2 # Converts ODL stuctures to IDL structures
3 # (C) 2004-2005, 2008 Jelmer Vernooij <jelmer@samba.org>
4
5 package Parse::Pidl::ODL;
6
7 use Parse::Pidl qw(error);
8 use Parse::Pidl::IDL;
9 use Parse::Pidl::Util qw(has_property unmake_str);
10 use Parse::Pidl::Typelist qw(hasType getType);
11 use strict;
12
13 use vars qw($VERSION);
14 $VERSION = '0.01';
15
16 sub FunctionAddObjArgs($)
17 {
18         my $e = shift;
19         
20         unshift(@{$e->{ELEMENTS}}, {
21                 'NAME' => 'ORPCthis',
22                 'POINTERS' => 0,
23                 'PROPERTIES' => { 'in' => '1' },
24                 'TYPE' => 'ORPCTHIS',
25                 'FILE' => $e->{FILE},
26                 'LINE' => $e->{LINE}
27         });
28         unshift(@{$e->{ELEMENTS}}, {
29                 'NAME' => 'ORPCthat',
30                 'POINTERS' => 1,
31                 'PROPERTIES' => { 'out' => '1', 'ref' => '1' },
32                 'TYPE' => 'ORPCTHAT',
33                 'FILE' => $e->{FILE},
34                 'LINE' => $e->{LINE}
35         });
36 }
37
38 sub ReplaceInterfacePointers($)
39 {
40         my ($e) = @_;
41         foreach my $x (@{$e->{ELEMENTS}}) {
42                 next unless (hasType($x->{TYPE}));
43                 next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
44                 
45                 $x->{TYPE} = "MInterfacePointer";
46         }
47 }
48
49 # Add ORPC specific bits to an interface.
50 sub ODL2IDL
51 {
52         my ($odl, $basedir, $opt_incdirs) = (@_);
53         my $addedorpc = 0;
54         my $interfaces = {};
55
56         foreach my $x (@$odl) {
57                 if ($x->{TYPE} eq "IMPORT") {
58                         foreach my $idl_file (@{$x->{PATHS}}) {
59                                 $idl_file = unmake_str($idl_file);
60                                 my $idl_path = undef;
61                                 foreach ($basedir, @$opt_incdirs) {
62                                         if (-f "$_/$idl_file") {
63                                                 $idl_path = "$_/$idl_file";
64                                                 last;
65                                         }
66                                 }
67                                 unless ($idl_path) {
68                                         error($x, "Unable to open include file `$idl_file'");
69                                         next;
70                                 }
71                                 my $podl = Parse::Pidl::IDL::parse_file($idl_path, $opt_incdirs);
72                                 if (defined(@$podl)) {
73                                         require Parse::Pidl::Typelist;
74
75                                         Parse::Pidl::Typelist::LoadIdl($podl);
76                                         my $pidl = ODL2IDL($podl, $basedir, $opt_incdirs);
77
78                                         foreach my $y (@$pidl) {
79                                                 if ($y->{TYPE} eq "INTERFACE") {
80                                                         $interfaces->{$y->{NAME}} = $y;
81                                                 }
82                                         }
83                                 } else {
84                                         error($x, "Failed to parse $idl_path");
85                                 }
86                         }
87                 }
88
89                 if ($x->{TYPE} eq "INTERFACE") {
90                         $interfaces->{$x->{NAME}} = $x;
91                         # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
92                         # and replace interfacepointers with MInterfacePointer
93                         # for 'object' interfaces
94                         if (has_property($x, "object")) {
95                                 foreach my $e (@{$x->{DATA}}) {
96                                         ($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
97                                         ReplaceInterfacePointers($e);
98                                 }
99                                 $addedorpc = 1;
100                         }
101
102                         if ($x->{BASE}) {
103                                 my $base = $interfaces->{$x->{BASE}};
104
105                                 unless (defined($base)) {
106                                         error($x, "Undefined base interface `$x->{BASE}'");
107                                 } else {
108                                         foreach my $fn (reverse @{$base->{DATA}}) {
109                                                 next unless ($fn->{TYPE} eq "FUNCTION");
110                                                 push (@{$x->{INHERITED_FUNCTIONS}}, $fn);
111                                         }
112                                 }
113                         }
114                 }
115         }
116
117         unshift (@$odl, {
118                 TYPE => "IMPORT", 
119                 PATHS => [ "\"orpc.idl\"" ],
120                 FILE => undef,
121                 LINE => undef
122         }) if ($addedorpc);
123
124
125         return $odl;
126 }
127
128 1;