mirror of
https://github.com/samba-team/samba.git
synced 2025-12-17 04:23:50 +03:00
44775a6ac4
* C expressions that just started with a constant were erroneously flagged as being a constant. * 1-length variable names in expressions were broken.
120 lines
2.3 KiB
Perl
120 lines
2.3 KiB
Perl
###################################################
|
|
# utility functions to support pidl
|
|
# Copyright tridge@samba.org 2000
|
|
# released under the GNU GPL
|
|
package Parse::Pidl::Util;
|
|
|
|
require Exporter;
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw(has_property property_matches ParseExpr is_constant make_str print_uuid);
|
|
use vars qw($VERSION);
|
|
$VERSION = '0.01';
|
|
|
|
use strict;
|
|
|
|
#####################################################################
|
|
# a dumper wrapper to prevent dependence on the Data::Dumper module
|
|
# unless we actually need it
|
|
sub MyDumper($)
|
|
{
|
|
require Data::Dumper;
|
|
my $s = shift;
|
|
return Data::Dumper::Dumper($s);
|
|
}
|
|
|
|
#####################################################################
|
|
# see if a pidl property list contains a given property
|
|
sub has_property($$)
|
|
{
|
|
my($e, $p) = @_;
|
|
|
|
return undef if (not defined($e->{PROPERTIES}));
|
|
|
|
return $e->{PROPERTIES}->{$p};
|
|
}
|
|
|
|
#####################################################################
|
|
# see if a pidl property matches a value
|
|
sub property_matches($$$)
|
|
{
|
|
my($e,$p,$v) = @_;
|
|
|
|
if (!defined has_property($e, $p)) {
|
|
return undef;
|
|
}
|
|
|
|
if ($e->{PROPERTIES}->{$p} =~ /$v/) {
|
|
return 1;
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
# return 1 if the string is a C constant
|
|
sub is_constant($)
|
|
{
|
|
my $s = shift;
|
|
if (defined $s && $s =~ /^\d$/) {
|
|
return 1;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
# return a "" quoted string, unless already quoted
|
|
sub make_str($)
|
|
{
|
|
my $str = shift;
|
|
if (substr($str, 0, 1) eq "\"") {
|
|
return $str;
|
|
}
|
|
return "\"$str\"";
|
|
}
|
|
|
|
sub 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)."}}";
|
|
}
|
|
|
|
# a hack to build on platforms that don't like negative enum values
|
|
my $useUintEnums = 0;
|
|
sub setUseUintEnums($)
|
|
{
|
|
$useUintEnums = shift;
|
|
}
|
|
sub useUintEnums()
|
|
{
|
|
return $useUintEnums;
|
|
}
|
|
|
|
sub ParseExpr($$)
|
|
{
|
|
my($expr,$varlist) = @_;
|
|
|
|
die("Undefined value in ParseExpr") if not defined($expr);
|
|
|
|
my @tokens = split /((?:[A-Za-z_])(?:(?:(?:[A-Za-z0-9_.])|(?:->))+)?)/, $expr;
|
|
my $ret = "";
|
|
|
|
foreach my $t (@tokens) {
|
|
if (defined($varlist->{$t})) {
|
|
$ret .= $varlist->{$t};
|
|
} else {
|
|
$ret .= $t;
|
|
}
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
1;
|