1###################################################
2# utility functions to support pidl
3# Copyright tridge@samba.org 2000
4# released under the GNU GPL
5package Parse::Pidl::Util;
6
7require Exporter;
8@ISA = qw(Exporter);
9@EXPORT = qw(has_property property_matches ParseExpr ParseExprExt is_constant make_str unmake_str print_uuid MyDumper genpad);
10use vars qw($VERSION);
11$VERSION = '0.01';
12
13use strict;
14
15use Parse::Pidl::Expr;
16use Parse::Pidl qw(error);
17
18=head1 NAME
19
20Parse::Pidl::Util - Generic utility functions for pidl
21
22=head1 SYNOPSIS
23
24use Parse::Pidl::Util;
25
26=head1 DESCRIPTION
27
28Simple module that contains a couple of trivial helper functions
29used throughout the various pidl modules.
30
31=head1 FUNCTIONS
32
33=over 4
34
35=cut
36
37=item B<MyDumper>
38a dumper wrapper to prevent dependence on the Data::Dumper module
39unless we actually need it
40
41=cut
42
43sub MyDumper($)
44{
45	require Data::Dumper;
46	$Data::Dumper::Sortkeys = 1;
47	my $s = shift;
48	return Data::Dumper::Dumper($s);
49}
50
51=item B<has_property>
52see if a pidl property list contains a given property
53
54=cut
55sub has_property($$)
56{
57	my($e, $p) = @_;
58
59	return undef if (not defined($e->{PROPERTIES}));
60
61	return $e->{PROPERTIES}->{$p};
62}
63
64=item B<property_matches>
65see if a pidl property matches a value
66
67=cut
68sub property_matches($$$)
69{
70	my($e,$p,$v) = @_;
71
72	if (!defined has_property($e, $p)) {
73		return undef;
74	}
75
76	if ($e->{PROPERTIES}->{$p} =~ /$v/) {
77		return 1;
78	}
79
80	return undef;
81}
82
83=item B<is_constant>
84return 1 if the string is a C constant
85
86=cut
87sub is_constant($)
88{
89	my $s = shift;
90	return 1 if ($s =~ /^\d+$/);
91	return 1 if ($s =~ /^0x[0-9A-Fa-f]+$/);
92	return 0;
93}
94
95=item B<make_str>
96return a "" quoted string, unless already quoted
97
98=cut
99sub make_str($)
100{
101	my $str = shift;
102	if (substr($str, 0, 1) eq "\"") {
103		return $str;
104	}
105	return "\"$str\"";
106}
107
108=item B<unmake_str>
109unquote a "" quoted string
110
111=cut
112sub unmake_str($)
113{
114	my $str = shift;
115
116	$str =~ s/^\"(.*)\"$/$1/;
117
118	return $str;
119}
120
121=item B<print_uuid>
122Print C representation of a UUID.
123
124=cut
125sub print_uuid($)
126{
127	my ($uuid) = @_;
128	$uuid =~ s/"//g;
129	my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;
130	return undef if not defined($node);
131
132	my @clock_seq = $clock_seq =~ /(..)/g;
133	my @node = $node =~ /(..)/g;
134
135	return "{0x$time_low,0x$time_mid,0x$time_hi," .
136		"{".join(',', map {"0x$_"} @clock_seq)."}," .
137		"{".join(',', map {"0x$_"} @node)."}}";
138}
139
140=item B<ParseExpr>
141Interpret an IDL expression, substituting particular variables.
142
143=cut
144sub ParseExpr($$$)
145{
146	my($expr, $varlist, $e) = @_;
147
148	my $x = new Parse::Pidl::Expr();
149
150	return $x->Run($expr, sub { my $x = shift; error($e, $x); },
151		# Lookup fn
152		sub { my $x = shift;
153			  return($varlist->{$x}) if (defined($varlist->{$x}));
154			  return $x;
155		  },
156		undef, undef);
157}
158
159=item B<ParseExprExt>
160Interpret an IDL expression, substituting particular variables. Can call
161callbacks when pointers are being dereferenced or variables are being used.
162
163=cut
164sub ParseExprExt($$$$$)
165{
166	my($expr, $varlist, $e, $deref, $use) = @_;
167
168	my $x = new Parse::Pidl::Expr();
169
170	return $x->Run($expr, sub { my $x = shift; error($e, $x); },
171		# Lookup fn
172		sub { my $x = shift;
173			  return($varlist->{$x}) if (defined($varlist->{$x}));
174			  return $x;
175		  },
176		$deref, $use);
177}
178
179=item B<genpad>
180return an empty string consisting of tabs and spaces suitable for proper indent
181of C-functions.
182
183=cut
184sub genpad($)
185{
186	my ($s) = @_;
187	my $nt = int((length($s)+1)/8);
188	my $lt = ($nt*8)-1;
189	my $ns = (length($s)-$lt);
190	return "\t"x($nt)." "x($ns);
191}
192
193=back
194
195=cut
196
1971;
198