← Back to branch summary

~zulcss/samba/server-dailies-3.4

« back to all changes in this revision

Viewing changes to source4/build/pasn1/util.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:
source4/build/pasn1/util.pm
 
1
###################################################
 
2
# utility functions to support pidl
 
3
# Copyright tridge@samba.org 2000
 
4
# released under the GNU GPL
 
5
package util;
 
6
 
 
7
#####################################################################
 
8
# load a data structure from a file (as saved with SaveStructure)
 
9
sub LoadStructure($)
 
10
{
 
11
        my $f = shift;
 
12
        my $contents = FileLoad($f);
 
13
        defined $contents || return undef;
 
14
        return eval "$contents";
 
15
}
 
16
 
 
17
use strict;
 
18
 
 
19
#####################################################################
 
20
# flatten an array of arrays into a single array
 
21
sub FlattenArray2($) 
 
22
{ 
 
23
    my $a = shift;
 
24
    my @b;
 
25
    for my $d (@{$a}) {
 
26
        for my $d1 (@{$d}) {
 
27
            push(@b, $d1);
 
28
        }
 
29
    }
 
30
    return \@b;
 
31
}
 
32
 
 
33
#####################################################################
 
34
# flatten an array of arrays into a single array
 
35
sub FlattenArray($) 
 
36
{ 
 
37
    my $a = shift;
 
38
    my @b;
 
39
    for my $d (@{$a}) {
 
40
        for my $d1 (@{$d}) {
 
41
            push(@b, $d1);
 
42
        }
 
43
    }
 
44
    return \@b;
 
45
}
 
46
 
 
47
#####################################################################
 
48
# flatten an array of hashes into a single hash
 
49
sub FlattenHash($) 
 
50
{ 
 
51
    my $a = shift;
 
52
    my %b;
 
53
    for my $d (@{$a}) {
 
54
        for my $k (keys %{$d}) {
 
55
            $b{$k} = $d->{$k};
 
56
        }
 
57
    }
 
58
    return \%b;
 
59
}
 
60
 
 
61
 
 
62
#####################################################################
 
63
# traverse a perl data structure removing any empty arrays or
 
64
# hashes and any hash elements that map to undef
 
65
sub CleanData($)
 
66
{
 
67
    sub CleanData($);
 
68
    my($v) = shift;
 
69
    if (ref($v) eq "ARRAY") {
 
70
        foreach my $i (0 .. $#{$v}) {
 
71
            CleanData($v->[$i]);
 
72
            if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { 
 
73
                    $v->[$i] = undef; 
 
74
                    next; 
 
75
            }
 
76
        }
 
77
        # this removes any undefined elements from the array
 
78
        @{$v} = grep { defined $_ } @{$v};
 
79
    } elsif (ref($v) eq "HASH") {
 
80
        foreach my $x (keys %{$v}) {
 
81
            CleanData($v->{$x});
 
82
            if (!defined $v->{$x}) { delete($v->{$x}); next; }
 
83
            if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
 
84
        }
 
85
    }
 
86
}
 
87
 
 
88
 
 
89
#####################################################################
 
90
# return the modification time of a file
 
91
sub FileModtime($)
 
92
{
 
93
    my($filename) = shift;
 
94
    return (stat($filename))[9];
 
95
}
 
96
 
 
97
 
 
98
#####################################################################
 
99
# read a file into a string
 
100
sub FileLoad($)
 
101
{
 
102
    my($filename) = shift;
 
103
    local(*INPUTFILE);
 
104
    open(INPUTFILE, $filename) || return undef;
 
105
    my($saved_delim) = $/;
 
106
    undef $/;
 
107
    my($data) = <INPUTFILE>;
 
108
    close(INPUTFILE);
 
109
    $/ = $saved_delim;
 
110
    return $data;
 
111
}
 
112
 
 
113
#####################################################################
 
114
# write a string into a file
 
115
sub FileSave($$)
 
116
{
 
117
    my($filename) = shift;
 
118
    my($v) = shift;
 
119
    local(*FILE);
 
120
    open(FILE, ">$filename") || die "can't open $filename";    
 
121
    print FILE $v;
 
122
    close(FILE);
 
123
}
 
124
 
 
125
#####################################################################
 
126
# return a filename with a changed extension
 
127
sub ChangeExtension($$)
 
128
{
 
129
    my($fname) = shift;
 
130
    my($ext) = shift;
 
131
    if ($fname =~ /^(.*)\.(.*?)$/) {
 
132
        return "$1$ext";
 
133
    }
 
134
    return "$fname$ext";
 
135
}
 
136
 
 
137
#####################################################################
 
138
# a dumper wrapper to prevent dependence on the Data::Dumper module
 
139
# unless we actually need it
 
140
sub MyDumper($)
 
141
{
 
142
        require Data::Dumper;
 
143
        my $s = shift;
 
144
        return Data::Dumper::Dumper($s);
 
145
}
 
146
 
 
147
#####################################################################
 
148
# save a data structure into a file
 
149
sub SaveStructure($$)
 
150
{
 
151
        my($filename) = shift;
 
152
        my($v) = shift;
 
153
        FileSave($filename, MyDumper($v));
 
154
}
 
155
 
 
156
#####################################################################
 
157
# see if a pidl property list contains a give property
 
158
sub has_property($$)
 
159
{
 
160
        my($e) = shift;
 
161
        my($p) = shift;
 
162
 
 
163
        if (!defined $e->{PROPERTIES}) {
 
164
                return undef;
 
165
        }
 
166
 
 
167
        return $e->{PROPERTIES}->{$p};
 
168
}
 
169
 
 
170
 
 
171
sub is_scalar_type($)
 
172
{
 
173
    my($type) = shift;
 
174
 
 
175
    if ($type =~ /^u?int\d+/) {
 
176
            return 1;
 
177
    }
 
178
    if ($type =~ /char|short|long|NTTIME|
 
179
        time_t|error_status_t|boolean32|unsigned32|
 
180
        HYPER_T|wchar_t|DATA_BLOB/x) {
 
181
            return 1;
 
182
    }
 
183
 
 
184
    return 0;
 
185
}
 
186
 
 
187
# return the NDR alignment for a type
 
188
sub type_align($)
 
189
{
 
190
    my($e) = shift;
 
191
    my $type = $e->{TYPE};
 
192
 
 
193
    if (need_wire_pointer($e)) {
 
194
            return 4;
 
195
    }
 
196
 
 
197
    return 4, if ($type eq "uint32");
 
198
    return 4, if ($type eq "long");
 
199
    return 2, if ($type eq "short");
 
200
    return 1, if ($type eq "char");
 
201
    return 1, if ($type eq "uint8");
 
202
    return 2, if ($type eq "uint16");
 
203
    return 4, if ($type eq "NTTIME");
 
204
    return 4, if ($type eq "time_t");
 
205
    return 8, if ($type eq "HYPER_T");
 
206
    return 2, if ($type eq "wchar_t");
 
207
    return 4, if ($type eq "DATA_BLOB");
 
208
 
 
209
    # it must be an external type - all we can do is guess 
 
210
    return 4;
 
211
}
 
212
 
 
213
# this is used to determine if the ndr push/pull functions will need
 
214
# a ndr_flags field to split by buffers/scalars
 
215
sub is_builtin_type($)
 
216
{
 
217
    my($type) = shift;
 
218
 
 
219
    return 1, if (is_scalar_type($type));
 
220
 
 
221
    return 0;
 
222
}
 
223
 
 
224
# determine if an element needs a reference pointer on the wire
 
225
# in its NDR representation
 
226
sub need_wire_pointer($)
 
227
{
 
228
        my $e = shift;
 
229
        if ($e->{POINTERS} && 
 
230
            !has_property($e, "ref")) {
 
231
                return $e->{POINTERS};
 
232
        }
 
233
        return undef;
 
234
}
 
235
 
 
236
# determine if an element is a pass-by-reference structure
 
237
sub is_ref_struct($)
 
238
{
 
239
        my $e = shift;
 
240
        if (!is_scalar_type($e->{TYPE}) &&
 
241
            has_property($e, "ref")) {
 
242
                return 1;
 
243
        }
 
244
        return 0;
 
245
}
 
246
 
 
247
# determine if an element is a pure scalar. pure scalars do not
 
248
# have a "buffers" section in NDR
 
249
sub is_pure_scalar($)
 
250
{
 
251
        my $e = shift;
 
252
        if (has_property($e, "ref")) {
 
253
                return 1;
 
254
        }
 
255
        if (is_scalar_type($e->{TYPE}) && 
 
256
            !$e->{POINTERS} && 
 
257
            !array_size($e)) {
 
258
                return 1;
 
259
        }
 
260
        return 0;
 
261
}
 
262
 
 
263
# determine the array size (size_is() or ARRAY_LEN)
 
264
sub array_size($)
 
265
{
 
266
        my $e = shift;
 
267
        my $size = has_property($e, "size_is");
 
268
        if ($size) {
 
269
                return $size;
 
270
        }
 
271
        $size = $e->{ARRAY_LEN};
 
272
        if ($size) {
 
273
                return $size;
 
274
        }
 
275
        return undef;
 
276
}
 
277
 
 
278
# see if a variable needs to be allocated by the NDR subsystem on pull
 
279
sub need_alloc($)
 
280
{
 
281
        my $e = shift;
 
282
 
 
283
        if (has_property($e, "ref")) {
 
284
                return 0;
 
285
        }
 
286
 
 
287
        if ($e->{POINTERS} || array_size($e)) {
 
288
                return 1;
 
289
        }
 
290
 
 
291
        return 0;
 
292
}
 
293
 
 
294
# determine the C prefix used to refer to a variable when passing to a push
 
295
# function. This will be '*' for pointers to scalar types, '' for scalar
 
296
# types and normal pointers and '&' for pass-by-reference structures
 
297
sub c_push_prefix($)
 
298
{
 
299
        my $e = shift;
 
300
 
 
301
        if ($e->{TYPE} =~ "string") {
 
302
                return "";
 
303
        }
 
304
 
 
305
        if (is_scalar_type($e->{TYPE}) &&
 
306
            $e->{POINTERS}) {
 
307
                return "*";
 
308
        }
 
309
        if (!is_scalar_type($e->{TYPE}) &&
 
310
            !$e->{POINTERS} &&
 
311
            !array_size($e)) {
 
312
                return "&";
 
313
        }
 
314
        return "";
 
315
}
 
316
 
 
317
 
 
318
# determine the C prefix used to refer to a variable when passing to a pull
 
319
# return '&' or ''
 
320
sub c_pull_prefix($)
 
321
{
 
322
        my $e = shift;
 
323
 
 
324
        if (!$e->{POINTERS} && !array_size($e)) {
 
325
                return "&";
 
326
        }
 
327
 
 
328
        if ($e->{TYPE} =~ "string") {
 
329
                return "&";
 
330
        }
 
331
 
 
332
        return "";
 
333
}
 
334
 
 
335
# determine if an element has a direct buffers component
 
336
sub has_direct_buffers($)
 
337
{
 
338
        my $e = shift;
 
339
        if ($e->{POINTERS} || array_size($e)) {
 
340
                return 1;
 
341
        }
 
342
        return 0;
 
343
}
 
344
 
 
345
# return 1 if the string is a C constant
 
346
sub is_constant($)
 
347
{
 
348
        my $s = shift;
 
349
        if ($s =~ /^\d/) {
 
350
                return 1;
 
351
        }
 
352
        return 0;
 
353
}
 
354
 
 
355
# return 1 if this is a fixed array
 
356
sub is_fixed_array($)
 
357
{
 
358
        my $e = shift;
 
359
        my $len = $e->{"ARRAY_LEN"};
 
360
        if (defined $len && is_constant($len)) {
 
361
                return 1;
 
362
        }
 
363
        return 0;
 
364
}
 
365
 
 
366
# return 1 if this is a inline array
 
367
sub is_inline_array($)
 
368
{
 
369
        my $e = shift;
 
370
        my $len = $e->{"ARRAY_LEN"};
 
371
        if (is_fixed_array($e) ||
 
372
            defined $len && $len ne "*") {
 
373
                return 1;
 
374
        }
 
375
        return 0;
 
376
}
 
377
 
 
378
1;
 
379