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 given 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/) {
203 # determine if an element is a pass-by-reference structure
207 if (!is_scalar_type($e->{TYPE}) &&
208 has_property($e, "ref")) {
214 # determine the array size (size_is() or ARRAY_LEN)
218 my $size = has_property($e, "size_is");
222 $size = $e->{ARRAY_LEN};
229 # return 1 if the string is a C constant
233 if (defined $s && $s =~ /^\d/) {
239 # return a "" quoted string, unless already quoted
243 if (substr($str, 0, 1) eq "\"") {
246 return "\"" . $str . "\"";
249 ###################################
250 # find a sibling var in a structure
255 my($fn) = $e->{PARENT};
257 if ($name =~ /\*(.*)/) {
261 for my $e2 (@{$fn->{ELEMENTS}}) {
262 return $e2 if ($e2->{NAME} eq $name);