1 ###################################################
2 # utility functions to support pidl
3 # Copyright tridge@samba.org 2000
4 # released under the GNU GPL
7 #####################################################################
8 # load a data structure from a file (as saved with SaveStructure)
12 my $contents = FileLoad
($f);
13 defined $contents || return undef;
14 return eval "$contents";
19 #####################################################################
20 # flatten an array of arrays into a single array
33 #####################################################################
34 # flatten an array of arrays into a single array
47 #####################################################################
48 # flatten an array of hashes into a single hash
54 for my $k (keys %{$d}) {
62 #####################################################################
63 # traverse a perl data structure removing any empty arrays or
64 # hashes and any hash elements that map to undef
69 if (ref($v) eq "ARRAY") {
70 foreach my $i (0 .. $#{$v}) {
72 if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) {
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}) {
82 if (!defined $v->{$x}) { delete($v->{$x}); next; }
83 if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
89 #####################################################################
90 # return the modification time of a file
93 my($filename) = shift;
94 return (stat($filename))[9];
98 #####################################################################
99 # read a file into a string
102 my($filename) = shift;
104 open(INPUTFILE
, $filename) || return undef;
105 my($saved_delim) = $/;
107 my($data) = <INPUTFILE
>;
113 #####################################################################
114 # write a string into a file
117 my($filename) = shift;
120 open(FILE
, ">$filename") || die "can't open $filename";
125 #####################################################################
126 # return a filename with a changed extension
127 sub ChangeExtension
($$)
131 if ($fname =~ /^(.*)\.(.*?)$/) {
137 #####################################################################
138 # a dumper wrapper to prevent dependence on the Data::Dumper module
139 # unless we actually need it
142 require Data
::Dumper
;
144 return Data
::Dumper
::Dumper
($s);
147 #####################################################################
148 # save a data structure into a file
149 sub SaveStructure
($$)
151 my($filename) = shift;
153 FileSave
($filename, MyDumper
($v));
156 #####################################################################
157 # find an interface in an array of interfaces
158 sub get_interface
($$)
164 if($_->{NAME
} eq $n) { return $_; }
170 #####################################################################
171 # see if a pidl property list contains a give property
177 if (!defined $e->{PROPERTIES
}) {
181 return $e->{PROPERTIES
}->{$p};
184 #####################################################################
185 # see if a pidl property matches a value
186 sub property_matches
($$$)
192 if (!defined has_property
($e, $p)) {
196 if ($e->{PROPERTIES
}->{$p} =~ /$v/) {
208 $enum_list{$name} = 1;
214 return defined $enum_list{$name}
217 sub enum_type_decl
($)
220 return "enum $e->{TYPE}";
231 sub register_bitmap
($$)
235 $bitmap_list{$name} = $bitmap;
241 return defined $bitmap_list{$name};
247 return $bitmap_list{$name};
250 sub bitmap_type_decl
($)
254 if (util
::has_property
($bitmap->{PARENT
}, "bitmap8bit")) {
256 } elsif (util
::has_property
($bitmap->{PARENT
}, "bitmap16bit")) {
258 } elsif (util
::has_property
($bitmap->{PARENT
}, "bitmap64bit")) {
264 sub bitmap_type_fn
($)
267 return bitmap_type_decl
($bitmap);
270 sub is_scalar_type
($)
274 if ($type =~ /^u?int\d+/) {
277 if ($type =~ /char
|short
|long
|NTTIME
|NTTIME_1sec
|
278 time_t
|error_status_t
|boolean32
|unsigned32
|
279 HYPER_T
|wchar_t
|DATA_BLOB
|WERROR
/x
) {
283 if (is_enum
($type)) {
287 if (is_bitmap
($type)) {
294 # return the NDR alignment for a type
298 my $type = $e->{TYPE
};
300 if (need_wire_pointer
($e)) {
304 return 1, if ($type eq "char");
305 return 1, if ($type eq "int8");
306 return 1, if ($type eq "uint8");
308 return 2, if ($type eq "short");
309 return 2, if ($type eq "wchar_t");
310 return 2, if ($type eq "int16");
311 return 2, if ($type eq "uint16");
313 return 4, if ($type eq "long");
314 return 4, if ($type eq "int32");
315 return 4, if ($type eq "uint32");
317 return 4, if ($type eq "int64");
318 return 4, if ($type eq "uint64");
320 return 4, if ($type eq "NTTIME");
321 return 4, if ($type eq "NTTIME_1sec");
322 return 4, if ($type eq "time_t");
324 return 4, if ($type eq "DATA_BLOB");
326 return 8, if ($type eq "HYPER_T");
328 # it must be an external type - all we can do is guess
332 # this is used to determine if the ndr push/pull functions will need
333 # a ndr_flags field to split by buffers/scalars
334 sub is_builtin_type
($)
338 return 1, if (is_scalar_type
($type));
343 # determine if an element needs a reference pointer on the wire
344 # in its NDR representation
345 sub need_wire_pointer
($)
348 if ($e->{POINTERS
} &&
349 !has_property
($e, "ref")) {
350 return $e->{POINTERS
};
355 # determine if an element is a pass-by-reference structure
359 if (!is_scalar_type
($e->{TYPE
}) &&
360 has_property
($e, "ref")) {
366 # determine if an element is a pure scalar. pure scalars do not
367 # have a "buffers" section in NDR
368 sub is_pure_scalar
($)
371 if (has_property
($e, "ref")) {
374 if (is_scalar_type
($e->{TYPE
}) &&
382 # determine the array size (size_is() or ARRAY_LEN)
386 my $size = has_property
($e, "size_is");
390 $size = $e->{ARRAY_LEN
};
397 # see if a variable needs to be allocated by the NDR subsystem on pull
402 if (has_property
($e, "ref")) {
406 if ($e->{POINTERS
} || array_size
($e)) {
413 # determine the C prefix used to refer to a variable when passing to a push
414 # function. This will be '*' for pointers to scalar types, '' for scalar
415 # types and normal pointers and '&' for pass-by-reference structures
420 if ($e->{TYPE
} =~ "string") {
424 if (is_scalar_type
($e->{TYPE
}) &&
428 if (!is_scalar_type
($e->{TYPE
}) &&
437 # determine the C prefix used to refer to a variable when passing to a pull
443 if (!$e->{POINTERS
} && !array_size
($e)) {
447 if ($e->{TYPE
} =~ "string") {
454 # determine if an element has a direct buffers component
455 sub has_direct_buffers
($)
458 if ($e->{POINTERS
} || array_size
($e)) {
464 # return 1 if the string is a C constant
468 if (defined $s && $s =~ /^\d/) {
474 # return 1 if this is a fixed array
475 sub is_fixed_array
($)
478 my $len = $e->{"ARRAY_LEN"};
479 if (defined $len && is_constant
($len)) {
485 # return 1 if this is a inline array
486 sub is_inline_array
($)
489 my $len = $e->{"ARRAY_LEN"};
490 if (is_fixed_array
($e) ||
491 defined $len && $len ne "*") {
497 # return a "" quoted string, unless already quoted
501 if (substr($str, 0, 1) eq "\"") {
504 return "\"" . $str . "\"";