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 # a dumper wrapper to prevent dependence on the Data::Dumper module
  92 # unless we actually need it
  93 sub MyDumper($)
  94 {
  95         require Data::Dumper;
  96         my $s = shift;
  97         return Data::Dumper::Dumper($s);
  98 }
  99
 100 #####################################################################
 101 # see if a pidl property list contains a given property
 102 sub has_property($$)
 103 {
 104         my($e) = shift;
 105         my($p) = shift;
 106
 107         if (!defined $e->{PROPERTIES}) {
 108                 return undef;
 109         }
 110
 111         return $e->{PROPERTIES}->{$p};
 112 }
 113
 114 #####################################################################
 115 # see if a pidl property matches a value
 116 sub property_matches($$$)
 117 {
 118         my($e) = shift;
 119         my($p) = shift;
 120         my($v) = shift;
 121
 122         if (!defined has_property($e, $p)) {
 123                 return undef;
 124         }
 125
 126         if ($e->{PROPERTIES}->{$p} =~ /$v/) {
 127                 return 1;
 128         }
 129
 130         return undef;
 131 }
 132
 133 # return 1 if the string is a C constant
 134 sub is_constant($)
 135 {
 136         my $s = shift;
 137         if (defined $s && $s =~ /^\d/) {
 138                 return 1;
 139         }
 140         return 0;
 141 }
 142
 143 # return a "" quoted string, unless already quoted
 144 sub make_str($)
 145 {
 146         my $str = shift;
 147         if (substr($str, 0, 1) eq "\"") {
 148                 return $str;
 149         }
 150         return "\"" . $str . "\"";
 151 }
 152
 153 # a hack to build on platforms that don't like negative enum values
 154 my $useUintEnums = 0;
 155 sub setUseUintEnums($)
 156 {
 157         $useUintEnums = shift;
 158 }
 159 sub useUintEnums()
 160 {
 161         return $useUintEnums;
 162 }
 163
 164 sub ParseExpr($$)
 165 {
 166         my($expr,$varlist) = @_;
 167
 168         die("Undefined value in ParseExpr") if not defined($expr);
 169
 170         my @tokens = split /((?:[A-Za-z_])(?:(?:(?:[A-Za-z0-9_.])|(?:->))+))/, $expr;
 171         my $ret = "";
 172
 173         foreach my $t (@tokens) {
 174                 if (defined($varlist->{$t})) {
 175                         $ret .= $varlist->{$t};
 176                 } else {
 177                         $ret .= $t;
 178                 }
 179         }
 180
 181         return $ret;
 182 }
 183
 184 1;