source/pidl/lib/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 make_str);
  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 # a dumper wrapper to prevent dependence on the Data::Dumper module
  57 # unless we actually need it
  58 sub MyDumper($)
  59 {
  60         require Data::Dumper;
  61         my $s = shift;
  62         return Data::Dumper::Dumper($s);
  63 }
  64
  65 #####################################################################
  66 # see if a pidl property list contains a given property
  67 sub has_property($$)
  68 {
  69         my($e) = shift;
  70         my($p) = shift;
  71
  72         if (!defined $e->{PROPERTIES}) {
  73                 return undef;
  74         }
  75
  76         return $e->{PROPERTIES}->{$p};
  77 }
  78
  79 #####################################################################
  80 # see if a pidl property matches a value
  81 sub property_matches($$$)
  82 {
  83         my($e) = shift;
  84         my($p) = shift;
  85         my($v) = shift;
  86
  87         if (!defined has_property($e, $p)) {
  88                 return undef;
  89         }
  90
  91         if ($e->{PROPERTIES}->{$p} =~ /$v/) {
  92                 return 1;
  93         }
  94
  95         return undef;
  96 }
  97
  98 # return 1 if the string is a C constant
  99 sub is_constant($)
 100 {
 101         my $s = shift;
 102         if (defined $s && $s =~ /^\d/) {
 103                 return 1;
 104         }
 105         return 0;
 106 }
 107
 108 # return a "" quoted string, unless already quoted
 109 sub make_str($)
 110 {
 111         my $str = shift;
 112         if (substr($str, 0, 1) eq "\"") {
 113                 return $str;
 114         }
 115         return "\"" . $str . "\"";
 116 }
 117
 118 # a hack to build on platforms that don't like negative enum values
 119 my $useUintEnums = 0;
 120 sub setUseUintEnums($)
 121 {
 122         $useUintEnums = shift;
 123 }
 124 sub useUintEnums()
 125 {
 126         return $useUintEnums;
 127 }
 128
 129 sub ParseExpr($$)
 130 {
 131         my($expr,$varlist) = @_;
 132
 133         die("Undefined value in ParseExpr") if not defined($expr);
 134
 135         my @tokens = split /((?:[A-Za-z_])(?:(?:(?:[A-Za-z0-9_.])|(?:->))+))/, $expr;
 136         my $ret = "";
 137
 138         foreach my $t (@tokens) {
 139                 if (defined($varlist->{$t})) {
 140                         $ret .= $varlist->{$t};
 141                 } else {
 142                         $ret .= $t;
 143                 }
 144         }
 145
 146         return $ret;
 147 }
 148
 149 1;