537714adf3609f3b0c87695d8e6bbaf5af21e7e2
[samba.git] / source / 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         return $v;
87 }
88
89
90 #####################################################################
91 # return the modification time of a file
92 sub FileModtime($)
93 {
94     my($filename) = shift;
95     return (stat($filename))[9];
96 }
97
98
99 #####################################################################
100 # read a file into a string
101 sub FileLoad($)
102 {
103     my($filename) = shift;
104     local(*INPUTFILE);
105     open(INPUTFILE, $filename) || return undef;
106     my($saved_delim) = $/;
107     undef $/;
108     my($data) = <INPUTFILE>;
109     close(INPUTFILE);
110     $/ = $saved_delim;
111     return $data;
112 }
113
114 #####################################################################
115 # write a string into a file
116 sub FileSave($$)
117 {
118     my($filename) = shift;
119     my($v) = shift;
120     local(*FILE);
121     open(FILE, ">$filename") || die "can't open $filename";    
122     print FILE $v;
123     close(FILE);
124 }
125
126 #####################################################################
127 # return a filename with a changed extension
128 sub ChangeExtension($$)
129 {
130     my($fname) = shift;
131     my($ext) = shift;
132     if ($fname =~ /^(.*)\.(.*?)$/) {
133         return "$1$ext";
134     }
135     return "$fname$ext";
136 }
137
138 #####################################################################
139 # a dumper wrapper to prevent dependence on the Data::Dumper module
140 # unless we actually need it
141 sub MyDumper($)
142 {
143         require Data::Dumper;
144         my $s = shift;
145         return Data::Dumper::Dumper($s);
146 }
147
148 #####################################################################
149 # save a data structure into a file
150 sub SaveStructure($$)
151 {
152         my($filename) = shift;
153         my($v) = shift;
154         FileSave($filename, MyDumper($v));
155 }
156
157 #####################################################################
158 # find an interface in an array of interfaces
159 sub get_interface($$)
160 {
161         my($if) = shift;
162         my($n) = shift;
163
164         foreach(@{$if}) {
165                 if($_->{NAME} eq $n) { return $_; }
166         }
167         
168         return 0;
169 }
170
171 #####################################################################
172 # see if a pidl property list contains a given property
173 sub has_property($$)
174 {
175         my($e) = shift;
176         my($p) = shift;
177
178         if (!defined $e->{PROPERTIES}) {
179                 return undef;
180         }
181
182         return $e->{PROPERTIES}->{$p};
183 }
184
185 #####################################################################
186 # see if a pidl property matches a value
187 sub property_matches($$$)
188 {
189         my($e) = shift;
190         my($p) = shift;
191         my($v) = shift;
192
193         if (!defined has_property($e, $p)) {
194                 return undef;
195         }
196
197         if ($e->{PROPERTIES}->{$p} =~ /$v/) {
198                 return 1;
199         }
200
201         return undef;
202 }
203
204 # determine if an element is a pass-by-reference structure
205 sub is_ref_struct($)
206 {
207         my $e = shift;
208         if (!is_scalar_type($e->{TYPE}) &&
209             has_property($e, "ref")) {
210                 return 1;
211         }
212         return 0;
213 }
214
215 # return 1 if the string is a C constant
216 sub is_constant($)
217 {
218         my $s = shift;
219         if (defined $s && $s =~ /^\d/) {
220                 return 1;
221         }
222         return 0;
223 }
224
225 # return a "" quoted string, unless already quoted
226 sub make_str($)
227 {
228         my $str = shift;
229         if (substr($str, 0, 1) eq "\"") {
230                 return $str;
231         }
232         return "\"" . $str . "\"";
233 }
234
235 ###################################
236 # find a sibling var in a structure
237 sub find_sibling($$)
238 {
239         my($e) = shift;
240         my($name) = shift;
241         my($fn) = $e->{PARENT};
242
243         if ($name =~ /\*(.*)/) {
244                 $name = $1;
245         }
246
247         for my $e2 (@{$fn->{ELEMENTS}}) {
248                 return $e2 if ($e2->{NAME} eq $name);
249         }
250
251         return undef;
252 }
253
254 1;