r7122: Some cleanups, simplification of the code.
[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 # traverse a perl data structure removing any empty arrays or
63 # hashes and any hash elements that map to undef
64 sub CleanData($)
65 {
66     sub CleanData($);
67     my($v) = shift;
68     if (ref($v) eq "ARRAY") {
69         foreach my $i (0 .. $#{$v}) {
70             CleanData($v->[$i]);
71             if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { 
72                     $v->[$i] = undef; 
73                     next; 
74             }
75         }
76         # this removes any undefined elements from the array
77         @{$v} = grep { defined $_ } @{$v};
78     } elsif (ref($v) eq "HASH") {
79         foreach my $x (keys %{$v}) {
80             CleanData($v->{$x});
81             if (!defined $v->{$x}) { delete($v->{$x}); next; }
82             if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
83         }
84     }
85         return $v;
86 }
87
88 #####################################################################
89 # return the modification time of a file
90 sub FileModtime($)
91 {
92     my($filename) = shift;
93     return (stat($filename))[9];
94 }
95
96 #####################################################################
97 # read a file into a string
98 sub FileLoad($)
99 {
100     my($filename) = shift;
101     local(*INPUTFILE);
102     open(INPUTFILE, $filename) || return undef;
103     my($saved_delim) = $/;
104     undef $/;
105     my($data) = <INPUTFILE>;
106     close(INPUTFILE);
107     $/ = $saved_delim;
108     return $data;
109 }
110
111 #####################################################################
112 # write a string into a file
113 sub FileSave($$)
114 {
115     my($filename) = shift;
116     my($v) = shift;
117     local(*FILE);
118     open(FILE, ">$filename") || die "can't open $filename";    
119     print FILE $v;
120     close(FILE);
121 }
122
123 #####################################################################
124 # return a filename with a changed extension
125 sub ChangeExtension($$)
126 {
127     my($fname) = shift;
128     my($ext) = shift;
129     if ($fname =~ /^(.*)\.(.*?)$/) {
130         return "$1$ext";
131     }
132     return "$fname$ext";
133 }
134
135 #####################################################################
136 # a dumper wrapper to prevent dependence on the Data::Dumper module
137 # unless we actually need it
138 sub MyDumper($)
139 {
140         require Data::Dumper;
141         my $s = shift;
142         return Data::Dumper::Dumper($s);
143 }
144
145 #####################################################################
146 # save a data structure into a file
147 sub SaveStructure($$)
148 {
149         my($filename) = shift;
150         my($v) = shift;
151         FileSave($filename, MyDumper($v));
152 }
153
154 #####################################################################
155 # see if a pidl property list contains a given property
156 sub has_property($$)
157 {
158         my($e) = shift;
159         my($p) = shift;
160
161         if (!defined $e->{PROPERTIES}) {
162                 return undef;
163         }
164
165         return $e->{PROPERTIES}->{$p};
166 }
167
168 #####################################################################
169 # see if a pidl property matches a value
170 sub property_matches($$$)
171 {
172         my($e) = shift;
173         my($p) = shift;
174         my($v) = shift;
175
176         if (!defined has_property($e, $p)) {
177                 return undef;
178         }
179
180         if ($e->{PROPERTIES}->{$p} =~ /$v/) {
181                 return 1;
182         }
183
184         return undef;
185 }
186
187 # return 1 if the string is a C constant
188 sub is_constant($)
189 {
190         my $s = shift;
191         if (defined $s && $s =~ /^\d/) {
192                 return 1;
193         }
194         return 0;
195 }
196
197 # return a "" quoted string, unless already quoted
198 sub make_str($)
199 {
200         my $str = shift;
201         if (substr($str, 0, 1) eq "\"") {
202                 return $str;
203         }
204         return "\"" . $str . "\"";
205 }
206
207 1;