18df78f90d7cf9291142141162779b87cc9e48dd
[samba.git] / source4 / build / pidl / com_header.pm
1 # COM Header generation
2 # (C) 2005 Jelmer Vernooij <jelmer@samba.org>
3
4 package COMHeader;
5
6 use typelist;
7
8 use strict;
9
10 sub GetArgumentProtoList($)
11 {
12         my $f = shift;
13         my $res = "";
14
15         foreach my $a (@{$f->{ELEMENTS}}) {
16
17                 $res .= ", " . typelist::mapType($a) . " ";
18
19                 my $l = $a->{POINTERS};
20                 $l-- if ($a->{TYPE} eq "string");
21                 foreach my $i (1..$l) {
22                         $res .= "*";
23                 }
24
25                 if (defined $a->{ARRAY_LEN} && 
26                 !util::is_constant($a->{ARRAY_LEN}) &&
27                 !$a->{POINTERS}) {
28                         $res .= "*";
29                 }
30                 $res .= $a->{NAME};
31                 if (defined $a->{ARRAY_LEN} && util::is_constant($a->{ARRAY_LEN})) {
32                         $res .= "[$a->{ARRAY_LEN}]";
33                 }
34         }
35
36         return $res;
37 }
38
39 sub GetArgumentList($)
40 {
41         my $f = shift;
42         my $res = "";
43
44         foreach my $a (@{$f->{ELEMENTS}}) {
45                 $res .= ", $a->{NAME}";
46         }
47
48         return $res;
49 }
50
51 #####################################################################
52 # generate vtable structure for COM interface
53 sub HeaderVTable($)
54 {
55         my $interface = shift;
56         my $res;
57         $res .= "#define " . uc($interface->{NAME}) . "_METHODS \\\n";
58         if (defined($interface->{BASE})) {
59                 $res .= "\t" . uc($interface->{BASE} . "_METHODS") . "\\\n";
60         }
61
62         my $data = $interface->{DATA};
63         foreach my $d (@{$data}) {
64                 $res .= "\t" . typelist::mapScalarType($d->{RETURN_TYPE}) . " (*$d->{NAME}) (struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . GetArgumentProtoList($d) . ");\\\n" if ($d->{TYPE} eq "FUNCTION");
65         }
66         $res .= "\n";
67         $res .= "struct $interface->{NAME}_vtable {\n";
68         $res .= "\t" . uc($interface->{NAME}) . "_METHODS\n";
69         $res .= "};\n\n";
70
71         return $res;
72 }
73
74 sub ParseInterface($)
75 {
76         my $if = shift;
77         my $res;
78
79         $res .="\n\n/* $if->{NAME} */\n";
80
81         $res .="#define COM_" . uc($if->{NAME}) . "_UUID $if->{PROPERTIES}->{uuid}\n\n";
82
83         $res .="struct $if->{NAME}_vtable;\n\n";
84
85         $res .="struct $if->{NAME} {
86         struct com_context *ctx;
87         struct $if->{NAME}_vtable *vtable;
88         void *object_data;
89 };\n\n";
90
91         $res.=HeaderVTable($if);
92
93         foreach my $d (@{$if->{DATA}}) {
94                 next if ($d->{TYPE} ne "FUNCTION");
95
96                 $res .= "#define $if->{NAME}_$d->{NAME}(interface, mem_ctx" . GetArgumentList($d) . ") ";
97
98                 $res .= "((interface)->vtable->$d->{NAME}(interface, mem_ctx" . GetArgumentList($d) . "))";
99
100                 $res .="\n";
101         }
102
103         return $res;
104 }
105
106 sub ParseCoClass($)
107 {
108         my $c = shift;
109         my $res = "";
110         $res .= "#define CLSID_" . uc($c->{NAME}) . " $c->{PROPERTIES}->{uuid}\n";
111         if (util::has_property($c, "progid")) {
112                 $res .= "#define PROGID_" . uc($c->{NAME}) . " $c->{PROPERTIES}->{progid}\n";
113         }
114         $res .= "\n";
115         return $res;
116 }
117
118 sub Parse($)
119 {
120         my $idl = shift;
121         my $res = "";
122
123         foreach my $x (@{$idl})
124         {
125                 if ($x->{TYPE} eq "INTERFACE" && util::has_property($x, "object")) {
126                         $res.=ParseInterface($x);
127                 } 
128
129                 if ($x->{TYPE} eq "COCLASS") {
130                         $res.=ParseCoClass($x);
131                 }
132         }
133
134         return $res;
135 }
136
137 1;