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