wmi-1.3.16 from opsview.com
This commit is contained in:
Are Casilla
@@ -0,0 +1,5 @@
|
||||
asn1.pm: asn1.yp
|
||||
yapp -s asn1.yp
|
||||
|
||||
clean:
|
||||
rm -f asn1.pm
|
||||
@@ -0,0 +1,306 @@
|
||||
########################
|
||||
# ASN.1 Parse::Yapp parser
|
||||
# Copyright (C) Stefan (metze) Metzmacher <metze@samba.org>
|
||||
# released under the GNU GPL version 2 or later
|
||||
|
||||
|
||||
|
||||
# the precedence actually doesn't matter at all for this grammer, but
|
||||
# by providing a precedence we reduce the number of conflicts
|
||||
# enormously
|
||||
%left '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ']' ':' ',' ';'
|
||||
|
||||
|
||||
################
|
||||
# grammer
|
||||
%%
|
||||
|
||||
asn1:
|
||||
identifier asn1_definitions asn1_delimitter asn1_begin asn1_decls asn1_end
|
||||
{{
|
||||
"OBJECT" => "ASN1_DEFINITION",
|
||||
"IDENTIFIER" => $_[1],
|
||||
"DATA" => $_[5]
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_delimitter:
|
||||
delimitter
|
||||
;
|
||||
|
||||
asn1_definitions:
|
||||
'DEFINITIONS'
|
||||
;
|
||||
|
||||
asn1_begin:
|
||||
'BEGIN'
|
||||
;
|
||||
|
||||
asn1_end:
|
||||
'END'
|
||||
;
|
||||
|
||||
asn1_decls:
|
||||
asn1_def
|
||||
{ [ $_[1] ] }
|
||||
| asn1_decls asn1_def
|
||||
{ push(@{$_[1]}, $_[2]); $_[1] }
|
||||
;
|
||||
|
||||
|
||||
|
||||
asn1_def:
|
||||
asn1_target asn1_delimitter asn1_application asn1_type
|
||||
{{
|
||||
"OBJECT" => "ASN1_DEF",
|
||||
"IDENTIFIER" => $_[1],
|
||||
"APPLICATION" => $_[3],
|
||||
"STRUCTURE" => $_[4]
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_target:
|
||||
identifier
|
||||
;
|
||||
|
||||
asn1_application:
|
||||
#empty
|
||||
| '[' 'APPLICATION' constant ']'
|
||||
{ $_[3] }
|
||||
;
|
||||
|
||||
asn1_type:
|
||||
asn1_boolean
|
||||
| asn1_integer
|
||||
| asn1_bit_string
|
||||
| asn1_octet_string
|
||||
| asn1_null
|
||||
| asn1_object_identifier
|
||||
| asn1_real
|
||||
| asn1_enumerated
|
||||
| asn1_sequence
|
||||
| identifier
|
||||
;
|
||||
|
||||
asn1_boolean:
|
||||
'BOOLEAN'
|
||||
{{
|
||||
"TYPE" => "BOOLEAN",
|
||||
"TAG" => 1
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_integer:
|
||||
'INTEGER'
|
||||
{{
|
||||
"TYPE" => "INTEGER",
|
||||
"TAG" => 2
|
||||
}}
|
||||
| 'INTEGER' '(' constant '.' '.' constant ')'
|
||||
{{
|
||||
"TYPE" => "INTEGER",
|
||||
"TAG" => 2,
|
||||
"RANGE_LOW" => $_[3],
|
||||
"RENAGE_HIGH" => $_[6]
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_bit_string:
|
||||
'BIT' 'STRING'
|
||||
{{
|
||||
"TYPE" => "BIT STRING",
|
||||
"TAG" => 3
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_octet_string:
|
||||
'OCTET' 'STRING'
|
||||
{{
|
||||
"TYPE" => "OCTET STRING",
|
||||
"TAG" => 4
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_null:
|
||||
'NULL'
|
||||
{{
|
||||
"TYPE" => "NULL",
|
||||
"TAG" => 5
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_object_identifier:
|
||||
'OBJECT' 'IDENTIFIER'
|
||||
{{
|
||||
"TYPE" => "OBJECT IDENTIFIER",
|
||||
"TAG" => 6
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_real:
|
||||
'REAL'
|
||||
{{
|
||||
"TYPE" => "REAL",
|
||||
"TAG" => 9
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_enumerated:
|
||||
'ENUMERATED'
|
||||
{{
|
||||
"TYPE" => "ENUMERATED",
|
||||
"TAG" => 10
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_sequence:
|
||||
'SEQUENCE' '{' asn1_var_dec_list '}'
|
||||
{{
|
||||
"TYPE" => "SEQUENCE",
|
||||
"TAG" => 16,
|
||||
"STRUCTURE" => $_[3]
|
||||
}}
|
||||
;
|
||||
|
||||
asn1_var_dec_list:
|
||||
asn1_var_dec
|
||||
{ [ $_[1] ] }
|
||||
| asn1_var_dec_list ',' asn1_var_dec
|
||||
{ push(@{$_[1]}, $_[3]); $_[1] }
|
||||
;
|
||||
|
||||
asn1_var_dec:
|
||||
identifier asn1_type
|
||||
{{
|
||||
"NAME" => $_[1],
|
||||
"TYPE" => $_[2]
|
||||
}}
|
||||
;
|
||||
|
||||
anytext: #empty { "" }
|
||||
| identifier | constant | text
|
||||
| anytext '-' anytext { "$_[1]$_[2]$_[3]" }
|
||||
| anytext '.' anytext { "$_[1]$_[2]$_[3]" }
|
||||
| anytext '*' anytext { "$_[1]$_[2]$_[3]" }
|
||||
| anytext '>' anytext { "$_[1]$_[2]$_[3]" }
|
||||
| anytext '|' anytext { "$_[1]$_[2]$_[3]" }
|
||||
| anytext '&' anytext { "$_[1]$_[2]$_[3]" }
|
||||
| anytext '/' anytext { "$_[1]$_[2]$_[3]" }
|
||||
| anytext '+' anytext { "$_[1]$_[2]$_[3]" }
|
||||
| anytext '(' anytext ')' anytext { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
|
||||
;
|
||||
|
||||
delimitter: DELIMITTER
|
||||
;
|
||||
|
||||
identifier: IDENTIFIER
|
||||
;
|
||||
|
||||
constant: CONSTANT
|
||||
;
|
||||
|
||||
text: TEXT { "\"$_[1]\"" }
|
||||
;
|
||||
|
||||
#####################################
|
||||
# start code
|
||||
%%
|
||||
|
||||
use util;
|
||||
|
||||
sub _ASN1_Error {
|
||||
if (exists $_[0]->YYData->{ERRMSG}) {
|
||||
print $_[0]->YYData->{ERRMSG};
|
||||
delete $_[0]->YYData->{ERRMSG};
|
||||
return;
|
||||
};
|
||||
my $line = $_[0]->YYData->{LINE};
|
||||
my $last_token = $_[0]->YYData->{LAST_TOKEN};
|
||||
my $file = $_[0]->YYData->{INPUT_FILENAME};
|
||||
|
||||
print "$file:$line: Syntax error near '$last_token'\n";
|
||||
}
|
||||
|
||||
sub _ASN1_Lexer($)
|
||||
{
|
||||
my($parser)=shift;
|
||||
|
||||
$parser->YYData->{INPUT}
|
||||
or return('',undef);
|
||||
|
||||
again:
|
||||
$parser->YYData->{INPUT} =~ s/^[ \t]*//;
|
||||
|
||||
for ($parser->YYData->{INPUT}) {
|
||||
if (/^\#/) {
|
||||
if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
|
||||
$parser->YYData->{LINE} = $1-1;
|
||||
$parser->YYData->{INPUT_FILENAME} = $2;
|
||||
goto again;
|
||||
}
|
||||
if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
|
||||
$parser->YYData->{LINE} = $1-1;
|
||||
$parser->YYData->{INPUT_FILENAME} = $2;
|
||||
goto again;
|
||||
}
|
||||
if (s/^(\#.*)$//m) {
|
||||
goto again;
|
||||
}
|
||||
}
|
||||
if (s/^(\n)//) {
|
||||
$parser->YYData->{LINE}++;
|
||||
goto again;
|
||||
}
|
||||
if (s/^(--.*\n)//) {
|
||||
$parser->YYData->{LINE}++;
|
||||
goto again;
|
||||
}
|
||||
if (s/^(::=)//) {
|
||||
$parser->YYData->{LAST_TOKEN} = $1;
|
||||
return('DELIMITTER',$1);
|
||||
}
|
||||
if (s/^\"(.*?)\"//) {
|
||||
$parser->YYData->{LAST_TOKEN} = $1;
|
||||
return('TEXT',$1);
|
||||
}
|
||||
if (s/^(\d+)(\W|$)/$2/) {
|
||||
$parser->YYData->{LAST_TOKEN} = $1;
|
||||
return('CONSTANT',$1);
|
||||
}
|
||||
if (s/^([\w_-]+)//) {
|
||||
$parser->YYData->{LAST_TOKEN} = $1;
|
||||
if ($1 =~
|
||||
/^(SEQUENCE|INTEGER|OCTET|STRING|
|
||||
APPLICATION|OPTIONAL|NULL|COMPONENTS|OF|
|
||||
BOOLEAN|ENUMERATED|CHOISE|REAL|BIT|OBJECT|IDENTIFIER|
|
||||
DEFAULT|FALSE|TRUE|SET|DEFINITIONS|BEGIN|END)$/x) {
|
||||
return $1;
|
||||
}
|
||||
return('IDENTIFIER',$1);
|
||||
}
|
||||
if (s/^(.)//s) {
|
||||
$parser->YYData->{LAST_TOKEN} = $1;
|
||||
return($1,$1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub parse_asn1($$)
|
||||
{
|
||||
my $self = shift;
|
||||
my $filename = shift;
|
||||
|
||||
my $saved_delim = $/;
|
||||
undef $/;
|
||||
my $cpp = $ENV{CPP};
|
||||
if (! defined $cpp) {
|
||||
$cpp = "cpp"
|
||||
}
|
||||
my $data = `$cpp -xc $filename`;
|
||||
$/ = $saved_delim;
|
||||
|
||||
$self->YYData->{INPUT} = $data;
|
||||
$self->YYData->{LINE} = 0;
|
||||
$self->YYData->{LAST_TOKEN} = "NONE";
|
||||
return $self->YYParse( yylex => \&_ASN1_Lexer, yyerror => \&_ASN1_Error );
|
||||
}
|
||||
Executable
+93
@@ -0,0 +1,93 @@
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
###################################################
|
||||
# package to parse ASN.1 files and generate code for
|
||||
# LDAP functions in Samba
|
||||
# Copyright tridge@samba.org 2002-2003
|
||||
# Copyright metze@samba.org 2004
|
||||
|
||||
# released under the GNU GPL
|
||||
|
||||
use strict;
|
||||
|
||||
use FindBin qw($RealBin);
|
||||
use lib "$RealBin";
|
||||
use lib "$RealBin/lib";
|
||||
use Getopt::Long;
|
||||
use File::Basename;
|
||||
use asn1;
|
||||
use util;
|
||||
|
||||
my($opt_help) = 0;
|
||||
my($opt_output);
|
||||
|
||||
my $asn1_parser = new asn1;
|
||||
|
||||
#####################################################################
|
||||
# parse an ASN.1 file returning a structure containing all the data
|
||||
sub ASN1Parse($)
|
||||
{
|
||||
my $filename = shift;
|
||||
my $asn1 = $asn1_parser->parse_asn1($filename);
|
||||
util::CleanData($asn1);
|
||||
return $asn1;
|
||||
}
|
||||
|
||||
|
||||
#########################################
|
||||
# display help text
|
||||
sub ShowHelp()
|
||||
{
|
||||
print "
|
||||
perl ASN.1 parser and code generator
|
||||
Copyright (C) tridge\@samba.org
|
||||
Copyright (C) metze\@samba.org
|
||||
|
||||
Usage: pasn1.pl [options] <asn1file>
|
||||
|
||||
Options:
|
||||
--help this help page
|
||||
--output OUTNAME put output in OUTNAME
|
||||
\n";
|
||||
exit(0);
|
||||
}
|
||||
|
||||
# main program
|
||||
GetOptions (
|
||||
'help|h|?' => \$opt_help,
|
||||
'output|o=s' => \$opt_output,
|
||||
);
|
||||
|
||||
if ($opt_help) {
|
||||
ShowHelp();
|
||||
exit(0);
|
||||
}
|
||||
|
||||
sub process_file($)
|
||||
{
|
||||
my $input_file = shift;
|
||||
my $output_file;
|
||||
my $pasn1;
|
||||
|
||||
my $basename = basename($input_file, ".asn1");
|
||||
|
||||
if (!defined($opt_output)) {
|
||||
$output_file = util::ChangeExtension($input_file, ".pasn1");
|
||||
} else {
|
||||
$output_file = $opt_output;
|
||||
}
|
||||
|
||||
# if (file is .pasn1) {
|
||||
# $pasn1 = util::LoadStructure($pasn1_file);
|
||||
# defined $pasn1 || die "Failed to load $pasn1_file - maybe you need --parse\n";
|
||||
# } else {
|
||||
$pasn1 = ASN1Parse($input_file);
|
||||
defined $pasn1 || die "Failed to parse $input_file";
|
||||
util::SaveStructure($output_file, $pasn1) ||
|
||||
die "Failed to save $output_file\n";
|
||||
#}
|
||||
}
|
||||
|
||||
foreach my $filename (@ARGV) {
|
||||
process_file($filename);
|
||||
}
|
||||
@@ -0,0 +1,379 @@
|
||||
###################################################
|
||||
# utility functions to support pidl
|
||||
# Copyright tridge@samba.org 2000
|
||||
# released under the GNU GPL
|
||||
package util;
|
||||
|
||||
#####################################################################
|
||||
# load a data structure from a file (as saved with SaveStructure)
|
||||
sub LoadStructure($)
|
||||
{
|
||||
my $f = shift;
|
||||
my $contents = FileLoad($f);
|
||||
defined $contents || return undef;
|
||||
return eval "$contents";
|
||||
}
|
||||
|
||||
use strict;
|
||||
|
||||
#####################################################################
|
||||
# flatten an array of arrays into a single array
|
||||
sub FlattenArray2($)
|
||||
{
|
||||
my $a = shift;
|
||||
my @b;
|
||||
for my $d (@{$a}) {
|
||||
for my $d1 (@{$d}) {
|
||||
push(@b, $d1);
|
||||
}
|
||||
}
|
||||
return \@b;
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
# flatten an array of arrays into a single array
|
||||
sub FlattenArray($)
|
||||
{
|
||||
my $a = shift;
|
||||
my @b;
|
||||
for my $d (@{$a}) {
|
||||
for my $d1 (@{$d}) {
|
||||
push(@b, $d1);
|
||||
}
|
||||
}
|
||||
return \@b;
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
# flatten an array of hashes into a single hash
|
||||
sub FlattenHash($)
|
||||
{
|
||||
my $a = shift;
|
||||
my %b;
|
||||
for my $d (@{$a}) {
|
||||
for my $k (keys %{$d}) {
|
||||
$b{$k} = $d->{$k};
|
||||
}
|
||||
}
|
||||
return \%b;
|
||||
}
|
||||
|
||||
|
||||
#####################################################################
|
||||
# traverse a perl data structure removing any empty arrays or
|
||||
# hashes and any hash elements that map to undef
|
||||
sub CleanData($)
|
||||
{
|
||||
sub CleanData($);
|
||||
my($v) = shift;
|
||||
if (ref($v) eq "ARRAY") {
|
||||
foreach my $i (0 .. $#{$v}) {
|
||||
CleanData($v->[$i]);
|
||||
if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) {
|
||||
$v->[$i] = undef;
|
||||
next;
|
||||
}
|
||||
}
|
||||
# this removes any undefined elements from the array
|
||||
@{$v} = grep { defined $_ } @{$v};
|
||||
} elsif (ref($v) eq "HASH") {
|
||||
foreach my $x (keys %{$v}) {
|
||||
CleanData($v->{$x});
|
||||
if (!defined $v->{$x}) { delete($v->{$x}); next; }
|
||||
if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#####################################################################
|
||||
# return the modification time of a file
|
||||
sub FileModtime($)
|
||||
{
|
||||
my($filename) = shift;
|
||||
return (stat($filename))[9];
|
||||
}
|
||||
|
||||
|
||||
#####################################################################
|
||||
# read a file into a string
|
||||
sub FileLoad($)
|
||||
{
|
||||
my($filename) = shift;
|
||||
local(*INPUTFILE);
|
||||
open(INPUTFILE, $filename) || return undef;
|
||||
my($saved_delim) = $/;
|
||||
undef $/;
|
||||
my($data) = <INPUTFILE>;
|
||||
close(INPUTFILE);
|
||||
$/ = $saved_delim;
|
||||
return $data;
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
# write a string into a file
|
||||
sub FileSave($$)
|
||||
{
|
||||
my($filename) = shift;
|
||||
my($v) = shift;
|
||||
local(*FILE);
|
||||
open(FILE, ">$filename") || die "can't open $filename";
|
||||
print FILE $v;
|
||||
close(FILE);
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
# return a filename with a changed extension
|
||||
sub ChangeExtension($$)
|
||||
{
|
||||
my($fname) = shift;
|
||||
my($ext) = shift;
|
||||
if ($fname =~ /^(.*)\.(.*?)$/) {
|
||||
return "$1$ext";
|
||||
}
|
||||
return "$fname$ext";
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
# 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);
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
# save a data structure into a file
|
||||
sub SaveStructure($$)
|
||||
{
|
||||
my($filename) = shift;
|
||||
my($v) = shift;
|
||||
FileSave($filename, MyDumper($v));
|
||||
}
|
||||
|
||||
#####################################################################
|
||||
# see if a pidl property list contains a give property
|
||||
sub has_property($$)
|
||||
{
|
||||
my($e) = shift;
|
||||
my($p) = shift;
|
||||
|
||||
if (!defined $e->{PROPERTIES}) {
|
||||
return undef;
|
||||
}
|
||||
|
||||
return $e->{PROPERTIES}->{$p};
|
||||
}
|
||||
|
||||
|
||||
sub is_scalar_type($)
|
||||
{
|
||||
my($type) = shift;
|
||||
|
||||
if ($type =~ /^u?int\d+/) {
|
||||
return 1;
|
||||
}
|
||||
if ($type =~ /char|short|long|NTTIME|
|
||||
time_t|error_status_t|boolean32|unsigned32|
|
||||
HYPER_T|wchar_t|DATA_BLOB/x) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# return the NDR alignment for a type
|
||||
sub type_align($)
|
||||
{
|
||||
my($e) = shift;
|
||||
my $type = $e->{TYPE};
|
||||
|
||||
if (need_wire_pointer($e)) {
|
||||
return 4;
|
||||
}
|
||||
|
||||
return 4, if ($type eq "uint32");
|
||||
return 4, if ($type eq "long");
|
||||
return 2, if ($type eq "short");
|
||||
return 1, if ($type eq "char");
|
||||
return 1, if ($type eq "uint8");
|
||||
return 2, if ($type eq "uint16");
|
||||
return 4, if ($type eq "NTTIME");
|
||||
return 4, if ($type eq "time_t");
|
||||
return 8, if ($type eq "HYPER_T");
|
||||
return 2, if ($type eq "wchar_t");
|
||||
return 4, if ($type eq "DATA_BLOB");
|
||||
|
||||
# it must be an external type - all we can do is guess
|
||||
return 4;
|
||||
}
|
||||
|
||||
# this is used to determine if the ndr push/pull functions will need
|
||||
# a ndr_flags field to split by buffers/scalars
|
||||
sub is_builtin_type($)
|
||||
{
|
||||
my($type) = shift;
|
||||
|
||||
return 1, if (is_scalar_type($type));
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# determine if an element needs a reference pointer on the wire
|
||||
# in its NDR representation
|
||||
sub need_wire_pointer($)
|
||||
{
|
||||
my $e = shift;
|
||||
if ($e->{POINTERS} &&
|
||||
!has_property($e, "ref")) {
|
||||
return $e->{POINTERS};
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# determine if an element is a pass-by-reference structure
|
||||
sub is_ref_struct($)
|
||||
{
|
||||
my $e = shift;
|
||||
if (!is_scalar_type($e->{TYPE}) &&
|
||||
has_property($e, "ref")) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
# determine if an element is a pure scalar. pure scalars do not
|
||||
# have a "buffers" section in NDR
|
||||
sub is_pure_scalar($)
|
||||
{
|
||||
my $e = shift;
|
||||
if (has_property($e, "ref")) {
|
||||
return 1;
|
||||
}
|
||||
if (is_scalar_type($e->{TYPE}) &&
|
||||
!$e->{POINTERS} &&
|
||||
!array_size($e)) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
# determine the array size (size_is() or ARRAY_LEN)
|
||||
sub array_size($)
|
||||
{
|
||||
my $e = shift;
|
||||
my $size = has_property($e, "size_is");
|
||||
if ($size) {
|
||||
return $size;
|
||||
}
|
||||
$size = $e->{ARRAY_LEN};
|
||||
if ($size) {
|
||||
return $size;
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
# see if a variable needs to be allocated by the NDR subsystem on pull
|
||||
sub need_alloc($)
|
||||
{
|
||||
my $e = shift;
|
||||
|
||||
if (has_property($e, "ref")) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
if ($e->{POINTERS} || array_size($e)) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
# determine the C prefix used to refer to a variable when passing to a push
|
||||
# function. This will be '*' for pointers to scalar types, '' for scalar
|
||||
# types and normal pointers and '&' for pass-by-reference structures
|
||||
sub c_push_prefix($)
|
||||
{
|
||||
my $e = shift;
|
||||
|
||||
if ($e->{TYPE} =~ "string") {
|
||||
return "";
|
||||
}
|
||||
|
||||
if (is_scalar_type($e->{TYPE}) &&
|
||||
$e->{POINTERS}) {
|
||||
return "*";
|
||||
}
|
||||
if (!is_scalar_type($e->{TYPE}) &&
|
||||
!$e->{POINTERS} &&
|
||||
!array_size($e)) {
|
||||
return "&";
|
||||
}
|
||||
return "";
|
||||
}
|
||||
|
||||
|
||||
# determine the C prefix used to refer to a variable when passing to a pull
|
||||
# return '&' or ''
|
||||
sub c_pull_prefix($)
|
||||
{
|
||||
my $e = shift;
|
||||
|
||||
if (!$e->{POINTERS} && !array_size($e)) {
|
||||
return "&";
|
||||
}
|
||||
|
||||
if ($e->{TYPE} =~ "string") {
|
||||
return "&";
|
||||
}
|
||||
|
||||
return "";
|
||||
}
|
||||
|
||||
# determine if an element has a direct buffers component
|
||||
sub has_direct_buffers($)
|
||||
{
|
||||
my $e = shift;
|
||||
if ($e->{POINTERS} || array_size($e)) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
# return 1 if the string is a C constant
|
||||
sub is_constant($)
|
||||
{
|
||||
my $s = shift;
|
||||
if ($s =~ /^\d/) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
# return 1 if this is a fixed array
|
||||
sub is_fixed_array($)
|
||||
{
|
||||
my $e = shift;
|
||||
my $len = $e->{"ARRAY_LEN"};
|
||||
if (defined $len && is_constant($len)) {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
# return 1 if this is a inline array
|
||||
sub is_inline_array($)
|
||||
{
|
||||
my $e = shift;
|
||||
my $len = $e->{"ARRAY_LEN"};
|
||||
if (is_fixed_array($e) ||
|
||||
defined $len && $len ne "*") {
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
Reference in New Issue
Block a user