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 unmake_str print_uuid MyDumper);
10 use vars qw($VERSION);
15 use Parse::Pidl::Expr;
16 use Parse::Pidl qw(error);
20 Parse::Pidl::Util - Generic utility functions for pidl
24 use Parse::Pidl::Util;
28 Simple module that contains a couple of trivial helper functions
29 used throughout the various pidl modules.
38 a dumper wrapper to prevent dependence on the Data::Dumper module
39 unless we actually need it
47 return Data::Dumper::Dumper($s);
51 see if a pidl property list contains a given property
58 return undef if (not defined($e->{PROPERTIES}));
60 return $e->{PROPERTIES}->{$p};
63 =item B<property_matches>
64 see if a pidl property matches a value
67 sub property_matches($$$)
71 if (!defined has_property($e, $p)) {
75 if ($e->{PROPERTIES}->{$p} =~ /$v/) {
83 return 1 if the string is a C constant
89 return 1 if ($s =~ /^\d+$/);
90 return 1 if ($s =~ /^0x[0-9A-Fa-f]+$/);
95 return a "" quoted string, unless already quoted
101 if (substr($str, 0, 1) eq "\"") {
108 unquote a "" quoted string
115 $str =~ s/^\"(.*)\"$/$1/;
121 Print C representation of a UUID.
128 my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;
129 return undef if not defined($node);
131 my @clock_seq = $clock_seq =~ /(..)/g;
132 my @node = $node =~ /(..)/g;
134 return "{0x$time_low,0x$time_mid,0x$time_hi," .
135 "{".join(',', map {"0x$_"} @clock_seq)."}," .
136 "{".join(',', map {"0x$_"} @node)."}}";
140 Interpret an IDL expression, substituting particular variables.
145 my($expr, $varlist, $e) = @_;
147 my $x = new Parse::Pidl::Expr();
149 return $x->Run($expr, sub { my $x = shift; error($e, $x); },
152 return($varlist->{$x}) if (defined($varlist->{$x}));
158 =item B<ParseExprExt>
159 Interpret an IDL expression, substituting particular variables. Can call
160 callbacks when pointers are being dereferenced or variables are being used.
163 sub ParseExprExt($$$$$)
165 my($expr, $varlist, $e, $deref, $use) = @_;
167 my $x = new Parse::Pidl::Expr();
169 return $x->Run($expr, sub { my $x = shift; error($e, $x); },
172 return($varlist->{$x}) if (defined($varlist->{$x}));