ad758df90b
Please note that the Alphatronics implementation does not follow the Vebon specification. An extra padding byte had to be added to the idl..
182 lines
3.2 KiB
Perl
182 lines
3.2 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 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 NAME
|
|
|
|
Parse::Pidl::Util - Generic utility functions for pidl
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Parse::Pidl::Util;
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Simple 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 module
|
|
unless we actually need it
|
|
|
|
=cut
|
|
|
|
sub 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
|
|
|
|
=cut
|
|
sub 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
|
|
|
|
=cut
|
|
sub 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
|
|
|
|
=cut
|
|
sub 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
|
|
|
|
=cut
|
|
sub make_str($)
|
|
{
|
|
my $str = shift;
|
|
if (substr($str, 0, 1) eq "\"") {
|
|
return $str;
|
|
}
|
|
return "\"$str\"";
|
|
}
|
|
|
|
=item B<unmake_str>
|
|
unquote a "" quoted string
|
|
|
|
=cut
|
|
sub unmake_str($)
|
|
{
|
|
my $str = shift;
|
|
|
|
$str =~ s/^\"(.*)\"$/$1/;
|
|
|
|
return $str;
|
|
}
|
|
|
|
=item B<print_uuid>
|
|
Print C representation of a UUID.
|
|
|
|
=cut
|
|
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)."}}";
|
|
}
|
|
|
|
=item B<ParseExpr>
|
|
Interpret an IDL expression, substituting particular variables.
|
|
|
|
=cut
|
|
sub 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.
|
|
|
|
=cut
|
|
sub 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
|
|
|
|
=cut
|
|
|
|
1;
|