view release on metacpan or  search on metacpan

Prima/sys/Gencls.pm  view on Meta::CPAN

				next;
			} elsif ( $tok eq 'define') {
				parse_define( $global);
				next;
			}
			putback( $tok2);
			putback( $tok);
		} elsif ( $tok eq 'use') {
			my $fid = getid;
			expect(';');
			save_context;
			my $loaded;
			foreach (@includeDirs) {
				my $f = "$_/$fid.cls";
				next unless -f $f;
				$loaded = $f;
			}
			die "$fid.cls not found\n" unless defined $loaded;
			load_file( $loaded);
			$level++;
			&load_structures;
			$level--;
			restore_context;
		} else {
			putback ( $tok);
			last;
		}
	}
}

#start of parse_file
load_file( shift);
load_structures;
$tok = gettok;
if (( $tok eq "object") || ( $tok eq "package")) {
	load_single_part( $tok);
} elsif ( $tok) {
	error "found $tok but expecting 'object' or 'package'";
} else {
	unless ( $level) {
		#$genInc = 0;
		$ownFile = $fileName;
		$ownFile =~ s/([^.]*)\..*$/$1/;
		my $out = $ownFile;
		$out =~ s[.*\/][];
		$ownCType = uc $out;
	}
}
} # end of parse_file

sub type2sv
{
	my ( $type, $name) = @_;
	$type = $mapTypes{ $type} || $type;
	if ( ref $type) {
		return "sv_$type->[PROPS]->{name}2HV(&($name))";
	} elsif ( $type eq 'Handle') {
		return "( $name ? (( $incInst)$name)-> $hMate : &PL_sv_undef)";
	} elsif ( $type eq 'string') {
		my $fname = $name;
		$fname =~ s/(.*)\b(\w+)$/${1}is_utf8.$2/;
		return "prima_svpv_utf8($name, $fname)";
	} elsif ( $type eq 'SV*') {
		return $name;
	} else {
		return "new${xsConv{$type}[7]}( $name$xsConv{$type}[5])";
	}
}

sub sv2type
{
	my ( $type, $name) = @_;
	$type = $mapTypes{ $type} || $type;
	if ( $type eq 'Handle') {
		return "$incGetMate( $name);";
	} elsif ( $type eq 'SV*') {
		return $name;
	} else {
		return "$xsConv{$type}[1]( $name$xsConv{$type}[8])";
	}
}

sub sv2type_pop
{
	my ( $type) = @_;
	$type = $mapTypes{ $type} || $type;
	if ( $type eq 'Handle') {
		return "$incGetMate( POPs);";
	} elsif ( $type eq 'SV*') {
		return 'POPs';
	} else {
		return "( $xsConv{$type}[0]) $xsConv{$type}[6]";
	}
}


sub mortal
{
	my $type = $mapTypes{ $_[0]} || $_[0];
	if ( $type eq 'SV*') {
		return '';
	} elsif ( $type eq 'Handle') {
		return 'sv_mortalcopy';
	} else {
		return 'sv_2mortal';
	}
}

sub cwrite
{
	my ( $type, $from, $to) = @_;
	$type = $mapTypes{ $type} || $type;
	if ( $type eq 'string') {
		return "strncpy( $to, $from, 255); $to\[255\]=0;";
	} else {
		return "$to = $from;";
	}
}

sub out_method_profile
# common method print sub
{