view release on metacpan or  search on metacpan

rev_AR_template.pl  view on Meta::CPAN

	switch( <@ $obj->{_switch} @> ){
@>         foreach my $key ( keys %{$obj->{_case}} ){
	case <@ $key @>:
@>		structToPerl( $obj->{_case}{$key}, "$LINE_INDENT\t" );
		break;
@>         }
	default:
		ARError_add( AR_RETURN_ERROR, AP_ERR_GENERAL, "<@ $class @>: Invalid case" );
		break;
	}

	ret = val;
@>     }elsif( $obj->{_list} ){
@>         my( $type, $data ) = ( $obj->{_type}, $obj->{_list}.'[i]' );
	AV *array;
	SV *val;
	I32 i;

	array = newAV();
	av_extend( array, <@ $obj->{_num} @>-1 );

	for( i = 0; i < <@ $obj->{_num} @>; ++i ){
		<@ perlCopy($type,'val',$data) @>;
		av_store( array, i, val );
	}

	ret = newRV_noinc((SV *) array);
@>     }else{
	HV *hash;
	SV *val;

	hash = newHV();

@>         foreach my $key ( keys %$obj ){
@>             structToPerl( $obj->{$key}, "$LINE_INDENT\t" );
	hv_store( hash, "<@ $key @>", <@ length($key) @>, ret, 0 );

@>         }
	ret = newRV_noinc((SV *) hash);
@>     }
}
@> }

@@ > support_generated.c



#--- END TEMPLATE ---



$ARS::CodeTemplate::DEF_CODE = ARS::CodeTemplate::compile( $ARS::CodeTemplate::TPT_CODE );
ARS::CodeTemplate::procdef( $ARS::CodeTemplate::DEF_CODE );

#use UTAN::Util;
#UTAN::Util::modFileByRegex( 'functions.c', 's/^(\s*)rev_ARQualifierStruct\(.*/$1p->qualifier.operation = AR_OPERATION_NONE;/' );


#--- EDIT HERE ---

sub evalTemplate {
	my( $tag, $type, $L, $R ) = @_;
#	print STDERR "evalTemplate( $tag, $type, $L, $R )\n";  # _DEBUG_
	$tag = lc($tag);
	$tag =~ s/^(?=[^_])/_/;

	my( $tpDef, $tp ) = ( $TEMPLATES{$tag} );
	if( !defined $tpDef ){
		die "NO TEMPLATE GROUP\n", "\$tag <$tag>  \$type <$type>  \$L <$L>  \$R <$R>\n";  # _DEBUG_
#		exit 1;
	}

#	foreach my $rx ( keys %$tpDef ){
#		if( $type =~ /^$rx$/ ){
#			$tp = $tpDef->{$rx};
#			last;
#		}
	my @match;
	for( my $i = 0; $i < $#{$tpDef}; $i+=2 ){
		$rx = $tpDef->[$i];
#		print "\$rx <$rx>\n";  # _DEBUG_
		@match = ($type =~ /^$rx$/);
		if( @match ){
			unshift @match, 1 if $rx =~ /(?<!\\)\(/;
			$tp = $tpDef->[$i+1];
			last;
		}
	}
	if( !defined $tp ){
		die "NO TEMPLATE\n", "\$tag <$tag>  \$type <$type>  \$L <$L>  \$R <$R>\n";  # _DEBUG_
#		exit 1;
	}
#	print STDERR "\$tp <", $tp, ">\n";  # _DEBUG_

	my $baseType = $type;
	$baseType =~ s/\*$//;

	my %val = ( L => $L, R => $R, T => $type, B => $baseType );
	map {$val{$_} = $match[$_]} (1..$#match) if $#match >= 1;
#	print "\$rx <", $rx, ">  \@match <", join('|',@match), ">  \%val <", join('|',%val), ">\n";  # _DEBUG_
	$tp =~ s/\%([LRTB0-9])\b/$val{$1}/g;

	return $tp;
}

sub typeCopy {
	my( $type, $L, $R ) = @_;
	$type = $CONVERT{$type}{_typedef} while defined $CONVERT{$type}{_typedef};
	my $str = evalTemplate( '_copy', $type, $L, $R );
	return $str;
}

sub perlCopy {
	my( $type, $L, $R ) = @_;
	$type = $CONVERT{$type}{_typedef} while defined $CONVERT{$type}{_typedef};
	my $str = evalTemplate( '_perl', $type, $L, $R );
	return $str;
}

sub keyFilter {
	my( $hRef, @fkey ) = @_;
	my @list;
	foreach my $fkey ( @fkey ){
		foreach my $key ( keys %$hRef ){
			push @list, $key if findSubKey($hRef->{$key},$fkey);
		}
	}
#	print STDERR "\@list <", join('|',@list), ">\n";  # _DEBUG_
	return @list;
}

sub findSubKey {
	my( $hRef, $fkey ) = @_;
	my $ret = 0;
	if( ref($hRef) eq 'HASH' ){
		foreach my $key ( keys %$hRef ){
			if( $key eq $fkey ){
				$ret = 1;
			}else{
				$ret = findSubKey( $hRef->{$key}, $fkey );
			}
			last if $ret == 1;
		}
	}
	return $ret;
}

sub versionIf {
	my( $obj ) = @_;
	if( $obj->{_min_version} && $obj->{_max_version} ){
		return '#if AR_CURRENT_API_VERSION >= '. $CURRENT_API_VERSION{$obj->{_min_version}} .' && AR_CURRENT_API_VERSION <= '. $CURRENT_API_VERSION{$obj->{_max_version}};
	}elsif( $obj->{_min_version} ){
		return '#if AR_CURRENT_API_VERSION >= ' . $CURRENT_API_VERSION{$obj->{_min_version}};
	}elsif( $obj->{_max_version} ){
		return '#if AR_CURRENT_API_VERSION <= ' . $CURRENT_API_VERSION{$obj->{_max_version}};
	}else{
		return '';
	}
}

sub versionEndif {
	my( $obj ) = @_;
	if( $obj->{_min_version} || $obj->{_max_version} ){
		return '#endif';
	}else{
		return '';
	}
}






#--- END EDIT ---