source4/build/pidl/Parse/Pidl/Util.pm

   1 ###################################################
   2 # utility functions to support pidl
   3 # Copyright tridge@samba.org 2000
   4 # released under the GNU GPL
   5 package Parse::Pidl::Util;
   6
   7 require Exporter;
   8 @ISA = qw(Exporter);
   9 @EXPORT = qw(has_property property_matches ParseExpr is_constant);
  10
  11 use strict;
  12
  13 #####################################################################
  14 # flatten an array of arrays into a single array
  15 sub FlattenArray2($)
  16 {
  17     my $a = shift;
  18     my @b;
  19     for my $d (@{$a}) {
  20         for my $d1 (@{$d}) {
  21             push(@b, $d1);
  22         }
  23     }
  24     return \@b;
  25 }
  26
  27 #####################################################################
  28 # flatten an array of arrays into a single array
  29 sub FlattenArray($)
  30 {
  31     my $a = shift;
  32     my @b;
  33     for my $d (@{$a}) {
  34         for my $d1 (@{$d}) {
  35             push(@b, $d1);
  36         }
  37     }
  38     return \@b;
  39 }
  40
  41 #####################################################################
  42 # flatten an array of hashes into a single hash
  43 sub FlattenHash($)
  44 {
  45     my $a = shift;
  46     my %b;
  47     for my $d (@{$a}) {
  48         for my $k (keys %{$d}) {
  49             $b{$k} = $d->{$k};
  50         }
  51     }
  52     return \%b;
  53 }
  54
  55 #####################################################################
  56 # return the modification time of a file
  57 sub FileModtime($)
  58 {
  59     my($filename) = shift;
  60     return (stat($filename))[9];
  61 }
  62
  63 #####################################################################
  64 # read a file into a string
  65 sub FileLoad($)
  66 {
  67     my($filename) = shift;
  68     local(*INPUTFILE);
  69     open(INPUTFILE, $filename) || return undef;
  70     my($saved_delim) = $/;
  71     undef $/;
  72     my($data) = <INPUTFILE>;
  73     close(INPUTFILE);
  74     $/ = $saved_delim;
  75     return $data;
  76 }
  77
  78 #####################################################################
  79 # write a string into a file
  80 sub FileSave($$)
  81 {
  82     my($filename) = shift;
  83     my($v) = shift;
  84     local(*FILE);
  85     open(FILE, ">$filename") || die "can't open $filename";
  86     print FILE $v;
  87     close(FILE);
  88 }
  89
  90 #####################################################################
  91 # return a filename with a changed extension
  92 sub ChangeExtension($$)
  93 {
  94     my($fname) = shift;
  95     my($ext) = shift;
  96     if ($fname =~ /^(.*)\.(.*?)$/) {
  97         return "$1$ext";
  98     }
  99     return "$fname$ext";
 100 }
 101
 102 #####################################################################
 103 # a dumper wrapper to prevent dependence on the Data::Dumper module
 104 # unless we actually need it
 105 sub MyDumper($)
 106 {
 107         require Data::Dumper;
 108         my $s = shift;
 109         return Data::Dumper::Dumper($s);
 110 }
 111
 112 #####################################################################
 113 # see if a pidl property list contains a given property
 114 sub has_property($$)
 115 {
 116         my($e) = shift;
 117         my($p) = shift;
 118
 119         if (!defined $e->{PROPERTIES}) {
 120                 return undef;
 121         }
 122
 123         return $e->{PROPERTIES}->{$p};
 124 }
 125
 126 #####################################################################
 127 # see if a pidl property matches a value
 128 sub property_matches($$$)
 129 {
 130         my($e) = shift;
 131         my($p) = shift;
 132         my($v) = shift;
 133
 134         if (!defined has_property($e, $p)) {
 135                 return undef;
 136         }
 137
 138         if ($e->{PROPERTIES}->{$p} =~ /$v/) {
 139                 return 1;
 140         }
 141
 142         return undef;
 143 }
 144
 145 # return 1 if the string is a C constant
 146 sub is_constant($)
 147 {
 148         my $s = shift;
 149         if (defined $s && $s =~ /^\d/) {
 150                 return 1;
 151         }
 152         return 0;
 153 }
 154
 155 # return a "" quoted string, unless already quoted
 156 sub make_str($)
 157 {
 158         my $str = shift;
 159         if (substr($str, 0, 1) eq "\"") {
 160                 return $str;
 161         }
 162         return "\"" . $str . "\"";
 163 }
 164
 165 # a hack to build on platforms that don't like negative enum values
 166 my $useUintEnums = 0;
 167 sub setUseUintEnums($)
 168 {
 169         $useUintEnums = shift;
 170 }
 171 sub useUintEnums()
 172 {
 173         return $useUintEnums;
 174 }
 175
 176 sub ParseExpr($$)
 177 {
 178         my($expr,$varlist) = @_;
 179
 180         die("Undefined value in ParseExpr") if not defined($expr);
 181
 182         my @tokens = split /((?:[A-Za-z_])(?:(?:(?:[A-Za-z0-9_.])|(?:->))+))/, $expr;
 183         my $ret = "";
 184
 185         foreach my $t (@tokens) {
 186                 if (defined($varlist->{$t})) {
 187                         $ret .= $varlist->{$t};
 188                 } else {
 189                         $ret .= $t;
 190                 }
 191         }
 192
 193         return $ret;
 194 }
 195
 196 1;