view release on metacpan or  search on metacpan

Jvm.pm  view on Meta::CPAN

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $DEBUG $CLASSPATH $LIBPATH);

require Exporter;
require DynaLoader;
require AutoLoader;

$DEBUG = 0;
$CLASSPATH = "."; #just to get rid of "-w" warnings.
$LIBPATH   = ".";

@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	
);
$VERSION = '0.9.2';

bootstrap Jvm $VERSION;

# Preloaded methods go here.

sub new {
    my($pkg, $className, $methodSig, @args) = @_;

    #Jvm::DEBUG("PKG: $pkg, CLASSNAME: $className, METHOD: $methodSig");

    if(_initJVM() < 0) {
	croak("Init Jvm() failed!");
    }

    if($className) {
	if(! $methodSig) {
	    die "Error: missing constructor signature!";
	}

	my(@sig) = _parseSig($methodSig);

	my($returnType) = pop(@sig);
	my $_args = _createArgs(\@sig, \@args);
	
	my $cls = findClass($className);
	if(! $cls) {
	    die "Failed to find class '$className'";
	}

	my $mid = $cls->getMethodID("<init>", $methodSig);
	if(! $mid) {
	    die "Failed to get method ID for '$methodSig'!";
	}
	return $cls->newObject($mid, $_args);
    } 

}


sub call {
    my($className, $methodName, $methodsig, @args) = @_;

    if(! $className) {
	die "Error: missing class name!";
    }
    if(! $methodName) {
	die "Error: missing method name!";
    }
    if(! $methodsig) {
	die "Error: missing method signature!";
    }


    my $class = findClass($className);
    if(! $class) {
	die "find class failed";
    }
    Jvm::DEBUG("Cls: $class");

    my $mid = $class->getStaticMethodID($methodName, $methodsig);
    if(! $mid) {
	die "find static methodID failed";
    }
    Jvm::DEBUG("Method: $mid");

    my(@sig) = _parseSig($methodsig);

    my($returnType) = pop(@sig);

    if(scalar(@sig) != scalar(@args)) {
	die "Error: The count of Signatures doesn't match that of Arguments!";
    }

    my $_args = _createArgs(\@sig, \@args);

    Jvm::DEBUG("args: $_args");

    my $ret = undef;
    if($returnType eq "Z") {
	$ret = $class->callStaticBooleanMethod($mid, $_args);
    } elsif($returnType eq "B") {
	$ret = $class->callStaticByteMethod($mid, $_args);
    } elsif($returnType eq "C") {
	$ret = $class->callStaticCharMethod($mid, $_args);
    } elsif($returnType eq "S") {
	$ret = $class->callStaticShortMethod($mid, $_args);
    } elsif($returnType eq "I") {
	$ret = $class->callStaticIntMethod($mid, $_args);
    } elsif($returnType eq "J") {
	$ret = $class->callStaticLongMethod($mid, $_args);
    } elsif($returnType eq "F") {
	$ret = $class->callStaticFloatMethod($mid, $_args);
    } elsif($returnType eq "D") {
	$ret = $class->callStaticDoubleMethod($mid, $_args);
    } elsif($returnType eq "V") {
	$ret = $class->callStaticVoidMethod($mid, $_args);
    } elsif($returnType =~/^L/) {
	$ret = $class->callStaticObjectMethod($mid, $_args);
	if($returnType eq 'Ljava/lang/String;') {
	    bless $ret, "jstring";
	    $ret = $ret->getString();
	} else {
	    # return the java object.
	}
    } elsif($returnType=~/\[/) {
	$ret = $class->callStaticObjectMethod($mid, $_args);
	bless $ret, "jobject";
	# convert jobjectArray to Perl Array 
	$ret = Jvm::returnArray($returnType, $ret);
	return (@{$ret});
    } else {
	die "unknown return Type: '$returnType'";
    }

    return $ret;
}

# Input       : "(ILjava/lang/String;)V"
# Return Array: ("I", "Ljava/lang/String;", "V")
#               The last one is return type.
sub _parseSig {
    my($sig) = @_;
    my(@in, $out);
    if($sig=~/^\((.*)\)(.+)$/) {
	@in    = _parseTypes($1);
	($out) = _parseTypes($2);