1# COM Header generation 2# (C) 2005 Jelmer Vernooij <jelmer@samba.org> 3 4package Parse::Pidl::Samba4::COM::Header; 5 6use Parse::Pidl::Typelist qw(mapTypeName); 7use Parse::Pidl::Util qw(has_property is_constant); 8 9use vars qw($VERSION); 10$VERSION = '0.01'; 11 12use strict; 13 14sub GetArgumentProtoList($) 15{ 16 my $f = shift; 17 my $res = ""; 18 19 foreach my $a (@{$f->{ELEMENTS}}) { 20 21 $res .= ", " . mapTypeName($a->{TYPE}) . " "; 22 23 my $l = $a->{POINTERS}; 24 $l-- if (Parse::Pidl::Typelist::scalar_is_reference($a->{TYPE})); 25 foreach my $i (1..$l) { 26 $res .= "*"; 27 } 28 29 if (defined $a->{ARRAY_LEN}[0] && !is_constant($a->{ARRAY_LEN}[0]) && 30 !$a->{POINTERS}) { 31 $res .= "*"; 32 } 33 $res .= $a->{NAME}; 34 if (defined $a->{ARRAY_LEN}[0] && is_constant($a->{ARRAY_LEN}[0])) { 35 $res .= "[$a->{ARRAY_LEN}[0]]"; 36 } 37 } 38 39 return $res; 40} 41 42sub GetArgumentList($) 43{ 44 my $f = shift; 45 my $res = ""; 46 47 foreach (@{$f->{ELEMENTS}}) { $res .= ", $_->{NAME}"; } 48 49 return $res; 50} 51 52##################################################################### 53# generate vtable structure for COM interface 54sub HeaderVTable($) 55{ 56 my $interface = shift; 57 my $res; 58 $res .= "#define " . uc($interface->{NAME}) . "_METHODS \\\n"; 59 if (defined($interface->{BASE})) { 60 $res .= "\t" . uc($interface->{BASE} . "_METHODS") . "\\\n"; 61 } 62 63 my $data = $interface->{DATA}; 64 foreach my $d (@{$data}) { 65 $res .= "\t" . mapTypeName($d->{RETURN_TYPE}) . " (*$d->{NAME}) (struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . GetArgumentProtoList($d) . ");\\\n" if ($d->{TYPE} eq "FUNCTION"); 66 } 67 $res .= "\n"; 68 $res .= "struct $interface->{NAME}_vtable {\n"; 69 $res .= "\tstruct GUID iid;\n"; 70 $res .= "\t" . uc($interface->{NAME}) . "_METHODS\n"; 71 $res .= "};\n\n"; 72 73 return $res; 74} 75 76sub ParseInterface($) 77{ 78 my $if = shift; 79 my $res; 80 81 $res .= "\n#ifndef _$if->{NAME}_\n"; 82 $res .= "#define _$if->{NAME}_\n"; 83 84 $res .="\n\n/* $if->{NAME} */\n"; 85 86 $res .="#define COM_" . uc($if->{NAME}) . "_UUID $if->{PROPERTIES}->{uuid}\n\n"; 87 88 $res .="struct $if->{NAME}_vtable;\n\n"; 89 90 $res .="struct $if->{NAME} { 91 struct OBJREF obj; 92 struct com_context *ctx; 93 struct $if->{NAME}_vtable *vtable; 94 void *object_data; 95};\n\n"; 96 97 $res.=HeaderVTable($if); 98 99 foreach my $d (@{$if->{DATA}}) { 100 next if ($d->{TYPE} ne "FUNCTION"); 101 102 $res .= "#define $if->{NAME}_$d->{NAME}(interface, mem_ctx" . GetArgumentList($d) . ") "; 103 104 $res .= "((interface)->vtable->$d->{NAME}(interface, mem_ctx" . GetArgumentList($d) . "))"; 105 106 $res .="\n"; 107 } 108 109 $res .= "#endif\n"; 110 111 return $res; 112} 113 114sub ParseCoClass($) 115{ 116 my ($c) = @_; 117 my $res = ""; 118 $res .= "#define CLSID_" . uc($c->{NAME}) . " $c->{PROPERTIES}->{uuid}\n"; 119 if (has_property($c, "progid")) { 120 $res .= "#define PROGID_" . uc($c->{NAME}) . " $c->{PROPERTIES}->{progid}\n"; 121 } 122 $res .= "\n"; 123 return $res; 124} 125 126sub Parse($$) 127{ 128 my ($idl,$ndr_header) = @_; 129 my $res = ""; 130 my $has_obj = 0; 131 132 $res .= "#include \"librpc/gen_ndr/orpc.h\"\n" . 133 "#include \"$ndr_header\"\n\n"; 134 135 foreach (@{$idl}) 136 { 137 if ($_->{TYPE} eq "INTERFACE" && has_property($_, "object")) { 138 $res .="struct $_->{NAME};\n"; 139 $has_obj = 1; 140 } 141 } 142 143 foreach (@{$idl}) 144 { 145 if ($_->{TYPE} eq "INTERFACE" && has_property($_, "object")) { 146 $res.=ParseInterface($_); 147 $has_obj = 1; 148 } 149 150 if ($_->{TYPE} eq "COCLASS") { 151 $res.=ParseCoClass($_); 152 $has_obj = 1; 153 } 154 } 155 156 return $res if ($has_obj); 157 return undef; 158} 159 1601; 161