← Back to branch summary

~zulcss/samba/server-dailies-3.4

« back to all changes in this revision

Viewing changes to pidl/lib/Parse/Pidl/Samba4.pm

  • Committer: Chuck Short
  • Date: 2010-09-28 20:38:39 UTC
  • Revision ID: zulcss@ubuntu.com-20100928203839-pgjulytsi9ue63x1
Initial version

Show diffs side-by-side

added added

removed removed

Lines of Context:
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 ArrayDynamicallyAllocated);
 
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 error);
 
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 ArrayDynamicallyAllocated($$)
 
40
{
 
41
        my ($e, $l) = @_;
 
42
        die("Not an array") unless ($l->{TYPE} eq "ARRAY");
 
43
        return 0 if ($l->{IS_FIXED} and not has_property($e, "charset"));
 
44
        return 1;
 
45
}
 
46
 
 
47
sub NumStars($;$)
 
48
{
 
49
        my ($e, $d) = @_;
 
50
        $d = 0 unless defined($d);
 
51
        my $n = 0;
 
52
 
 
53
        foreach my $l (@{$e->{LEVELS}}) {
 
54
                next unless ($l->{TYPE} eq "POINTER");
 
55
 
 
56
                my $nl = GetNextLevel($e, $l);
 
57
                next if (defined($nl) and $nl->{TYPE} eq "ARRAY");
 
58
 
 
59
                $n++;
 
60
        }
 
61
 
 
62
        if ($n >= 1) {
 
63
                $n-- if (scalar_is_reference($e->{TYPE}));
 
64
        }
 
65
 
 
66
        foreach my $l (@{$e->{LEVELS}}) {
 
67
                next unless ($l->{TYPE} eq "ARRAY");
 
68
                next unless (ArrayDynamicallyAllocated($e, $l));
 
69
                $n++;
 
70
        }
 
71
 
 
72
        error($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);
 
73
 
 
74
        $n -= $d;
 
75
 
 
76
        return $n;
 
77
}
 
78
 
 
79
sub ElementStars($;$)
 
80
{
 
81
        my ($e, $d) = @_;
 
82
        my $res = "";
 
83
        my $n = 0;
 
84
 
 
85
        $n = NumStars($e, $d);
 
86
        $res .= "*" foreach (1..$n);
 
87
 
 
88
        return $res;
 
89
}
 
90
 
 
91
sub ArrayBrackets($)
 
92
{
 
93
        my ($e) = @_;
 
94
        my $res = "";
 
95
 
 
96
        foreach my $l (@{$e->{LEVELS}}) {
 
97
                next unless ($l->{TYPE} eq "ARRAY");
 
98
                next if ArrayDynamicallyAllocated($e, $l);
 
99
                $res .= "[$l->{SIZE_IS}]";
 
100
        }
 
101
 
 
102
        return $res;
 
103
}
 
104
 
 
105
sub DeclLong($)
 
106
{
 
107
        my ($e) = shift;
 
108
        my $res = "";
 
109
 
 
110
        if (has_property($e, "represent_as")) {
 
111
                $res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
 
112
        } else {
 
113
                if (has_property($e, "charset")) {
 
114
                        $res .= "const char ";
 
115
                } else {
 
116
                        $res .= mapTypeName($e->{TYPE})." ";
 
117
                }
 
118
 
 
119
                $res .= ElementStars($e);
 
120
        }
 
121
        $res .= $e->{NAME};
 
122
        $res .= ArrayBrackets($e);
 
123
 
 
124
        return $res;
 
125
}
 
126
 
 
127
1;