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 # a hack to build on platforms that don't like negative enum values
 208 my $useUintEnums = 0;
 209 sub setUseUintEnums($)
 210 {
 211         $useUintEnums = shift;
 212 }
 213 sub useUintEnums()
 214 {
 215         return $useUintEnums;
 216 }
 217
 218 1;