1 ###################################################
2 # utility functions to support pidl
3 # Copyright tridge@samba.org 2000
4 # released under the GNU GPL
5 package Parse::Pidl::Util;
9 @EXPORT = qw(has_property property_matches ParseExpr ParseExprExt is_constant make_str print_uuid MyDumper);
10 use vars qw($VERSION);
15 use Parse::Pidl::Expr;
16 use Parse::Pidl qw(error);
18 #####################################################################
19 # a dumper wrapper to prevent dependence on the Data::Dumper module
20 # unless we actually need it
25 return Data::Dumper::Dumper($s);
28 #####################################################################
29 # see if a pidl property list contains a given property
34 return undef if (not defined($e->{PROPERTIES}));
36 return $e->{PROPERTIES}->{$p};
39 #####################################################################
40 # see if a pidl property matches a value
41 sub property_matches($$$)
45 if (!defined has_property($e, $p)) {
49 if ($e->{PROPERTIES}->{$p} =~ /$v/) {
56 # return 1 if the string is a C constant
60 return 1 if (defined $s && $s =~ /^\d+$/);
61 return 1 if (defined $s && $s =~ /^0x[0-9A-Fa-f]+$/);
65 # return a "" quoted string, unless already quoted
69 if (substr($str, 0, 1) eq "\"") {
79 my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;
80 return undef if not defined($node);
82 my @clock_seq = $clock_seq =~ /(..)/g;
83 my @node = $node =~ /(..)/g;
85 return "{0x$time_low,0x$time_mid,0x$time_hi," .
86 "{".join(',', map {"0x$_"} @clock_seq)."}," .
87 "{".join(',', map {"0x$_"} @node)."}}";
92 my($expr, $varlist, $e) = @_;
94 die("Undefined value in ParseExpr") if not defined($expr);
96 my $x = new Parse::Pidl::Expr();
98 return $x->Run($expr, sub { my $x = shift; error($e, $x); },
101 return($varlist->{$x}) if (defined($varlist->{$x}));
107 sub ParseExprExt($$$$)
109 my($expr, $varlist, $e, $deref) = @_;
111 die("Undefined value in ParseExpr") if not defined($expr);
113 my $x = new Parse::Pidl::Expr();
115 return $x->Run($expr, sub { my $x = shift; error($e, $x); },
118 return($varlist->{$x}) if (defined($varlist->{$x}));