r5475: Move some existing and new type information functions to typelist.pm
[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 # determine if an element is a pass-by-reference structure
204 sub is_ref_struct($)
205 {
206         my $e = shift;
207         if (!is_scalar_type($e->{TYPE}) &&
208             has_property($e, "ref")) {
209                 return 1;
210         }
211         return 0;
212 }
213
214 # determine the array size (size_is() or ARRAY_LEN)
215 sub array_size($)
216 {
217         my $e = shift;
218         my $size = has_property($e, "size_is");
219         if ($size) {
220                 return $size;
221         }
222         $size = $e->{ARRAY_LEN};
223         if ($size) {
224                 return $size;
225         }
226         return undef;
227 }
228
229 # return 1 if the string is a C constant
230 sub is_constant($)
231 {
232         my $s = shift;
233         if (defined $s && $s =~ /^\d/) {
234                 return 1;
235         }
236         return 0;
237 }
238
239 # return a "" quoted string, unless already quoted
240 sub make_str($)
241 {
242         my $str = shift;
243         if (substr($str, 0, 1) eq "\"") {
244                 return $str;
245         }
246         return "\"" . $str . "\"";
247 }
248
249 1;