← Back to branch summary

~zulcss/samba/server-dailies-3.4

« back to all changes in this revision

Viewing changes to pidl/lib/Parse/Pidl/Util.pm

  • Committer: Chuck Short
  • Date: 2010-09-28 20:38:39 UTC
  • Revision ID: zulcss@ubuntu.com-20100928203839-pgjulytsi9ue63x1
Initial version

Show diffs side-by-side

added added

removed removed

Lines of Context:
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);
 
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
        my $s = shift;
 
47
        return Data::Dumper::Dumper($s);
 
48
}
 
49
 
 
50
=item B<has_property>
 
51
see if a pidl property list contains a given property
 
52
 
 
53
=cut
 
54
sub has_property($$)
 
55
{
 
56
        my($e, $p) = @_;
 
57
 
 
58
        return undef if (not defined($e->{PROPERTIES}));
 
59
 
 
60
        return $e->{PROPERTIES}->{$p};
 
61
}
 
62
 
 
63
=item B<property_matches>
 
64
see if a pidl property matches a value
 
65
 
 
66
=cut
 
67
sub property_matches($$$)
 
68
{
 
69
        my($e,$p,$v) = @_;
 
70
 
 
71
        if (!defined has_property($e, $p)) {
 
72
                return undef;
 
73
        }
 
74
 
 
75
        if ($e->{PROPERTIES}->{$p} =~ /$v/) {
 
76
                return 1;
 
77
        }
 
78
 
 
79
        return undef;
 
80
}
 
81
 
 
82
=item B<is_constant>
 
83
return 1 if the string is a C constant
 
84
 
 
85
=cut
 
86
sub is_constant($)
 
87
{
 
88
        my $s = shift;
 
89
        return 1 if ($s =~ /^\d+$/);
 
90
        return 1 if ($s =~ /^0x[0-9A-Fa-f]+$/);
 
91
        return 0;
 
92
}
 
93
 
 
94
=item B<make_str>
 
95
return a "" quoted string, unless already quoted
 
96
 
 
97
=cut
 
98
sub make_str($)
 
99
{
 
100
        my $str = shift;
 
101
        if (substr($str, 0, 1) eq "\"") {
 
102
                return $str;
 
103
        }
 
104
        return "\"$str\"";
 
105
}
 
106
 
 
107
=item B<unmake_str>
 
108
unquote a "" quoted string
 
109
 
 
110
=cut
 
111
sub unmake_str($)
 
112
{
 
113
        my $str = shift;
 
114
        
 
115
        $str =~ s/^\"(.*)\"$/$1/;
 
116
 
 
117
        return $str;
 
118
}
 
119
 
 
120
=item B<print_uuid>
 
121
Print C representation of a UUID.
 
122
 
 
123
=cut
 
124
sub print_uuid($)
 
125
{
 
126
        my ($uuid) = @_;
 
127
        $uuid =~ s/"//g;
 
128
        my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;
 
129
        return undef if not defined($node);
 
130
 
 
131
        my @clock_seq = $clock_seq =~ /(..)/g;
 
132
        my @node = $node =~ /(..)/g;
 
133
 
 
134
        return "{0x$time_low,0x$time_mid,0x$time_hi," .
 
135
                "{".join(',', map {"0x$_"} @clock_seq)."}," .
 
136
                "{".join(',', map {"0x$_"} @node)."}}";
 
137
}
 
138
 
 
139
=item B<ParseExpr>
 
140
Interpret an IDL expression, substituting particular variables.
 
141
 
 
142
=cut
 
143
sub ParseExpr($$$)
 
144
{
 
145
        my($expr, $varlist, $e) = @_;
 
146
 
 
147
        my $x = new Parse::Pidl::Expr();
 
148
        
 
149
        return $x->Run($expr, sub { my $x = shift; error($e, $x); },
 
150
                # Lookup fn 
 
151
                sub { my $x = shift; 
 
152
                          return($varlist->{$x}) if (defined($varlist->{$x})); 
 
153
                          return $x;
 
154
                  },
 
155
                undef, undef);
 
156
}
 
157
 
 
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.
 
161
 
 
162
=cut
 
163
sub ParseExprExt($$$$$)
 
164
{
 
165
        my($expr, $varlist, $e, $deref, $use) = @_;
 
166
 
 
167
        my $x = new Parse::Pidl::Expr();
 
168
        
 
169
        return $x->Run($expr, sub { my $x = shift; error($e, $x); },
 
170
                # Lookup fn 
 
171
                sub { my $x = shift; 
 
172
                          return($varlist->{$x}) if (defined($varlist->{$x})); 
 
173
                          return $x;
 
174
                  },
 
175
                $deref, $use);
 
176
}
 
177
 
 
178
=back
 
179
 
 
180
=cut
 
181
 
 
182
1;