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