r15260: Don't dereference NULL pointers to obtain array lengths - found by
[samba.git] / source / pidl / lib / Parse / Pidl / ODL.pm
1 ##########################################
2 # Converts ODL stuctures to IDL structures
3 # (C) 2004-2005 Jelmer Vernooij <jelmer@samba.org>
4
5 package Parse::Pidl::ODL;
6
7 use Parse::Pidl::Util qw(has_property);
8 use Parse::Pidl::Typelist qw(hasType getType);
9 use strict;
10
11 use vars qw($VERSION);
12 $VERSION = '0.01';
13
14 #####################################################################
15 # find an interface in an array of interfaces
16 sub get_interface($$)
17 {
18         my($if) = shift;
19         my($n) = shift;
20
21         foreach(@{$if}) {
22                 if($_->{NAME} eq $n) { return $_; }
23         }
24         
25         return 0;
26 }
27
28 sub FunctionAddObjArgs($)
29 {
30         my $e = shift;
31         
32         unshift(@{$e->{ELEMENTS}}, {
33                 'NAME' => 'ORPCthis',
34                 'POINTERS' => 0,
35                 'PROPERTIES' => { 'in' => '1' },
36                 'TYPE' => 'ORPCTHIS'
37         });
38         unshift(@{$e->{ELEMENTS}}, {
39                 'NAME' => 'ORPCthat',
40                 'POINTERS' => 0,
41                 'PROPERTIES' => { 'out' => '1' },
42                 'TYPE' => 'ORPCTHAT'
43         });
44 }
45
46 sub ReplaceInterfacePointers($)
47 {
48         my $e = shift;
49
50         foreach my $x (@{$e->{ELEMENTS}}) {
51                 next unless (hasType($x->{TYPE}));
52                 next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
53                 
54                 $x->{TYPE} = "MInterfacePointer";
55         }
56 }
57
58 # Add ORPC specific bits to an interface.
59 sub ODL2IDL($)
60 {
61         my $odl = shift;
62         
63         foreach my $x (@{$odl}) {
64                 # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
65                 # and replace interfacepointers with MInterfacePointer
66                 # for 'object' interfaces
67                 if (has_property($x, "object")) {
68                         foreach my $e (@{$x->{DATA}}) {
69                                 ($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
70                                 ReplaceInterfacePointers($e);
71                         }
72                         # Object interfaces use ORPC
73                         my @depends = ();
74                         if(has_property($x, "depends")) {
75                                 @depends = split /,/, $x->{PROPERTIES}->{depends};
76                         }
77                         push @depends, "orpc";
78                         $x->{PROPERTIES}->{depends} = join(',',@depends);
79                 }
80
81                 if ($x->{BASE}) {
82                         my $base = get_interface($odl, $x->{BASE});
83
84                         foreach my $fn (reverse @{$base->{DATA}}) {
85                                 next unless ($fn->{TYPE} eq "FUNCTION");
86                                 unshift (@{$x->{DATA}}, $fn);
87                                 push (@{$x->{INHERITED_FUNCTIONS}}, $fn->{NAME});
88                         }
89                 }
90         }
91
92         return $odl;
93 }
94
95 1;