1 ###################################################
2 # Samba4 parser generator for IDL structures
3 # Copyright jelmer@samba.org 2005
4 # released under the GNU GPL
6 package Parse
::Pidl
::Typelist
;
10 @EXPORT_OK = qw(hasType getType resolveType mapTypeName scalar_is_reference expandAlias
11 mapScalarType addType typeIs is_signed is_scalar enum_type_fn
12 bitmap_type_fn mapType typeHasBody is_fixed_size_scalar
14 use vars
qw($VERSION);
17 use Parse::Pidl::Util qw(has_property);
22 my @reference_scalars = (
23 "string", "string_array", "nbt_string", "dns_string",
24 "wrepl_nbt_name", "dnsp_name", "dnsp_string",
25 "ipv4address", "ipv6address"
28 my @non_fixed_size_scalars = (
29 "string", "string_array", "nbt_string", "dns_string",
30 "wrepl_nbt_name", "dnsp_name", "dnsp_string"
33 # a list of known scalar types
40 "uint16" => "uint16_t",
41 "int1632" => "int16_t",
42 "uint1632" => "uint16_t",
44 "uint32" => "uint32_t",
45 "int3264" => "int32_t",
46 "uint3264" => "uint32_t",
47 "hyper" => "uint64_t",
49 "udlong" => "uint64_t",
50 "udlongr" => "uint64_t",
53 "DATA_BLOB" => "DATA_BLOB",
54 "string" => "const char *",
55 "string_array" => "const char **",
60 "NTTIME_1sec" => "NTTIME",
61 "NTTIME_hyper" => "NTTIME",
63 "NTSTATUS" => "NTSTATUS",
64 "COMRESULT" => "COMRESULT",
65 "dns_string" => "const char *",
66 "nbt_string" => "const char *",
67 "wrepl_nbt_name"=> "struct nbt_name *",
68 "ipv4address" => "const char *",
69 "ipv6address" => "const char *",
70 "dnsp_name" => "const char *",
71 "dnsp_string" => "const char *",
75 "error_status_t" => "uint32",
76 "boolean8" => "uint8",
77 "boolean32" => "uint32",
86 "HRESULT" => "COMRESULT",
93 return $aliases{$name} if defined($aliases{$name});
98 # map from a IDL type to a C header type
103 # it's a bug when a type is not in the list
104 # of known scalars or has no mapping
105 return $scalars{$name} if defined($scalars{$name});
107 die("Unknown scalar type $name");
113 $types{$t->{NAME
}} = $t;
120 if (not hasType
($ctype)) {
121 # assume struct typedef
122 return { TYPE
=> "TYPEDEF", NAME
=> $ctype, DATA
=> { TYPE
=> "STRUCT" } };
124 return getType
($ctype);
133 return ($t) if (ref($t) eq "HASH" and not defined($t->{NAME
}));
134 return undef if not hasType
($t);
135 return $types{$t->{NAME
}} if (ref($t) eq "HASH");
144 if (ref($t) eq "HASH") {
145 return 1 if ($t->{TYPE
} eq "TYPEDEF" and $t->{DATA
}->{TYPE
} eq $tt);
146 return 1 if ($t->{TYPE
} eq $tt);
149 if (hasType
($t) and getType
($t)->{TYPE
} eq "TYPEDEF") {
150 return typeIs
(getType
($t)->{DATA
}, $tt);
158 if (ref($t) eq "HASH") {
159 return 1 if (not defined($t->{NAME
}));
160 return 1 if (defined($types{$t->{NAME
}}) and
161 $types{$t->{NAME
}}->{TYPE
} eq $t->{TYPE
});
164 return 1 if defined($types{$t});
186 return 1 if (ref($type) eq "HASH" and
187 ($type->{TYPE
} eq "SCALAR" or $type->{TYPE
} eq "ENUM" or
188 $type->{TYPE
} eq "BITMAP"));
190 if (my $dt = getType
($type)) {
191 return is_scalar
($dt->{DATA
}) if ($dt->{TYPE
} eq "TYPEDEF");
192 return 1 if ($dt->{TYPE
} eq "SCALAR" or $dt->{TYPE
} eq "ENUM" or
193 $dt->{TYPE
} eq "BITMAP");
199 sub is_fixed_size_scalar
($)
203 return 0 unless is_scalar
($name);
204 return 0 if (grep(/^$name$/, @non_fixed_size_scalars));
208 sub scalar_is_reference
($)
212 return 1 if (grep(/^$name$/, @reference_scalars));
216 sub RegisterScalars
()
218 foreach (keys %scalars) {
222 BASEFILE
=> "<builtin>",
235 $enum->{TYPE
} eq "ENUM" or die("not an enum");
237 # for typedef enum { } we need to check $enum->{PARENT}
238 if (has_property
($enum, "enum8bit")) {
240 } elsif (has_property
($enum, "enum16bit")) {
242 } elsif (has_property
($enum, "v1_enum")) {
244 } elsif (has_property
($enum->{PARENT
}, "enum8bit")) {
246 } elsif (has_property
($enum->{PARENT
}, "enum16bit")) {
248 } elsif (has_property
($enum->{PARENT
}, "v1_enum")) {
254 sub bitmap_type_fn
($)
258 $bitmap->{TYPE
} eq "BITMAP" or die("not a bitmap");
260 if (has_property
($bitmap, "bitmap8bit")) {
262 } elsif (has_property
($bitmap, "bitmap16bit")) {
264 } elsif (has_property
($bitmap, "bitmap64bit")) {
275 if ($e->{TYPE
} eq "TYPEDEF") {
276 return 0 unless(defined($e->{DATA
}));
277 return typeHasBody
($e->{DATA
});
280 return defined($e->{ELEMENTS
});
288 return mapType
($t->{DATA
}, $n) if ($t->{TYPE
} eq "TYPEDEF");
289 return mapScalarType
($n) if ($t->{TYPE
} eq "SCALAR");
290 return "enum $n" if ($t->{TYPE
} eq "ENUM");
291 return "struct $n" if ($t->{TYPE
} eq "STRUCT" or $t->{TYPE
} eq "INTERFACE");
292 return "union $n" if ($t->{TYPE
} eq "UNION");
293 return mapScalarType
(bitmap_type_fn
($t)) if ($t->{TYPE
} eq "BITMAP");
294 return "struct $n" if ($t->{TYPE
} eq "PIPE");
295 die("Unknown type $t->{TYPE}");
301 return "void" unless defined($t);
303 $t = expandAlias
($t);
305 if ($dt = getType
($t)) {
306 return mapType
($dt, $dt->{NAME
});
307 } elsif (ref($t) eq "HASH" and defined($t->{NAME
})) {
308 return mapType
($t, $t->{NAME
});
319 my $basename = shift;
321 foreach my $x (@
{$idl}) {
322 next if $x->{TYPE
} ne "INTERFACE";
324 # DCOM interfaces can be types as well
329 BASEFILE
=> $basename,
330 }) if (has_property
($x, "object"));
332 foreach my $y (@
{$x->{DATA
}}) {
333 if ($y->{TYPE
} eq "TYPEDEF"
334 or $y->{TYPE
} eq "UNION"
335 or $y->{TYPE
} eq "STRUCT"
336 or $y->{TYPE
} eq "ENUM"
337 or $y->{TYPE
} eq "BITMAP"
338 or $y->{TYPE
} eq "PIPE") {
339 $y->{BASEFILE
} = $basename;
346 sub GenerateTypeLib
()
348 return Parse
::Pidl
::Util
::MyDumper
(\
%types);