pyldb: avoid segfault when adding an element with no name
[kai/samba-autobuild/.git] / 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 unmake_str print_uuid MyDumper genpad);
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 =head1 NAME
19
20 Parse::Pidl::Util - Generic utility functions for pidl
21
22 =head1 SYNOPSIS
23
24 use Parse::Pidl::Util;
25
26 =head1 DESCRIPTION
27
28 Simple module that contains a couple of trivial helper functions 
29 used throughout the various pidl modules.
30
31 =head1 FUNCTIONS
32
33 =over 4
34
35 =cut
36
37 =item B<MyDumper>
38 a dumper wrapper to prevent dependence on the Data::Dumper module
39 unless we actually need it
40
41 =cut
42
43 sub 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>
52 see if a pidl property list contains a given property
53
54 =cut
55 sub 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>
65 see if a pidl property matches a value
66
67 =cut
68 sub 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>
84 return 1 if the string is a C constant
85
86 =cut
87 sub 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>
96 return a "" quoted string, unless already quoted
97
98 =cut
99 sub 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>
109 unquote a "" quoted string
110
111 =cut
112 sub unmake_str($)
113 {
114         my $str = shift;
115         
116         $str =~ s/^\"(.*)\"$/$1/;
117
118         return $str;
119 }
120
121 =item B<print_uuid>
122 Print C representation of a UUID.
123
124 =cut
125 sub 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>
141 Interpret an IDL expression, substituting particular variables.
142
143 =cut
144 sub 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>
160 Interpret an IDL expression, substituting particular variables. Can call 
161 callbacks when pointers are being dereferenced or variables are being used.
162
163 =cut
164 sub 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>
180 return an empty string consisting of tabs and spaces suitable for proper indent
181 of C-functions.
182
183 =cut
184 sub 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
197 1;