#################################################### utility functions to support pidl# Copyright tridge@samba.org 2000# released under the GNU GPLpackage Parse::Pidl::Util;require Exporter;@ISA = qw(Exporter);@EXPORT = qw(has_property property_matches ParseExpr ParseExprExt is_constant make_str unmake_str print_uuid MyDumper);use vars qw($VERSION);$VERSION = '0.01';use strict;use Parse::Pidl::Expr;use Parse::Pidl qw(error);=head1 NAMEParse::Pidl::Util - Generic utility functions for pidl=head1 SYNOPSISuse Parse::Pidl::Util;=head1 DESCRIPTIONSimple module that contains a couple of trivial helper functions used throughout the various pidl modules.=head1 FUNCTIONS=over 4=cut=item B<MyDumper>a dumper wrapper to prevent dependence on the Data::Dumper moduleunless we actually need it=cutsub MyDumper($){	require Data::Dumper;	my $s = shift;	return Data::Dumper::Dumper($s);}=item B<has_property>see if a pidl property list contains a given property=cutsub has_property($$){	my($e, $p) = @_;	return undef if (not defined($e->{PROPERTIES}));	return $e->{PROPERTIES}->{$p};}=item B<property_matches>see if a pidl property matches a value=cutsub property_matches($$$){	my($e,$p,$v) = @_;	if (!defined has_property($e, $p)) {		return undef;	}	if ($e->{PROPERTIES}->{$p} =~ /$v/) {		return 1;	}	return undef;}=item B<is_constant>return 1 if the string is a C constant=cutsub is_constant($){	my $s = shift;	return 1 if ($s =~ /^\d+$/);	return 1 if ($s =~ /^0x[0-9A-Fa-f]+$/);	return 0;}=item B<make_str>return a "" quoted string, unless already quoted=cutsub make_str($){	my $str = shift;	if (substr($str, 0, 1) eq "\"") {		return $str;	}	return "\"$str\"";}=item B<unmake_str>unquote a "" quoted string=cutsub unmake_str($){	my $str = shift;		$str =~ s/^\"(.*)\"$/$1/;	return $str;}=item B<print_uuid>Print C representation of a UUID.=cutsub print_uuid($){	my ($uuid) = @_;	$uuid =~ s/"//g;	my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;	return undef if not defined($node);	my @clock_seq = $clock_seq =~ /(..)/g;	my @node = $node =~ /(..)/g;	return "{0x$time_low,0x$time_mid,0x$time_hi," .		"{".join(',', map {"0x$_"} @clock_seq)."}," .		"{".join(',', map {"0x$_"} @node)."}}";}=item B<ParseExpr>Interpret an IDL expression, substituting particular variables.=cutsub ParseExpr($$$){	my($expr, $varlist, $e) = @_;	my $x = new Parse::Pidl::Expr();		return $x->Run($expr, sub { my $x = shift; error($e, $x); },		# Lookup fn 		sub { my $x = shift; 			  return($varlist->{$x}) if (defined($varlist->{$x})); 			  return $x;		  },		undef, undef);}=item B<ParseExprExt>Interpret an IDL expression, substituting particular variables. Can call callbacks when pointers are being dereferenced or variables are being used.=cutsub ParseExprExt($$$$$){	my($expr, $varlist, $e, $deref, $use) = @_;	my $x = new Parse::Pidl::Expr();		return $x->Run($expr, sub { my $x = shift; error($e, $x); },		# Lookup fn 		sub { my $x = shift; 			  return($varlist->{$x}) if (defined($varlist->{$x})); 			  return $x;		  },		$deref, $use);}=back=cut1;