Merge branch 'v4-0-test' of git://git.samba.org/samba into 4-0-local
[samba.git] / source4 / pidl / lib / Parse / Pidl / Samba4.pm
1 ###################################################
2 # Common Samba4 functions
3 # Copyright jelmer@samba.org 2006
4 # released under the GNU GPL
5
6 package Parse::Pidl::Samba4;
7
8 require Exporter;
9 @ISA = qw(Exporter);
10 @EXPORT = qw(is_intree choose_header NumStars ElementStars ArrayBrackets DeclLong);
11
12 use Parse::Pidl::Util qw(has_property is_constant);
13 use Parse::Pidl::NDR qw(GetNextLevel);
14 use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
15 use Parse::Pidl qw(fatal);
16 use strict;
17
18 use vars qw($VERSION);
19 $VERSION = '0.01';
20
21 sub is_intree()
22 {
23         my $srcdir = $ENV{srcdir};
24         $srcdir = $srcdir ? "$srcdir/" : "";
25         return 4 if (-f "${srcdir}kdc/kdc.c");
26         return 3 if (-f "${srcdir}include/smb.h");
27         return 0;
28 }
29
30 # Return an #include line depending on whether this build is an in-tree
31 # build or not.
32 sub choose_header($$)
33 {
34         my ($in,$out) = @_;
35         return "#include \"$in\"" if (is_intree());
36         return "#include <$out>";
37 }
38
39 sub NumStars($;$)
40 {
41         my ($e, $d) = @_;
42         $d = 0 unless defined($d);
43         my $n = 0;
44
45         foreach my $l (@{$e->{LEVELS}}) {
46                 next unless ($l->{TYPE} eq "POINTER");
47
48                 my $nl = GetNextLevel($e, $l);
49                 next if (defined($nl) and $nl->{TYPE} eq "ARRAY");
50
51                 $n++;
52         }
53
54         if ($n >= 1) {
55                 $n-- if (scalar_is_reference($e->{TYPE}));
56         }
57
58         foreach my $l (@{$e->{LEVELS}}) {
59                 next unless ($l->{TYPE} eq "ARRAY");
60                 next if ($l->{IS_FIXED}) and not has_property($e, "charset");
61                 $n++;
62         }
63
64         fatal($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);
65
66         $n -= $d;
67
68         return $n;
69 }
70
71 sub ElementStars($;$)
72 {
73         my ($e, $d) = @_;
74         my $res = "";
75         my $n = 0;
76
77         $n = NumStars($e, $d);
78         $res .= "*" foreach (1..$n);
79
80         return $res;
81 }
82
83 sub ArrayBrackets($)
84 {
85         my ($e) = @_;
86         my $res = "";
87
88         foreach my $l (@{$e->{LEVELS}}) {
89                 next unless ($l->{TYPE} eq "ARRAY");
90                 next unless ($l->{IS_FIXED}) and not has_property($e, "charset");
91                 $res .= "[$l->{SIZE_IS}]";
92         }
93
94         return $res;
95 }
96
97 sub DeclLong($)
98 {
99         my ($e) = shift;
100         my $res = "";
101
102         if (has_property($e, "represent_as")) {
103                 $res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
104         } else {
105                 if (has_property($e, "charset")) {
106                         $res .= "const char ";
107                 } else {
108                         $res .= mapTypeName($e->{TYPE})." ";
109                 }
110
111                 $res .= ElementStars($e);
112         }
113         $res .= $e->{NAME};
114         $res .= ArrayBrackets($e);
115
116         return $res;
117 }
118
119 1;