r9459: Move pidl up one level (to prevent too much nesting)

(This used to be commit e48202275e60c18e464457d200daeb953386e221)

1 files changed, 336 insertions, 0 deletions

diff --git a/source4/pidl/Parse/Pidl/Typelist.pm b/source4/pidl/Parse/Pidl/Typelist.pm
new file mode 100644
index 0000000000..10a4baf7e7
--- /dev/null
+++ b/source4/pidl/Parse/Pidl/Typelist.pm
@@ -0,0 +1,336 @@
+###################################################
+# Samba4 parser generator for IDL structures
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+package Parse::Pidl::Typelist;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(hasType getType mapType);
+
+use Parse::Pidl::Util qw(has_property);
+use strict;
+
+my %typedefs = ();
+
+# a list of known scalar types
+my $scalars = {
+	# 0 byte types
+	"void"		=> {
+				C_TYPE		=> "void",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 0
+			},
+
+	# 1 byte types
+	"char"		=> {
+				C_TYPE		=> "char",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 1
+			},
+	"int8"		=> {
+				C_TYPE		=> "int8_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 1
+			},
+	"uint8"		=> {
+				C_TYPE		=> "uint8_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 1
+			},
+
+	# 2 byte types
+	"int16"		=> {
+				C_TYPE		=> "int16_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 2
+			},
+	"uint16"	=> {	C_TYPE		=> "uint16_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 2
+			},
+
+	# 4 byte types
+	"int32"		=> {
+				C_TYPE		=> "int32_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+	"uint32"	=> {	C_TYPE		=> "uint32_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+
+	# 8 byte types
+	"hyper"		=> {
+				C_TYPE		=> "uint64_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 8
+			},
+	"dlong"		=> {
+				C_TYPE		=> "int64_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+	"udlong"	=> {
+				C_TYPE		=> "uint64_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+	"udlongr"	=> {
+				C_TYPE		=> "uint64_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+
+	# DATA_BLOB types
+	"DATA_BLOB"	=> {
+				C_TYPE		=> "DATA_BLOB",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+
+	# string types
+	"string"	=> {
+				C_TYPE		=> "const char *",
+				IS_REFERENCE	=> 1,
+				NDR_ALIGN	=> 4 #???
+			},
+	"string_array"	=> {
+				C_TYPE		=> "const char **",
+				IS_REFERENCE	=> 1,
+				NDR_ALIGN	=> 4 #???
+			},
+
+	# time types
+	"time_t"	=> {
+				C_TYPE		=> "time_t",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+	"NTTIME"	=> {
+				C_TYPE		=> "NTTIME",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+	"NTTIME_1sec"	=> {
+				C_TYPE		=> "NTTIME",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+	"NTTIME_hyper"	=> {
+				C_TYPE		=> "NTTIME",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 8
+			},
+
+
+	# error code types
+	"WERROR"	=> {
+				C_TYPE		=> "WERROR",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+	"NTSTATUS"	=> {
+				C_TYPE		=> "NTSTATUS",
+				IS_REFERENCE	=> 0,
+				NDR_ALIGN	=> 4
+			},
+	"COMRESULT" => { 
+				"C_TYPE"	=> "COMRESULT",
+				IS_REFERENCE => 0,
+				NDR_ALIGN => 4
+			},
+
+	# special types
+	"nbt_string"	=> {
+				C_TYPE		=> "const char *",
+				IS_REFERENCE	=> 1,
+				NDR_ALIGN	=> 4 #???
+			},
+	"ipv4address"	=> {
+				C_TYPE		=> "const char *",
+				IS_REFERENCE	=> 1,
+				NDR_ALIGN	=> 4
+			}
+};
+
+# map from a IDL type to a C header type
+sub mapScalarType($)
+{
+	my $name = shift;
+
+	# it's a bug when a type is not in the list
+	# of known scalars or has no mapping
+	return $typedefs{$name}->{DATA}->{C_TYPE} if defined($typedefs{$name}) and defined($typedefs{$name}->{DATA}->{C_TYPE});
+
+	die("Unknown scalar type $name");
+}
+
+sub getScalarAlignment($)
+{
+	my $name = shift;
+
+	# it's a bug when a type is not in the list
+	# of known scalars or has no mapping
+	return $scalars->{$name}{NDR_ALIGN} if defined($scalars->{$name}) and defined($scalars->{$name}{NDR_ALIGN});
+
+	die("Unknown scalar type $name");
+}
+
+sub addType($)
+{
+	my $t = shift;
+	$typedefs{$t->{NAME}} = $t;
+}
+
+sub getType($)
+{
+	my $t = shift;
+	return undef if not hasType($t);
+	return $typedefs{$t};
+}
+
+sub typeIs($$)
+{
+	my $t = shift;
+	my $tt = shift;
+
+	return 1 if (hasType($t) and getType($t)->{DATA}->{TYPE} eq $tt);
+	return 0;
+}
+
+sub hasType($)
+{
+	my $t = shift;
+	return 1 if defined($typedefs{$t});
+	return 0;
+}
+
+sub is_scalar($)
+{
+	my $type = shift;
+
+	return 0 unless(hasType($type));
+
+	if (my $dt = getType($type)->{DATA}->{TYPE}) {
+		return 1 if ($dt eq "SCALAR" or $dt eq "ENUM" or $dt eq "BITMAP");
+	}
+
+	return 0;
+}
+
+sub scalar_is_reference($)
+{
+	my $name = shift;
+
+	return $scalars->{$name}{IS_REFERENCE} if defined($scalars->{$name}) and defined($scalars->{$name}{IS_REFERENCE});
+	return 0;
+}
+
+sub RegisterScalars()
+{
+	foreach my $k (keys %{$scalars}) {
+		$typedefs{$k} = {
+			NAME => $k,
+			TYPE => "TYPEDEF",
+			DATA => $scalars->{$k}
+		};
+		$typedefs{$k}->{DATA}->{TYPE} = "SCALAR";
+		$typedefs{$k}->{DATA}->{NAME} = $k;
+	}
+}
+
+my $aliases = {
+	"DWORD" => "uint32",
+	"int" => "int32",
+	"WORD" => "uint16",
+	"char" => "uint8",
+	"long" => "int32",
+	"short" => "int16",
+	"HYPER_T" => "hyper",
+	"HRESULT" => "COMRESULT",
+};
+
+sub RegisterAliases()
+{
+	foreach my $k (keys %{$aliases}) {
+		$typedefs{$k} = $typedefs{$aliases->{$k}};
+	}
+}
+
+sub enum_type_fn($)
+{
+	my $enum = shift;
+	if (has_property($enum->{PARENT}, "enum8bit")) {
+		return "uint8";
+	} elsif (has_property($enum->{PARENT}, "v1_enum")) {
+		return "uint32";
+	}
+	return "uint16";
+}
+
+sub bitmap_type_fn($)
+{
+	my $bitmap = shift;
+
+	if (has_property($bitmap, "bitmap8bit")) {
+		return "uint8";
+	} elsif (has_property($bitmap, "bitmap16bit")) {
+		return "uint16";
+	} elsif (has_property($bitmap, "bitmap64bit")) {
+		return "hyper";
+	}
+	return "uint32";
+}
+
+sub mapType($)
+{
+	my $t = shift;
+	die("Undef passed to mapType") unless defined($t);
+	my $dt;
+
+	unless ($dt or ($dt = getType($t))) {
+		# Best guess
+		return "struct $t";
+	}
+	return mapScalarType($t) if ($dt->{DATA}->{TYPE} eq "SCALAR");
+	return "enum $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "ENUM");
+	return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "STRUCT");
+	return "struct $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "INTERFACE");
+	return "union $dt->{NAME}" if ($dt->{DATA}->{TYPE} eq "UNION");
+
+	if ($dt->{DATA}->{TYPE} eq "BITMAP") {
+		return mapScalarType(bitmap_type_fn($dt->{DATA}));
+	}
+
+	die("Unknown type $dt->{DATA}->{TYPE}");
+}
+
+sub LoadIdl($)
+{
+	my $idl = shift;
+
+	foreach my $x (@{$idl}) {
+		next if $x->{TYPE} ne "INTERFACE";
+
+		# DCOM interfaces can be types as well
+		addType({
+			NAME => $x->{NAME},
+			TYPE => "TYPEDEF",
+			DATA => $x
+			}) if (has_property($x, "object"));
+
+		foreach my $y (@{$x->{DATA}}) {
+			addType($y) if (
+				$y->{TYPE} eq "TYPEDEF" 
+			     or $y->{TYPE} eq "DECLARE");
+		}
+	}
+}
+
+RegisterScalars();
+RegisterAliases();
+
+1;