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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
###################################################
# 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 ArrayDynamicallyAllocated);
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 error);
use strict;
use warnings;
use vars qw($VERSION);
$VERSION = '0.01';
# return true if we are using pidl within the samba source tree. This changes
# the names of include files, as some include files (such as ntstatus.h) have
# different paths when installed to the patch in the source tree
sub is_intree()
{
my $srcdir = $ENV{srcdir};
$srcdir = $srcdir ? "$srcdir/" : "";
return 1 if (-f "${srcdir}kdc/kdc.c");
return 1 if (-d "${srcdir}source4");
return 1 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 ArrayDynamicallyAllocated($$)
{
my ($e, $l) = @_;
die("Not an array") unless ($l->{TYPE} eq "ARRAY");
return 0 if ($l->{IS_FIXED} and not has_property($e, "charset"));
return 1;
}
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 unless (ArrayDynamicallyAllocated($e, $l));
$n++;
}
error($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 if ArrayDynamicallyAllocated($e, $l);
$res .= "[$l->{SIZE_IS}]";
}
return $res;
}
sub DeclLong($;$)
{
my ($e, $p) = @_;
my $res = "";
$p = "" unless defined($p);
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 .= $p.$e->{NAME};
$res .= ArrayBrackets($e);
return $res;
}
1;
|
