r5447: Add some utility functions for arrays and use them.
[samba.git] / source4 / build / pidl / 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 # find an interface in an array of interfaces
158 sub get_interface($$)
159 {
160         my($if) = shift;
161         my($n) = shift;
162
163         foreach(@{$if}) {
164                 if($_->{NAME} eq $n) { return $_; }
165         }
166         
167         return 0;
168 }
169
170 #####################################################################
171 # see if a pidl property list contains a given property
172 sub has_property($$)
173 {
174         my($e) = shift;
175         my($p) = shift;
176
177         if (!defined $e->{PROPERTIES}) {
178                 return undef;
179         }
180
181         return $e->{PROPERTIES}->{$p};
182 }
183
184 #####################################################################
185 # see if a pidl property matches a value
186 sub property_matches($$$)
187 {
188         my($e) = shift;
189         my($p) = shift;
190         my($v) = shift;
191
192         if (!defined has_property($e, $p)) {
193                 return undef;
194         }
195
196         if ($e->{PROPERTIES}->{$p} =~ /$v/) {
197                 return 1;
198         }
199
200         return undef;
201 }
202
203 my %enum_list;
204
205 sub enum_type_decl($)
206 {
207         my $enum = shift;
208         return "enum $enum->{TYPE}";
209 }
210
211 sub enum_type_fn($)
212 {
213         my $enum = shift;
214         if (util::has_property($enum->{PARENT}, "enum8bit")) {
215                 return "uint8";
216         } elsif (util::has_property($enum->{PARENT}, "v1_enum")) {
217                 return "uint32";
218         }
219         return "uint16";
220 }
221
222 my %bitmap_list;
223
224 sub bitmap_type_fn($)
225 {
226         my $bitmap = shift;
227
228         if (util::has_property($bitmap->{PARENT}, "bitmap8bit")) {
229                 return "uint8";
230         } elsif (util::has_property($bitmap->{PARENT}, "bitmap16bit")) {
231                 return "uint16";
232         } elsif (util::has_property($bitmap->{PARENT}, "bitmap64bit")) {
233                 return "uint64";
234         }
235         return "uint32";
236 }
237
238 sub bitmap_type_decl($)
239 {
240         my $bitmap = shift;
241         return map_type(bitmap_type_fn($bitmap));
242 }
243
244
245 # determine if an element is a pass-by-reference structure
246 sub is_ref_struct($)
247 {
248         my $e = shift;
249         if (!is_scalar_type($e->{TYPE}) &&
250             has_property($e, "ref")) {
251                 return 1;
252         }
253         return 0;
254 }
255
256 # determine the array size (size_is() or ARRAY_LEN)
257 sub array_size($)
258 {
259         my $e = shift;
260         my $size = has_property($e, "size_is");
261         if ($size) {
262                 return $size;
263         }
264         $size = $e->{ARRAY_LEN};
265         if ($size) {
266                 return $size;
267         }
268         return undef;
269 }
270
271 # return 1 if the string is a C constant
272 sub is_constant($)
273 {
274         my $s = shift;
275         if (defined $s && $s =~ /^\d/) {
276                 return 1;
277         }
278         return 0;
279 }
280
281 # return a "" quoted string, unless already quoted
282 sub make_str($)
283 {
284         my $str = shift;
285         if (substr($str, 0, 1) eq "\"") {
286                 return $str;
287         }
288         return "\"" . $str . "\"";
289 }
290
291
292 # provide mappings between IDL base types and types in our headers
293 my %type_mappings = 
294     (
295      "int8"         => "int8_t",
296      "uint8"        => "uint8_t",
297      "short"        => "int16_t",
298      "wchar_t"      => "uint16_t",
299      "int16"        => "int16_t",
300      "uint16"       => "uint16_t",
301      "int32"        => "int32_t",
302      "uint32"       => "uint32_t",
303      "int64"        => "int64_t",
304      "uint64"       => "uint64_t",
305      "dlong"        => "int64_t",
306      "udlong"       => "uint64_t",
307      "udlongr"      => "uint64_t",
308      "hyper"        => "uint64_t",
309      "NTTIME_1sec"  => "NTTIME",
310      "NTTIME_hyper" => "NTTIME",
311      "ipv4address"  => "const char *"
312      );
313
314 # map from a IDL type to a C header type
315 sub map_type($)
316 {
317         my $name = shift;
318         if (my $ret = $type_mappings{$name}) {
319                 return $ret;
320         }
321         return $name;
322 }
323
324 1;
325