summaryrefslogtreecommitdiff
path: root/pidl/lib/Parse/Pidl/Samba4.pm
blob: d42e01cdb0424cc51d413fcfa496a934ae534d4e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
###################################################
# Common Samba4 functions
# Copyright jelmer@samba.org 2006
# released under the GNU GPL

package Parse::Pidl::Samba4;

require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(is_intree choose_header NumStars ElementStars ArrayBrackets DeclLong);

use Parse::Pidl::Util qw(has_property is_constant);
use Parse::Pidl::NDR qw(GetNextLevel);
use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
use Parse::Pidl qw(fatal);
use strict;

use vars qw($VERSION);
$VERSION = '0.01';

sub is_intree()
{
	my $srcdir = $ENV{srcdir};
	$srcdir = $srcdir ? "$srcdir/" : "";
	return 4 if (-f "${srcdir}kdc/kdc.c");
	return 3 if (-f "${srcdir}include/smb.h");
	return 0;
}

# Return an #include line depending on whether this build is an in-tree
# build or not.
sub choose_header($$)
{
	my ($in,$out) = @_;
	return "#include \"$in\"" if (is_intree());
	return "#include <$out>";
}

sub NumStars($;$)
{
	my ($e, $d) = @_;
	$d = 0 unless defined($d);
	my $n = 0;

	foreach my $l (@{$e->{LEVELS}}) {
		next unless ($l->{TYPE} eq "POINTER");

		my $nl = GetNextLevel($e, $l);
		next if (defined($nl) and $nl->{TYPE} eq "ARRAY");

		$n++;
	}

	if ($n >= 1) {
		$n-- if (scalar_is_reference($e->{TYPE}));
	}

	foreach my $l (@{$e->{LEVELS}}) {
		next unless ($l->{TYPE} eq "ARRAY");
		next if ($l->{IS_FIXED}) and not has_property($e, "charset");
		$n++;
	}

	fatal($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);

	$n -= $d;

	return $n;
}

sub ElementStars($;$)
{
	my ($e, $d) = @_;
	my $res = "";
	my $n = 0;

	$n = NumStars($e, $d);
	$res .= "*" foreach (1..$n);

	return $res;
}

sub ArrayBrackets($)
{
	my ($e) = @_;
	my $res = "";

	foreach my $l (@{$e->{LEVELS}}) {
		next unless ($l->{TYPE} eq "ARRAY");
		next unless ($l->{IS_FIXED}) and not has_property($e, "charset");
		$res .= "[$l->{SIZE_IS}]";
	}

	return $res;
}

sub DeclLong($)
{
	my ($e) = shift;
	my $res = "";

	if (has_property($e, "represent_as")) {
		$res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
	} else {
		if (has_property($e, "charset")) {
			$res .= "const char ";
		} else {
			$res .= mapTypeName($e->{TYPE})." ";
		}

		$res .= ElementStars($e);
	}
	$res .= $e->{NAME};
	$res .= ArrayBrackets($e);

	return $res;
}

1;