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