source4/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 print_uuid);
  10 use vars qw($VERSION);
  11 $VERSION = '0.01';
  12
  13 use strict;
  14
  15 use Parse::Pidl::Expr;
  16
  17 #####################################################################
  18 # a dumper wrapper to prevent dependence on the Data::Dumper module
  19 # unless we actually need it
  20 sub MyDumper($)
  21 {
  22         require Data::Dumper;
  23         my $s = shift;
  24         return Data::Dumper::Dumper($s);
  25 }
  26
  27 #####################################################################
  28 # see if a pidl property list contains a given property
  29 sub has_property($$)
  30 {
  31         my($e, $p) = @_;
  32
  33         return undef if (not defined($e->{PROPERTIES}));
  34
  35         return $e->{PROPERTIES}->{$p};
  36 }
  37
  38 #####################################################################
  39 # see if a pidl property matches a value
  40 sub property_matches($$$)
  41 {
  42         my($e,$p,$v) = @_;
  43
  44         if (!defined has_property($e, $p)) {
  45                 return undef;
  46         }
  47
  48         if ($e->{PROPERTIES}->{$p} =~ /$v/) {
  49                 return 1;
  50         }
  51
  52         return undef;
  53 }
  54
  55 # return 1 if the string is a C constant
  56 sub is_constant($)
  57 {
  58         my $s = shift;
  59         return 1 if (defined $s && $s =~ /^\d+$/);
  60         return 1 if (defined $s && $s =~ /^0x[0-9A-Fa-f]+$/);
  61         return 0;
  62 }
  63
  64 # return a "" quoted string, unless already quoted
  65 sub make_str($)
  66 {
  67         my $str = shift;
  68         if (substr($str, 0, 1) eq "\"") {
  69                 return $str;
  70         }
  71         return "\"$str\"";
  72 }
  73
  74 sub print_uuid($)
  75 {
  76         my ($uuid) = @_;
  77         $uuid =~ s/"//g;
  78         my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;
  79         return undef if not defined($node);
  80
  81         my @clock_seq = $clock_seq =~ /(..)/g;
  82         my @node = $node =~ /(..)/g;
  83
  84         return "{0x$time_low,0x$time_mid,0x$time_hi," .
  85                 "{".join(',', map {"0x$_"} @clock_seq)."}," .
  86                 "{".join(',', map {"0x$_"} @node)."}}";
  87 }
  88
  89 # a hack to build on platforms that don't like negative enum values
  90 my $useUintEnums = 0;
  91 sub setUseUintEnums($)
  92 {
  93         $useUintEnums = shift;
  94 }
  95 sub useUintEnums()
  96 {
  97         return $useUintEnums;
  98 }
  99
 100 sub ParseExpr($$)
 101 {
 102         my($expr, $varlist) = @_;
 103
 104         die("Undefined value in ParseExpr") if not defined($expr);
 105
 106         my $x = new Parse::Pidl::Expr();
 107
 108         return $x->Run($expr, sub { my $x = shift; die(MyDumper($x)); },
 109                 # Lookup fn
 110                 sub { my $x = shift;
 111                           return($varlist->{$x}) if (defined($varlist->{$x}));
 112                           return $x;
 113                   },
 114                 undef);
 115 }
 116
 117 1;