INTERN.h Included before domestic .h files
intrpvar.h Variables held in each interpreter instance
iperlsys.h Perl's interface to the system
-jpl/bin/jpl JPL compiler
-jpl/ChangeLog Java/Perl Lingo change log
-jpl/docs/Tutorial.pod Perl and Java Tutorial
-jpl/get_jdk/get_jdk.pl JDK download tool
-jpl/get_jdk/jdk_hosts JDK availability list
-jpl/get_jdk/README Instructions for using get_jdk.pl
-jpl/install-jpl JPL install utility
-jpl/JNI/Changes Java Native Interface changes
-jpl/JNI/Closer.java Java Native Interface example
-jpl/JNI/JNIConfig Java Native Interface config
-jpl/JNI/JNIConfig.kaffe Java Native Interface config
-jpl/JNI/JNIConfig.noembed Java Native Interface config
-jpl/JNI/JNIConfig.standard Java Native Interface config
-jpl/JNI/JNIConfig.Win32 Java Native Interface config
-jpl/JNI/JNI.pm Java Native Interface module
-jpl/JNI/JNI.xs Java Native Interface module
-jpl/JNI/Makefile.PL Java Native Interface makefile generator
-jpl/JNI/test.pl Java Native Interface tests
-jpl/JNI/typemap Java/Perl interface typemap
-jpl/JNI/typemap.gcc Java/Perl interface typemap
-jpl/JNI/typemap.win32 Java/Perl interface typemap
-jpl/JPL/AutoLoader.pm Java/Perl compiler module
-jpl/JPL/Class.pm Java/Perl compiler module
-jpl/JPL/Compile.pm Java/Perl compiler module
-jpl/JPL/Makefile.PL Java/Perl makefile generator
-jpl/JPL_Rolo/cardfile Rolodex sample application
-jpl/JPL_Rolo/JPL_Rolo.jpl Rolodex sample application
-jpl/JPL_Rolo/Makefile.PL Makefile generator
-jpl/JPL_Rolo/README Instructions
-jpl/PerlInterpreter/Makefile.PL Makefile generator
-jpl/PerlInterpreter/PerlInterpreter.c Perl interpreter abstraction
-jpl/PerlInterpreter/PerlInterpreter.h Perl interpreter abstraction
-jpl/PerlInterpreter/PerlInterpreter.java Perl interpreter abstraction
-jpl/README JPL instructions
-jpl/README.JUST-JNI JPL instructions
-jpl/Sample/Makefile.PL JPL sample makefile generator
-jpl/Sample/Sample.jpl JPL sample
-jpl/SETVARS.PL JPL setup
-jpl/Test/Makefile.PL JPL tests makefile generator
-jpl/Test/Test.jpl JPL tests
keywords.h The keyword numbers
keywords.pl Program to write keywords.h
lib/abbrev.pl An abbreviation table builder
+++ /dev/null
-2000-12-18 Bradley M. Kuhn <bkuhn@ebb.org>
-
- * JNI/JNI.pm: Updated version to 0.1
-
-2000-12-16 Bradley M. Kuhn <bkuhn@ebb.org>
-
- * JNI/JNI.pm (AUTOLOAD): Added check to make sure fiels only
- appear once in CLASSPATH.
-
-2000-12-07 Bradley M. Kuhn <bkuhn@ebb.org>
-
- * JNI/JNI.xs: Added a requirement that -DJPL_DEBUG be defined for
- JNI.xs to print out jpldebug options
-
-2000-12-06 Bradley M. Kuhn <bkuhn@ebb.org>
-
- * JNI/JNI.pm: removed some stray C-m's floating in the file
-
- * README.JUST-JNI: Added instructions concerning Kaffe.
-
- * JNI/JNI.xs (GetJavaVM): Added support for Kaffe's options, and
- made sure version number gets set. Also did error checking on
- creating the JVM.
- Fixed bug on option processing.
-
- * JNI/Makefile.PL: Added support to configure Kaffe, including
- automatic creation of JNI/Config.pm (a new file).
-
- * JNI/JNI.pm (AUTOLOAD): Added support for Kaffe.
-
+++ /dev/null
-Revision history for Perl extension JNI.
-
-0.01 Wed Jun 4 13:16:03 1997
- - original version; created by h2xs 1.18
-
+++ /dev/null
-import java.awt.event.*;
-import java.awt.*;
-public class Closer extends WindowAdapter {
-
- public void windowClosing(WindowEvent e) {
- Window w = e.getWindow();
- w.dispose();
- }
-}
+++ /dev/null
-package JNI;
-
-use strict;
-use Carp;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $JVM @JVM_ARGS $JAVALIB);
-
-require Exporter;
-require DynaLoader;
-require AutoLoader;
-
-@ISA = qw(Exporter DynaLoader);
-
-@EXPORT = qw(
- JNI_ABORT
- JNI_COMMIT
- JNI_ERR
- JNI_FALSE
- JNI_H
- JNI_OK
- JNI_TRUE
- GetVersion
- DefineClass
- FindClass
- GetSuperclass
- IsAssignableFrom
- Throw
- ThrowNew
- ExceptionOccurred
- ExceptionDescribe
- ExceptionClear
- FatalError
- NewGlobalRef
- DeleteGlobalRef
- DeleteLocalRef
- IsSameObject
- AllocObject
- NewObject
- NewObjectA
- GetObjectClass
- IsInstanceOf
- GetMethodID
- CallObjectMethod
- CallObjectMethodA
- CallBooleanMethod
- CallBooleanMethodA
- CallByteMethod
- CallByteMethodA
- CallCharMethod
- CallCharMethodA
- CallShortMethod
- CallShortMethodA
- CallIntMethod
- CallIntMethodA
- CallLongMethod
- CallLongMethodA
- CallFloatMethod
- CallFloatMethodA
- CallDoubleMethod
- CallDoubleMethodA
- CallVoidMethod
- CallVoidMethodA
- CallNonvirtualObjectMethod
- CallNonvirtualObjectMethodA
- CallNonvirtualBooleanMethod
- CallNonvirtualBooleanMethodA
- CallNonvirtualByteMethod
- CallNonvirtualByteMethodA
- CallNonvirtualCharMethod
- CallNonvirtualCharMethodA
- CallNonvirtualShortMethod
- CallNonvirtualShortMethodA
- CallNonvirtualIntMethod
- CallNonvirtualIntMethodA
- CallNonvirtualLongMethod
- CallNonvirtualLongMethodA
- CallNonvirtualFloatMethod
- CallNonvirtualFloatMethodA
- CallNonvirtualDoubleMethod
- CallNonvirtualDoubleMethodA
- CallNonvirtualVoidMethod
- CallNonvirtualVoidMethodA
- GetFieldID
- GetObjectField
- GetBooleanField
- GetByteField
- GetCharField
- GetShortField
- GetIntField
- GetLongField
- GetFloatField
- GetDoubleField
- SetObjectField
- SetBooleanField
- SetByteField
- SetCharField
- SetShortField
- SetIntField
- SetLongField
- SetFloatField
- SetDoubleField
- GetStaticMethodID
- CallStaticObjectMethod
- CallStaticObjectMethodA
- CallStaticBooleanMethod
- CallStaticBooleanMethodA
- CallStaticByteMethod
- CallStaticByteMethodA
- CallStaticCharMethod
- CallStaticCharMethodA
- CallStaticShortMethod
- CallStaticShortMethodA
- CallStaticIntMethod
- CallStaticIntMethodA
- CallStaticLongMethod
- CallStaticLongMethodA
- CallStaticFloatMethod
- CallStaticFloatMethodA
- CallStaticDoubleMethod
- CallStaticDoubleMethodA
- CallStaticVoidMethod
- CallStaticVoidMethodA
- GetStaticFieldID
- GetStaticObjectField
- GetStaticBooleanField
- GetStaticByteField
- GetStaticCharField
- GetStaticShortField
- GetStaticIntField
- GetStaticLongField
- GetStaticFloatField
- GetStaticDoubleField
- SetStaticObjectField
- SetStaticBooleanField
- SetStaticByteField
- SetStaticCharField
- SetStaticShortField
- SetStaticIntField
- SetStaticLongField
- SetStaticFloatField
- SetStaticDoubleField
- NewString
- GetStringLength
- GetStringChars
- NewStringUTF
- GetStringUTFLength
- GetStringUTFChars
- GetArrayLength
- NewObjectArray
- GetObjectArrayElement
- SetObjectArrayElement
- NewBooleanArray
- NewByteArray
- NewCharArray
- NewShortArray
- NewIntArray
- NewLongArray
- NewFloatArray
- NewDoubleArray
- GetBooleanArrayElements
- GetByteArrayElements
- GetCharArrayElements
- GetShortArrayElements
- GetIntArrayElements
- GetLongArrayElements
- GetFloatArrayElements
- GetDoubleArrayElements
- GetBooleanArrayRegion
- GetByteArrayRegion
- GetCharArrayRegion
- GetShortArrayRegion
- GetIntArrayRegion
- GetLongArrayRegion
- GetFloatArrayRegion
- GetDoubleArrayRegion
- SetBooleanArrayRegion
- SetByteArrayRegion
- SetCharArrayRegion
- SetShortArrayRegion
- SetIntArrayRegion
- SetLongArrayRegion
- SetFloatArrayRegion
- SetDoubleArrayRegion
- RegisterNatives
- UnregisterNatives
- MonitorEnter
- MonitorExit
- GetJavaVM
-);
-
-$VERSION = '0.2';
-
-sub AUTOLOAD {
- # This AUTOLOAD is used to 'autoload' constants from the constant()
- # XS function. If a constant is not found then control is passed
- # to the AUTOLOAD in AutoLoader.
-
- my $constname;
- ($constname = $AUTOLOAD) =~ s/.*:://;
- my $val = constant($constname, @_ ? $_[0] : 0);
- if ($! != 0) {
- if ($! =~ /Invalid/) {
- $AutoLoader::AUTOLOAD = $AUTOLOAD;
- goto &AutoLoader::AUTOLOAD;
- }
- else {
- croak "Your vendor has not defined JNI macro $constname";
- }
- }
- eval "sub $AUTOLOAD { $val }";
- goto &$AUTOLOAD;
-}
-
-bootstrap JNI $VERSION;
-
-if (not $JPL::_env_) {
- # Note that only Kaffe support only cares about what JNI::Config says
- use JNI::Config qw($KAFFE $LD_LIBRARY_PATH $CLASS_HOME $LIB_HOME $JAVA_LIB);
-
- # Win32 and Sun JDK pay attention to $ENV{JAVA_HOME}; Kaffe doesn't
- $ENV{JAVA_HOME} ||= "/usr/local/java";
-
- my ($arch, @CLASSPATH);
- if ($^O eq 'MSWin32' and (! $JNI::Config::KAFFE) ) {
-
- $arch = 'MSWin32' unless -d "$ENV{JAVA_HOME}/lib/$arch";
- @CLASSPATH = split(/;/, $ENV{CLASSPATH});
- @CLASSPATH = "." unless @CLASSPATH;
- push @CLASSPATH,
- "$ENV{JAVA_HOME}\\classes",
- "$ENV{JAVA_HOME}\\lib\\classes.zip",
- # MSR - added for JDK 1.3
- "$ENV{JAVA_HOME}\\jre\\lib\\rt.jar",
- # MSR - added to find Closer.class
- '.';
-
- $ENV{CLASSPATH} = join(';', @CLASSPATH);
- $ENV{THREADS_TYPE} ||= "green_threads";
-
- #$JAVALIB = "$ENV{JAVA_HOME}/lib/$arch/$ENV{THREADS_TYPE}";
- # MSR - changed above for JDK 1.3
- $JAVALIB = "$ENV{JAVA_HOME}/lib/";
-
- $ENV{LD_LIBRARY_PATH} .= ":$JAVALIB";
-
- push @JVM_ARGS, "classpath", $ENV{CLASSPATH};
- print "JVM_ARGS=@JVM_ARGS!\n" if $JPL::DEBUG;
- $JVM = GetJavaVM("$JAVALIB/javai.dll",@JVM_ARGS);
- } elsif ($^O eq 'MSWin32' and $JNI::Config::KAFFE) {
- croak "Kaffe is not yet supported on MSWin32 platform!";
- } elsif ($JNI::Config::KAFFE) {
- # The following code has to build a classpath for us. It would be
- # better if we could have *both* a classpath and a classhome, and
- # not have to "guess" at the classpath like this. We should be able
- # to send in, say, a classpath of ".", and classhome of
- # ".../share/kaffe", and have it build the right classpath. That
- # doesn't work. The function initClasspath() in findInJar.c in the
- # Kaffe source says: "Oh, you have a classpath, well forget
- # classhome!" This seems brain-dead to me. But, anyway, that's why
- # I don't use the classhome option on GetJavaVM. I have to build
- # the classpath by hand. *sigh*
- # -- bkuhn
-
- my $classpath = $ENV{CLASSPATH} || ".";
- my %classCheck;
- @classCheck{split(/\s*:\s*/, $classpath)} = 1;
- foreach my $jarFile (qw(Klasses.jar comm.jar pjava.jar
- tools.jar microsoft.jar rmi.jar)) {
- $classpath .= ":$JNI::Config::CLASS_HOME/$jarFile"
- unless defined $classCheck{"$JNI::Config::CLASS_HOME/$jarFile"};
- # Assume that if someone else already put these here, they knew
- # what they were doing and have the order right.
- }
- $classpath = ".:$classpath" unless defined $classCheck{"."};
-
- $ENV{CLASSPATH} = $classpath; # Not needed for GetJavaVM(), since
- # we pass it in as a JVM option, but
- # something else might expect it.
- # (also see comment above)
- print STDERR "bkuhn: JNI classpath=$classpath\n";
- unshift(@JVM_ARGS, "classpath", $classpath,
- "libraryhome", $JNI::Config::LIB_HOME);
-
- # The following line is useless; see comment above.
- # "classhome", $JNI::Config::CLASS_HOME);
-
- $JVM = GetJavaVM($JNI::Config::JAVA_LIB, @JVM_ARGS);
- } else {
- chop($arch = `uname -p`);
- chop($arch = `uname -m`) unless -d "$ENV{JAVA_HOME}/lib/$arch";
-
- @CLASSPATH = split(/:/, $ENV{CLASSPATH});
- @CLASSPATH = "." unless @CLASSPATH;
- push @CLASSPATH,
- "$ENV{JAVA_HOME}/classes",
- "$ENV{JAVA_HOME}/lib/classes.zip";
- $ENV{CLASSPATH} = join(':', @CLASSPATH);
-
- $ENV{THREADS_TYPE} ||= "green_threads";
-
- $JAVALIB = "$ENV{JAVA_HOME}/lib/$arch/$ENV{THREADS_TYPE}";
- $ENV{LD_LIBRARY_PATH} .= ":$JAVALIB";
- push @JVM_ARGS, "classpath", $ENV{CLASSPATH};
- print "JVM_ARGS=@JVM_ARGS!\n" if $JPL::DEBUG;
- $JVM = GetJavaVM("$JAVALIB/libjava.so",@JVM_ARGS);
- }
-}
-
-1;
-__END__
-
-=head1 NAME
-
-JNI - Perl encapsulation of the Java Native Interface
-
-=head1 SYNOPSIS
-
- use JNI;
-
-=head1 DESCRIPTION
-
-=head1 Exported constants
-
- JNI_ABORT
- JNI_COMMIT
- JNI_ERR
- JNI_FALSE
- JNI_H
- JNI_OK
- JNI_TRUE
-
-
-=head1 AUTHOR
-
-Copyright 1998, O'Reilly & Associates, Inc.
-
-This package may be copied under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-perl(1).
-
-=cut
+++ /dev/null
-/*
- * Copyright 1997, O'Reilly & Associate, Inc.
- *
- * This package may be copied under the same terms as Perl itself.
- */
-
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#include <stdio.h>
-#include <jni.h>
-
-#ifndef PERL_VERSION
-# include <patchlevel.h>
-# define PERL_REVISION 5
-# define PERL_VERSION PATCHLEVEL
-# define PERL_SUBVERSION SUBVERSION
-#endif
-
-#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75))
-# define PL_na na
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_dowarn dowarn
-#endif
-
-#ifndef newSVpvn
-# define newSVpvn(a,b) newSVpv(a,b)
-#endif
-
-#ifndef pTHX
-# define pTHX void
-# define pTHX_
-# define aTHX
-# define aTHX_
-# define dTHX extern int JNI___notused
-#endif
-
-#ifndef WIN32
-# include <dlfcn.h>
-#endif
-
-#ifdef EMBEDDEDPERL
-extern JNIEnv* jplcurenv;
-extern int jpldebug;
-#else
-JNIEnv* jplcurenv;
-int jpldebug = 1;
-#endif
-
-#define SysRet jint
-
-#ifdef WIN32
-static void JNICALL call_my_exit(jint status)
-{
- my_exit(status);
-}
-#else
-static void call_my_exit(jint status)
-{
- my_exit(status);
-}
-#endif
-
-jvalue*
-makeargs(char *sig, SV** svp, int items)
-{
- jvalue* jv = (jvalue*)safemalloc(sizeof(jvalue) * items);
- int ix = 0;
- char *s = sig;
- JNIEnv* env = jplcurenv;
- char *start;
- STRLEN n_a;
-
- if (jpldebug)
- fprintf(stderr, "sig = %s, items = %d\n", sig, items);
- if (*s++ != '(')
- goto cleanup;
-
- while (items--) {
- SV *sv = *svp++;
- start = s;
- switch (*s++) {
- case 'Z':
- jv[ix++].z = (jboolean)(SvIV(sv) != 0);
- break;
- case 'B':
- jv[ix++].b = (jbyte)SvIV(sv);
- break;
- case 'C':
- jv[ix++].c = (jchar)SvIV(sv);
- break;
- case 'S':
- jv[ix++].s = (jshort)SvIV(sv);
- break;
- case 'I':
- jv[ix++].i = (jint)SvIV(sv);
- break;
- case 'J':
- jv[ix++].j = (jlong)SvNV(sv);
- break;
- case 'F':
- jv[ix++].f = (jfloat)SvNV(sv);
- break;
- case 'D':
- jv[ix++].d = (jdouble)SvNV(sv);
- break;
- case '[':
- switch (*s++) {
- case 'Z':
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- jboolean* buf = (jboolean*)malloc(len * sizeof(jboolean));
- int i;
- SV** esv;
-
- jbooleanArray ja = (*env)->NewBooleanArray(env, len);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
- buf[i] = (jboolean)SvIV(*esv);
- (*env)->SetBooleanArrayRegion(env, ja, 0, len, buf);
- free((void*)buf);
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else if (SvPOK(sv)) {
- jsize len = sv_len(sv) / sizeof(jboolean);
-
- jbooleanArray ja = (*env)->NewBooleanArray(env, len);
- (*env)->SetBooleanArrayRegion(env, ja, 0, len, (jboolean*)SvPV(sv,n_a));
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- case 'B':
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- jbyte* buf = (jbyte*)malloc(len * sizeof(jbyte));
- int i;
- SV** esv;
-
- jbyteArray ja = (*env)->NewByteArray(env, len);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
- buf[i] = (jbyte)SvIV(*esv);
- (*env)->SetByteArrayRegion(env, ja, 0, len, buf);
- free((void*)buf);
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else if (SvPOK(sv)) {
- jsize len = sv_len(sv) / sizeof(jbyte);
-
- jbyteArray ja = (*env)->NewByteArray(env, len);
- (*env)->SetByteArrayRegion(env, ja, 0, len, (jbyte*)SvPV(sv,n_a));
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- case 'C':
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- jchar* buf = (jchar*)malloc(len * sizeof(jchar));
- int i;
- SV** esv;
-
- jcharArray ja = (*env)->NewCharArray(env, len);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
- buf[i] = (jchar)SvIV(*esv);
- (*env)->SetCharArrayRegion(env, ja, 0, len, buf);
- free((void*)buf);
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else if (SvPOK(sv)) {
- jsize len = sv_len(sv) / sizeof(jchar);
-
- jcharArray ja = (*env)->NewCharArray(env, len);
- (*env)->SetCharArrayRegion(env, ja, 0, len, (jchar*)SvPV(sv,n_a));
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- case 'S':
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- jshort* buf = (jshort*)malloc(len * sizeof(jshort));
- int i;
- SV** esv;
-
- jshortArray ja = (*env)->NewShortArray(env, len);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
- buf[i] = (jshort)SvIV(*esv);
- (*env)->SetShortArrayRegion(env, ja, 0, len, buf);
- free((void*)buf);
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else if (SvPOK(sv)) {
- jsize len = sv_len(sv) / sizeof(jshort);
-
- jshortArray ja = (*env)->NewShortArray(env, len);
- (*env)->SetShortArrayRegion(env, ja, 0, len, (jshort*)SvPV(sv,n_a));
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- case 'I':
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- jint* buf = (jint*)malloc(len * sizeof(jint));
- int i;
- SV** esv;
-
- jintArray ja = (*env)->NewIntArray(env, len);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
- buf[i] = (jint)SvIV(*esv);
- (*env)->SetIntArrayRegion(env, ja, 0, len, buf);
- free((void*)buf);
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else if (SvPOK(sv)) {
- jsize len = sv_len(sv) / sizeof(jint);
-
- jintArray ja = (*env)->NewIntArray(env, len);
- (*env)->SetIntArrayRegion(env, ja, 0, len, (jint*)SvPV(sv,n_a));
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- case 'J':
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- jlong* buf = (jlong*)malloc(len * sizeof(jlong));
- int i;
- SV** esv;
-
- jlongArray ja = (*env)->NewLongArray(env, len);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
- buf[i] = (jlong)SvNV(*esv);
- (*env)->SetLongArrayRegion(env, ja, 0, len, buf);
- free((void*)buf);
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else if (SvPOK(sv)) {
- jsize len = sv_len(sv) / sizeof(jlong);
-
- jlongArray ja = (*env)->NewLongArray(env, len);
- (*env)->SetLongArrayRegion(env, ja, 0, len, (jlong*)SvPV(sv,n_a));
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- case 'F':
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- jfloat* buf = (jfloat*)malloc(len * sizeof(jfloat));
- int i;
- SV** esv;
-
- jfloatArray ja = (*env)->NewFloatArray(env, len);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
- buf[i] = (jfloat)SvNV(*esv);
- (*env)->SetFloatArrayRegion(env, ja, 0, len, buf);
- free((void*)buf);
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else if (SvPOK(sv)) {
- jsize len = sv_len(sv) / sizeof(jfloat);
-
- jfloatArray ja = (*env)->NewFloatArray(env, len);
- (*env)->SetFloatArrayRegion(env, ja, 0, len, (jfloat*)SvPV(sv,n_a));
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- case 'D':
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- jdouble* buf = (jdouble*)malloc(len * sizeof(jdouble));
- int i;
- SV** esv;
-
- jdoubleArray ja = (*env)->NewDoubleArray(env, len);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
- buf[i] = (jdouble)SvNV(*esv);
- (*env)->SetDoubleArrayRegion(env, ja, 0, len, buf);
- free((void*)buf);
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else if (SvPOK(sv)) {
- jsize len = sv_len(sv) / sizeof(jdouble);
-
- jdoubleArray ja = (*env)->NewDoubleArray(env, len);
- (*env)->SetDoubleArrayRegion(env, ja, 0, len, (jdouble*)SvPV(sv,n_a));
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- case 'L':
- while (*s != ';') s++;
- s++;
- if (strnEQ(start, "[Ljava/lang/String;", 19)) {
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- int i;
- SV** esv;
- static jclass jcl = 0;
- jobjectArray ja;
-
- if (!jcl)
- jcl = (*env)->FindClass(env, "java/lang/String");
- ja = (*env)->NewObjectArray(env, len, jcl, 0);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++) {
- jobject str = (jobject)(*env)->NewStringUTF(env, SvPV(*esv,n_a));
- (*env)->SetObjectArrayElement(env, ja, i, str);
- }
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- }
- /* FALL THROUGH */
- default:
- if (SvROK(sv)) {
- SV* rv = (SV*)SvRV(sv);
- if (SvOBJECT(rv))
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- else if (SvTYPE(rv) == SVt_PVAV) {
- jsize len = av_len((AV*)rv) + 1;
- int i;
- SV** esv;
- static jclass jcl = 0;
- jobjectArray ja;
-
- if (!jcl)
- jcl = (*env)->FindClass(env, "java/lang/Object");
- ja = (*env)->NewObjectArray(env, len, jcl, 0);
- for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++) {
- if (SvROK(*esv) && (rv = SvRV(*esv)) && SvOBJECT(rv)) {
- (*env)->SetObjectArrayElement(env, ja, i, (jobject)(void*)SvIV(rv));
- }
- else {
- jobject str = (jobject)(*env)->NewStringUTF(env, SvPV(*esv,n_a));
- (*env)->SetObjectArrayElement(env, ja, i, str);
- }
- }
- jv[ix++].l = (jobject)ja;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- }
- else
- jv[ix++].l = (jobject)(void*)0;
- break;
- }
- break;
- case 'L':
- if (!SvROK(sv) || strnEQ(s, "java/lang/String;", 17)) {
- s += 17;
- jv[ix++].l = (jobject)(*env)->NewStringUTF(env, (char*) SvPV(sv,n_a));
- break;
- }
- while (*s != ';') s++;
- s++;
- if (SvROK(sv)) {
- SV* rv = SvRV(sv);
- jv[ix++].l = (jobject)(void*)SvIV(rv);
- }
- break;
- case ')':
- croak("too many arguments, signature: %s", sig);
- goto cleanup;
- default:
- croak("panic: malformed signature: %s", s-1);
- goto cleanup;
- }
-
- }
- if (*s != ')') {
- croak("not enough arguments, signature: %s", sig);
- goto cleanup;
- }
- return jv;
-
-cleanup:
- safefree((char*)jv);
- return 0;
-}
-
-static int
-not_here(char *s)
-{
- croak("%s not implemented on this architecture", s);
- return -1;
-}
-
-static double
-constant(char *name, int arg)
-{
- errno = 0;
- switch (*name) {
- case 'A':
- break;
- case 'B':
- break;
- case 'C':
- break;
- case 'D':
- break;
- case 'E':
- break;
- case 'F':
- break;
- case 'G':
- break;
- case 'H':
- break;
- case 'I':
- break;
- case 'J':
- if (strEQ(name, "JNI_ABORT"))
-#ifdef JNI_ABORT
- return JNI_ABORT;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "JNI_COMMIT"))
-#ifdef JNI_COMMIT
- return JNI_COMMIT;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "JNI_ERR"))
-#ifdef JNI_ERR
- return JNI_ERR;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "JNI_FALSE"))
-#ifdef JNI_FALSE
- return JNI_FALSE;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "JNI_H"))
-#ifdef JNI_H
-#ifdef WIN32
- return 1;
-#else
- return JNI_H;
-#endif
-#else
- goto not_there;
-#endif
- if (strEQ(name, "JNI_OK"))
-#ifdef JNI_OK
- return JNI_OK;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "JNI_TRUE"))
-#ifdef JNI_TRUE
- return JNI_TRUE;
-#else
- goto not_there;
-#endif
- break;
- case 'K':
- break;
- case 'L':
- break;
- case 'M':
- break;
- case 'N':
- break;
- case 'O':
- break;
- case 'P':
- break;
- case 'Q':
- break;
- case 'R':
- break;
- case 'S':
- break;
- case 'T':
- break;
- case 'U':
- break;
- case 'V':
- break;
- case 'W':
- break;
- case 'X':
- break;
- case 'Y':
- break;
- case 'Z':
- break;
- }
- errno = EINVAL;
- return 0;
-
-not_there:
- errno = ENOENT;
- return 0;
-}
-
-#define FETCHENV jplcurenv
-#define RESTOREENV jplcurenv = env
-
-MODULE = JNI PACKAGE = JNI
-
-PROTOTYPES: ENABLE
-
-double
-constant(name,arg)
- char * name
- int arg
-
-jint
-GetVersion()
- JNIEnv * env = FETCHENV;
- CODE:
- {
- RETVAL = (*env)->GetVersion(env);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jclass
-DefineClass(name, loader, buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jsize buf_len_ = NO_INIT;
- const char * name
- jobject loader
- const jbyte * buf
- CODE:
- {
-#ifdef KAFFE
- RETVAL = (*env)->DefineClass(env, loader, buf, (jsize)buf_len_);
-#else
- RETVAL = (*env)->DefineClass(env, name, loader, buf, (jsize)buf_len_);
-#endif
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jclass
-FindClass(name)
- JNIEnv * env = FETCHENV;
- const char * name
- CODE:
- {
- RETVAL = (*env)->FindClass(env, name);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jclass
-GetSuperclass(sub)
- JNIEnv * env = FETCHENV;
- jclass sub
- CODE:
- {
- RETVAL = (*env)->GetSuperclass(env, sub);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-IsAssignableFrom(sub, sup)
- JNIEnv * env = FETCHENV;
- jclass sub
- jclass sup
- CODE:
- {
- RETVAL = (*env)->IsAssignableFrom(env, sub, sup);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-SysRet
-Throw(obj)
- JNIEnv * env = FETCHENV;
- jthrowable obj
- CODE:
- {
- RETVAL = (*env)->Throw(env, obj);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-SysRet
-ThrowNew(clazz, msg)
- JNIEnv * env = FETCHENV;
- jclass clazz
- const char * msg
- CODE:
- {
- RETVAL = (*env)->ThrowNew(env, clazz, msg);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jthrowable
-ExceptionOccurred()
- JNIEnv * env = FETCHENV;
- CODE:
- {
- RETVAL = (*env)->ExceptionOccurred(env);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-void
-ExceptionDescribe()
- JNIEnv * env = FETCHENV;
- CODE:
- {
- (*env)->ExceptionDescribe(env);
- RESTOREENV;
- }
-
-void
-ExceptionClear()
- JNIEnv * env = FETCHENV;
- CODE:
- {
- (*env)->ExceptionClear(env);
- RESTOREENV;
- }
-
-void
-FatalError(msg)
- JNIEnv * env = FETCHENV;
- const char * msg
- CODE:
- {
- (*env)->FatalError(env, msg);
- RESTOREENV;
- }
-
-jobject
-NewGlobalRef(lobj)
- JNIEnv * env = FETCHENV;
- jobject lobj
- CODE:
- {
- RETVAL = (*env)->NewGlobalRef(env, lobj);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-void
-DeleteGlobalRef(gref)
- JNIEnv * env = FETCHENV;
- jobject gref
- CODE:
- {
- (*env)->DeleteGlobalRef(env, gref);
- RESTOREENV;
- }
-
-void
-DeleteLocalRef(obj)
- JNIEnv * env = FETCHENV;
- jobject obj
- CODE:
- {
- (*env)->DeleteLocalRef(env, obj);
- RESTOREENV;
- }
-
-jboolean
-IsSameObject(obj1,obj2)
- JNIEnv * env = FETCHENV;
- jobject obj1
- jobject obj2
- CODE:
- {
- RETVAL = (*env)->IsSameObject(env, obj1,obj2);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-AllocObject(clazz)
- JNIEnv * env = FETCHENV;
- jclass clazz
- CODE:
- {
- RETVAL = (*env)->AllocObject(env, clazz);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-NewObject(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->NewObjectA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-NewObjectA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->NewObjectA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jclass
-GetObjectClass(obj)
- JNIEnv * env = FETCHENV;
- jobject obj
- CODE:
- {
- RETVAL = (*env)->GetObjectClass(env, obj);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-IsInstanceOf(obj,clazz)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- CODE:
- {
- RETVAL = (*env)->IsInstanceOf(env, obj,clazz);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jmethodID
-GetMethodID(clazz,name,sig)
- JNIEnv * env = FETCHENV;
- jclass clazz
- const char * name
- const char * sig
- CODE:
- {
- RETVAL = (*env)->GetMethodID(env, clazz,name,sig);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-CallObjectMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallObjectMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-CallObjectMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallObjectMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-CallBooleanMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallBooleanMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-CallBooleanMethodA(obj,methodID, args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallBooleanMethodA(env, obj,methodID, args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyte
-CallByteMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallByteMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyte
-CallByteMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallByteMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jchar
-CallCharMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallCharMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jchar
-CallCharMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallCharMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshort
-CallShortMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallShortMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshort
-CallShortMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallShortMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jint
-CallIntMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallIntMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jint
-CallIntMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallIntMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlong
-CallLongMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallLongMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlong
-CallLongMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallLongMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloat
-CallFloatMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallFloatMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloat
-CallFloatMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallFloatMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdouble
-CallDoubleMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallDoubleMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdouble
-CallDoubleMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallDoubleMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-void
-CallVoidMethod(obj,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- (*env)->CallVoidMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
-
-void
-CallVoidMethodA(obj,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- (*env)->CallVoidMethodA(env, obj,methodID,args);
- RESTOREENV;
- }
-
-jobject
-CallNonvirtualObjectMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualObjectMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-CallNonvirtualObjectMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualObjectMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-CallNonvirtualBooleanMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualBooleanMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-CallNonvirtualBooleanMethodA(obj,clazz,methodID, args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualBooleanMethodA(env, obj,clazz,methodID, args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyte
-CallNonvirtualByteMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualByteMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyte
-CallNonvirtualByteMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualByteMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jchar
-CallNonvirtualCharMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualCharMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jchar
-CallNonvirtualCharMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualCharMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshort
-CallNonvirtualShortMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualShortMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshort
-CallNonvirtualShortMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualShortMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jint
-CallNonvirtualIntMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualIntMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jint
-CallNonvirtualIntMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualIntMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlong
-CallNonvirtualLongMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualLongMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlong
-CallNonvirtualLongMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualLongMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloat
-CallNonvirtualFloatMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualFloatMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloat
-CallNonvirtualFloatMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualFloatMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdouble
-CallNonvirtualDoubleMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallNonvirtualDoubleMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdouble
-CallNonvirtualDoubleMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallNonvirtualDoubleMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-void
-CallNonvirtualVoidMethod(obj,clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- (*env)->CallNonvirtualVoidMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
-
-void
-CallNonvirtualVoidMethodA(obj,clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jobject obj
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- (*env)->CallNonvirtualVoidMethodA(env, obj,clazz,methodID,args);
- RESTOREENV;
- }
-
-jfieldID
-GetFieldID(clazz,name,sig)
- JNIEnv * env = FETCHENV;
- jclass clazz
- const char * name
- const char * sig
- CODE:
- {
- RETVAL = (*env)->GetFieldID(env, clazz,name,sig);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-GetObjectField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetObjectField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-GetBooleanField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetBooleanField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyte
-GetByteField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetByteField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jchar
-GetCharField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetCharField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshort
-GetShortField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetShortField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jint
-GetIntField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetIntField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlong
-GetLongField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetLongField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloat
-GetFloatField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetFloatField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdouble
-GetDoubleField(obj,fieldID)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetDoubleField(env, obj,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-void
-SetObjectField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jobject val
- CODE:
- {
- (*env)->SetObjectField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-void
-SetBooleanField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jboolean val
- CODE:
- {
- (*env)->SetBooleanField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-void
-SetByteField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jbyte val
- CODE:
- {
- (*env)->SetByteField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-void
-SetCharField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jchar val
- CODE:
- {
- (*env)->SetCharField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-void
-SetShortField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jshort val
- CODE:
- {
- (*env)->SetShortField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-void
-SetIntField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jint val
- CODE:
- {
- (*env)->SetIntField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-void
-SetLongField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jlong val
- CODE:
- {
- (*env)->SetLongField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-void
-SetFloatField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jfloat val
- CODE:
- {
- (*env)->SetFloatField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-void
-SetDoubleField(obj,fieldID,val)
- JNIEnv * env = FETCHENV;
- jobject obj
- jfieldID fieldID
- char * sig = 0;
- jdouble val
- CODE:
- {
- (*env)->SetDoubleField(env, obj,fieldID,val);
- RESTOREENV;
- }
-
-jmethodID
-GetStaticMethodID(clazz,name,sig)
- JNIEnv * env = FETCHENV;
- jclass clazz
- const char * name
- const char * sig
- CODE:
- {
- RETVAL = (*env)->GetStaticMethodID(env, clazz,name,sig);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-CallStaticObjectMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticObjectMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-CallStaticObjectMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticObjectMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-CallStaticBooleanMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticBooleanMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-CallStaticBooleanMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticBooleanMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyte
-CallStaticByteMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticByteMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyte
-CallStaticByteMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticByteMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jchar
-CallStaticCharMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticCharMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jchar
-CallStaticCharMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticCharMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshort
-CallStaticShortMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticShortMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshort
-CallStaticShortMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticShortMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jint
-CallStaticIntMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticIntMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jint
-CallStaticIntMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticIntMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlong
-CallStaticLongMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticLongMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlong
-CallStaticLongMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticLongMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloat
-CallStaticFloatMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticFloatMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloat
-CallStaticFloatMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticFloatMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdouble
-CallStaticDoubleMethod(clazz,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- RETVAL = (*env)->CallStaticDoubleMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdouble
-CallStaticDoubleMethodA(clazz,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- RETVAL = (*env)->CallStaticDoubleMethodA(env, clazz,methodID,args);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-void
-CallStaticVoidMethod(cls,methodID,...)
- JNIEnv * env = FETCHENV;
- jclass cls
- jmethodID methodID
- char * sig = 0;
- int argoff = $min_args;
- CODE:
- {
- jvalue * args = makeargs(sig, &ST(argoff), items - argoff);
- (*env)->CallStaticVoidMethodA(env, cls,methodID,args);
- RESTOREENV;
- }
-
-void
-CallStaticVoidMethodA(cls,methodID,args)
- JNIEnv * env = FETCHENV;
- jclass cls
- jmethodID methodID
- char * sig = 0;
- jvalue * args
- CODE:
- {
- (*env)->CallStaticVoidMethodA(env, cls,methodID,args);
- RESTOREENV;
- }
-
-jfieldID
-GetStaticFieldID(clazz,name,sig)
- JNIEnv * env = FETCHENV;
- jclass clazz
- const char * name
- const char * sig
- CODE:
- {
- RETVAL = (*env)->GetStaticFieldID(env, clazz,name,sig);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-GetStaticObjectField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticObjectField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean
-GetStaticBooleanField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticBooleanField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyte
-GetStaticByteField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticByteField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jchar
-GetStaticCharField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticCharField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshort
-GetStaticShortField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticShortField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jint
-GetStaticIntField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticIntField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlong
-GetStaticLongField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticLongField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloat
-GetStaticFloatField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticFloatField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdouble
-GetStaticDoubleField(clazz,fieldID)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- CODE:
- {
- RETVAL = (*env)->GetStaticDoubleField(env, clazz,fieldID);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-void
-SetStaticObjectField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jobject value
- CODE:
- {
- (*env)->SetStaticObjectField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-void
-SetStaticBooleanField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jboolean value
- CODE:
- {
- (*env)->SetStaticBooleanField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-void
-SetStaticByteField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jbyte value
- CODE:
- {
- (*env)->SetStaticByteField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-void
-SetStaticCharField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jchar value
- CODE:
- {
- (*env)->SetStaticCharField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-void
-SetStaticShortField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jshort value
- CODE:
- {
- (*env)->SetStaticShortField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-void
-SetStaticIntField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jint value
- CODE:
- {
- (*env)->SetStaticIntField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-void
-SetStaticLongField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jlong value
- CODE:
- {
- (*env)->SetStaticLongField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-void
-SetStaticFloatField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jfloat value
- CODE:
- {
- (*env)->SetStaticFloatField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-void
-SetStaticDoubleField(clazz,fieldID,value)
- JNIEnv * env = FETCHENV;
- jclass clazz
- jfieldID fieldID
- char * sig = 0;
- jdouble value
- CODE:
- {
- (*env)->SetStaticDoubleField(env, clazz,fieldID,value);
- RESTOREENV;
- }
-
-jstring
-NewString(unicode)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jsize unicode_len_ = NO_INIT;
- const jchar * unicode
- CODE:
- {
- RETVAL = (*env)->NewString(env, unicode, unicode_len_);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jsize
-GetStringLength(str)
- JNIEnv * env = FETCHENV;
- jstring str
- CODE:
- {
- RETVAL = (*env)->GetStringLength(env, str);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-const jchar *
-GetStringChars(str)
- JNIEnv * env = FETCHENV;
- jstring str
- jboolean isCopy = NO_INIT;
- jsize RETVAL_len_ = NO_INIT;
- CODE:
- {
- RETVAL = (*env)->GetStringChars(env, str,&isCopy);
- RETVAL_len_ = (*env)->GetStringLength(env, str);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
- CLEANUP:
- (*env)->ReleaseStringChars(env, str,RETVAL);
-
-jstring
-NewStringUTF(utf)
- JNIEnv * env = FETCHENV;
- const char * utf
- CODE:
- {
- RETVAL = (*env)->NewStringUTF(env, utf);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jsize
-GetStringUTFLength(str)
- JNIEnv * env = FETCHENV;
- jstring str
- CODE:
- {
- RETVAL = (*env)->GetStringUTFLength(env, str);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-const char *
-GetStringUTFChars(str)
- JNIEnv * env = FETCHENV;
- jstring str
- jboolean isCopy = NO_INIT;
- CODE:
- {
- RETVAL = (*env)->GetStringUTFChars(env, str,&isCopy);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
- CLEANUP:
- (*env)->ReleaseStringUTFChars(env, str, RETVAL);
-
-
-jsize
-GetArrayLength(array)
- JNIEnv * env = FETCHENV;
- jarray array
- CODE:
- {
- RETVAL = (*env)->GetArrayLength(env, array);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobjectArray
-NewObjectArray(len,clazz,init)
- JNIEnv * env = FETCHENV;
- jsize len
- jclass clazz
- jobject init
- CODE:
- {
- RETVAL = (*env)->NewObjectArray(env, len,clazz,init);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jobject
-GetObjectArrayElement(array,index)
- JNIEnv * env = FETCHENV;
- jobjectArray array
- jsize index
- CODE:
- {
- RETVAL = (*env)->GetObjectArrayElement(env, array,index);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-void
-SetObjectArrayElement(array,index,val)
- JNIEnv * env = FETCHENV;
- jobjectArray array
- jsize index
- jobject val
- CODE:
- {
- (*env)->SetObjectArrayElement(env, array,index,val);
- RESTOREENV;
- }
-
-jbooleanArray
-NewBooleanArray(len)
- JNIEnv * env = FETCHENV;
- jsize len
- CODE:
- {
- RETVAL = (*env)->NewBooleanArray(env, len);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jbyteArray
-NewByteArray(len)
- JNIEnv * env = FETCHENV;
- jsize len
- CODE:
- {
- RETVAL = (*env)->NewByteArray(env, len);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jcharArray
-NewCharArray(len)
- JNIEnv * env = FETCHENV;
- jsize len
- CODE:
- {
- RETVAL = (*env)->NewCharArray(env, len);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jshortArray
-NewShortArray(len)
- JNIEnv * env = FETCHENV;
- jsize len
- CODE:
- {
- RETVAL = (*env)->NewShortArray(env, len);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jintArray
-NewIntArray(len)
- JNIEnv * env = FETCHENV;
- jsize len
- CODE:
- {
- RETVAL = (*env)->NewIntArray(env, len);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jlongArray
-NewLongArray(len)
- JNIEnv * env = FETCHENV;
- jsize len
- CODE:
- {
- RETVAL = (*env)->NewLongArray(env, len);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jfloatArray
-NewFloatArray(len)
- JNIEnv * env = FETCHENV;
- jsize len
- CODE:
- {
- RETVAL = (*env)->NewFloatArray(env, len);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jdoubleArray
-NewDoubleArray(len)
- JNIEnv * env = FETCHENV;
- jsize len
- CODE:
- {
- RETVAL = (*env)->NewDoubleArray(env, len);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-jboolean *
-GetBooleanArrayElements(array)
- JNIEnv * env = FETCHENV;
- jsize RETVAL_len_ = NO_INIT;
- jbooleanArray array
- jboolean isCopy = NO_INIT;
- PPCODE:
- {
- RETVAL = (*env)->GetBooleanArrayElements(env, array,&isCopy);
- RETVAL_len_ = (*env)->GetArrayLength(env, array);
- if (GIMME == G_ARRAY) {
- int i;
- jboolean* r = RETVAL;
- EXTEND(sp, RETVAL_len_);
- for (i = RETVAL_len_; i; --i) {
- PUSHs(sv_2mortal(newSViv(*r++)));
- }
- }
- else {
- if (RETVAL_len_) {
- PUSHs(sv_2mortal(newSVpvn((char*)RETVAL,
- (STRLEN)RETVAL_len_ * sizeof(jboolean))));
- }
- else
- PUSHs(&PL_sv_no);
- }
- (*env)->ReleaseBooleanArrayElements(env, array,RETVAL,JNI_ABORT);
- RESTOREENV;
- }
-
-jbyte *
-GetByteArrayElements(array)
- JNIEnv * env = FETCHENV;
- jsize RETVAL_len_ = NO_INIT;
- jbyteArray array
- jboolean isCopy = NO_INIT;
- PPCODE:
- {
- RETVAL = (*env)->GetByteArrayElements(env, array,&isCopy);
- RETVAL_len_ = (*env)->GetArrayLength(env, array);
- if (GIMME == G_ARRAY) {
- int i;
- jbyte* r = RETVAL;
- EXTEND(sp, RETVAL_len_);
- for (i = RETVAL_len_; i; --i) {
- PUSHs(sv_2mortal(newSViv(*r++)));
- }
- }
- else {
- if (RETVAL_len_) {
- PUSHs(sv_2mortal(newSVpvn((char*)RETVAL,
- (STRLEN)RETVAL_len_ * sizeof(jbyte))));
- }
- else
- PUSHs(&PL_sv_no);
- }
- (*env)->ReleaseByteArrayElements(env, array,RETVAL,JNI_ABORT);
- RESTOREENV;
- }
-
-jchar *
-GetCharArrayElements(array)
- JNIEnv * env = FETCHENV;
- jsize RETVAL_len_ = NO_INIT;
- jcharArray array
- jboolean isCopy = NO_INIT;
- PPCODE:
- {
- RETVAL = (*env)->GetCharArrayElements(env, array,&isCopy);
- RETVAL_len_ = (*env)->GetArrayLength(env, array);
- if (GIMME == G_ARRAY) {
- int i;
- jchar* r = RETVAL;
- EXTEND(sp, RETVAL_len_);
- for (i = RETVAL_len_; i; --i) {
- PUSHs(sv_2mortal(newSViv(*r++)));
- }
- }
- else {
- if (RETVAL_len_) {
- PUSHs(sv_2mortal(newSVpvn((char*)RETVAL,
- (STRLEN)RETVAL_len_ * sizeof(jchar))));
- }
- else
- PUSHs(&PL_sv_no);
- }
- (*env)->ReleaseCharArrayElements(env, array,RETVAL,JNI_ABORT);
- RESTOREENV;
- }
-
-jshort *
-GetShortArrayElements(array)
- JNIEnv * env = FETCHENV;
- jsize RETVAL_len_ = NO_INIT;
- jshortArray array
- jboolean isCopy = NO_INIT;
- PPCODE:
- {
- RETVAL = (*env)->GetShortArrayElements(env, array,&isCopy);
- RETVAL_len_ = (*env)->GetArrayLength(env, array);
- if (GIMME == G_ARRAY) {
- int i;
- jshort* r = RETVAL;
- EXTEND(sp, RETVAL_len_);
- for (i = RETVAL_len_; i; --i) {
- PUSHs(sv_2mortal(newSViv(*r++)));
- }
- }
- else {
- if (RETVAL_len_) {
- PUSHs(sv_2mortal(newSVpvn((char*)RETVAL,
- (STRLEN)RETVAL_len_ * sizeof(jshort))));
- }
- else
- PUSHs(&PL_sv_no);
- }
- (*env)->ReleaseShortArrayElements(env, array,RETVAL,JNI_ABORT);
- RESTOREENV;
- }
-
-jint *
-GetIntArrayElements(array)
- JNIEnv * env = FETCHENV;
- jsize RETVAL_len_ = NO_INIT;
- jintArray array
- jboolean isCopy = NO_INIT;
- PPCODE:
- {
- RETVAL = (*env)->GetIntArrayElements(env, array,&isCopy);
- RETVAL_len_ = (*env)->GetArrayLength(env, array);
- if (GIMME == G_ARRAY) {
- int i;
- jint* r = RETVAL;
- EXTEND(sp, RETVAL_len_);
- for (i = RETVAL_len_; i; --i) {
- PUSHs(sv_2mortal(newSViv(*r++)));
- }
- }
- else {
- if (RETVAL_len_) {
- PUSHs(sv_2mortal(newSVpvn((char*)RETVAL,
- (STRLEN)RETVAL_len_ * sizeof(jint))));
- }
- else
- PUSHs(&PL_sv_no);
- }
- (*env)->ReleaseIntArrayElements(env, array,RETVAL,JNI_ABORT);
- RESTOREENV;
- }
-
-jlong *
-GetLongArrayElements(array)
- JNIEnv * env = FETCHENV;
- jsize RETVAL_len_ = NO_INIT;
- jlongArray array
- jboolean isCopy = NO_INIT;
- PPCODE:
- {
- RETVAL = (*env)->GetLongArrayElements(env, array,&isCopy);
- RETVAL_len_ = (*env)->GetArrayLength(env, array);
- if (GIMME == G_ARRAY) {
- int i;
- jlong* r = RETVAL;
- EXTEND(sp, RETVAL_len_);
- for (i = RETVAL_len_; i; --i) {
- PUSHs(sv_2mortal(newSViv(*r++)));
- }
- }
- else {
- if (RETVAL_len_) {
- PUSHs(sv_2mortal(newSVpvn((char*)RETVAL,
- (STRLEN)RETVAL_len_ * sizeof(jlong))));
- }
- else
- PUSHs(&PL_sv_no);
- }
- (*env)->ReleaseLongArrayElements(env, array,RETVAL,JNI_ABORT);
- RESTOREENV;
- }
-
-jfloat *
-GetFloatArrayElements(array)
- JNIEnv * env = FETCHENV;
- jsize RETVAL_len_ = NO_INIT;
- jfloatArray array
- jboolean isCopy = NO_INIT;
- PPCODE:
- {
- RETVAL = (*env)->GetFloatArrayElements(env, array,&isCopy);
- RETVAL_len_ = (*env)->GetArrayLength(env, array);
- if (GIMME == G_ARRAY) {
- int i;
- jfloat* r = RETVAL;
- EXTEND(sp, RETVAL_len_);
- for (i = RETVAL_len_; i; --i) {
- PUSHs(sv_2mortal(newSVnv(*r++)));
- }
- }
- else {
- if (RETVAL_len_) {
- PUSHs(sv_2mortal(newSVpvn((char*)RETVAL,
- (STRLEN)RETVAL_len_ * sizeof(jfloat))));
- }
- else
- PUSHs(&PL_sv_no);
- }
- (*env)->ReleaseFloatArrayElements(env, array,RETVAL,JNI_ABORT);
- RESTOREENV;
- }
-
-jdouble *
-GetDoubleArrayElements(array)
- JNIEnv * env = FETCHENV;
- jsize RETVAL_len_ = NO_INIT;
- jdoubleArray array
- jboolean isCopy = NO_INIT;
- PPCODE:
- {
- RETVAL = (*env)->GetDoubleArrayElements(env, array,&isCopy);
- RETVAL_len_ = (*env)->GetArrayLength(env, array);
- if (GIMME == G_ARRAY) {
- int i;
- jdouble* r = RETVAL;
- EXTEND(sp, RETVAL_len_);
- for (i = RETVAL_len_; i; --i) {
- PUSHs(sv_2mortal(newSVnv(*r++)));
- }
- }
- else {
- if (RETVAL_len_) {
- PUSHs(sv_2mortal(newSVpvn((char*)RETVAL,
- (STRLEN)RETVAL_len_ * sizeof(jdouble))));
- }
- else
- PUSHs(&PL_sv_no);
- }
- (*env)->ReleaseDoubleArrayElements(env, array,RETVAL,JNI_ABORT);
- RESTOREENV;
- }
-
-void
-GetBooleanArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- jbooleanArray array
- jsize start
- jsize len
- STRLEN tmplen = len * sizeof(jboolean) + 1;
- char * tmpbuf = (char*)sv_pvn_force(ST(3), &tmplen);
- jboolean * buf = (jboolean*)sv_grow(ST(3),len * sizeof(jboolean)+1);
- CODE:
- {
- (*env)->GetBooleanArrayRegion(env, array,start,len,buf);
- SvCUR_set(ST(3), len * sizeof(jboolean));
- *SvEND(ST(3)) = '\0';
- RESTOREENV;
- }
-
-void
-GetByteArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- jbyteArray array
- jsize start
- jsize len
- STRLEN tmplen = len * sizeof(jboolean) + 1;
- char * tmpbuf = (char*)sv_pvn_force(ST(3), &tmplen);
- jbyte * buf = (jbyte*)sv_grow(ST(3),len * sizeof(jbyte)+1);
- CODE:
- {
- (*env)->GetByteArrayRegion(env, array,start,len,buf);
- SvCUR_set(ST(3), len * sizeof(jbyte));
- *SvEND(ST(3)) = '\0';
- RESTOREENV;
- }
-
-void
-GetCharArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- jcharArray array
- jsize start
- jsize len
- STRLEN tmplen = len * sizeof(jboolean) + 1;
- char * tmpbuf = (char*)sv_pvn_force(ST(3), &tmplen);
- jchar * buf = (jchar*)sv_grow(ST(3),len * sizeof(jchar)+1);
- CODE:
- {
- (*env)->GetCharArrayRegion(env, array,start,len,buf);
- SvCUR_set(ST(3), len * sizeof(jchar));
- *SvEND(ST(3)) = '\0';
- RESTOREENV;
- }
-
-void
-GetShortArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- jshortArray array
- jsize start
- jsize len
- STRLEN tmplen = len * sizeof(jboolean) + 1;
- char * tmpbuf = (char*)sv_pvn_force(ST(3), &tmplen);
- jshort * buf = (jshort*)sv_grow(ST(3),len * sizeof(jshort)+1);
- CODE:
- {
- (*env)->GetShortArrayRegion(env, array,start,len,buf);
- SvCUR_set(ST(3), len * sizeof(jshort));
- *SvEND(ST(3)) = '\0';
- RESTOREENV;
- }
-
-void
-GetIntArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- jintArray array
- jsize start
- jsize len
- STRLEN tmplen = len * sizeof(jboolean) + 1;
- char * tmpbuf = (char*)sv_pvn_force(ST(3), &tmplen);
- jint * buf = (jint*)sv_grow(ST(3),len * sizeof(jint)+1);
- CODE:
- {
- (*env)->GetIntArrayRegion(env, array,start,len,buf);
- SvCUR_set(ST(3), len * sizeof(jint));
- *SvEND(ST(3)) = '\0';
- RESTOREENV;
- }
-
-void
-GetLongArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- jlongArray array
- jsize start
- jsize len
- STRLEN tmplen = len * sizeof(jboolean) + 1;
- char * tmpbuf = (char*)sv_pvn_force(ST(3), &tmplen);
- jlong * buf = (jlong*)sv_grow(ST(3),len * sizeof(jlong)+1);
- CODE:
- {
- (*env)->GetLongArrayRegion(env, array,start,len,buf);
- SvCUR_set(ST(3), len * sizeof(jlong));
- *SvEND(ST(3)) = '\0';
- RESTOREENV;
- }
-
-void
-GetFloatArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- jfloatArray array
- jsize start
- jsize len
- STRLEN tmplen = len * sizeof(jboolean) + 1;
- char * tmpbuf = (char*)sv_pvn_force(ST(3), &tmplen);
- jfloat * buf = (jfloat*)sv_grow(ST(3),len * sizeof(jfloat)+1);
- CODE:
- {
- (*env)->GetFloatArrayRegion(env, array,start,len,buf);
- SvCUR_set(ST(3), len * sizeof(jfloat));
- *SvEND(ST(3)) = '\0';
- RESTOREENV;
- }
-
-void
-GetDoubleArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- jdoubleArray array
- jsize start
- jsize len
- STRLEN tmplen = len * sizeof(jboolean) + 1;
- char * tmpbuf = (char*)sv_pvn_force(ST(3), &tmplen);
- jdouble * buf = (jdouble*)sv_grow(ST(3),len * sizeof(jdouble)+1);
- CODE:
- {
- (*env)->GetDoubleArrayRegion(env, array,start,len,buf);
- SvCUR_set(ST(3), len * sizeof(jdouble));
- *SvEND(ST(3)) = '\0';
- RESTOREENV;
- }
-
-void
-SetBooleanArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jbooleanArray array
- jsize start
- jsize len
- jsize buf_len_ = NO_INIT;
- jboolean * buf
- CODE:
- {
- if (buf_len_ < len)
- croak("string is too short");
- else if (buf_len_ > len && PL_dowarn)
- warn("string is too long");
- (*env)->SetBooleanArrayRegion(env, array,start,len,buf);
- RESTOREENV;
- }
-
-void
-SetByteArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jbyteArray array
- jsize start
- jsize len
- jsize buf_len_ = NO_INIT;
- jbyte * buf
- CODE:
- {
- if (buf_len_ < len)
- croak("string is too short");
- else if (buf_len_ > len && PL_dowarn)
- warn("string is too long");
- (*env)->SetByteArrayRegion(env, array,start,len,buf);
- RESTOREENV;
- }
-
-void
-SetCharArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jcharArray array
- jsize start
- jsize len
- jsize buf_len_ = NO_INIT;
- jchar * buf
- CODE:
- {
- if (buf_len_ < len)
- croak("string is too short");
- else if (buf_len_ > len && PL_dowarn)
- warn("string is too long");
- (*env)->SetCharArrayRegion(env, array,start,len,buf);
- RESTOREENV;
- }
-
-void
-SetShortArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jshortArray array
- jsize start
- jsize len
- jsize buf_len_ = NO_INIT;
- jshort * buf
- CODE:
- {
- if (buf_len_ < len)
- croak("string is too short");
- else if (buf_len_ > len && PL_dowarn)
- warn("string is too long");
- (*env)->SetShortArrayRegion(env, array,start,len,buf);
- RESTOREENV;
- }
-
-void
-SetIntArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jintArray array
- jsize start
- jsize len
- jsize buf_len_ = NO_INIT;
- jint * buf
- CODE:
- {
- if (buf_len_ < len)
- croak("string is too short");
- else if (buf_len_ > len && PL_dowarn)
- warn("string is too long");
- (*env)->SetIntArrayRegion(env, array,start,len,buf);
- RESTOREENV;
- }
-
-void
-SetLongArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jlongArray array
- jsize start
- jsize len
- jsize buf_len_ = NO_INIT;
- jlong * buf
- CODE:
- {
- if (buf_len_ < len)
- croak("string is too short");
- else if (buf_len_ > len && PL_dowarn)
- warn("string is too long");
- (*env)->SetLongArrayRegion(env, array,start,len,buf);
- RESTOREENV;
- }
-
-void
-SetFloatArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jfloatArray array
- jsize start
- jsize len
- jsize buf_len_ = NO_INIT;
- jfloat * buf
- CODE:
- {
- if (buf_len_ < len)
- croak("string is too short");
- else if (buf_len_ > len && PL_dowarn)
- warn("string is too long");
- (*env)->SetFloatArrayRegion(env, array,start,len,buf);
- RESTOREENV;
- }
-
-void
-SetDoubleArrayRegion(array,start,len,buf)
- JNIEnv * env = FETCHENV;
- STRLEN tmplen = NO_INIT;
- jdoubleArray array
- jsize start
- jsize len
- jsize buf_len_ = NO_INIT;
- jdouble * buf
- CODE:
- {
- if (buf_len_ < len)
- croak("string is too short");
- else if (buf_len_ > len && PL_dowarn)
- warn("string is too long");
- (*env)->SetDoubleArrayRegion(env, array,start,len,buf);
- RESTOREENV;
- }
-
-SysRet
-RegisterNatives(clazz,methods,nMethods)
- JNIEnv * env = FETCHENV;
- jclass clazz
- JNINativeMethod * methods
- jint nMethods
- CODE:
- {
- RETVAL = (*env)->RegisterNatives(env, clazz,methods,nMethods);
- }
-
-SysRet
-UnregisterNatives(clazz)
- JNIEnv * env = FETCHENV;
- jclass clazz
- CODE:
- {
- RETVAL = (*env)->UnregisterNatives(env, clazz);
- }
- OUTPUT:
- RETVAL
-
-SysRet
-MonitorEnter(obj)
- JNIEnv * env = FETCHENV;
- jobject obj
- CODE:
- {
- RETVAL = (*env)->MonitorEnter(env, obj);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-SysRet
-MonitorExit(obj)
- JNIEnv * env = FETCHENV;
- jobject obj
- CODE:
- {
- RETVAL = (*env)->MonitorExit(env, obj);
- RESTOREENV;
- }
- OUTPUT:
- RETVAL
-
-JavaVM *
-GetJavaVM(...)
- JNIEnv * env = FETCHENV;
- CODE:
- {
-#ifdef JPL_DEBUG
- jpldebug = 1;
-#else
- jpldebug = 0;
-#endif
- if (env) { /* We're embedded. */
- if ((*env)->GetJavaVM(env, &RETVAL) < 0)
- RETVAL = 0;
- }
- else { /* We're embedding. */
-#ifdef KAFFE
- JavaVMInitArgs vm_args;
-#else
- JDK1_1InitArgs vm_args;
-#endif
- char *lib;
- if (jpldebug) {
- fprintf(stderr, "We're embedding Java in Perl.\n");
- }
-
- if (items--) {
- ++mark;
- lib = SvPV(*mark, PL_na);
- }
- else
- lib = 0;
- if (jpldebug) {
- fprintf(stderr, "lib is %s.\n", lib);
- }
-#ifdef WIN32
- if (LoadLibrary("jvm.dll")) {
- if (!LoadLibrary("javai.dll")) {
- warn("Can't load javai.dll");
- }
- } else {
- if (lib && !LoadLibrary(lib))
- croak("Can't load javai.dll");
- }
-#else
- if (jpldebug) {
- fprintf(stderr, "Opening Java shared library.\n");
- }
-#ifdef KAFFE
- if (!dlopen("libkaffevm.so", RTLD_LAZY|RTLD_GLOBAL)) {
-#else
- if (!dlopen("libjava.so", RTLD_LAZY|RTLD_GLOBAL)) {
-#endif
- if (lib && !dlopen(lib, RTLD_LAZY|RTLD_GLOBAL))
- croak("Can't load Java shared library.");
- }
-#endif
- /* Kaffe seems to get very upset if vm_args.version isn't set */
-#ifdef KAFFE
- vm_args.version = JNI_VERSION_1_1;
-#endif
- JNI_GetDefaultJavaVMInitArgs(&vm_args);
- vm_args.exit = &call_my_exit;
- if (jpldebug) {
- fprintf(stderr, "items = %d\n", items);
- fprintf(stderr, "mark = %s\n", SvPV(*mark, PL_na));
- }
- while (items > 1) {
- char *s;
- ++mark;
- s = SvPV(*mark,PL_na);
- ++mark;
- if (jpldebug) {
- fprintf(stderr, "*s = %s\n", s);
- fprintf(stderr, "val = %s\n", SvPV(*mark, PL_na));
- }
- items -= 2;
- if (strEQ(s, "checkSource"))
- vm_args.checkSource = (jint)SvIV(*mark);
- else if (strEQ(s, "nativeStackSize"))
- vm_args.nativeStackSize = (jint)SvIV(*mark);
- else if (strEQ(s, "javaStackSize"))
- vm_args.javaStackSize = (jint)SvIV(*mark);
- else if (strEQ(s, "minHeapSize"))
- vm_args.minHeapSize = (jint)SvIV(*mark);
- else if (strEQ(s, "maxHeapSize"))
- vm_args.maxHeapSize = (jint)SvIV(*mark);
- else if (strEQ(s, "verifyMode"))
- vm_args.verifyMode = (jint)SvIV(*mark);
- else if (strEQ(s, "classpath"))
- vm_args.classpath = savepv(SvPV(*mark,PL_na));
- else if (strEQ(s, "enableClassGC"))
- vm_args.enableClassGC = (jint)SvIV(*mark);
- else if (strEQ(s, "enableVerboseGC"))
- vm_args.enableVerboseGC = (jint)SvIV(*mark);
- else if (strEQ(s, "disableAsyncGC"))
- vm_args.disableAsyncGC = (jint)SvIV(*mark);
-#ifdef KAFFE
- else if (strEQ(s, "libraryhome"))
- vm_args.libraryhome = savepv(SvPV(*mark,PL_na));
- else if (strEQ(s, "classhome"))
- vm_args.classhome = savepv(SvPV(*mark,PL_na));
- else if (strEQ(s, "enableVerboseJIT"))
- vm_args.enableVerboseJIT = (jint)SvIV(*mark);
- else if (strEQ(s, "enableVerboseClassloading"))
- vm_args.enableVerboseClassloading = (jint)SvIV(*mark);
- else if (strEQ(s, "enableVerboseCall"))
- vm_args.enableVerboseCall = (jint)SvIV(*mark);
- else if (strEQ(s, "allocHeapSize"))
- vm_args.allocHeapSize = (jint)SvIV(*mark);
-#else
- else if (strEQ(s, "verbose"))
- vm_args.verbose = (jint)SvIV(*mark);
- else if (strEQ(s, "debugging"))
- vm_args.debugging = (jboolean)SvIV(*mark);
- else if (strEQ(s, "debugPort"))
- vm_args.debugPort = (jint)SvIV(*mark);
-#endif
- else
- croak("unrecognized option: %s", s);
- }
-
- if (jpldebug) {
- fprintf(stderr, "Creating Java VM...\n");
- fprintf(stderr, "Working CLASSPATH: %s\n",
- vm_args.classpath);
- }
- if (JNI_CreateJavaVM(&RETVAL, &jplcurenv, &vm_args) < 0) {
- croak("Unable to create instance of JVM");
- }
- if (jpldebug) {
- fprintf(stderr, "Created Java VM.\n");
- }
-
- }
- }
-
+++ /dev/null
-eval `$JPL_SRC/setvars -perl`;
-$java = $ENV{JAVA_HOME};
-$jpl = $ENV{JPL_HOME};
-
-# Where are the Java includes?
-#
-@INCLUDE = ("$java/include", "$java/include/$^O", "$java/include/genunix");
-
-# Are we embedding Perl in Java?
-#
-$EMBEDDEDPERL = 1;
-
-1;
+++ /dev/null
-# Are we using Kaffe?
-#
-$KAFFE = 0;
-
-# Where are the Java includes?
-#
-@INCLUDE = ("C:\\jdk1.1.8\\include", "C:\\jdk1.1.8\\include\\win32");
-
-# Are we embedding Perl in Java?
-#
-$EMBEDDEDPERL = 0;
-
-# Extra C flags
-#
-$CCFLAGS=" -Z7 -D_DEBUG";
-
-$MYEXTLIB = "C:\\jdk1.1.8\\lib\\javai.lib " .
- "$Config{installarchlib}\\CORE\\perlcore.lib " .
- "$Config{installarchlib}\\CORE\\perlcapi.lib";
-
-1;
+++ /dev/null
-eval `$JPL_SRC/setvars -perl`;
-$java = $ENV{JAVA_HOME};
-$jpl = $ENV{JPL_HOME};
-
-# Are we using Kaffe?
-#
-$KAFFE = 1;
-
-# What is the name of the JVM library?
-#
-$LIBJVM="kaffevm";
-
-# Where is the JVM library?
-#
-$LIBLOC="/usr/local/lib";
-
-# Where are the Java includes?
-#
-#@INCLUDE = ('$java/include', '$java/include/$^O' '$java/include/genunix');
-@INCLUDE = ( '/usr/local/include/kaffe');
-
-# Are we embedding Perl in Java?
-#
-$EMBEDDEDPERL = 0;
-
-1;
+++ /dev/null
-eval `$JPL_SRC/setvars -perl`;
-$java = $ENV{JAVA_HOME};
-$jpl = $ENV{JPL_HOME};
-
-# Are we using Kaffe?
-#
-$KAFFE = 0;
-
-# What is the name of the JVM library?
-#
-$LIBJVM="java";
-
-# Where is the JVM library?
-#
-$LIBLOC="/usr/local/java/lib/i686/green_threads/";
-
-# Where are the Java includes?
-#
-@INCLUDE = ("$java/include", "$java/include/$^O", "$java/include/genunix");
-
-# Are we embedding Perl in Java?
-#
-$EMBEDDEDPERL = 0;
-
-1;
+++ /dev/null
-eval `$JPL_SRC/setvars -perl`;
-$java = $ENV{JAVA_HOME};
-$jpl = $ENV{JPL_HOME};
-
-# Where are the Java includes?
-#
-@INCLUDE = ("$java/include", "$java/include/$^O", "$java/include/genunix");
-
-# Are we embedding Perl in Java?
-#
-$EMBEDDEDPERL = 1;
-
-1;
+++ /dev/null
-#!/usr/bin/perl
-use ExtUtils::MakeMaker;
-use Getopt::Std;
-use Config;
-$ARCHNAME = $Config{archname};
-use File::Basename;
-
-getopts('e'); # embedding?
-
-$CCFLAGS .= $ENV{CCFLAGS} if defined $ENV{CCFLAGS};
-
-# $USE_KAFFE is a boolean that tells us whether or not we should use Kaffe.
-# Set by find_includes (it seemed as good a place as any).
-
-# Note that we don't check to see the version of Kaffe is one we support.
-# Currently, the only one we support is the one from CVS.
-
-my $USE_KAFFE = 0;
-
-#require "JNIConfig";
-
-if ($^O eq 'solaris') {
- $LIBPATH = " -R$Config{archlib}/CORE -L$Config{archlib}/CORE";
-} elsif ($^O eq 'MSWin32') {
- $LIBPATH = " -L$Config{archlib}\\CORE";
- # MSR - added MS VC++ default library path
- # bjepson - fixed to support path names w/spaces in them.
- push(@WINLIBS, (split"\;",$ENV{LIB}));
- grep s/\\$//, @WINLIBS; # eliminate trailing \
- grep s/\/$//, @WINLIBS; # eliminate trailing /
- $LIBPATH .= join(" ", "", map { qq["-L$_" ] } @WINLIBS);
-} else {
- $LIBPATH = " -L$Config{archlib}/CORE";
-}
-#$LIBS = " -lperl";
-
-# Figure out where Java might live
-#
-# MSR - added JDK 1.3
-#
-
-my @JAVA_HOME_GUESSES = qw(/usr/local/java /usr/java /usr/local/jdk117_v3
- C:\\JDK1.1.8 C:\\JDK1.2.1 C:\\JDK1.2.2 C:\\JDK1.3 );
-
-my @KAFFE_PREFIX_GUESSES = qw(/usr/local /usr);
-
-if (! defined $ENV{JAVA_HOME}) {
- print "You didn't define JAVA_HOME, so I'm trying a few guesses.\n";
- print "If this fails, you might want to try setting JAVA_HOME and\n";
- print "running me again.\n";
-} else {
- @JAVA_HOME_GUESSES = ( $ENV{JAVA_HOME} );
-}
-
-if (! defined $ENV{KAFFE_PREFIX}) {
- print "\nYou didn't define KAFFE_PREFIX, so I'm trying a few guesses.",
- "\nIf this fails, and you are using Kaffe, you might want to try\n",
- "setting KAFFE_PREFIX and running me again.\n",
- "If you want to ignore any possible Kaffe installation, set the\n",
- "KAFFE_PREFIX to and empty string.\n\n";
-} else {
- @KAFFE_PREFIX_GUESSES = ($ENV{KAFFE_PREFIX} eq "") ? () :
- ( $ENV{KAFFE_PREFIX} );
-}
-
-my(@KAFFE_INCLUDE_GUESSES, @KAFFE_LIB_GUESSES);
-foreach my $kaffePrefix (@KAFFE_PREFIX_GUESSES) {
- push(@KAFFE_INCLUDE_GUESSES, "$kaffePrefix/include/kaffe");
- push(@KAFFE_LIB_GUESSES, "$kaffePrefix/lib");
- push(@KAFFE_LIB_GUESSES, "$kaffePrefix/lib/kaffe");
-}
- $guess .= "/include/kaffe";
-
-# Let's find out where jni.h lives
-#
-my @INCLUDE = find_includes();
-
-if ($^O eq 'MSWin32') {
- # MSR - added MS VC++ default include path
- push(@INCLUDE,(split"\;",$ENV{INCLUDE}));
- grep s/\\$//, @INCLUDE; # remove trailing \
- grep s/\/$//, @INCLUDE; # remove trailing \
- $INC = join("", map { qq["-I$_" ] } @INCLUDE);
-
-} else {
- $INC = join(" -I", ("", @INCLUDE));
-}
-
-# Let's find out the name of the Java shared library
-#
-my @JAVALIBS = find_libs();
-
-# Find out some defines based on the library we are linking to
-#
-foreach (@JAVALIBS) {
- if ( $^O eq 'MSWin32') { # We're on Win32
- $INC =~ s#/#\\#g;
- $INC =~ s#\\$##;
- print $INC, "\n";
- $CCFLAGS .= " -DWIN32 -Z7 -D_DEBUG";
- $MYEXTLIB = "$libjava";
- }
-}
-
-$CCFLAGS .= " -DKAFFE" if ($USE_KAFFE);
-
-# Let's find out the path of the library we need to link against.
-#
-foreach (@JAVALIBS) {
- if ($^O eq 'MSWin32') { # We're on Win32
- $_ =~ s#/#\\\\#g;
- }
- my ($libname, $libpath, $libsuffix) = fileparse($_, ("\.so", "\.lib"));
- $libname =~ s/^lib//;
- if ($^O eq 'solaris') {
- $LIBPATH .= " -R$libpath -L$libpath"
- } else {
- $LIBPATH .= " -L$libpath"
- }
- $LIBS .= " -l$libname";
-}
-
-# Do we need -D_REENTRANT?
-if ($LIBPATH =~ /native/) {
- print "Looks like native threads...\n";
- $CCFLAGS .= " -D_REENTRANT";
-}
-
-if ($opt_e) {
- print "We're embedding Perl in Java via libPerlInterpreter.so.\n";
- eval `../setvars -perl`;
- $CCFLAGS .= " -DEMBEDDEDPERL";
- $LIBPATH .= " -R$ENV{JPL_HOME}/lib/$ARCHNAME -L$ENV{JPL_HOME}/lib/$ARCHNAME";
- $LIBS .= " -lPerlInterpreter";
-}
-
-# Needed for JNI.
-if ($^O eq 'solaris') {
- $LIBS = " -lthread -lc $LIBS"; #-lthread must be first!!!
- $CCFLAGS .= " -D_REENTRANT";
-}
-
-# MSR - clean up LIBS
-$LIBS =~ s/-l$//;
-
-#
-# Next, build JNI/Config.pm. This is a superfluous thing for the SUN and
-# Microsoft JDKs, but absolutely necessary for Kaffe. I think at some
-# point, the Microsoft and SUN implementations should use JNI::Config, too.
-#
-
-if (! -d "JNI") {
- mkdir("JNI", 0755) || die "Unable to make JNI directory: $!";
-}
-open(JNICONFIG, ">JNI/Config.pm") || die "Unable to open JNI/Config.pm: $!";
-
-print JNICONFIG "# DO NOT EDIT! Autogenerated by JNI/Makefile.PL\n\n",
- "package JNI::Config;\nuse strict;\nuse Carp;\n",
- "\nuse vars qw(\$KAFFE \$LIB_JAVA \$CLASS_HOME ",
- "\$LIB_HOME);\n\n",
- "\$KAFFE = $USE_KAFFE;\n\$LIB_JAVA = \"$JAVALIBS[0]\";\n";
-if ($USE_KAFFE) {
- my $path = $JAVALIBS[0];
- $path =~ s%/(kaffe/)?libkaffevm.so$%%;
-
- print JNICONFIG "\$LIB_HOME = \"$path/kaffe\";\n";
- $path =~ s%/lib%%;
- print JNICONFIG "\$CLASS_HOME = \"$path/share/kaffe\";\n";
-}
-print JNICONFIG "\n\n1;\n";
-close JNICONFIG;
-
-
-my %Makefile = (
- NAME => 'JNI',
- VERSION_FROM => 'JNI.pm',
- DEFINE => '',
- LINKTYPE => 'dynamic',
- INC => $INC,
- CCFLAGS => "$Config{ccflags} $CCFLAGS",
- ($Config{archname} =~ /mswin32.*-object/i ? ('CAPI' => 'TRUE') : ()),
-
- clean => {FILES => "JNI/* JNI"}
-);
-
-$Makefile{LIBS} = ["$LIBPATH $LIBS"];
-if ($MYEXTLIB) {
- $Makefile{MYEXTLIB} = $MYEXTLIB;
-}
-
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-#
-WriteMakefile(%Makefile);
-
-if ($USE_KAFFE) {
- my $path = $JAVALIBS[0];
- $path =~ s%/libkaffevm.so$%%;
- print "\n\n***NOTE: be sure to have:\n",
- " LD_LIBRARY_PATH=$path\n",
- " in your enviornment (or installed as a system dynamic\n",
- " library location) when you compile and run this.\n";
-}
-
-# subroutine to find a library
-#
-sub find_stuff {
-
- my ($candidates, $locations) = @_;
- my $lib;
- $wanted = sub {
- foreach my $name (@$candidates) {
- if (/$name$/ and ! /green_threads/ and !/include-old/) {
- $lib = $File::Find::name;
- }
- }
- };
-
- use File::Find;
- foreach my $guess (@$locations) {
- next unless -d $guess;
- find (\&$wanted, $guess);
- }
- if (! $lib) {
- print "Could not find @$candidates\n";
- } else {
- print "Found @$candidates as $lib\n\n";
- }
- return $lib;
-}
-
-# Extra lib for Java 1.2
-#
-# if we want KAFFE, check for it, otherwise search for Java
-
-sub find_libs {
- my($libjava, $libawt, $libjvm);
-
- if ($USE_KAFFE) {
- $libjava = find_stuff(['libkaffevm.so'], \@KAFFE_LIB_GUESSES);
- $libawt = find_stuff(['libawt.so'], \@KAFFE_LIB_GUESSES);
- } else {
- $libjava = find_stuff(['libjava.so', 'javai.lib', 'jvm.lib'],
- \@JAVA_HOME_GUESSES);
- $libjvm = find_stuff(['libjvm.so'], \@JAVA_HOME_GUESSES);
- $libawt = find_stuff(['libawt.so'], \@JAVA_HOME_GUESSES);
- if (defined $libjvm) { # JDK 1.2
- my $libhpi = find_stuff(['libhpi.so'], \@JAVA_HOME_GUESSES);
- return($libjava, $libjvm, $libhpi, $libawt);
- }
- }
- return($libjava, $libawt);
-}
-
-# We need to find jni.h and jni_md.h
-#
-
-# Always do find_includes as the first operation, as it has the side effect
-# of deciding whether or not we are looking for Kaffe. --bkuhn
-
-sub find_includes {
-
- my @CANDIDATES = qw(jni.h jni_md.h);
- my @includes;
-
- sub find_inc {
- foreach my $name (@CANDIDATES) {
- if (/$name$/) {
- my ($hname, $hpath, $hsuffix) =
- fileparse($File::Find::name, ("\.h", "\.H"));
- unless ($hpath =~ /include-old/) {
- print "Found $hname$hsuffix in $hpath\n";
- push @includes, $hpath;
- }
- }
- }
- }
-
- use File::Find;
- foreach my $guess (@KAFFE_INCLUDE_GUESSES) {
- next unless -d $guess;
- find (\&find_inc, $guess);
- }
- # If we have found includes, then we are using Kaffe.
- if (@includes > 0) {
- $USE_KAFFE = 1;
- } else {
- foreach my $guess (@JAVA_HOME_GUESSES) {
- next unless -d $guess;
- find (\&find_inc, $guess);
- }
- }
- die "Could not find Java includes!" unless (@includes);
-
- return @includes;
-}
-
+++ /dev/null
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
-
-######################### We start with some black magic to print on failure.
-
-# Change 1..1 below to 1..last_test_to_print .
-# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..3\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use JNI;
-$loaded = 1;
-print "ok 1\n";
-
-######################### End of black magic.
-
-# Insert your test code below (better if it prints "ok 13"
-# (correspondingly "not ok 13") depending on the success of chunk 13
-# of the test code):
-
-# Simple StringBuffer test.
-#
-use JPL::AutoLoader;
-use JPL::Class 'java::lang::StringBuffer';
-$sb = java::lang::StringBuffer->new__s("TEST");
-if ($sb->toString____s() eq "TEST") {
- print "ok 2\n";
-} else {
- print "not ok 2\n";
-}
-
-# Put up a frame and let the user close it.
-#
-use JPL::AutoLoader;
-use JPL::Class 'java::awt::Frame';
-use JPL::Class 'Closer';
-
-$f = java::awt::Frame->new__s("Close Me, Please!");
-my $setSize = getmeth("setSize", ["int", "int"], []);
-my $addWindowListener = getmeth("addWindowListener",
- ["java.awt.event.WindowListener"], []);
-
-$f->$addWindowListener( new Closer );
-$f->$setSize(200,200);
-$f->show();
-
-while (1) {
-
- if (!$f->isVisible____Z) {
- last;
- }
-
- # Sleep a bit.
- #
- sleep 1;
-}
-
-print "ok 3\n";
+++ /dev/null
-JavaVM * T_JPTROBJ
-JNINativeMethod * T_JPTROBJ
-const char * T_PV
-const jbyte * T_JMEM
-const jchar * T_JMEM
-jarray T_JPTROBJ
-jboolean T_IV
-jboolean * T_JMEM
-jbooleanArray T_JPTROBJ
-jbyte T_IV
-jbyte * T_JMEM
-jbyteArray T_JPTROBJ
-jchar T_IV
-jchar * T_JMEM
-jcharArray T_JPTROBJ
-jclass T_JPTROBJ
-jdouble T_NV
-jdouble * T_JMEM
-jdoubleArray T_JPTROBJ
-jfieldID T_JIDSIG
-jfloat T_NV
-jfloat * T_JMEM
-jfloatArray T_JPTROBJ
-jint T_IV
-jint * T_JMEM
-jintArray T_JPTROBJ
-jlong T_NV
-jlong * T_JMEM
-jlongArray T_JPTROBJ
-jmethodID T_JIDSIG
-jobject T_JPTROBJ
-jobjectArray T_JPTROBJ
-jshort T_IV
-jshort * T_JMEM
-jshortArray T_JPTROBJ
-jsize T_IV
-jstring T_JSTRING
-jthrowable T_JPTROBJ
-jvalue * T_JVALUELIST
-
-INPUT
-T_JMEM
- {
- $var = ($type)SvPV($arg,tmplen);
- ${var}_len_ = (jsize) tmplen / sizeof(${subtype});
- }
-T_JSTRING
- if (SvROK($arg)) {
- $var = ($type)(void*)SvIV(SvRV($arg));
- }
- else
- $var = ($type)(*env)->NewStringUTF(env, (char *) SvPV($arg,PL_na))
-T_JVALUELIST
- if (SvROK($arg)) {
- AV* av = (AV*)SvRV($arg);
- if (SvTYPE(av) == SVt_PVAV) {
- I32 maxarg = AvFILL(av) + 1;
- $var = makeargs(sig, AvARRAY(av), maxarg);
- }
- else
- croak(\"$var is not an array reference\");
- }
- else
- croak(\"$var is not a reference\")
-T_JIDSIG
- {
- $var = ($type)SvIV($arg);
- sig = (char*)SvPV($arg,PL_na);
- }
-T_JPTROBJ
- if (SvROK($arg) && SvOBJECT(SvRV($arg))) {
- IV tmp = SvIV((SV*)SvRV($arg));
- $var = ($type) tmp;
- }
- else
- croak(\"$var is not of type ${ntype}\")
-
-OUTPUT
-T_JMEM
- sv_setpvn((SV*)$arg, (char*)$var, (STRLEN)${var}_len_ * sizeof(${subtype}));
-T_JSTRING
- {
- static HV* ${var}_stashhv_ = 0;
- if (!${var}_stashhv_)
- ${var}_stashhv_ = gv_stashpv("java::lang::String", TRUE);
-
- sv_bless(
- sv_setref_iv($arg, Nullch, (IV)(void*)${var}),
- ${var}_stashhv_);
-
- }
-T_JIDSIG
- sv_setiv($arg, (IV)(void*)$var);
- sv_setpv($arg, (char*)sig);
- SvIOK_on($arg);
-T_JPTROBJ
- sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-
-# basic C types
-# int T_IV
-# unsigned T_IV
-# unsigned int T_IV
-# long T_IV
-# unsigned long T_IV
-# short T_IV
-# unsigned short T_IV
-# char T_CHAR
-# unsigned char T_U_CHAR
-# char * T_PV
-# unsigned char * T_PV
-# caddr_t T_PV
-# wchar_t * T_PV
-# wchar_t T_IV
-# bool_t T_IV
-# size_t T_IV
-# ssize_t T_IV
-# time_t T_NV
-# unsigned long * T_OPAQUEPTR
-# char ** T_PACKED
-# void * T_PTR
-# Time_t * T_PV
-# SV * T_SV
-# SVREF T_SVREF
-# AV * T_AVREF
-# HV * T_HVREF
-# CV * T_CVREF
-#
-# IV T_IV
-# I32 T_IV
-# I16 T_IV
-# I8 T_IV
-# U32 T_U_LONG
-# U16 T_U_SHORT
-# U8 T_IV
-# Result T_U_CHAR
-# Boolean T_IV
-# double T_DOUBLE
-# SysRet T_SYSRET
-# SysRetLong T_SYSRET
-# FILE * T_IN
-# FileHandle T_PTROBJ
-# InputStream T_IN
-# InOutStream T_INOUT
-# OutputStream T_OUT
-# bool T_BOOL
-#
-#############################################################################
-# INPUT
-# T_SV
-# $var = $arg
-# T_SVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (SV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_AVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (AV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_HVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (HV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_CVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (CV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_SYSRET
-# $var NOT IMPLEMENTED
-# T_IV
-# $var = ($type)SvIV($arg)
-# T_INT
-# $var = (int)SvIV($arg)
-# T_ENUM
-# $var = ($type)SvIV($arg)
-# T_BOOL
-# $var = (int)SvIV($arg)
-# T_U_INT
-# $var = (unsigned int)SvIV($arg)
-# T_SHORT
-# $var = (short)SvIV($arg)
-# T_U_SHORT
-# $var = (unsigned short)SvIV($arg)
-# T_LONG
-# $var = (long)SvIV($arg)
-# T_U_LONG
-# $var = (unsigned long)SvIV($arg)
-# T_CHAR
-# $var = (char)*SvPV($arg,PL_na)
-# T_U_CHAR
-# $var = (unsigned char)SvIV($arg)
-# T_FLOAT
-# $var = (float)SvNV($arg)
-# T_NV
-# $var = ($type)SvNV($arg)
-# T_DOUBLE
-# $var = (double)SvNV($arg)
-# T_PV
-# $var = ($type)SvPV($arg,PL_na)
-# T_PTR
-# $var = ($type)SvIV($arg)
-# T_PTRREF
-# if (SvROK($arg)) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not a reference\")
-# T_REF_IV_REF
-# if (sv_isa($arg, \"${type}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type *) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_REF_IV_PTR
-# if (sv_isa($arg, \"${type}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_PTROBJ
-# if (sv_derived_from($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_PTRDESC
-# if (sv_isa($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# ${type}_desc = (\U${type}_DESC\E*) tmp;
-# $var = ${type}_desc->ptr;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_REFREF
-# if (SvROK($arg)) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type) tmp;
-# }
-# else
-# croak(\"$var is not a reference\")
-# T_REFOBJ
-# if (sv_isa($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_OPAQUE
-# $var NOT IMPLEMENTED
-# T_OPAQUEPTR
-# $var = ($type)SvPV($arg,PL_na)
-# T_PACKED
-# $var = XS_unpack_$ntype($arg)
-# T_PACKEDARRAY
-# $var = XS_unpack_$ntype($arg)
-# T_CALLBACK
-# $var = make_perl_cb_$type($arg)
-# T_ARRAY
-# $var = $ntype(items -= $argoff);
-# U32 ix_$var = $argoff;
-# while (items--) {
-# DO_ARRAY_ELEM;
-# }
-# T_IN
-# $var = IoIFP(sv_2io($arg))
-# T_INOUT
-# $var = IoIFP(sv_2io($arg))
-# T_OUT
-# $var = IoOFP(sv_2io($arg))
-##############################################################################
-# OUTPUT
-# T_SV
-# $arg = $var;
-# T_SVREF
-# $arg = newRV((SV*)$var);
-# T_AVREF
-# $arg = newRV((SV*)$var);
-# T_HVREF
-# $arg = newRV((SV*)$var);
-# T_CVREF
-# $arg = newRV((SV*)$var);
-# T_IV
-# sv_setiv($arg, (IV)$var);
-# T_INT
-# sv_setiv($arg, (IV)$var);
-# T_SYSRET
-# if ($var != -1) {
-# if ($var == 0)
-# sv_setpvn($arg, "0 but true", 10);
-# else
-# sv_setiv($arg, (IV)$var);
-# }
-# T_ENUM
-# sv_setiv($arg, (IV)$var);
-# T_BOOL
-# $arg = boolSV($var);
-# T_U_INT
-# sv_setiv($arg, (IV)$var);
-# T_SHORT
-# sv_setiv($arg, (IV)$var);
-# T_U_SHORT
-# sv_setiv($arg, (IV)$var);
-# T_LONG
-# sv_setiv($arg, (IV)$var);
-# T_U_LONG
-# sv_setiv($arg, (IV)$var);
-# T_CHAR
-# sv_setpvn($arg, (char *)&$var, 1);
-# T_U_CHAR
-# sv_setiv($arg, (IV)$var);
-# T_FLOAT
-# sv_setnv($arg, (double)$var);
-# T_NV
-# sv_setnv($arg, (double)$var);
-# T_DOUBLE
-# sv_setnv($arg, (double)$var);
-# T_PV
-# sv_setpv((SV*)$arg, $var);
-# T_PTR
-# sv_setiv($arg, (IV)$var);
-# T_PTRREF
-# sv_setref_pv($arg, Nullch, (void*)$var);
-# T_REF_IV_REF
-# sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
-# T_REF_IV_PTR
-# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-# T_PTROBJ
-# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-# T_PTRDESC
-# sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
-# T_REFREF
-# sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
-# ($var ? (void*)new $ntype($var) : 0));
-# T_REFOBJ
-# NOT IMPLEMENTED
-# T_OPAQUE
-# sv_setpvn($arg, (char *)&$var, sizeof($var));
-# T_OPAQUEPTR
-# sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
-# T_PACKED
-# XS_pack_$ntype($arg, $var);
-# T_PACKEDARRAY
-# XS_pack_$ntype($arg, $var, count_$ntype);
-# T_DATAUNIT
-# sv_setpvn($arg, $var.chp(), $var.size());
-# T_CALLBACK
-# sv_setpvn($arg, $var.context.value().chp(),
-# $var.context.value().size());
-# T_ARRAY
-# ST_EXTEND($var.size);
-# for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
-# ST(ix_$var) = sv_newmortal();
-# DO_ARRAY_ELEM
-# }
-# sp += $var.size - 1;
-# T_IN
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
-# T_INOUT
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
-# T_OUT
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
+++ /dev/null
-JavaVM * T_JPTROBJ
-JNINativeMethod * T_JPTROBJ
-const char * T_PV
-const jbyte * T_JMEM
-const jchar * T_JMEM
-jarray T_JPTROBJ
-jboolean T_IV
-jboolean * T_JMEM
-jbooleanArray T_JPTROBJ
-jbyte T_IV
-jbyte * T_JMEM
-jbyteArray T_JPTROBJ
-jchar T_IV
-jchar * T_JMEM
-jcharArray T_JPTROBJ
-jclass T_JPTROBJ
-jdouble T_NV
-jdouble * T_JMEM
-jdoubleArray T_JPTROBJ
-jfieldID T_JIDSIG
-jfloat T_NV
-jfloat * T_JMEM
-jfloatArray T_JPTROBJ
-jint T_IV
-jint * T_JMEM
-jintArray T_JPTROBJ
-jlong T_NV
-jlong * T_JMEM
-jlongArray T_JPTROBJ
-jmethodID T_JIDSIG
-jobject T_JPTROBJ
-jobjectArray T_JPTROBJ
-jshort T_IV
-jshort * T_JMEM
-jshortArray T_JPTROBJ
-jsize T_IV
-jstring T_JSTRING
-jthrowable T_JPTROBJ
-jvalue * T_JVALUELIST
-
-INPUT
-T_JMEM
- {
- $var = ($type)SvPV($arg,tmplen);
- ${var}_len_ = (jsize) tmplen / sizeof(${subtype});
- }
-T_JSTRING
- if (SvROK($arg)) {
- $var = ($type)(void*)SvIV(SvRV($arg));
- }
- else
- $var = ($type)(*env)->NewStringUTF(env, (char *) SvPV($arg,PL_na))
-T_JVALUELIST
- if (SvROK($arg)) {
- AV* av = (AV*)SvRV($arg);
- if (SvTYPE(av) == SVt_PVAV) {
- I32 maxarg = AvFILL(av) + 1;
- $var = makeargs(sig, AvARRAY(av), maxarg);
- }
- else
- croak(\"$var is not an array reference\");
- }
- else
- croak(\"$var is not a reference\")
-T_JIDSIG
- {
- $var = ($type)SvIV($arg);
- sig = (char*)SvPV($arg,PL_na);
- }
-T_JPTROBJ
- if (SvROK($arg) && SvOBJECT(SvRV($arg))) {
- IV tmp = SvIV((SV*)SvRV($arg));
- $var = ($type) tmp;
- }
- else
- croak(\"$var is not of type ${ntype}\")
-
-OUTPUT
-T_JMEM
- sv_setpvn((SV*)$arg, (char*)$var, (STRLEN)${var}_len_ * sizeof(${subtype}));
-T_JSTRING
- {
- static HV* ${var}_stashhv_ = 0;
- if (!${var}_stashhv_)
- ${var}_stashhv_ = gv_stashpv("java::lang::String", TRUE);
-
- sv_bless(
- sv_setref_iv($arg, Nullch, (IV)(void*)${var}),
- ${var}_stashhv_);
-
- }
-T_JIDSIG
- sv_setiv($arg, (IV)(void*)$var);
- sv_setpv($arg, (char*)sig);
- SvIOK_on($arg);
-T_JPTROBJ
- sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-
-# basic C types
-# int T_IV
-# unsigned T_IV
-# unsigned int T_IV
-# long T_IV
-# unsigned long T_IV
-# short T_IV
-# unsigned short T_IV
-# char T_CHAR
-# unsigned char T_U_CHAR
-# char * T_PV
-# unsigned char * T_PV
-# caddr_t T_PV
-# wchar_t * T_PV
-# wchar_t T_IV
-# bool_t T_IV
-# size_t T_IV
-# ssize_t T_IV
-# time_t T_NV
-# unsigned long * T_OPAQUEPTR
-# char ** T_PACKED
-# void * T_PTR
-# Time_t * T_PV
-# SV * T_SV
-# SVREF T_SVREF
-# AV * T_AVREF
-# HV * T_HVREF
-# CV * T_CVREF
-#
-# IV T_IV
-# I32 T_IV
-# I16 T_IV
-# I8 T_IV
-# U32 T_U_LONG
-# U16 T_U_SHORT
-# U8 T_IV
-# Result T_U_CHAR
-# Boolean T_IV
-# double T_DOUBLE
-# SysRet T_SYSRET
-# SysRetLong T_SYSRET
-# FILE * T_IN
-# FileHandle T_PTROBJ
-# InputStream T_IN
-# InOutStream T_INOUT
-# OutputStream T_OUT
-# bool T_BOOL
-#
-#############################################################################
-# INPUT
-# T_SV
-# $var = $arg
-# T_SVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (SV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_AVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (AV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_HVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (HV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_CVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (CV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_SYSRET
-# $var NOT IMPLEMENTED
-# T_IV
-# $var = ($type)SvIV($arg)
-# T_INT
-# $var = (int)SvIV($arg)
-# T_ENUM
-# $var = ($type)SvIV($arg)
-# T_BOOL
-# $var = (int)SvIV($arg)
-# T_U_INT
-# $var = (unsigned int)SvIV($arg)
-# T_SHORT
-# $var = (short)SvIV($arg)
-# T_U_SHORT
-# $var = (unsigned short)SvIV($arg)
-# T_LONG
-# $var = (long)SvIV($arg)
-# T_U_LONG
-# $var = (unsigned long)SvIV($arg)
-# T_CHAR
-# $var = (char)*SvPV($arg,PL_na)
-# T_U_CHAR
-# $var = (unsigned char)SvIV($arg)
-# T_FLOAT
-# $var = (float)SvNV($arg)
-# T_NV
-# $var = ($type)SvNV($arg)
-# T_DOUBLE
-# $var = (double)SvNV($arg)
-# T_PV
-# $var = ($type)SvPV($arg,PL_na)
-# T_PTR
-# $var = ($type)SvIV($arg)
-# T_PTRREF
-# if (SvROK($arg)) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not a reference\")
-# T_REF_IV_REF
-# if (sv_isa($arg, \"${type}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type *) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_REF_IV_PTR
-# if (sv_isa($arg, \"${type}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_PTROBJ
-# if (sv_derived_from($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_PTRDESC
-# if (sv_isa($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# ${type}_desc = (\U${type}_DESC\E*) tmp;
-# $var = ${type}_desc->ptr;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_REFREF
-# if (SvROK($arg)) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type) tmp;
-# }
-# else
-# croak(\"$var is not a reference\")
-# T_REFOBJ
-# if (sv_isa($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_OPAQUE
-# $var NOT IMPLEMENTED
-# T_OPAQUEPTR
-# $var = ($type)SvPV($arg,PL_na)
-# T_PACKED
-# $var = XS_unpack_$ntype($arg)
-# T_PACKEDARRAY
-# $var = XS_unpack_$ntype($arg)
-# T_CALLBACK
-# $var = make_perl_cb_$type($arg)
-# T_ARRAY
-# $var = $ntype(items -= $argoff);
-# U32 ix_$var = $argoff;
-# while (items--) {
-# DO_ARRAY_ELEM;
-# }
-# T_IN
-# $var = IoIFP(sv_2io($arg))
-# T_INOUT
-# $var = IoIFP(sv_2io($arg))
-# T_OUT
-# $var = IoOFP(sv_2io($arg))
-##############################################################################
-# OUTPUT
-# T_SV
-# $arg = $var;
-# T_SVREF
-# $arg = newRV((SV*)$var);
-# T_AVREF
-# $arg = newRV((SV*)$var);
-# T_HVREF
-# $arg = newRV((SV*)$var);
-# T_CVREF
-# $arg = newRV((SV*)$var);
-# T_IV
-# sv_setiv($arg, (IV)$var);
-# T_INT
-# sv_setiv($arg, (IV)$var);
-# T_SYSRET
-# if ($var != -1) {
-# if ($var == 0)
-# sv_setpvn($arg, "0 but true", 10);
-# else
-# sv_setiv($arg, (IV)$var);
-# }
-# T_ENUM
-# sv_setiv($arg, (IV)$var);
-# T_BOOL
-# $arg = boolSV($var);
-# T_U_INT
-# sv_setiv($arg, (IV)$var);
-# T_SHORT
-# sv_setiv($arg, (IV)$var);
-# T_U_SHORT
-# sv_setiv($arg, (IV)$var);
-# T_LONG
-# sv_setiv($arg, (IV)$var);
-# T_U_LONG
-# sv_setiv($arg, (IV)$var);
-# T_CHAR
-# sv_setpvn($arg, (char *)&$var, 1);
-# T_U_CHAR
-# sv_setiv($arg, (IV)$var);
-# T_FLOAT
-# sv_setnv($arg, (double)$var);
-# T_NV
-# sv_setnv($arg, (double)$var);
-# T_DOUBLE
-# sv_setnv($arg, (double)$var);
-# T_PV
-# sv_setpv((SV*)$arg, $var);
-# T_PTR
-# sv_setiv($arg, (IV)$var);
-# T_PTRREF
-# sv_setref_pv($arg, Nullch, (void*)$var);
-# T_REF_IV_REF
-# sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
-# T_REF_IV_PTR
-# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-# T_PTROBJ
-# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-# T_PTRDESC
-# sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
-# T_REFREF
-# sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
-# ($var ? (void*)new $ntype($var) : 0));
-# T_REFOBJ
-# NOT IMPLEMENTED
-# T_OPAQUE
-# sv_setpvn($arg, (char *)&$var, sizeof($var));
-# T_OPAQUEPTR
-# sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
-# T_PACKED
-# XS_pack_$ntype($arg, $var);
-# T_PACKEDARRAY
-# XS_pack_$ntype($arg, $var, count_$ntype);
-# T_DATAUNIT
-# sv_setpvn($arg, $var.chp(), $var.size());
-# T_CALLBACK
-# sv_setpvn($arg, $var.context.value().chp(),
-# $var.context.value().size());
-# T_ARRAY
-# ST_EXTEND($var.size);
-# for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
-# ST(ix_$var) = sv_newmortal();
-# DO_ARRAY_ELEM
-# }
-# sp += $var.size - 1;
-# T_IN
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
-# T_INOUT
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
-# T_OUT
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
+++ /dev/null
-JavaVM * T_JPTROBJ
-JNINativeMethod * T_JPTROBJ
-const char * T_PV
-const jbyte * T_JMEM
-const jchar * T_JMEM
-jarray T_JPTROBJ
-jboolean T_IV
-jboolean * T_JMEM
-jbooleanArray T_JPTROBJ
-jbyte T_IV
-jbyte * T_JMEM
-jbyteArray T_JPTROBJ
-jchar T_IV
-jchar * T_JMEM
-jcharArray T_JPTROBJ
-jclass T_JPTROBJ
-jdouble T_NV
-jdouble * T_JMEM
-jdoubleArray T_JPTROBJ
-jfieldID T_JIDSIG
-jfloat T_NV
-jfloat * T_JMEM
-jfloatArray T_JPTROBJ
-jint T_IV
-jint * T_JMEM
-jintArray T_JPTROBJ
-jlong T_NV
-jlong * T_JMEM
-jlongArray T_JPTROBJ
-jmethodID T_JIDSIG
-jobject T_JPTROBJ
-jobjectArray T_JPTROBJ
-jshort T_IV
-jshort * T_JMEM
-jshortArray T_JPTROBJ
-jsize T_IV
-jstring T_JSTRING
-jthrowable T_JPTROBJ
-jvalue * T_JVALUELIST
-
-INPUT
-T_JMEM
- {
- $var = ($type)SvPV($arg,tmplen);
- ${var}_len_ = (jsize) tmplen / sizeof(${subtype});
- }
-T_JSTRING
- if (SvROK($arg)) {
- $var = ($type)(void*)SvIV(SvRV($arg));
- }
- else
- $var = ($type)env->NewStringUTF((char *) SvPV($arg,PL_na))
-T_JVALUELIST
- if (SvROK($arg)) {
- AV* av = (AV*)SvRV($arg);
- if (SvTYPE(av) == SVt_PVAV) {
- I32 maxarg = AvFILL(av) + 1;
- $var = makeargs(sig, AvARRAY(av), maxarg);
- }
- else
- croak(\"$var is not an array reference\");
- }
- else
- croak(\"$var is not a reference\")
-T_JIDSIG
- {
- $var = ($type)SvIV($arg);
- sig = (char*)SvPV($arg,PL_na);
- }
-T_JPTROBJ
- if (SvROK($arg) && SvOBJECT(SvRV($arg))) {
- IV tmp = SvIV((SV*)SvRV($arg));
- $var = ($type) tmp;
- }
- else
- croak(\"$var is not of type ${ntype}\")
-
-OUTPUT
-T_JMEM
- sv_setpvn((SV*)$arg, (char*)$var, (STRLEN)${var}_len_ * sizeof(${subtype}));
-T_JSTRING
- {
- static HV* ${var}_stashhv_ = 0;
- if (!${var}_stashhv_)
- ${var}_stashhv_ = gv_stashpv("java::lang::String", TRUE);
-
- sv_bless(
- sv_setref_iv($arg, Nullch, (IV)(void*)${var}),
- ${var}_stashhv_);
-
- }
-T_JIDSIG
- sv_setiv($arg, (IV)(void*)$var);
- sv_setpv($arg, (char*)sig);
- SvIOK_on($arg);
-T_JPTROBJ
- sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-
-# basic C types
-# int T_IV
-# unsigned T_IV
-# unsigned int T_IV
-# long T_IV
-# unsigned long T_IV
-# short T_IV
-# unsigned short T_IV
-# char T_CHAR
-# unsigned char T_U_CHAR
-# char * T_PV
-# unsigned char * T_PV
-# caddr_t T_PV
-# wchar_t * T_PV
-# wchar_t T_IV
-# bool_t T_IV
-# size_t T_IV
-# ssize_t T_IV
-# time_t T_NV
-# unsigned long * T_OPAQUEPTR
-# char ** T_PACKED
-# void * T_PTR
-# Time_t * T_PV
-# SV * T_SV
-# SVREF T_SVREF
-# AV * T_AVREF
-# HV * T_HVREF
-# CV * T_CVREF
-#
-# IV T_IV
-# I32 T_IV
-# I16 T_IV
-# I8 T_IV
-# U32 T_U_LONG
-# U16 T_U_SHORT
-# U8 T_IV
-# Result T_U_CHAR
-# Boolean T_IV
-# double T_DOUBLE
-# SysRet T_SYSRET
-# SysRetLong T_SYSRET
-# FILE * T_IN
-# FileHandle T_PTROBJ
-# InputStream T_IN
-# InOutStream T_INOUT
-# OutputStream T_OUT
-# bool T_BOOL
-#
-#############################################################################
-# INPUT
-# T_SV
-# $var = $arg
-# T_SVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (SV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_AVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (AV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_HVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (HV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_CVREF
-# if (sv_isa($arg, \"${ntype}\"))
-# $var = (CV*)SvRV($arg);
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_SYSRET
-# $var NOT IMPLEMENTED
-# T_IV
-# $var = ($type)SvIV($arg)
-# T_INT
-# $var = (int)SvIV($arg)
-# T_ENUM
-# $var = ($type)SvIV($arg)
-# T_BOOL
-# $var = (int)SvIV($arg)
-# T_U_INT
-# $var = (unsigned int)SvIV($arg)
-# T_SHORT
-# $var = (short)SvIV($arg)
-# T_U_SHORT
-# $var = (unsigned short)SvIV($arg)
-# T_LONG
-# $var = (long)SvIV($arg)
-# T_U_LONG
-# $var = (unsigned long)SvIV($arg)
-# T_CHAR
-# $var = (char)*SvPV($arg,PL_na)
-# T_U_CHAR
-# $var = (unsigned char)SvIV($arg)
-# T_FLOAT
-# $var = (float)SvNV($arg)
-# T_NV
-# $var = ($type)SvNV($arg)
-# T_DOUBLE
-# $var = (double)SvNV($arg)
-# T_PV
-# $var = ($type)SvPV($arg,PL_na)
-# T_PTR
-# $var = ($type)SvIV($arg)
-# T_PTRREF
-# if (SvROK($arg)) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not a reference\")
-# T_REF_IV_REF
-# if (sv_isa($arg, \"${type}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type *) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_REF_IV_PTR
-# if (sv_isa($arg, \"${type}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_PTROBJ
-# if (sv_derived_from($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = ($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_PTRDESC
-# if (sv_isa($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# ${type}_desc = (\U${type}_DESC\E*) tmp;
-# $var = ${type}_desc->ptr;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_REFREF
-# if (SvROK($arg)) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type) tmp;
-# }
-# else
-# croak(\"$var is not a reference\")
-# T_REFOBJ
-# if (sv_isa($arg, \"${ntype}\")) {
-# IV tmp = SvIV((SV*)SvRV($arg));
-# $var = *($type) tmp;
-# }
-# else
-# croak(\"$var is not of type ${ntype}\")
-# T_OPAQUE
-# $var NOT IMPLEMENTED
-# T_OPAQUEPTR
-# $var = ($type)SvPV($arg,PL_na)
-# T_PACKED
-# $var = XS_unpack_$ntype($arg)
-# T_PACKEDARRAY
-# $var = XS_unpack_$ntype($arg)
-# T_CALLBACK
-# $var = make_perl_cb_$type($arg)
-# T_ARRAY
-# $var = $ntype(items -= $argoff);
-# U32 ix_$var = $argoff;
-# while (items--) {
-# DO_ARRAY_ELEM;
-# }
-# T_IN
-# $var = IoIFP(sv_2io($arg))
-# T_INOUT
-# $var = IoIFP(sv_2io($arg))
-# T_OUT
-# $var = IoOFP(sv_2io($arg))
-##############################################################################
-# OUTPUT
-# T_SV
-# $arg = $var;
-# T_SVREF
-# $arg = newRV((SV*)$var);
-# T_AVREF
-# $arg = newRV((SV*)$var);
-# T_HVREF
-# $arg = newRV((SV*)$var);
-# T_CVREF
-# $arg = newRV((SV*)$var);
-# T_IV
-# sv_setiv($arg, (IV)$var);
-# T_INT
-# sv_setiv($arg, (IV)$var);
-# T_SYSRET
-# if ($var != -1) {
-# if ($var == 0)
-# sv_setpvn($arg, "0 but true", 10);
-# else
-# sv_setiv($arg, (IV)$var);
-# }
-# T_ENUM
-# sv_setiv($arg, (IV)$var);
-# T_BOOL
-# $arg = boolSV($var);
-# T_U_INT
-# sv_setiv($arg, (IV)$var);
-# T_SHORT
-# sv_setiv($arg, (IV)$var);
-# T_U_SHORT
-# sv_setiv($arg, (IV)$var);
-# T_LONG
-# sv_setiv($arg, (IV)$var);
-# T_U_LONG
-# sv_setiv($arg, (IV)$var);
-# T_CHAR
-# sv_setpvn($arg, (char *)&$var, 1);
-# T_U_CHAR
-# sv_setiv($arg, (IV)$var);
-# T_FLOAT
-# sv_setnv($arg, (double)$var);
-# T_NV
-# sv_setnv($arg, (double)$var);
-# T_DOUBLE
-# sv_setnv($arg, (double)$var);
-# T_PV
-# sv_setpv((SV*)$arg, $var);
-# T_PTR
-# sv_setiv($arg, (IV)$var);
-# T_PTRREF
-# sv_setref_pv($arg, Nullch, (void*)$var);
-# T_REF_IV_REF
-# sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var));
-# T_REF_IV_PTR
-# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-# T_PTROBJ
-# sv_setref_pv($arg, \"${ntype}\", (void*)$var);
-# T_PTRDESC
-# sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var));
-# T_REFREF
-# sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
-# ($var ? (void*)new $ntype($var) : 0));
-# T_REFOBJ
-# NOT IMPLEMENTED
-# T_OPAQUE
-# sv_setpvn($arg, (char *)&$var, sizeof($var));
-# T_OPAQUEPTR
-# sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
-# T_PACKED
-# XS_pack_$ntype($arg, $var);
-# T_PACKEDARRAY
-# XS_pack_$ntype($arg, $var, count_$ntype);
-# T_DATAUNIT
-# sv_setpvn($arg, $var.chp(), $var.size());
-# T_CALLBACK
-# sv_setpvn($arg, $var.context.value().chp(),
-# $var.context.value().size());
-# T_ARRAY
-# ST_EXTEND($var.size);
-# for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
-# ST(ix_$var) = sv_newmortal();
-# DO_ARRAY_ELEM
-# }
-# sp += $var.size - 1;
-# T_IN
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "<&", 2, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
-# T_INOUT
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "+<&", 3, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
-# T_OUT
-# {
-# GV *gv = newGVgen("$Package");
-# if ( do_open(gv, "+>&", 3, FALSE, 0, 0, $var) )
-# sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1)));
-# else
-# $arg = &PL_sv_undef;
-# }
+++ /dev/null
-package JPL::AutoLoader;
-
-use strict;
-
-use vars qw(@ISA @EXPORT $AUTOLOAD);
-
-use Exporter;
-@ISA = "Exporter";
-@EXPORT = ("AUTOLOAD", "getmeth");
-
-my %callmethod = (
- V => 'Void',
- Z => 'Boolean',
- B => 'Byte',
- C => 'Char',
- S => 'Short',
- I => 'Int',
- J => 'Long',
- F => 'Float',
- D => 'Double',
-);
-
-# A lookup table to convert the data types that Java
-# developers are used to seeing into the JNI-mangled
-# versions.
-#
-# bjepson 13 August 1997
-#
-my %type_table = (
- 'void' => 'V',
- 'boolean' => 'Z',
- 'byte' => 'B',
- 'char' => 'C',
- 'short' => 'S',
- 'int' => 'I',
- 'long' => 'J',
- 'float' => 'F',
- 'double' => 'D'
-);
-
-# A cache for method ids.
-#
-# bjepson 13 August 1997
-#
-my %MID_CACHE;
-
-# A cache for methods.
-#
-# bjepson 13 August 1997
-#
-my %METHOD_CACHE;
-
-use JNI;
-
-# XXX We're assuming for the moment that method ids are persistent...
-
-sub AUTOLOAD {
-
- print "AUTOLOAD $AUTOLOAD(@_)\n" if $JPL::DEBUG;
- my ($classname, $methodsig) = $AUTOLOAD =~ /^(.*)::(.*)/;
- print "class = $classname, method = $methodsig\n" if $JPL::DEBUG;
-
- if ($methodsig eq "DESTROY") {
- print "sub $AUTOLOAD {}\n" if $JPL::DEBUG;
- eval "sub $AUTOLOAD {}";
- return;
- }
-
- (my $jclassname = $classname) =~ s/^JPL:://;
- $jclassname =~ s{::}{/}g;
- my $class = JNI::FindClass($jclassname)
- or die "Can't find Java class $jclassname\n";
-
- # This method lookup allows the user to pass in
- # references to two array that contain the input and
- # output data types of the method.
- #
- # bjepson 13 August 1997
- #
- my ($methodname, $sig, $retsig, $slow_way);
- if (ref $_[1] eq 'ARRAY' && ref $_[2] eq 'ARRAY') {
-
- $slow_way = 1;
-
- # First we strip out the input and output args.
- #
- my ($in,$out) = splice(@_, 1, 2);
-
- # let's mangle up the input argument types.
- #
- my @in = jni_mangle($in);
-
- # if they didn't hand us any output values types, make
- # them void by default.
- #
- unless (@{ $out }) {
- $out = ['void'];
- }
-
- # mangle the output types
- #
- my @out = jni_mangle($out);
-
- $methodname = $methodsig;
- $retsig = join("", @out);
- $sig = "(" . join("", @in) . ")" . $retsig;
-
- } else {
-
- ($methodname, $sig) = split /__/, $methodsig, 2;
- $sig ||= "__V"; # default is void return
-
- # Now demangle the signature.
-
- $sig =~ s/_3/[/g;
- $sig =~ s/_2/;/g;
- my $tmp;
- $sig =~ s{
- (s|L[^;]*;)
- }{
- $1 eq 's'
- ? "Ljava/lang/String;"
- : (($tmp = $1) =~ tr[_][/], $tmp)
- }egx;
- if ($sig =~ s/(.*)__(.*)/($1)$2/) {
- $retsig = $2;
- }
- else { # void return is assumed
- $sig = "($sig)V";
- $retsig = "V";
- }
- $sig =~ s/_1/_/g;
- }
- print "sig = $sig\n" if $JPL::DEBUG;
-
- # Now look up the method's ID somehow or other.
- #
- $methodname = "<init>" if $methodname eq 'new';
- my $mid;
-
- # Added a method id cache to compensate for avoiding
- # Perl's method cache...
- #
- if ($MID_CACHE{qq[$classname:$methodname:$sig]}) {
-
- $mid = $MID_CACHE{qq[$classname:$methodname:$sig]};
- print "got method " . ($mid + 0) . " from cache.\n" if $JPL::DEBUG;
-
- } elsif (ref $_[0] or $methodname eq '<init>') {
-
- # Look up an instance method or a constructor
- #
- $mid = JNI::GetMethodID($class, $methodname, $sig);
-
- } else {
-
- # Look up a static method
- #
- $mid = JNI::GetStaticMethodID($class, $methodname, $sig);
-
- }
-
- # Add this method to the cache.
- #
- # bjepson 13 August 1997
- #
- $MID_CACHE{qq[$classname:$methodname:$sig]} = $mid if $slow_way;
-
- if ($mid == 0) {
-
- JNI::ExceptionClear();
- # Could do some guessing here on return type...
- die "Can't get method id for $AUTOLOAD($sig)\n";
-
- }
-
- print "mid = ", $mid + 0, ", $mid\n" if $JPL::DEBUG;
- my $rettype = $callmethod{$retsig} || "Object";
- print "*** rettype = $rettype\n" if $JPL::DEBUG;
-
- my $blesspack;
- no strict 'refs';
- if ($rettype eq "Object") {
- $blesspack = $retsig;
- $blesspack =~ s/^L//;
- $blesspack =~ s/;$//;
- $blesspack =~ s#/#::#g;
- print "*** Some sort of wizardry...\n" if $JPL::DEBUG;
- print %{$blesspack . "::"}, "\n" if $JPL::DEBUG;
- print defined %{$blesspack . "::"}, "\n" if $JPL::DEBUG;
- if (not defined %{$blesspack . "::"}) {
- #if ($blesspack eq "java::lang::String") {
- if ($blesspack =~ /java::/) {
- eval <<"END" . <<'ENDQ';
-package $blesspack;
-END
-use JPL::AutoLoader;
-use overload
- '""' => sub { JNI::GetStringUTFChars($_[0]) },
- '0+' => sub { 0 + "$_[0]" },
- fallback => 1;
-ENDQ
- }
- else {
- eval <<"END";
-package $blesspack;
-use JPL::AutoLoader;
-END
- }
- }
- }
-
- # Finally, call the method. Er, somehow...
- #
- my $METHOD;
-
- my $real_mid = $mid + 0; # weird overloading that I
- # don't understand ?!
- if (ref ${$METHOD_CACHE{qq[$real_mid]}} eq 'CODE') {
-
- $METHOD = ${$METHOD_CACHE{qq[$real_mid]}};
- print qq[Pulled $classname, $methodname, $sig from cache.\n] if $JPL::DEBUG;
-
- } elsif ($methodname eq "<init>") {
- $METHOD = sub {
- my $self = shift;
- my $class = JNI::FindClass($jclassname);
- bless $class->JNI::NewObjectA($mid, \@_), $classname;
- };
- }
- elsif (ref $_[0]) {
- if ($blesspack) {
- $METHOD = sub {
- my $self = shift;
- if (ref $self eq $classname) {
- my $callmethod = "JNI::Call${rettype}MethodA";
- bless $self->$callmethod($mid, \@_), $blesspack;
- }
- else {
- my $callmethod = "JNI::CallNonvirtual${rettype}MethodA";
- bless $self->$callmethod($class, $mid, \@_), $blesspack;
- }
- };
- }
- else {
- $METHOD = sub {
- my $self = shift;
- if (ref $self eq $classname) {
- my $callmethod = "JNI::Call${rettype}MethodA";
- $self->$callmethod($mid, \@_);
- }
- else {
- my $callmethod = "JNI::CallNonvirtual${rettype}MethodA";
- $self->$callmethod($class, $mid, \@_);
- }
- };
- }
- }
- else {
- my $callmethod = "JNI::CallStatic${rettype}MethodA";
- if ($blesspack) {
- $METHOD = sub {
- my $self = shift;
- bless $class->$callmethod($mid, \@_), $blesspack;
- };
- }
- else {
- $METHOD = sub {
- my $self = shift;
- $class->$callmethod($mid, \@_);
- };
- }
- }
- if ($slow_way) {
- $METHOD_CACHE{qq[$real_mid]} = \$METHOD;
- &$METHOD;
- }
- else {
- *$AUTOLOAD = $METHOD;
- goto &$AUTOLOAD;
- }
-}
-
-sub jni_mangle {
-
- my $arr = shift;
- my @ret;
-
- foreach my $arg (@{ $arr }) {
-
- my $ret;
-
- # Count the dangling []s.
- #
- $ret = '[' x $arg =~ s/\[\]//g;
-
- # Is it a primitive type?
- #
- if ($type_table{$arg}) {
- $ret .= $type_table{$arg};
- } else {
- # some sort of class
- #
- $arg =~ s#\.#/#g;
- $ret .= "L$arg;";
- }
- push @ret, $ret;
-
- }
-
- return @ret;
-
-}
-
-sub getmeth {
- my ($meth, $in, $out) = @_;
- my @in = jni_mangle($in);
-
- # if they didn't hand us any output values types, make
- # them void by default.
- #
- unless ($out and @$out) {
- $out = ['void'];
- }
-
- # mangle the output types
- #
- my @out = jni_mangle($out);
-
- my $sig = join("", '#', @in, '#', @out);
- $sig =~ s/_/_1/g;
- my $tmp;
- $sig =~ s{
- (L[^;]*;)
- }{
- ($tmp = $1) =~ tr[/][_], $tmp
- }egx;
- $sig =~ s{Ljava/lang/String;}{s}g;
- $sig =~ s/;/_2/g;
- $sig =~ s/\[/_3/g;
- $sig =~ s/#/__/g;
- $meth . $sig;
-}
-
-{
- package java::lang::String;
- use overload
- '""' => sub { JNI::GetStringUTFChars($_[0]) },
- '0+' => sub { 0 + "$_[0]" },
- fallback => 1;
-}
-1;
+++ /dev/null
-package JPL::Class;
-use JPL::AutoLoader ();
-
-sub DESTROY {}
-
-sub import {
- my $class = shift;
- foreach $class (@_) {
- *{$class . "::AUTOLOAD"} = *JPL::AutoLoader::AUTOLOAD;
- *{$class . "::DESTROY"} = \&DESTROY;
- }
-}
-1;
+++ /dev/null
-#!/usr/bin/perl -w
-
-# Copyright 1997, O'Reilly & Associate, Inc.
-#
-# This package may be copied under the same terms as Perl itself.
-
-package JPL::Compile;
-use Exporter ();
-@ISA = qw(Exporter);
-@EXPORT = qw(files file);
-
-use strict;
-
-
-warn "You don't have a recent JDK kit your PATH, so this may fail.\n"
- unless $ENV{PATH} =~ /(java|jdk1.[1-9])/;
-
-sub emit;
-
-my $PERL = "";
-my $LASTCLASS = "";
-my $PERLLINE = 0;
-my $PROTO;
-
-my @protos;
-
-my $plfile;
-my $jpfile;
-my $hfile;
-my $h_file;
-my $cfile;
-my $jfile;
-my $classfile;
-
-my $DEBUG = $ENV{JPLDEBUG};
-
-my %ptype = qw(
- Z boolean
- B byte
- C char
- S short
- I int
- J long
- F float
- D double
-);
-
-$ENV{CLASSPATH} =~ s/^/.:/ unless $ENV{CLASSPATH} =~ /^\.(?::|$)/;
-
-unless (caller) {
- files(@ARGV);
-}
-
-#######################################################################
-
-sub files {
- foreach my $jpfile (@_) {
- file($jpfile);
- }
- print "make\n";
- system "make";
-}
-
-sub file {
- my $jpfile = shift;
- my $JAVA = "";
- my $lastpos = 0;
- my $linenum = 2;
- my %classseen;
- my %fieldsig;
- my %staticfield;
-
- (my $file = $jpfile) =~ s/\.jpl$//;
- $jpfile = "$file.jpl";
- $jfile = "$file.java";
- $hfile = "$file.h";
- $cfile = "$file.c";
- $plfile = "$file.pl";
- $classfile = "$file.class";
-
- ($h_file = $hfile) =~ s/_/_0005f/g;
-
- emit_c_header();
-
- # Extract out arg names from .java file, since .class doesn't have 'em.
-
- open(JPFILE, $jpfile) or die "Can't open $jpfile: $!\n";
- undef $/;
- $_ = <JPFILE>;
- close JPFILE;
-
- die "$jpfile doesn't seem to define class $file!\n"
- unless /class\s+\b$file\b[\w\s.,]*{/;
-
- @protos = ();
- open(JFILE, ">$jfile") or die "Can't create $jfile: $!\n";
-
- while (m/\bperl\b([^\n]*?\b(\w+)\s*\(\s*(.*?)\s*\)[\s\w.,]*)\{\{(.*?)\}\}/sg) {
- $JAVA = substr($`, $lastpos);
- $lastpos = pos $_;
- $JAVA .= "native";
- $JAVA .= $1;
-
- my $method = $2;
-
- my $proto = $3;
-
- my $perl = $4;
- (my $repl = $4) =~ tr/\n//cd;
- $JAVA .= ';';
- $linenum += $JAVA =~ tr/\n/\n/;
- $JAVA .= $repl;
- print JFILE $JAVA;
-
- $proto =~ s/\s+/ /g;
- $perl =~ s/^[ \t]+\Z//m;
- $perl =~ s/^[ \t]*\n//;
- push(@protos, [$method, $proto, $perl, $linenum]);
-
- $linenum += $repl =~ tr/\n/\n/;
- }
-
- print JFILE <<"END";
- static {
- System.loadLibrary("$file");
- PerlInterpreter pi = new PerlInterpreter().fetch();
- // pi.eval("\$JPL::DEBUG = \$ENV{JPLDEBUG};");
- pi.eval("warn qq{loading $file\\n} if \$JPL::DEBUG");
- pi.eval("eval {require '$plfile'}; print \$@ if \$@;");
- }
-END
-
- print JFILE substr($_, $lastpos);
-
- close JFILE;
-
- # Produce the corresponding .h file. Should really use make...
-
- if (not -s $hfile or -M $hfile > -M $jfile) {
- if (not -s $classfile or -M $classfile > -M $jfile) {
- unlink $classfile;
- print "javac $jfile\n";
- system "javac $jfile" and die "Couldn't run javac: exit $?\n";
- if (not -s $classfile or -M $classfile > -M $jfile) {
- die "Couldn't produce $classfile from $jfile!";
- }
- }
- unlink $hfile;
- print "javah -jni $file\n";
- system "javah -jni $file" and die "Couldn't run javah: exit $?\n";
- if (not -s $hfile and -s $h_file) {
- rename $h_file, $hfile;
- }
- if (not -s $hfile or -M $hfile > -M $jfile) {
- die "Couldn't produce $hfile from $classfile!";
- }
- }
-
- # Easiest place to get fields is from javap.
-
- print "javap -s $file\n";
- open(JP, "javap -s $file|");
- $/ = "\n";
- while (<JP>) {
- if (/^\s+([A-Za-z_].*) (\w+)[\[\d\]]*;/) {
- my $jtype = $1;
- my $name = $2;
- $_ = <JP>;
- s!^\s*/\*\s*!!;
- s!\s*\*/\s*!!;
- print "Field $jtype $name $_\n" if $DEBUG;
- $fieldsig{$name} = $_;
- $staticfield{$name} = $jtype =~ /\bstatic\b/;
- }
- while (m/L([^;]*);/g) {
- my $pclass = j2p_class($1);
- $classseen{$pclass}++;
- }
- }
- close JP;
-
- open(HFILE, $hfile) or die "Couldn't open $hfile: $!\n";
- undef $/;
- $_ = <HFILE>;
- close HFILE;
-
- die "panic: native method mismatch" if @protos != s/^JNIEXPORT/JNIEXPORT/gm;
-
- $PROTO = 0;
- while (m{
- \*\s*Class:\s*(\w+)\s*
- \*\s*Method:\s*(\w+)\s*
- \*\s*Signature:\s*(\S+)\s*\*/\s*
- JNIEXPORT\s*(.*?)\s*JNICALL\s*(\w+)\s*\((.*?)\)
- }gx) {
- my $class = $1;
- my $method = $2;
- my $signature = $3;
- my $rettype = $4;
- my $cname = $5;
- my $ctypes = $6;
- $class =~ s/_0005f/_/g;
- if ($method ne $protos[$PROTO][0]) {
- die "Method name mismatch: $method vs $protos[$PROTO][0]\n";
- }
- print "$class.$method($protos[$PROTO][1]) =>
- $signature
- $rettype $cname($ctypes)\n" if $DEBUG;
-
- # Insert argument names into parameter list.
-
- my $env = "env";
- my $obj = "obj";
- my @jargs = split(/\s*,\s*/, $protos[$PROTO][1]);
- foreach my $arg (@jargs) {
- $arg =~ s/^.*\b(\w+).*$/${1}/;
- }
- my @tmpargs = @jargs;
- unshift(@tmpargs, $env, $obj);
- print "\t@tmpargs\n" if $DEBUG;
- $ctypes .= ",";
- $ctypes =~ s/,/' ' . shift(@tmpargs) . '_,'/eg;
- $ctypes =~ s/,$//;
- $ctypes =~ s/env_/env/;
- $ctypes =~ s/obj_/obj/;
- print "\t$ctypes\n" if $DEBUG;
-
- my $jlen = @jargs + 1;
-
- (my $mangclass = $class) =~ s/_/_1/g;
- (my $mangmethod = $method) =~ s/_/_1/g;
- my $plname = $cname;
- $plname =~ s/^Java_${mangclass}_${mangmethod}/JPL::${class}::${method}/;
- $plname =~ s/Ljava_lang_String_2/s/g;
-
- # Make glue code for each argument.
-
- (my $sig = $signature) =~ s/^\(//;
-
- my $decls = "";
- my $glue = "";
-
- foreach my $jarg (@jargs) {
- if ($sig =~ s/^[ZBCSI]//) {
- $glue .= <<"";
-! /* $jarg */
-! PUSHs(sv_2mortal(newSViv(${jarg}_)));
-!
-
- }
- elsif ($sig =~ s/^[JFD]//) {
- $glue .= <<"";
-! /* $jarg */
-! PUSHs(sv_2mortal(newSVnv(${jarg}_)));
-!
-
- }
- elsif ($sig =~ s#^Ljava/lang/String;##) {
- $glue .= <<"";
-! /* $jarg */
-! tmpjb = (jbyte*)(*env)->GetStringUTFChars(env,${jarg}_,0);
-! PUSHs(sv_2mortal(newSVpv((char*)tmpjb,0)));
-! (*env)->ReleaseStringUTFChars(env,${jarg}_,tmpjb);
-!
-
- }
- elsif ($sig =~ s/^L([^;]*);//) {
- my $pclass = j2p_class($1);
- $classseen{$pclass}++;
- $glue .= <<"";
-! /* $jarg */
-! if (!${jarg}_stashhv_)
-! ${jarg}_stashhv_ = gv_stashpv("$pclass", TRUE);
-!
-! PUSHs(sv_bless(
-! sv_setref_iv(sv_newmortal(), Nullch, (IV)(void*)${jarg}_),
-! ${jarg}_stashhv_));
-! if (jpldebug)
-! fprintf(stderr, "Done with $jarg\\n");
-!
-
- $decls .= <<"";
-! static HV* ${jarg}_stashhv_ = 0;
-
-
- }
- elsif ($sig =~ s/^\[+([ZBCSIJFD]|L[^;]*;)//) {
- my $pclass = "jarray";
- $classseen{$pclass}++;
- $glue .= <<"";
-! /* $jarg */
-! if (!${jarg}_stashhv_)
-! ${jarg}_stashhv_ = gv_stashpv("$pclass", TRUE);
-!
-! PUSHs(sv_bless(
-! sv_setref_iv(sv_newmortal(), Nullch, (IV)(void*)${jarg}_),
-! ${jarg}_stashhv_));
-! if (jpldebug)
-! fprintf(stderr, "Done with $jarg\\n");
-!
-
- $decls .= <<"";
-! static HV* ${jarg}_stashhv_ = 0;
-
- }
- else {
- die "Short signature: $signature\n" if $sig eq "";
- die "Unrecognized letter '" . substr($sig, 0, 1) . "' in signature $signature\n";
- }
- }
-
- $sig =~ s/^\)// or die "Argument mismatch in signature: $method$signature\n";
-
- my $void = $signature =~ /\)V$/;
-
- $decls .= <<"" if $signature =~ m#java/lang/String#;
-! jbyte* tmpjb;
-
- $decls .= <<"" unless $void;
-! SV* retsv;
-! $rettype retval;
-!
-! if (jpldebug)
-! fprintf(stderr, "Got to $cname\\n");
-! ENTER;
-! SAVETMPS;
-
- emit <<"";
-!JNIEXPORT $rettype JNICALL
-!$cname($ctypes)
-!{
-! static SV* methodsv = 0;
-! static HV* stashhv = 0;
-! dSP;
-$decls
-! PUSHMARK(sp);
-! EXTEND(sp,$jlen);
-!
-! sv_setiv(perl_get_sv("JPL::_env_", 1), (IV)(void*)env);
-! jplcurenv = env;
-!
-! if (jpldebug)
-! fprintf(stderr, "env = %lx\\n", (long)$env);
-!
-! if (!methodsv)
-! methodsv = (SV*)perl_get_cv("$plname", TRUE);
-! if (!stashhv)
-! stashhv = gv_stashpv("JPL::$class", TRUE);
-!
-! if (jpldebug)
-! fprintf(stderr, "blessing obj = %lx\\n", obj);
-! PUSHs(sv_bless(
-! sv_setref_iv(sv_newmortal(), Nullch, (IV)(void*)obj),
-! stashhv));
-!
-$glue
-
- # Finally, call the subroutine.
-
- my $mod;
- $mod = "|G_DISCARD" if $void;
-
- if ($void) {
- emit <<"";
-! PUTBACK;
-! perl_call_sv(methodsv, G_EVAL|G_KEEPERR|G_DISCARD);
-!
-
- }
- else {
- emit <<"";
-! PUTBACK;
-! if (perl_call_sv(methodsv, G_EVAL|G_KEEPERR))
-! retsv = *PL_stack_sp--;
-! else
-! retsv = &PL_sv_undef;
-!
-
- }
-
- emit <<"";
-! if (SvTRUE(ERRSV)) {
-! jthrowable newExcCls;
-!
-! (*env)->ExceptionDescribe(env);
-! (*env)->ExceptionClear(env);
-!
-! newExcCls = (*env)->FindClass(env, "java/lang/RuntimeException");
-! if (newExcCls)
-! (*env)->ThrowNew(env, newExcCls, SvPV(ERRSV,PL_na));
-! }
-!
-
- # Fix up the return value, if any.
-
- if ($sig =~ s/^V//) {
- emit <<"";
-! return;
-
- }
- elsif ($sig =~ s/^[ZBCSI]//) {
- emit <<"";
-! retval = ($rettype)SvIV(retsv);
-! FREETMPS;
-! LEAVE;
-! return retval;
-
- }
- elsif ($sig =~ s/^[JFD]//) {
- emit <<"";
-! retval = ($rettype)SvNV(retsv);
-! FREETMPS;
-! LEAVE;
-! return retval;
-
- }
- elsif ($sig =~ s#^Ljava/lang/String;##) {
- emit <<"";
-! retval = (*env)->NewStringUTF(env, SvPV(retsv,PL_na));
-! FREETMPS;
-! LEAVE;
-! return retval;
-
- }
- elsif ($sig =~ s/^L[^;]*;//) {
- emit <<"";
-! if (SvROK(retsv)) {
-! SV* rv = (SV*)SvRV(retsv);
-! if (SvOBJECT(rv))
-! retval = ($rettype)(void*)SvIV(rv);
-! else
-! retval = ($rettype)(void*)0;
-! }
-! else
-! retval = ($rettype)(void*)0;
-! FREETMPS;
-! LEAVE;
-! return retval;
-
- }
- elsif ($sig =~ s/^\[([ZBCSIJFD])//) {
- my $elemtype = $1;
- my $ptype = "\u$ptype{$elemtype}";
- my $ntype = "j$ptype{$elemtype}";
- my $in = $elemtype =~ /^[JFD]/ ? "N" : "I";
- emit <<"";
-! if (SvROK(retsv)) {
-! SV* rv = (SV*)SvRV(retsv);
-! if (SvOBJECT(rv))
-! retval = ($rettype)(void*)SvIV(rv);
-! else if (SvTYPE(rv) == SVt_PVAV) {
-! jsize len = av_len((AV*)rv) + 1;
-! $ntype* buf = ($ntype*)malloc(len * sizeof($ntype));
-! int i;
-! SV** esv;
-!
-! ${ntype}Array ja = (*env)->New${ptype}Array(env, len);
-! for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
-! buf[i] = ($ntype)Sv${in}V(*esv);
-! (*env)->Set${ptype}ArrayRegion(env, ja, 0, len, buf);
-! free((void*)buf);
-! retval = ($rettype)ja;
-! }
-! else
-! retval = ($rettype)(void*)0;
-! }
-! else if (SvPOK(retsv)) {
-! jsize len = sv_len(retsv) / sizeof($ntype);
-!
-! ${ntype}Array ja = (*env)->New${ptype}Array(env, len);
-! (*env)->Set${ptype}ArrayRegion(env, ja, 0, len, ($ntype*)SvPV(retsv,PL_na));
-! retval = ($rettype)ja;
-! }
-! else
-! retval = ($rettype)(void*)0;
-! FREETMPS;
-! LEAVE;
-! return retval;
-
- }
- elsif ($sig =~ s!^\[Ljava/lang/String;!!) {
- emit <<"";
-! if (SvROK(retsv)) {
-! SV* rv = (SV*)SvRV(retsv);
-! if (SvOBJECT(rv))
-! retval = ($rettype)(void*)SvIV(rv);
-! else if (SvTYPE(rv) == SVt_PVAV) {
-! jsize len = av_len((AV*)rv) + 1;
-! int i;
-! SV** esv;
-! static jclass jcl = 0;
-! jarray ja;
-!
-! if (!jcl)
-! jcl = (*env)->FindClass(env, "java/lang/String");
-! ja = (*env)->NewObjectArray(env, len, jcl, 0);
-! for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++) {
-! jobject str = (jobject)(*env)->NewStringUTF(env, SvPV(*esv,PL_na));
-! (*env)->SetObjectArrayElement(env, ja, i, str);
-! }
-! retval = ($rettype)ja;
-! }
-! else
-! retval = ($rettype)(void*)0;
-! }
-! else
-! retval = ($rettype)(void*)0;
-! FREETMPS;
-! LEAVE;
-! return retval;
-
- }
- elsif ($sig =~ s/^(\[+)([ZBCSIJFD]|L[^;]*;)//) {
- my $arity = length $1;
- my $elemtype = $2;
- emit <<"";
-! if (SvROK(retsv)) {
-! SV* rv = (SV*)SvRV(retsv);
-! if (SvOBJECT(rv))
-! retval = ($rettype)(void*)SvIV(rv);
-! else if (SvTYPE(rv) == SVt_PVAV) {
-! jsize len = av_len((AV*)rv) + 1;
-! int i;
-! SV** esv;
-! static jclass jcl = 0;
-! jarray ja;
-!
-! if (!jcl)
-! jcl = (*env)->FindClass(env, "java/lang/Object");
-! ja = (*env)->NewObjectArray(env, len, jcl, 0);
-! for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++) {
-! if (SvROK(*esv) && (rv = SvRV(*esv)) && SvOBJECT(rv)) {
-! (*env)->SetObjectArrayElement(env, ja, i,
-! (jobject)(void*)SvIV(rv));
-! }
-! else {
-! jobject str = (jobject)(*env)->NewStringUTF(env,
-! SvPV(*esv,PL_na));
-! (*env)->SetObjectArrayElement(env, ja, i, str);
-! }
-! }
-! retval = ($rettype)ja;
-! }
-! else
-! retval = ($rettype)(void*)0;
-! }
-! else
-! retval = ($rettype)(void*)0;
-! FREETMPS;
-! LEAVE;
-! return retval;
-
- }
- else {
- die "No return type: $signature\n" if $sig eq "";
- die "Unrecognized return type '" . substr($sig, 0, 1) . "' in signature $signature\n";
- }
-
- emit <<"";
-!}
-!
-
- my $perl = "";
-
- if ($class ne $LASTCLASS) {
- $LASTCLASS = $class;
- $perl .= <<"";
-package JPL::${class};
-use JNI;
-use JPL::AutoLoader;
-\@ISA = qw(jobject);
-\$clazz = JNI::FindClass("$file");\n
-
- foreach my $field (sort keys %fieldsig) {
- my $sig = $fieldsig{$field};
- my $ptype = $ptype{$sig};
- if ($ptype) {
- $ptype = "\u$ptype";
- if ($staticfield{$field}) {
- $perl .= <<"";
-\$${field}_FieldID = JNI::GetStaticFieldID(\$clazz, "$field", "$sig");
-sub $field (\$;\$) {
- my \$self = shift;
- if (\@_) {
- JNI::SetStatic${ptype}Field(\$clazz, \$${field}_FieldID, \$_[0]);
- }
- else {
- JNI::GetStatic${ptype}Field(\$clazz, \$${field}_FieldID);
- }
-}\n
-
- }
- else {
- $perl .= <<"";
-\$${field}_FieldID = JNI::GetFieldID(\$clazz, "$field", "$sig");
-sub $field (\$;\$) {
- my \$self = shift;
- if (\@_) {
- JNI::Set${ptype}Field(\$self, \$${field}_FieldID, \$_[0]);
- }
- else {
- JNI::Get${ptype}Field(\$self, \$${field}_FieldID);
- }
-}\n
-
- }
- }
- else {
- my $pltype = $sig;
- if ($pltype =~ s/^L(.*);/$1/) {
- $pltype =~ s!/!::!g;
- }
- else {
- $pltype = 'jarray';
- }
- if ($pltype eq "java::lang::String") {
- if ($staticfield{$field}) {
- $perl .= <<"";
-\$${field}_FieldID = JNI::GetStaticFieldID(\$clazz, "$field", "$sig");
-sub $field (\$;\$) {
- my \$self = shift;
- if (\@_) {
- JNI::SetStaticObjectField(\$clazz, \$${field}_FieldID,
- ref \$_[0] ? \$_[0] : JNI::NewStringUTF(\$_[0]));
- }
- else {
- JNI::GetStringUTFChars(JNI::GetStaticObjectField(\$clazz, \$${field}_FieldID));
- }
-}\n
-
- }
- else {
- $perl .= <<"";
-\$${field}_FieldID = JNI::GetFieldID(\$clazz, "$field", "$sig");
-sub $field (\$;\$) {
- my \$self = shift;
- if (\@_) {
- JNI::SetObjectField(\$self, \$${field}_FieldID,
- ref \$_[0] ? \$_[0] : JNI::NewStringUTF(\$_[0]));
- }
- else {
- JNI::GetStringUTFChars(JNI::GetObjectField(\$self, \$${field}_FieldID));
- }
-}\n
-
- }
- }
- else {
- if ($staticfield{$field}) {
- $perl .= <<"";
-\$${field}_FieldID = JNI::GetStaticFieldID(\$clazz, "$field", "$sig");
-sub $field (\$;\$) {
- my \$self = shift;
- if (\@_) {
- JNI::SetStaticObjectField(\$clazz, \$${field}_FieldID, \$_[0]);
- }
- else {
- bless JNI::GetStaticObjectField(\$clazz, \$${field}_FieldID), "$pltype";
- }
-}\n
-
- }
- else {
- $perl .= <<"";
-\$${field}_FieldID = JNI::GetFieldID(\$clazz, "$field", "$sig");
-sub $field (\$;\$) {
- my \$self = shift;
- if (\@_) {
- JNI::SetObjectField(\$self, \$${field}_FieldID, \$_[0]);
- }
- else {
- bless JNI::GetObjectField(\$self, \$${field}_FieldID), "$pltype";
- }
-}\n
-
- }
- }
- }
- }
- }
-
- $plname =~ s/^JPL::${class}:://;
-
- my $proto = '$' x (@jargs + 1);
- $perl .= "sub $plname ($proto) {\n";
- $perl .= ' my ($self, ';
- foreach my $jarg (@jargs) {
- $perl .= "\$$jarg, ";
- }
- $perl =~ s/, $/) = \@_;\n/;
- $perl .= <<"END";
- warn "JPL::${class}::$plname(\@_)\\n" if \$JPL::DEBUG;
-#line $protos[$PROTO][3] "$jpfile"
-$protos[$PROTO][2]}
-
-END
-
- $PERLLINE += $perl =~ tr/\n/\n/ + 2;
- $perl .= <<"END";
-#line $PERLLINE ""
-END
- $PERLLINE--;
-
- $PERL .= $perl;
- }
- continue {
- $PROTO++;
- print "\n" if $DEBUG;
- }
-
- emit_c_footer();
-
- rename $cfile, "$cfile.old";
- rename "$cfile.new", $cfile;
-
- open(PLFILE, ">$plfile") or die "Can't create $plfile: $!\n";
- print PLFILE "BEGIN { \$JPL::_env_ ||= 1; } # suppress bogus embedding\n\n";
- if (%classseen) {
- my @classes = sort keys %classseen;
- print PLFILE "use JPL::Class qw(@classes);\n\n";
- }
- print PLFILE $PERL;
- print PLFILE "1;\n";
- close PLFILE;
-
- print "perl -c $plfile\n";
- system "perl -c $plfile" and die "jpl stopped\n";
-}
-
-sub emit_c_header {
- open(CFILE, ">$cfile.new") or die "Can't create $cfile.new: $!\n";
- emit <<"";
-!/* This file is automatically generated. Do not modify! */
-!
-!#include "$hfile"
-!
-!#include "EXTERN.h"
-!#include "perl.h"
-!
-!#ifndef EXTERN_C
-!# ifdef __cplusplus
-!# define EXTERN_C extern "C"
-!# else
-!# define EXTERN_C extern
-!# endif
-!#endif
-!
-!extern int jpldebug;
-!extern JNIEnv* jplcurenv;
-!
-
-}
-
-
-sub emit_c_footer {
- close CFILE;
-}
-
-sub emit {
- my $string = shift;
- $string =~ s/^!//mg;
- print CFILE $string;
-}
-
-sub j2p_class {
- my $jclass = shift;
- $jclass =~ s#/#::#g;
- $jclass;
-}
+++ /dev/null
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'NAME' => 'JPL::Class',
-);
+++ /dev/null
-import java.awt.*;
-import java.awt.event.*;
-import java.lang.*;
-import java.util.*;
-
-public class JPL_Rolo extends Frame {
-
- // The primary key of the row that is current onscreen.
- //
- int current_row = 0;
-
- // TextField objects for each column.
- //
- TextField fld_name, fld_address, fld_city, fld_state, fld_zip, fld_id;
-
- // Add or Edit mode.
- //
- String edit_status;
-
- // a layout manager for the Frame
- //
- GridBagLayout gb = new GridBagLayout();
-
- // Action buttons.
- //
- Button next, previous, quit, save, newrow, edit, cancel, delete;
-
- // A Panel for the action buttons.
- //
- Panel actionbuttons;
-
- /**
- * Construct a new instance of JPL_Rolo.
- */
- public JPL_Rolo(String[] argv) {
- CreateForm();
- addWindowListener(new WinEventHandler() );
- }
-
- public void CreateForm() {
-
- // set the layout for the frame
- //
- this.setLayout(gb);
-
- // this is the offset within the GridBagLayout. If
- // I want the next object on a different line, I
- // postincrement. If not, I don't.
- //
- int i = 0;
-
- // Add a text field for the name.
- //
- AddToFrame(new Label("Name:"), 0, i);
- fld_name = new TextField(20);
- fld_name.setEditable(false);
- AddToFrame(fld_name, 1, i++);
-
- // The address.
- //
- AddToFrame(new Label("Address:"), 0, i);
- fld_address = new TextField(35);
- fld_address.setEditable(false);
- AddToFrame(fld_address, 1, i++);
-
- // The City. I'm not going to increment i, so the
- // next field will show up on the same line.
- //
- AddToFrame(new Label("City:"), 0, i);
- fld_city = new TextField(20);
- fld_city.setEditable(false);
- AddToFrame(fld_city, 1, i);
-
- // The State.
- //
- AddToFrame(new Label("State:"), 2, i);
- fld_state = new TextField(2);
- fld_state.setEditable(false);
- AddToFrame(fld_state, 3, i++);
-
- // The Zip Code.
- //
- AddToFrame(new Label("Zip:"), 0, i);
- fld_zip = new TextField(11);
- fld_zip.setEditable(false);
- AddToFrame(fld_zip, 1, i++);
-
- // The id - this is always read-only.
- //
- AddToFrame(new Label("Id:"), 0, i);
- fld_id = new TextField(4);
- fld_id.setEditable(false);
- AddToFrame(fld_id, 1, i++);
-
- // create the button panel and give it a FlowLayout
- //
- actionbuttons = new Panel();
- actionbuttons.setLayout(new FlowLayout(FlowLayout.CENTER, 5, 5));
-
- // Add the button panel to the Frame. The AddToFrame
- // method isn't really set up to handle this sort of
- // panel, so we will go through the tedious process
- // of managing the GridBagConstraints...
- //
- GridBagConstraints c = new GridBagConstraints();
- c.gridwidth = 3; c.gridheight = 1;
- c.fill = GridBagConstraints.NONE;
- c.anchor = GridBagConstraints.CENTER;
- c.weightx = 0.0; c.weighty = 0.0;
- c.gridx = 0; c.gridy = i;
- ((GridBagLayout)this.getLayout()).setConstraints(actionbuttons, c);
- this.add(actionbuttons);
-
- // instantiate and add each of the buttons
- //
- previous = new Button("Previous");
- actionbuttons.add(previous);
- previous.addActionListener( new PrevRowHandler() );
-
- next = new Button("Next");
- actionbuttons.add(next);
- next.addActionListener( new NextRowHandler() );
-
- quit = new Button("Quit");
- actionbuttons.add(quit);
- quit.addActionListener( new QuitHandler() );
-
- newrow = new Button("New");
- actionbuttons.add(newrow);
- newrow.addActionListener( new NewRowHandler() );
-
- edit = new Button("Edit");
- actionbuttons.add(edit);
- edit.addActionListener( new EditRowHandler() );
-
- delete = new Button("Delete");
- actionbuttons.add(delete);
- delete.addActionListener( new DeleteRowHandler() );
-
- // save and cancel are disabled until the user
- // is adding or editing.
- //
- save = new Button("Save");
- actionbuttons.add(save);
- save.setEnabled(false);
- save.addActionListener( new SaveHandler() );
-
- cancel = new Button("Cancel");
- actionbuttons.add(cancel);
- cancel.setEnabled(false);
- cancel.addActionListener( new CancelHandler() );
-
- // Invoke getRow() to display the first row in the table.
- //
- getRow(0);
-
- }
-
- /**
- * Return the id of the current row.
- */
- public int getCurrentRowVal() {
- return current_row;
- }
-
- public void setCols(String name, String address, String city, String state, String zip, String id) {
-
- clearForm();
-
- fld_name.setText(name);
- fld_address.setText(address);
- fld_city.setText(city);
- fld_state.setText(state);
- fld_zip.setText(zip);
- fld_id.setText(id);
- current_row = Integer.parseInt(id);
-
- }
-
-
- public void setCurrentRow(int r) {
- current_row = r;
- }
-
- public String getName() { return fld_name.getText(); }
- public String getAddress() { return fld_address.getText(); }
- public String getCity() { return fld_city.getText(); }
- public String getState() { return fld_state.getText(); }
- public String getZip() { return fld_zip.getText(); }
- public String getId() { return fld_id.getText(); }
-
- /**
- * This eventhandler will move to the previous row.
- */
- class PrevRowHandler implements ActionListener {
- public void actionPerformed( ActionEvent e) {
- getRow(-1);
- }
- }
-
- /**
- * This eventhandler will move to the next row.
- */
- class NextRowHandler implements ActionListener {
- public void actionPerformed( ActionEvent e) {
- getRow(1);
- }
- }
-
- /**
- * This eventhandler will terminate the application.
- */
- class QuitHandler implements ActionListener {
- public void actionPerformed( ActionEvent e) {
- System.exit(0);
- }
- }
-
- /**
- * This eventhandler will display a blank record and put
- * this application in new record mode.
- */
- class NewRowHandler implements ActionListener {
- public void actionPerformed( ActionEvent e) {
- clearForm();
- edit_status = "new";
- setEdit();
- }
- }
-
- /**
- * This eventhandler will put the application in edit
- * mode (for the current row).
- */
- class EditRowHandler implements ActionListener {
- public void actionPerformed( ActionEvent e) {
- edit_status = "edit";
- setEdit();
- }
- }
- /**
- * This eventhandler will delete the current row.
- */
- class DeleteRowHandler implements ActionListener {
- public void actionPerformed( ActionEvent e) {
- delRow();
- }
- }
-
- /**
- * This eventhandler will save (update or insert) the
- * current record.
- */
- class SaveHandler implements ActionListener {
- public void actionPerformed( ActionEvent e) {
-
- if (edit_status.equals("new")) {
- saveIt();
- }
- if (edit_status.equals("edit")) {
- updateRow();
- }
-
- // set the edit_status to "browse", and call setBrowse()
- //
- edit_status = "browse";
- setBrowse();
- }
- }
-
- /**
- * This eventhandler cancels any pending edit.
- */
- class CancelHandler implements ActionListener {
- public void actionPerformed( ActionEvent e) {
- // if it was new, make sure that they can't edit the
- // id field...
-
- if (edit_status.equals("new")) {
- fld_id.setEditable(false);
- }
-
- // return the edit_status to browse, call getRow()
- // to retrieve the row they were looking at
- // before editing or adding, and call setBrowse()
- //
- edit_status = "browse";
- getRow(0);
- setBrowse();
- }
- }
-
- // This is the event handler to deal with cases where
- // the user closes the window with a window control.
- //
- class WinEventHandler extends WindowAdapter {
- public void windowClosing(WindowEvent e) {
- System.exit(0);
- }
- }
-
- /**
- * clearForm()
- */
- protected void clearForm () {
- fld_name.setText("");
- fld_address.setText("");
- fld_city.setText("");
- fld_state.setText("");
- fld_zip.setText("");
- fld_id.setText("");
- }
-
- /**
- * AddToFrame()
- * A convenience method to wrap the living hell
- * that is GridBagConstraints()
- */
- protected void AddToFrame (Component item, int x, int y) {
-
- // some sane layout defaults.
- //
- GridBagConstraints c = new GridBagConstraints();
- c.gridwidth = 1; c.gridheight = 1;
- c.fill = GridBagConstraints.NONE;
- c.anchor = GridBagConstraints.NORTHWEST;
- c.weightx = 0.0; c.weighty = 0.0;
-
- // set the grid coordinates
- //
- c.gridx = x; c.gridy = y;
-
- // set the constraints, and add the item to the layout
- //
-
- ((GridBagLayout)this.getLayout()).setConstraints(item, c);
- this.add(item);
- }
-
- /**
- * setEdit()
- *
- * prepare the form for editing/adding
- */
- protected void setEdit () {
-
- // disable all these buttons
- //
- next.setEnabled(false);
- previous.setEnabled(false);
- newrow.setEnabled(false);
- edit.setEnabled(false);
- delete.setEnabled(false);
-
- // set everything except the id to be editable
- //
- fld_name.setEditable(true);
- fld_address.setEditable(true);
- fld_city.setEditable(true);
- fld_state.setEditable(true);
- fld_zip.setEditable(true);
-
- // enable these two buttons
- //
- save.setEnabled(true);
- cancel.setEnabled(true);
- }
-
- /**
- * setBrowse()
- *
- * prepare the form for viewing
- *
- */
- protected void setBrowse() {
-
- // enable all these buttons
- //
- next.setEnabled(true);
- previous.setEnabled(true);
- newrow.setEnabled(true);
- edit.setEnabled(true);
- delete.setEnabled(true);
-
- // disable the fields
- //
- fld_name.setEditable(false);
- fld_address.setEditable(false);
- fld_city.setEditable(false);
- fld_state.setEditable(false);
- fld_zip.setEditable(false);
- fld_id.setEditable(false);
-
- // disable these two buttons
- //
- save.setEnabled(false);
- cancel.setEnabled(false);
- }
-
- perl void delRow() {{
-
- my $id = $self->getId____s();
-
- $sql = qq[delete from cardfile ] .
- qq[where (id = $id)];
-
- use Sprite;
- my $rdb = new Sprite();
- my @data = $rdb->sql($sql);
- $rdb->close("cardfile");
- my $status = shift @data;
- if (!$status) {
- print STDERR "Bummer - couldn't execute query!\n";
- die;
- }
- $self->setCurrentRow__I(0);
- $self->getRow__I(0);
-
- }}
-
- perl void updateRow() {{
-
- my $name = $self->getName____s();
- my $address = $self->getAddress____s();
- my $city = $self->getCity____s();
- my $state = $self->getState____s();
- my $zip = $self->getZip____s();
- my $id = $self->getId____s();
-
- $sql = qq[update cardfile ] .
- qq[set name = ('$name'), ] .
- qq[set address = ('$address'), ] .
- qq[set city = ('$city'), ] .
- qq[set state = ('$state'), ] .
- qq[set zip = ('$zip') ] .
- qq[where (id = $id)];
-
- use Sprite;
- my $rdb = new Sprite();
- my @data = $rdb->sql($sql);
- $rdb->close("cardfile");
- my $status = shift @data;
- if (!$status) {
- print STDERR "Bummer - couldn't execute query!\n";
- die;
- }
-
- }}
-
-
- /**
- * getRow()
- *
- * This method is used to either fetch this current row,
- * in which case it is given an argument of zero, or it
- * can be used to move relative to the current row, in
- * which case it must be given an argument of 1 or -1.
- *
- */
-
-
- perl void getRow(int direction) {{
-
- use Sprite;
- my $rdb = new Sprite();
-
- my $nextid = $self->getCurrentRowVal____I() + $direction;
- my $op;
- if ($direction == -1) {
- $op = "<=";
- } else {
- $op = ">=";
- }
- my $sql = "select name, address, city, " .
- "state, zip, id from cardfile " .
- "where id $op $nextid";
-
- my @data = $rdb->sql($sql);
- $rdb->close("cardfile");
-
- my $status = shift @data;
- if (!$status) {
- print STDERR "Bummer - couldn't execute query!\n";
- die;
- }
-
- my $numrows = scalar(@data);
-
- if (!$numrows) {
- print STDERR "End of file reached.\n";
- return;
- }
-
- my $index;
- if ($direction == -1) {
- $index = $#data;
- } else {
- $index = 0;
- }
- my($name, $address, $city, $state, $zip, $id) = @{$data[$index]};
- $self->setCols__ssssss($name, $address, $city, $state, $zip, $id);
-
- }}
-
- perl void saveIt() {{
-
- use Sprite;
- my $rdb = new Sprite();
-
- my @data = $rdb->sql("select id, name from cardfile");
-
- my $status = shift @data;
- if (!$status) {
- print STDERR "Bummer - couldn't execute query!\n";
- die;
- }
-
- my @ids;
- foreach $record (@data) {
- my ($id, $name) = split (/\0/, $record, 2);
- push @ids, $id;
- }
- @ids = sort @ids;
- my $newid = $ids[$#ids] + 1;
-
- my $name = $self->getName____s();
- my $address = $self->getAddress____s();
- my $city = $self->getCity____s();
- my $state = $self->getState____s();
- my $zip = $self->getZip____s();
-
- my $sql = "insert into cardfile (name, address, city, state, zip, id) values ('$name', '$address', '$city', '$state', '$zip', $newid)";
- @data = $rdb->sql($sql);
- $rdb->close("cardfile");
-
- $status = shift @data;
- if (!$status) {
- print STDERR "Bummer - couldn't execute insert!\n";
- die;
- }
-
- $self->setCurrentRow__I($newid);
-
- }}
-
- public static void main(String[] args) {
-
- // make a new JPL_Rolo, pack() it and show() it.
- JPL_Rolo cardfile = new JPL_Rolo(args);
- cardfile.pack();
- cardfile.show();
-
- }
-
-}
-
-
+++ /dev/null
-#!/usr/bin/perl
-
-$JPL_HOME = $ENV{JPL_HOME}
- or die "You have not run setvars to set your environment variables.\n" .
- "See the JPL README file for more information.\n";
-
-use Config;
-
-eval `$JPL_HOME/setvars -perl`;
-
-chop($WHAT = `pwd`);
-$WHAT =~ s#.*/##;
-
-if ($^O eq 'linux') {
- $flags = "-Dbool=char"; # avoid builtin bool altogether
- $libs = "-lc -lm -ldl";
-}
-else {
- $flags = "";
- $libs = "-lc -lm -ldl";
-}
-chop($cwd = `pwd`);
-($jpldir = $cwd) =~ s#/[^/]*$##;
-
-open(MAKEFILE, ">Makefile");
-
-print MAKEFILE <<"SUBS";
-CC = $Config{cc}
-WHAT = $WHAT
-PERL = perl$]
-ARCHNAME = $Config{archname}
-JAVA_HOME = $ENV{JAVA_HOME}
-JPL_HOME = $ENV{JPL_HOME}
-PERLARCHDIR = $Config{archlib}
-FLAGS = $Config{cccdlflags} $Config{ccdlflags} $Config{lddlflags} $flags
-INCL = -I\$(PERLARCHDIR)/CORE \\
- -I\$(JAVA_HOME)/include \\
- -I\$(JAVA_HOME)/include/$^O \\
- -I\$(JAVA_HOME)/include/genunix
-LIBS = $libs
-
-SUBS
-
-print MAKEFILE <<'NOSUBS';
-.SUFFIXES: .jpl .class
-
-.jpl.class:
- $(PERL) -MJPL::Compile -e "file('$*.jpl')"
-
-all: $(WHAT).class lib$(WHAT).so
-
-debug: $(WHAT)_g.class lib$(WHAT)_g.so
-
-lib$(WHAT).so: $(WHAT).c $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter.so
- $(CC) $(FLAGS) $(INCL) $(WHAT).c \
- $(PERLARCHDIR)/CORE/libperl.so \
- $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter.so \
- $(LIBS) \
- -o lib$(WHAT).so
-
-lib$(WHAT)_g.so: $(WHAT).c $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter_g.so
- $(CC) -g $(FLAGS) $(INCL) $(WHAT).c \
- $(PERLARCHDIR)/CORE/libperl.so \
- $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter_g.so \
- $(LIBS) \
- -o lib$(WHAT)_g.so
-
-test:
-
-install: all
- cp $(WHAT).class $(JPL_HOME)/lib
- cp lib$(WHAT).so $(JPL_HOME)/lib/$(ARCHNAME)
- cp $(WHAT).pl $(JPL_HOME)/perl
-
-clean:
- rm -f $(WHAT).c $(WHAT).h \
- $(WHAT)*.class $(WHAT)*.pl lib$(WHAT).so $(WHAT)*.java
-
-distclean: clean
- rm -f Makefile
-
-NOSUBS
-
-close MAKEFILE;
+++ /dev/null
-Welcome to the Sprite sample application for Larry Wall's JPL. This
-application showcases a merging of Java and Perl in which Java is employed
-to generate a user interface, and Perl is used for data access.
-Specifically, Perl is used with Shishir Gundavaram's Sprite module to offer
-permanent storage through SQL manipulation of text files. This application
-is a Rolodex(tm)-style address file, offering the ability to add, edit or
-delete names and addresses. You may also navigate through the address list.
-
-To use this example, you will need to install the Sprite module from CPAN.
-
-To install the sample, you must first have JPL installed and working.
-Please ensure that you have set environment variables as directed in the
-JPL README and that the JPL Sample program works. Once this has been
-accomplished, you can build the files in this directory with the following
-commmands:
-
- perl Makefile.PL
- make
- make install
-
-You can run this by typing:
-
- java JPL_Rolo
-
-The application should appear with some sample data, and you can mess
-around with it and put all your friends in the address book. Far out!
-
+++ /dev/null
-name,address,city,state,zip,id
-Brian Jepson,50 Hudson Street,Providence,RI,02909,100
-Elvis Presley,50 Hudson Street,Providence,RI,02909,101
-AS220,115 Empire Street,Providence,RI,02909,600
-Mr. Jones,100 Loudermilk Drive,Springfield,??,,602
-George Maciunas,Canal Street,New York,NY,????,603
-Emmett Williams,Broome Street,New York,NY,?????,605
+++ /dev/null
-#!/usr/bin/perl
-
-$JPL_SRC = "..";
-
-use Config;
-
-eval `$JPL_SRC/setvars -perl`;
-
-if ($^O eq 'linux') {
- $flags = "-Dbool=char"; # avoid builtin bool altogether
- $libs = "-lc -lm -ldl";
-} else {
- $flags = "";
- $libs = "-lc -lm -ldl";
-}
-
-# Needed for JNI.
-if ($^O eq 'solaris') {
- $libs .= " -lthread";
-}
-
-open(MAKEFILE, ">Makefile");
-
-print MAKEFILE <<"SUBS";
-WHAT = PerlInterpreter
-JAVA_HOME = $ENV{JAVA_HOME}
-JPL_HOME = $ENV{JPL_HOME}
-ARCHNAME = $Config{archname}
-PERLARCHDIR = $Config{archlib}
-CC = $Config{cc}
-FLAGS = $Config{cccdlflags} $Config{ccdlflags} $Config{lddlflags} $flags
-INCL = -I\$(PERLARCHDIR)/CORE \\
- -I\$(JAVA_HOME)/include \\
- -I\$(JAVA_HOME)/include/$^O \\
- -I\$(JAVA_HOME)/include/genunix
-LIBS = $libs
-
-SUBS
-
-
-print MAKEFILE <<'NOSUBS';
-.SUFFIXES: .java .class
-
-.java.class:
- javac $*.java
-
-.class.h:
- javah -jni $*
-
-all: PerlInterpreter.class libPerlInterpreter.so
-
-PerlInterpreter.class: PerlInterpreter.java
-
-PerlInterpreter.h: PerlInterpreter.class
-
-libPerlInterpreter.so: PerlInterpreter.c PerlInterpreter.h
- $(CC) $(FLAGS) $(INCL) PerlInterpreter.c \
- $(PERLARCHDIR)/auto/DynaLoader/DynaLoader.a \
- $(LIBS) \
- -o libPerlInterpreter.so
-
-test:
-
-install: all
- mkdir -p $(JPL_HOME)/lib/$(ARCHNAME)
- cp libPerlInterpreter.so $(JPL_HOME)/lib/$(ARCHNAME)
- cp $(WHAT).class $(JPL_HOME)/lib
-
-clean:
- rm -f libPerlInterpreter.so
- rm -f PerlInterpreter.class
-NOSUBS
-
-close MAKEFILE;
+++ /dev/null
-/*
- * "The Road goes ever on and on, down from the door where it began."
- */
-
-#include "PerlInterpreter.h"
-#include <dlfcn.h>
-
-#include "EXTERN.h"
-#include "perl.h"
-
-#ifndef PERL_VERSION
-# include <patchlevel.h>
-# define PERL_REVISION 5
-# define PERL_VERSION PATCHLEVEL
-# define PERL_SUBVERSION SUBVERSION
-#endif
-
-#if PERL_REVISION == 5 && (PERL_VERSION < 4 || \
- (PERL_VERSION == 4 && PERL_SUBVERSION <= 75))
-# define PL_na na
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_dowarn dowarn
-# define PL_curinterp curinterp
-# define PL_do_undump do_undump
-# define PL_perl_destruct_level perl_destruct_level
-# define ERRSV GvSV(errgv)
-#endif
-
-#ifndef newSVpvn
-# define newSVpvn(a,b) newSVpv(a,b)
-#endif
-
-#ifndef pTHX
-# define pTHX void
-# define pTHX_
-# define aTHX
-# define aTHX_
-# define dTHX extern int JNI___notused
-#endif
-
-#ifndef EXTERN_C
-# ifdef __cplusplus
-# define EXTERN_C extern "C"
-# else
-# define EXTERN_C extern
-# endif
-#endif
-
-static void xs_init (pTHX);
-static PerlInterpreter *my_perl;
-
-int jpldebug = 0;
-JNIEnv *jplcurenv;
-
-JNIEXPORT void JNICALL
-Java_PerlInterpreter_init(JNIEnv *env, jobject obj, jstring js)
-{
- int exitstatus;
- int argc = 3;
- SV* envsv;
- SV* objsv;
-
- static char *argv[] = {"perl", "-e", "1", 0};
-
- if (getenv("JPLDEBUG"))
- jpldebug = atoi(getenv("JPLDEBUG"));
-
- if (jpldebug)
- fprintf(stderr, "init\n");
-
- if (!dlopen("libperl.so", RTLD_LAZY|RTLD_GLOBAL)) {
- fprintf(stderr, "%s\n", dlerror());
- exit(1);
- }
-
- if (PL_curinterp)
- return;
-
- perl_init_i18nl10n(1);
-
- if (!PL_do_undump) {
- my_perl = perl_alloc();
- if (!my_perl)
- exit(1);
- perl_construct( my_perl );
- PL_perl_destruct_level = 0;
- }
-
- exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL );
-
- if (!exitstatus)
- Java_PerlInterpreter_eval(env, obj, js);
-
-}
-
-JNIEXPORT void JNICALL
-Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jstring js)
-{
- SV* envsv;
- SV* objsv;
- dSP;
- jbyte* jb;
-
- ENTER;
- SAVETMPS;
-
- jplcurenv = env;
- envsv = perl_get_sv("JPL::_env_", 1);
- sv_setiv(envsv, (IV)(void*)env);
- objsv = perl_get_sv("JPL::_obj_", 1);
- sv_setiv(objsv, (IV)(void*)obj);
-
- jb = (jbyte*)(*env)->GetStringUTFChars(env,js,0);
-
- if (jpldebug)
- fprintf(stderr, "eval %s\n", (char*)jb);
-
- perl_eval_pv( (char*)jb, 0 );
-
- if (SvTRUE(ERRSV)) {
- jthrowable newExcCls;
-
- (*env)->ExceptionDescribe(env);
- (*env)->ExceptionClear(env);
-
- newExcCls = (*env)->FindClass(env, "java/lang/RuntimeException");
- if (newExcCls)
- (*env)->ThrowNew(env, newExcCls, SvPV(ERRSV,PL_na));
- }
-
- (*env)->ReleaseStringUTFChars(env,js,jb);
- FREETMPS;
- LEAVE;
-
-}
-
-/*
-JNIEXPORT jint JNICALL
-Java_PerlInterpreter_eval(JNIEnv *env, jobject obj, jint ji)
-{
- op = (OP*)(void*)ji;
- op = (*op->op_ppaddr)(pTHX);
- return (jint)(void*)op;
-}
-*/
-
-/* Register any extra external extensions */
-
-/* Do not delete this line--writemain depends on it */
-EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
-EXTERN_C void boot_JNI (pTHX_ CV* cv);
-
-static void
-xs_init(pTHX)
-{
- char *file = __FILE__;
- dXSUB_SYS;
- newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-}
+++ /dev/null
-/* DO NOT EDIT THIS FILE - it is machine generated */
-#include <jni.h>
-/* Header for class PerlInterpreter */
-
-#ifndef _Included_PerlInterpreter
-#define _Included_PerlInterpreter
-#ifdef __cplusplus
-extern "C" {
-#endif
-/* Inaccessible static: initted */
-/*
- * Class: PerlInterpreter
- * Method: init
- * Signature: (Ljava/lang/String;)V
- */
-JNIEXPORT void JNICALL Java_PerlInterpreter_init
- (JNIEnv *, jobject, jstring);
-
-/*
- * Class: PerlInterpreter
- * Method: eval
- * Signature: (Ljava/lang/String;)V
- */
-JNIEXPORT void JNICALL Java_PerlInterpreter_eval
- (JNIEnv *, jobject, jstring);
-
-#ifdef __cplusplus
-}
-#endif
-#endif
+++ /dev/null
-class PerlInterpreter {
- static boolean initted = false;
-
- public native void init(String s);
- public native void eval(String s);
-
-// public native long op(long i);
-
- public PerlInterpreter fetch () {
- if (!initted) {
- init("$JPL::DEBUG = $ENV{JPLDEBUG}");
- initted = true;
- }
- return this;
- }
-
- static {
- System.loadLibrary("PerlInterpreter");
- }
-}
-
+++ /dev/null
-Copyright 1998, O'Reilly & Associates, Inc.
-
-This package may be copied under the same terms as Perl itself.
-
-Disclaimers
------------
-This is a work in progress, and relies on bleeding-edge technology
-from the network. Don't expect not to be surprised occasionally.
-
-Requirements
-------------
-Under Solaris and GNU/Linux (and other Unix-like systems), Perl 5.005 (or
-later) must be compiled and installed as a shared library (libperl.so). I
-had to use the system's malloc. JPL was originally built and tested with
-5.004_04 and early Java 1.1 development kits. This version has not been
-well tested under other versions, so you can expect some rough edges.
-
-You need JDK 1.1. On Solaris, 1.1.5 has been verified to work. GNU/Linux
-users can try the latest version (1.1.3 or later) available from (for
-example):
-
- ftp://ftp.blackdown.org/pub/Linux/JDK/1.1.3/updates/libjava-1.1.3v2-1.tar.gz
-
-(GNU/Linux users can also try Kaffe (see below).)
-
-The get_jdk directory contains a script that will download JDK (but not
-the patch file above) off of the net for you. (This presumes you've
-already installed the modules mentioned in ../README.)
-
-You may need to ensure that all files under the ../jpl directory are writable.
-install-jpl expects to be run with super-user privileges so that it can
-put things in the right places.
-
-Microsoft Windows
------------------
-Only a subset of JPL works under Microsoft Windows. This subset includes
-the JNI extension and the JPL module. This is enough for you to embed
-Java in Perl, but not Perl in Java.
-
-This has only been tested with the Sun JDK 1.1.8. I haven't tested it
-with JDK 1.2 (aka Java 2) or any Microsoft implementation of Java.
-
-Kaffe
------
-You might notice some mention of Kaffe (www.kaffe.org) in the source files.
-This is because support has been added for Kaffe for JNI:: and JPL::. In
-other words, you can now call to Java from Perl using Kaffe.
-
-You'll likely need the a checkout circa 2000-12-03 or later from Kaffe's
-CVS. It has been verified that Kaffe 1.0.5 definitely *will not work*.
-Kaffe 1.0.6 might work, but the CVS tree definitely works (as of
-2000-12-06).
-
-You can get the CVS tree from:
-
-cvs -z3 -d ':pserver:readonly@cvs.kaffe.org:/cvs/kaffe' checkout kaffe
-
-(password is 'readonly')
-
-What the heck is JPL?
----------------------
-JPL is a hybrid (to use the polite term) language. It's basically Java
-in which the methods can optionally be implemented by Perl code. A
-preprocessor called "JPL::Compile" looks at your .jpl file and spits
-out the appropriate .java, .c, .h, .pl, and .so files to accomplish the
-desired task. Hopefully a lot of those files can go away in the future
-as jpl mutates into a Perl-to-Java compiler. The long-term goal is for
-jpl to be able to take a pure Perl file and spit out a java .class
-file. This initial version of JPL is an attempt to begin to mesh the
-semantics of Java and Perl. Some people may find it useful in its
-current form, but you should know right up front that we've still got a
-ways to go with it. A journey of a thousand miles continues with the
-second step...
-
-JPL Syntax
-----------
-JPL syntax is trivial, given that you know Java and Perl. Pretend like
-you're writing a native Java method, but say "perl" instead of
-"native", and then instead of omitting the body of the method, put your
-Perl code in double curlies. (See Sample.jpl for an example.)
-
-Calling back from Perl to Java is done through the JNI (Java Native
-Interface). No weird transmogrifications are done by the preprocessor
-to your Perl code--it's all normal Perl. The preprocessor just wraps
-it up into funny subroutines you don't see unless you peek at the .pl
-file it generates.
-
-Installation
-------------
-There are two ways to install JPL.
-
-The first way gives you the ability to embed Perl in Java programs. You
-can also call back into Java from your embedded Perl programs. This should
-work well with most JDKs, and is the only option for people using a JDK
-that uses green threads (see your JDK documentation).
-
-The second way lets you embed Java in Perl, but doesn't provide support
-for the other direction. This is good, in theory, if you need to work with
-a lot of Java classes from within Perl. I say "in theory," because this
-doesn't actually work a lot of the time. To use this second way, you
-must be using a JDK with native threads. Please see README.JUST-JNI for
-details.
-
-At this point, the second way is the only way to use JPL under Microsoft
-Windows, and probably the only way to use JPL if you're using a version
-of Perl compiled by someone else (such as the Perl that comes with RedHat).
-
-Installation the First Way (All of JPL)
----------------------------------------
-Run "install-jpl". You have to tell it whether you want to use the
-current directory for JPL_HOME or some other directory. Everything
-else should take care of itself, except that after install-jpl
-writes the setvars program, you are responsible to invoke it properly
-before any JPL applications can be compiled under the current shell.
-
- sh: eval `setvars -sh`
- csh: eval `setvars -csh`
- perl: eval `setvars -perl`;
-
-install-jpl has been tested under:
-
- Solaris 2.5.1 SPARC, GCC 2.8.0, Perl 5.005_03, JDK 1.1.7
- Debian 2.1 x86, Perl 5.005_60, JDK 1.1.7v3
-
-********************
-Solaris 2.5.1 Users:
-********************
-
-NOTE: Under Solaris 2.5.1, you may get an error message when install-jpl
-builds Sample.jpl:
-
- You must install a Solaris patch to run this version of the Java
- runtime. Please see the README and release notes for more
- information.
- Exiting.
-
- This is apparently a spurious message, and it has been reported to
- Sun. Although this message aborts the installation, all of JPL is
- installed by the time this message is reached. To recover and continue,
- run setvars as described above, cd to the Sample directory, and type
- 'make' to continue building. You can then run 'java Sample' to test the
- example.
-
- Unfortunately, each time you use 'make' to build a JPL application,
- it will abort when it tries to run 'perl -c' on the generated .pl
- file. However, you can continue building by typing 'make' again.
-
-Mailing List
-------------
-To subscribe to the jpl mailing list, send an email message to
-jpl-subscribe@perl.org.
-
-CVS Access
-----------
-Information on accessing the bleeding edge JPL via CVS can be found at:
-
- http://users.ids.net/~bjepson/jpl/cvs.html
-
-More Info
----------
-
-You can look at the Sample and Test directories, as well as the ../eg
-directory for examples.
-
-Perhaps the most important bit of advice we can give you is to watch
-
- http://perl.oreilly.com
-
-for further information on how to get further information.
-
-Have the appropriate amount of fun.
+++ /dev/null
-Just-JNI (call into Java from Perl only)
-----------------------------------------
-
-This has been tested with:
-
- Debian GNU/Linux 2.2 i386, perl 5.6.0, Kaffe (CVS, 2000-12-05 or later)
- RedHat 6.1, perl-5.00503-6 (RedHat RPM), IBM JDK 1.1.8
- Debian 2.1 SPARC, Perl 5.005_60, JDK 1.2 beta (crashes with AWT, though)
- Windows NT 4.0 SP4, ActivePerl 519, JDK 1.1.8, Visual C++
- Solaris 7, Perl 5.005_03, JDK 1.1.6, GCC 2.8.1
-
-Solaris 7 Note (this probably applies to all native thread situations):
-
- Native threads were tricky. I had to build my own Perl, configured with:
-
- sh Configure -Dprefix=/opt/perl5.005 -Duseshrplib -Doptimize=-g \
- -Uusemymalloc -D cc=gcc -Dusethreads -d
-
- When Configure let me edit config.sh, I changed libs to:
-
- libs='-lthread -lsocket -lnsl -ldl -lm -lposix4 -lpthread -lc -lcrypt'
-
- The leading -lthread is the only thing I had to add.
-
-Kaffe Note:
-
-I believe that Kaffe with JIT enabled will likely be problematic. I had a
-lot of trouble with it, that simply went away with interpreter-based Kaffe.
-FWIW, here's how I configured Kaffe:
-
- env AM_CPPFLAGS=-DDEBUG CFLAGS="-O0 -ggdb" ./configure --disable-gcj \
- --with-engine=intrp
-
-Likely you don't need all that debugging stuff.
-
-Also, when I build perl, I do this, to be on the safe side. I was worried
-about thread interaction, but realized there was no need to build threaded
-perl, but I thought that the perl code should probably be reentrant, so, I
-did this:
-
- sh ./Configure -Dcc=gcc -Doptimize='-D_REENTRANT -DDEBUGGING -ggdb' \
- -Dlibperl='libperl.so' -Duseshrplib='true'
-
-Again, you likely don't need the debugging flags.
-
-
-How do I do this crazy thing?
------------------------------
-
-1) Cd into the JPL directory. Type the following:
-
- perl Makefile.PL
- make
- make install
-
- Under windows, that's:
-
- perl Makefile.PL
- nmake
- nmake install
-
-3) cd into the JNI directory (cd ../JNI or cd ..\JNI)
-
-4) We now need to compile and make the Closer.class available to your
- JPL program. Closer is a WindowListener that closes the Frame we
- make in the test program.
-
- It seems that we've managed to fix the problem with CLASSPATH not
- getting propagated to the JVM, so if '.' is in your CLASSPATH, you
- should be able to compile Closer.java and leave it in the current
- directory:
-
- javac Closer.java
-
- or perhaps
-
- jikes Closer.java
-
-5) Make the demo:
-
- a) type the following:
-
- for SUN's proprietary software Java:
-
- env JAVA_HOME=/path/to/java perl Makefile.PL
- # setting the JAVA_HOME enviornment variable might not be needed
- # if Java is in installed in a canonical location
- make
- make test
-
- for Kaffe:
-
- env KAFFE_PREFIX=/kaffe/installation/prefix perl Makefile.PL
- # setting the KAFFE_PREFIX enviornment variable might not be needed
- # if Kaffe is in a canonical location
- make
- make test
-
- Under Windows:
-
- perl Makefile.PL
- nmake
- nmake test
-
-
- b) if all went well, type:
-
- make install
-
- or, under Windows:
-
- nmake install
-
+++ /dev/null
-# Your JDK top-level directory.
-#
-$ENV{JAVA_HOME} = 'c:\jdk1.1.8';
-
-# The location where you extracted JPL.
-#
-$ENV{JPL_HOME} = 'D:\jpl';
-
-# The executeable name of Perl
-#
-$ENV{JPLPERL} = 'perl';
+++ /dev/null
-#!/usr/bin/perl
-
-$JPL_HOME = $ENV{JPL_HOME}
- or die "You have not run setvars to set your environment variables.\n" .
- "See the JPL README file for more information.\n";
-
-use Config;
-
-eval `$JPL_HOME/setvars -perl`;
-
-chop($WHAT = `pwd`);
-$WHAT =~ s#.*/##;
-
-if ($^O eq 'linux') {
- $flags = "-Dbool=char"; # avoid builtin bool altogether
- $libs = "-lc -lm -ldl";
-} else {
- $flags = "";
- $libs = "-lc -lm -ldl";
-}
-
-# Needed for JNI
-if ($^O eq 'solaris') {
- $libs .= " -lthread";
-}
-
-chop($cwd = `pwd`);
-($jpldir = $cwd) =~ s#/[^/]*$##;
-
-open(MAKEFILE, ">Makefile");
-
-print MAKEFILE <<"SUBS";
-CC = $Config{cc}
-WHAT = $WHAT
-PERL = perl$]
-ARCHNAME = $Config{archname}
-JAVA_HOME = $ENV{JAVA_HOME}
-JPL_HOME = $ENV{JPL_HOME}
-PERLARCHDIR = $Config{archlib}
-FLAGS = $Config{cccdlflags} $Config{ccdlflags} $Config{lddlflags} $flags
-INCL = -I\$(PERLARCHDIR)/CORE \\
- -I\$(JAVA_HOME)/include \\
- -I\$(JAVA_HOME)/include/$^O \\
- -I\$(JAVA_HOME)/include/genunix
-LIBS = $libs
-
-SUBS
-
-print MAKEFILE <<'NOSUBS';
-.SUFFIXES: .jpl .class
-
-.jpl.class:
- $(PERL) -MJPL::Compile -e "file('$*.jpl')"
-
-all: $(WHAT).class lib$(WHAT).so
-
-debug: $(WHAT)_g.class lib$(WHAT)_g.so
-
-lib$(WHAT).so: $(WHAT).c $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter.so
- $(CC) $(FLAGS) $(INCL) $(WHAT).c \
- $(PERLARCHDIR)/CORE/libperl.so \
- $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter.so \
- $(LIBS) \
- -o lib$(WHAT).so
-
-lib$(WHAT)_g.so: $(WHAT).c $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter_g.so
- $(CC) -g $(FLAGS) $(INCL) $(WHAT).c \
- $(PERLARCHDIR)/CORE/libperl.so \
- $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter_g.so \
- $(LIBS) \
- -o lib$(WHAT)_g.so
-
-test: all
- java $(WHAT)
-
-install: all
- cp *.class $(JPL_HOME)/lib
- cp lib$(WHAT).so $(JPL_HOME)/lib/$(ARCHNAME)
- cp $(WHAT).pl $(JPL_HOME)/perl
-
-clean:
- rm -f $(WHAT).c $(WHAT).h \
- $(WHAT)*.class $(WHAT)*.pl lib$(WHAT).so $(WHAT)*.java
-
-distclean: clean
- rm -f Makefile
-
-NOSUBS
-
-close MAKEFILE;
+++ /dev/null
-class Sample {
- public static void main(String[] args) {
- Sample sam = new Sample();
- System.out.println(sam.foo("manny","moe","jack"));
- System.out.println(sam.foo(1));
- System.out.println(sam.foo(3.0));
- sam.foo();
- }
-
- public static int thrice(int i) {
- return i * 3;
- }
-
- perl void foo() {{
- use POSIX;
- print "TZ = ", POSIX::tzname(), "\n";
- print "Got to ${self}->foo() method\n";
- print "foo__I(2) = ", $self->foo__I__I(2),"\n";
- print "thrice(123) = ", JPL::Sample->thrice__I__I(123), "\n";
- print "thrice(12) = ", JPL::Sample->thrice__I__I(12), "\n";
- print $self->foo__sss__s("MANNY", "MOE", "JACK"), "\n";
- print 41 + $self->foo__sss__s("1", "2", "3"), "\n";
- print "Perl version is $]\n";
- }}
-
- perl int foo(int a) {{
- $a + $a;
- }}
-
- perl double foo(double a) {{
- use JPL::Class 'java::util::Random';
- $rng = java::util::Random->new();
- print "RNG = $rng\n";
- print $rng->nextDouble____D(), "\n";
- print $rng->nextDouble____D(), "\n";
- print $rng->nextDouble____D(), "\n";
- print $rng->nextDouble____D(), "\n";
- return $a * $a;
- }}
-
- perl String foo( String a,
- String b,
- String c ) {{
- print "a = $a, b = $b, c = $c\n";
- join "+", $a, $b, $c;
- }}
-
-}
+++ /dev/null
-#!/usr/bin/perl
-
-$JPL_HOME = $ENV{JPL_HOME}
- or die "You have not run setvars to set your environment variables.\n" .
- "See the JPL README file for more information.\n";
-
-use Config;
-
-eval `$JPL_HOME/setvars -perl`;
-
-chop($WHAT = `pwd`);
-$WHAT =~ s#.*/##;
-
-if ($^O eq 'linux') {
- $flags = "-Dbool=char"; # avoid builtin bool altogether
- $libs = "-lc -lm -ldl";
-}
-else {
- $flags = "";
- $libs = "-lc -lm -ldl";
-}
-chop($cwd = `pwd`);
-($jpldir = $cwd) =~ s#/[^/]*$##;
-
-open(MAKEFILE, ">Makefile");
-
-print MAKEFILE <<"SUBS";
-CC = $Config{cc}
-WHAT = $WHAT
-PERL = perl$]
-ARCHNAME = $Config{archname}
-JAVA_HOME = $ENV{JAVA_HOME}
-JPL_HOME = $ENV{JPL_HOME}
-PERLARCHDIR = $Config{archlib}
-FLAGS = $Config{cccdlflags} $Config{ccdlflags} $Config{lddlflags} $flags
-INCL = -I\$(PERLARCHDIR)/CORE \\
- -I\$(JAVA_HOME)/include \\
- -I\$(JAVA_HOME)/include/$^O \\
- -I\$(JAVA_HOME)/include/genunix
-LIBS = $libs
-
-SUBS
-
-print MAKEFILE <<'NOSUBS';
-.SUFFIXES: .jpl .class
-
-.jpl.class:
- $(PERL) -MJPL::Compile -e "file('$*.jpl')"
-
-all: $(WHAT).class lib$(WHAT).so
-
-debug: $(WHAT)_g.class lib$(WHAT)_g.so
-
-lib$(WHAT).so: $(WHAT).c $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter.so
- $(CC) $(FLAGS) $(INCL) $(WHAT).c \
- $(PERLARCHDIR)/CORE/libperl.so \
- $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter.so \
- $(LIBS) \
- -o lib$(WHAT).so
-
-lib$(WHAT)_g.so: $(WHAT).c $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter_g.so
- $(CC) -g $(FLAGS) $(INCL) $(WHAT).c \
- $(PERLARCHDIR)/CORE/libperl.so \
- $(JPL_HOME)/lib/$(ARCHNAME)/libPerlInterpreter_g.so \
- $(LIBS) \
- -o lib$(WHAT)_g.so
-
-test:
-
-install: all
- cp $(WHAT).class $(JPL_HOME)/lib
- cp lib$(WHAT).so $(JPL_HOME)/lib/$(ARCHNAME)
- cp $(WHAT).pl $(JPL_HOME)/perl
-
-clean:
- rm -f $(WHAT).c $(WHAT).h \
- $(WHAT)*.class $(WHAT)*.pl lib$(WHAT).so $(WHAT)*.java
-
-distclean: clean
- rm -f Makefile
-
-NOSUBS
-
-close MAKEFILE;
+++ /dev/null
-import java.util.*;
-
-public class Test {
-
- int myint = 123;
- double mydouble = 3.14159265;
- String mystring = "my string";
- static String ourstring = "our string";
- static boolean embedded = false;
- int array[] = {1,2,3};
- Vector v;
-
- public Test() {
-
-
- v = new Vector();
- v.addElement("Hello");
- printfields();
- Vector x = perlTryVec(v);
- x.addElement("World");
- Vector y = perlTryVec(x);
- if (!embedded) System.err.println("Thank you, perlTryVec!");
-
- if (!embedded) System.err.println(retchars());
- if (!embedded) System.err.println("Thank you, retchars!");
-
- String[] s = retstrings();
- if (!embedded) System.err.println(s[0] + s[1] + s[2] + s[3]);
- if (!embedded) System.err.println("Thank you, retstrings!");
-
- Object[] o = retobjects(v, x, y);
- if (!embedded) System.err.println(o[1]);
- if (!embedded) System.err.println(o[3]);
- if (!embedded) System.err.println(o[4]);
- if (!embedded) System.err.println("Thank you, retobjects!");
-
- passarray(s);
-
- if (!embedded) System.err.println(s[0] + s[1] + s[2] + s[3]);
- if (!embedded) System.err.println("Thank you, passarray!");
-
- printfields();
- if (!embedded) System.err.println("Thank you, printfields!");
- setfields();
- if (!embedded) System.err.println("Thank you, setfields!");
- printfields();
- if (!embedded) System.err.println("Thank you, printfields!");
- }
-
- perl Vector perlTryVec(Vector v) throws RuntimeException {{
- print "v is: $v\n";
- print "v isa: ", ref $v,"\n";
-
- print "In perlTryVec() - Vector size is: ", $v->size([],['int']), "\n";
- @foo = times;
- $size ||= getmeth('size', [], ['int']);
- for ($i = 10000; $i; --$i) {
- $x = $v->$size();
- }
- @bar = times;
- printf "%5.2fu %5.2fs\n", $bar[0] - $foo[0], $bar[1] - $foo[1];
- return $v;
- }}
-
- perl char[] retchars() {{
- print "In retchars()\n";
- return [65,66,67];
- }}
-
- perl String[] retstrings() {{
- print "In retstrings()\n";
- return [1,2,3,"many"];
- }}
-
- perl Object[] retobjects(Vector v, Vector x, Vector y) {{
- print "In retstrings()\n";
- return [$v, $x, $y, "this is only a test", 123];
- }}
-
- perl void passarray(String[] s) {{
- print "In passarray()\n";
- print "s = $s\n";
- $t = GetObjectArrayElement($s,3);
- print "t = $t\n";
- $x = GetStringUTFChars($t);
- print "$x\n";
- $t = SetObjectArrayElement($s,3,NewStringUTF("infinity"));
- }}
-
- perl void printfields() {{
-
- $| = 1;
- eval {print $self->v->toString____s(), "\n";};
- print $@ if $@;
-
- print $self->myint, "\n";
- print $self->mydouble, "\n";
- print $self->mystring, "\n";
- print JPL::Test->ourstring, "\n";
-
- @nums = GetIntArrayElements($self->array());
- print "@nums\n";
-
- @nums = unpack("i*", scalar GetIntArrayElements($self->array()));
- print "@nums\n";
- }}
-
- perl void setfields() {{
- $self->myint(321);
- $self->mydouble(2.7182918);
- $self->mystring("MY STRING!!!");
- JPL::Test->ourstring("OUR STRING!!!");
- }}
-
- public static void main(String[] argv) {
- if (java.lang.reflect.Array.getLength(argv) > 0 &&
- argv[0].equals("-nothanks"))
- embedded = true;
- Test f = new Test();
- if (!embedded) System.err.println("Thank you, Test!");
- }
-}
+++ /dev/null
-#!/usr/bin/perl -w
-
-# Copyright 1997, O'Reilly & Associate, Inc.
-#
-# This package may be copied under the same terms as Perl itself.
-
-use JPL::Compile qw(files);
-files(@ARGV);
+++ /dev/null
-=head1 NAME
-
-Tutorial - Perl and Java
-
-=head1 SYNOPSIS
-
-Java and Perl have different strengths and complement each other well.
-
-You can connect them at runtime with tools such as JPL, PJC, or
-ActiveX. In theory, you can convert Perl to Java bytecode, and
-vice-versa.
-
-=head2 Note:
-
-Not actually a conversion.
-
-At this stage, we are generating Java opcodes by walking Perl's syntax
-tree. This is very different from converting Perl to Java. It's a lot
-easier!
-
-=head1 1.1 Perl and Java, Compared
-
-Perl offers rich text processing features, high-level network APIs,
-excellent database integration, and a centralized repository of
-reusable code:
-
-=over 4
-
-=item *
-
-Regular expression engine is a powerful sub language that can perform
-complex text manipulations and extract data.
-
-=item *
-
-Packages such as libwww-perl (LWP) and libnet are powerful, high-level
-interfaces to network functionality.
-
-=item *
-
-The Perl DBI is an interface to SQL data sources.
-
-=item *
-
-CPAN provides a centralized, organized archive of reusable code.
-
-=back
-
-Java has a powerful graphical API, has numerous embedded
-implementations, excellent database integration, but no single
-recognized repository of reusable code.
-
-=over 4
-
-=item *
-
-The Swing (JFC) toolkit is a powerful toolkit for developing user
-interfaces. Java also boasts 2D and 3D graphics APIs.
-
-=item *
-
-Java comes in embedded flavors, such as:
-
-=over 4
-
-=item *
-
-Kaffe C<http://www.transvirtual.com/> - embedded implementations for
-different platforms
-
-=item *
-
-Waba C<http://www.wabasoft.com/> - a subset of Java for Windows CE and
-PalmOS
-
-=item *
-
-It's embedded into web browsers (Netscape and MS Internet Explorer)
-
-=item *
-
-and more...
-
-=back
-
-=item *
-
-Java's JDBC is similar to Perl's DBI
-
-=item *
-
-Java has many different repositories of code. Efforts such as the
-Giant Java Tree C<http://www.gjt.org/> attempt to create a unified
-repository.
-
-=back
-
-=head1 1.2 Opportunities to Combine Java and Perl
-
-You have a Java program with a lot of data that needs to be parsed,
-filed, briefed, debriefed, and numbered.
-
-You want to build your GUI in Java, but let Perl do the heavy lifting.
-
-You've adopted the "Java is a systems language, Perl is a scripting
-language" paradigm, and it works for you.
-
-You're not sure which regex implementation to use:
-
-C<org.teeth.green.loony.raving.monster.regex.*;>
-
-C<com.zeppelin.regex.*;>
-
-You want the I<B<best of both worlds>>.
-
-=head1 1.3 Important Differences between Java and Perl
-
-=over 4
-
-=item *
-
-C<perl> compiles and executes programs each time you run them (unless you
-use the Perl compiler).
-
-=item *
-
-C<javac> compiles programs in advance, C<java> runs them in the Java
-interpreter.
-
-=item *
-
-The Java interpreter supports method overloading (methods can have the
-same name, but are differentiated on the basis of their argument
-types). Overloaded methods generally perform the same function, but
-methods with a shorter argument list often use defaults:
-
-=back
-
- // Draw a circle in the center of the screen
- int drawCircle(int radius);
-
- // Draw a circle at specified coordinates
- int drawCircle(int radius, int h, int k);
-
-=over 4
-
-=item *
-
-The Perl interpreter doesn't support method overloading. In JPL, when
-we call Java from Perl, we need to use some tricks to specify the Java
-method we want to invoke. We'll learn about this when we see JPL's
-C<getmeth> function.
-
-=back
-
-=head2 Note:
-
-At the time this presentation was prepared, JPL did not work with Perl
-for Win32. However, JPL is in the core Perl distribution, and there
-are plans to make it work with Perl for Win32.
-
-With that in mind, I'm presenting the JPL material first, because it
-is of interest to both Win32 and Unix Perl people. The Win32-specific
-stuff (alternatives to JPL) will come last. I won't be offended if the
-Unix people leave when I move to this section of the tutorial, since
-there is no Unix material in that section. I'm perfectly happy to take
-questions between JPL and ActiveX sections.
-
-A subset of JPL now works on Win32. You can embed Java in Perl, but
-you cannot embed Perl in Java (yet).
-
-=head1 2.1 JPL Overview
-
-Let's look at an overview of JPL.
-
-=head2 2.1.1 Calling Perl from Java
-
-Well-supported by JPL, but it is a complicated process:
-
-=over 4
-
-=item *
-
-The JPL preprocessor parses the I<.jpl> file and generates C code
-wrappers for Perl methods. It also generates Java and Perl source
-files.
-
-=item *
-
-The C compiler compiles the wrapper and links it to the
-I<libPerlInterpreter.so> shared library, producing a shared library for
-the wrapper.
-
-=item *
-
-The Java compiler compiles the Java source file, which uses native
-methods to load the wrapper.
-
-=item *
-
-The wrapper connects the Java code to the Perl code in the Perl source
-file.
-
-=back
-
-Fortunately, a generic F<Makefile.PL> simplifies the process. This is a
-Perl script that generates a I<Makefile> for you.
-
-=head2 2.1.2 Calling Java from Perl
-
-This works best when Perl is embedded within a Java program.
-
-The JNI Perl module creates and loads a JVM. There is no precompiler,
-nothing extra -- it's just a Perl module and extension.
-
- B<A Problem, Though>. In theory, you can call Java from standalone
- Perl programs, but this doesn't work because some implementations
- of Java use a user-level threads package (green threads) that
- override some functions in the C library. Perl is comfortable
- using these functions, but Java is not happy using the standard C
- library functions.
-
-So, with green threads, you can't reliably embed Java in a standalone
-Perl program.
-
-Many Java implementations now use native threads. JPL has been tested
-on Solaris with JDK 1.1.x and native threads, but not on Linux.
-
-=head2 Note:
-
-Oddly enough, this is the only way it works on Win32.
-
-On Unix, I've still had trouble, even with native threads. I might
-need to recompile perl with -DREENTRANT, but I'm not sure.
-
-
-=head1 2.2 Working with JPL
-
-How to set up a JPL application, compile, and install it.
-
-=head2 2.2.1 Setting up a Project
-
-=over 4
-
-=item 1
-
-The I<install-jpl> script creates the I<setvars> script. Source the
-output of I<setvars> into your shell when you want to develop or run
-JPL applications.
-
-=item 2
-
-Create a directory with the name of your project, such as
-I<Frotz>. (if you want to use the generic F<Makefile.PL>, you need a
-separate directory for each JPL class you create).
-
-=item 3
-
-Copy the generic F<Makefile.PL> into the project directory. The
-I<jpl/Sample> directory in the Perl distribution includes the generic
-F<Makefile.PL>.
-
-=item 4
-
-Write a I<.jpl> program with the same name as the project (such as
-F<Frotz.jpl>)
-
-=back
-
-=head2 2.2.2 Compiling and Installing a Project
-
-Type C<make> to compile the application, and C<make install> to
-install it. This installs the application in the I<jpl> directory you
-created when you installed JPL.
-
- B<Beware>. The default I<jpl> directory is the same as the
- directory you install it I<from>. If you go with the default and
- delete your Perl source, you'll delete your JPL installation!
-
-Type C<java Frotz> (or the name you chose in step 2 of section 2.2.1)
-to run it
-
-=head2 2.2.3 What's in the jpl Directory?
-
-=over 4
-
-=item *
-
-B<libPerlInterpreter.so>: a shared library that loads the Perl
-interpreter.
-
-=item *
-
-Compiled F<.class> files for JPL applications you have written.
-
-=item *
-
-Native code shared library wrappers for JPL applications you have
-written.
-
-=item *
-
-Perl scripts that contain the Perl code to load at runtime.
-
-=back
-
- Beware. If you issue the C<make> command and then run the examples
- in your development directory, you might be in for a surprise! If
- the JPL directories come first in your CLASSPATH and
- LD_LIBRARY_PATH, you'll keep running the installed, older version,
- rather than the one you are developing
-
-=head2 Note:
-
-"Source" means to load it into your current shell, with something
-like:
-
-C<eval-backtick-setvars-backtick>
-
-as opposed to just executing it, because then only the subshell gets
-the environment vars.
-
-=head1 2.3 Calling Perl from Java
-
-Now, we'll look at how you can invoke Perl from Java.
-
-=head2 2.3.1 Perl Methods
-
-You can put Perl methods in your F<.jpl> file. Perl methods are
-declared C<perl> and use double curly braces to make life easier on
-the JPL preprocessor:
-
- perl int perlMultiply(int a, int b) {{
- my $result = $a * $b;
- return $result;
- }}
-
-In your Java code, you can invoke Perl methods like a Java method. The
-native code wrappers take care of running the Perl code:
-
- public void invokePerlFunction() {
- int x = 3;
- int y = 6;
- int retval = perlMultiply(x, y);
- System.out.println(x + " * " + y + " = " + retval);
- }
-
-class MethodDemo
-
- class MethodDemo {
- // A Perl method to multiply two numbers and
- // return the result.
- //
- perl int perlMultiply(int a, int b) {{
- my $result = $a * $b;
- return $result;
- }}
-
- // A Java method to call the Perl function.
- //
- public void invokePerlFunction() {
- int x = 3;
- int y = 6;
- int retval = perlMultiply(x, y);
- System.out.println(x +" * "+ y +" = "+ retval);
- }
-
- public static void main(String[] args) {
- MethodDemo demo = new MethodDemo();
- demo.invokePerlFunction();
- }
- }
-
-=head2 Where did $self go?
-
-Don't worry, C<$self> is still there. JPL takes care of fetching it, as
-well as all the other arguments:
-
- perl int perlMultiply(int a, int b) {{
- my $result = $a * $b;
- return $result;
- }}
-
- perl void calculateProduct() {{
- my $x = 3;
- my $y = 6;
- my $retval = $self->perlMultiply($x, $y);
- print "$x * $y = $retval\n";
- }}
-
- B<Note>. JPL takes care of putting all the arguments, including
- C<$self>, into variables. If you see a variable in the function
- header, you will get a variable of the same name without having to
- use C<shift> or C<@_>, guaranteed.
-
-
-
-NOTE: I've added a line that prints the output of "ref dollar sign self"
-You'll see this when I run the demo.
-
- class SelfDemo {
-
- // A Perl method to multiply two values.
- //
- perl int perlMultiply(int a, int b) {{
- my $result = $a * $b;
- return $result;
- }}
-
- // A Perl method to invoke another Perl method.
- //
- perl void calculateProduct() {{
- my $x = 3;
- my $y = 6;
- # Ahhh. There's our old friend, $self!
- #
- my $retval = $self->perlMultiply($x, $y);
- # Display the results.
- #
- print "$x * $y = $retval\n";
- }}
-
- public static void main(String[] args) {
- SelfDemo demo = new SelfDemo();
- demo.calculateProduct();
- }
- }
-
-=head2 Passing Arrays
-
-If you pass an array from Java into a Perl method, it arrives in the
-form of a scalar reference.
-
-Use the GetIntArrayElements() JNI function to convert that scalar into
-an array of integers.
-
- perl void min_max( int[] data ) {{
-
- # Get the array elements
- #
- my @new_array = GetIntArrayElements( $data );
-
- # Sort the array numerically
- #
- my @sorted = sort {$a <=> $b} @new_array;
-
- print "Min: $sorted[0], ",
- "Max: $sorted[$#sorted]\n";
- }}
-
- void minMaxDemo() {
- int[] data = {101, 99, 42, 666, 23};
- min_max( data );
- }
-
-Some JNI Array Functions
-
-=over 4
-
-=item GetBooleanArrayElements( scalar)
-
-Converts scalar to an array of booleans.
-
-=item GetByteArrayElements( scalar )
-
-Converts scalar to an array of bytes.
-
-=item GetCharArrayElements( scalar )
-
-Converts scalar to an array of characters.
-
-=item GetShortArrayElements( scalar )
-
-Converts scalar to an array of short integers.
-
-=item GetIntArrayElements( scalar )
-
-Converts scalar to an array of integers.
-
-=item GetLongArrayElements( scalar )
-
-Converts scalar to an array of long integers.
-
-=item GetFloatArrayElements( scalar )
-
-Converts scalar to an array of floating point numbers.
-
-=item GetDoubleArrayElements( scalar )
-
-Converts scalar to an array of double precision numbers.
-
-=item GetArrayLength( scalar )
-
-Returns the length of the array.
-
-=back
-
-PerlTakesArray.jpl
- // Show how to pass an array from Java to Perl.
- //
-
- public class PerlTakesArray {
-
- perl void min_max( int[] data ) {{
- # Get the array elements
- #
- my @new_array = GetIntArrayElements( $data );
-
- # Sort the array numerically
- #
- my @sorted = sort {$a <=> $b} @new_array;
- print "Min: $sorted[0], ",
- "Max: $sorted[$#sorted]\n";
- }}
-
- void minMaxDemo() {
- // Create an array and ask Perl to tell us
- // the min and max values.
- int[] data = {101, 99, 42, 666, 23};
- min_max( data );
- }
-
- public static void main(String[] argv) {
- PerlTakesArray demo = new PerlTakesArray();
- demo.minMaxDemo();
- }
-
- }
-
-=head2 2.3.4 Passing Arrays of Objects
-
-Working with arrays of objects is a little more complicated, because you
-need to work with them one at a time.
-
-Fetch one element at a time with GetObjectArrayElement(), which returns
-an object of type java.lang.Object (the most generic type).
-
-Explicitly cast the Object to its real type with bless().
-
- perl void sortArray( String[] names ) {{
- my @new_array;
- for (my $i = 0; $i < GetArrayLength($names); $i++) {
- my $string = GetObjectArrayElement($names, $i);
- bless $string, "java::lang::String";
- push @new_array, $string;
- }
- print join(', ', sort @new_array), "\n";
- }}
-
- void arrayDemo() {
- String[] names = {"Omega", "Gamma", "Beta", "Alpha"};
- sortArray( names );
- }
-
-Note. String is not a primitive type: it is a class (java.lang.String).
-So, you need to use this technique for Strings as well. You can't use
-the technique in 2.3.3.
-
-PerlTakesObjectArray.jpl
-
- public class PerlTakesObjectArray {
-
- // Perl method to sort an array of strings.
- //
- perl void sortArray( String[] names ) {{
- my @new_array; # an array to copy names[] to
-
- # Fetch each element from the array.
- for (my $i = 0; $i < GetArrayLength($names); $i++) {
-
- # Get the object (it's not a String yet!) at
- # the current index ($i).
- my $string = GetObjectArrayElement($names, $i);
-
- # Cast (bless) it into a String.
- bless $string, "java::lang::String";
-
- # Add it to the array.
- push @new_array, $string;
- }
-
- # Print the sorted, comma-delimited array.
- print join(', ', sort @new_array), "\n";
-
- }}
-
- // Create a String array and ask Perl to sort it for us.
- //
-
- void arrayDemo() {
- String[] names = {"Omega", "Gamma", "Beta", "Alpha"};
- sortArray( names );
- }
-
- public static void main(String[] argv) {
- PerlTakesObjectArray demo = new PerlTakesObjectArray();
- demo.arrayDemo();
- }
- }
-
-=head2 2.3.5 Returning Arrays from Perl to Java
-
-To write a Perl method that returns an array, declare its return value
-as an array type. Make sure you return a reference to the array, not a
-list:
-
- perl int[] getTime() {{
- my ($sec, $min, $hour, @unused) = localtime(time);
- # Return an array with seconds, minutes, hours
- my @time_array = ($sec, $min, $hour);
- return \@time_array;
- }}
-
- void testArray() {
- int time[] = getTime();
- System.out.println(time[2] + ":" + time[1]);
- }
-
-PerlGivesArray.jpl
-
- // Simple JPL demo to show how to send an array to Java
- // from Perl
-
- class PerlGivesArray {
- // Call the Perl method to get an array and print
- // the hour and minute elements.
-
- void testArray() {
- int time[] = getTime();
- System.out.println(time[2] + ":" + time[1]);
- }
-
- // Perl method that returns an array reference.
- //
- perl int[] getTime() {{
- # Get the first three arguments from localtime,
- # discard the rest.
- my ($sec, $min, $hour, @unused) = localtime(time);
-
- # Return an array with seconds, minutes, hours
- my @time_array = ($sec, $min, $hour);
- return \@time_array;
- }}
-
- public static void main(String[] argv) {
- PerlGivesArray demo = new PerlGivesArray();
- demo.testArray();
- }
- }
-
-=head2 2.3.6 Arrays from Strings
-
-JPL will slice Perl strings up into Java arrays for you. If you declare
-a Perl method as an array type and return a string (instead of an array
-reference), JPL splits up the elements into an array.
-
-Consider this example, where a GIF stored in a string gets turned into
-an array of bytes so Java can make an Image out of it:
-
- void generateImage() {
- Toolkit kit = Toolkit.getDefaultToolkit();
- byte[] image_data = mkImage();
- img = kit.createImage( image_data );
- }
-
- perl byte[] mkImage() {{
- use GD;
- my $im = new GD::Image( $self->width, $self->height);
- my $white = $im->colorAllocate(255, 255, 255);
- my $blue = $im->colorAllocate(0, 0, 255);
- $im->fill($white, 0, 0);
- $im->string(gdLargeFont, 10, 10, "Hello, World", $blue);
- return $im->gif;
- }}
-
-GifDemo.jpl
-
- import java.awt.*;
- import java.awt.event.*;
- import java.awt.image.*;
-
- /*
- * A JPL program that demonstrates passing byte arrays
- * between Java and Perl
- *
- */
-
- class GIFDemo extends Canvas {
- Image img;
- int width = 200;
- int height = 30;
-
- // Constructor for this class.
- public GIFDemo() {
- this.setSize(width, height);
- }
-
- // Java method to create an image.
- //
- void generateImage() {
- Toolkit kit = Toolkit.getDefaultToolkit();
-
- // Invoke the mkImage() Perl method to generate an
- // image.
-
- byte[] image_data = mkImage();
-
- // Create the image with the byte array we got
- // from the Perl method.
-
- img = kit.createImage( image_data );
- }
-
- // A Perl method to generate an image.
-
- perl byte[] mkImage() {{
-
- # Use the GD image manipulation extension.
-
- use GD;
-
- # Create a new image with the height and width specified
- # in the enclosing Java class.
-
- my $im = new GD::Image( $self->width, $self->height);
-
- # Allocate two colors.
-
- my $white = $im->colorAllocate(255, 255, 255);
- my $blue = $im->colorAllocate(0, 0, 255);
-
- # Fill the image with white and draw a greeting.
-
- $im->fill($white, 0, 0);
- $im->string(gdLargeFont, 10, 10,
- "Hello, World", $blue);
- return $im->gif;
- }}
-
- // Java uses this to repaint the image when necessary.
-
- public void paint(Graphics g) {
- g.drawImage(img, 0, 0, this);
- }
-
- // The entry point.
-
- public static void main(String[] argv) {
-
- // Set up a frame and create an image.
-
- Frame f = new Frame("GD Example");
- f.setLayout(new BorderLayout());
-
- GIFDemo demo = new GIFDemo();
- demo.generateImage();
-
- f.add("Center", demo);
- f.addWindowListener( new Handler() );
-
- f.pack();
- f.show();
-
- }
- }
-
- // A handler to process a request to close a window.
-
- class Handler extends WindowAdapter {
- public void windowClosing(WindowEvent e) {
- System.exit(0);
- }
- }
-
-=head2 2.3.7 Summary: Calling Perl from Java
-
-=over 4
-
-=item 1
-
-Put your embedded Perl code in methods that are declared C<perl>.
-
-=item 2
-
-Use double, rather than single, curly braces ({{ and }}).
-
-=item 3
-
-Invoke the Perl methods from Java just like any other Java method.
-
-=item 4
-
-No need to pull arguments off of C<@_> with C<shift>: JPL takes care of
-this for you. This includes C<$self>.
-
-=item 5
-
-If you pass a Java array into a Perl method, it comes in as a scalar
-reference.
-
-=item 6
-
-Convert references to arrays of primitives with C<Get*ArrayElements>
-
-=item 7
-
-Use C<GetObjectArrayElement> to get elements from arrays of strings and
-other objects.
-
-=item 8
-
-To return an array from a C<perl> method, declare the method as returning
-an array type, and either:
-
-=item 9
-
-Return an array reference.
-
-=item 10
-
-Return a string: JPL slices it up for you.
-
-=back
-
-=head1 2.4 Calling Java from Perl
-
-Next, let's look at how to invoke Java from Perl.
-
-=head2 2.4.1 Java in Perl in Java
-
-Remember the issues from 2.1.2 - this is unstable unless you are calling Java from Perl methods that are themselves embedded in a Java program.
-
-=head2 2.4.2 Java in Perl: Simple Constructors
-
-Use JPL::Class to load the class:
-
-C<use JPL::Class "java::awt::Frame";>
-
-Invoke the constructor to create an instance of the class:
-
-C<my $f = java::awt::Frame->new;>
-
-You've got a reference to a Java object in $f, a Perl scalar. I think
-this is cool.
-
-=head2 2.4.3 Constructors that Take Parameters
-
-If the constructor has parameters, look up the method signature with
-C<getmeth>:
-
-my $new = getmeth("new", ['java.lang.String'], []);
-
-The first argument to C<getmeth> is the name of the method. The second
-argument is a reference to an array that contains a list of the argument
-types. The final argument to C<getmeth> is a reference to an array
-containing a single element with the return type. Constructors always
-have a null (void) return type, even though they return an instance of
-an object.
-
-Invoke the method through the variable you created:
-
-my $f = java::awt::Frame->$new( "Frame Demo" );
-
-Because Java supports method overloading, the only way Java can
-distinguish between different methods that have the same name is through
-the method signature. The C<getmeth> function simply returns a mangled,
-Perl-friendly version of the signature. JPL's AutoLoader takes care of
-finding the right class.
-
-For example, the method signature for $new is C<(Ljava/lang/String;)V>.
-In Perl, this is translated to C<new__Ljava_lang_String_2__V>. Sure, it
-means something to Java, but thanks to C<getmeth> and JPL's AutoLoader,
-we don't have to worry about it!
-
-=head2 2.4.4 More on getmeth
-
-The C<getmeth> function is not just for constructors. You'll use it to look
-up method signatures for any method that takes arguments.
-
-To use C<getmeth>, just supply the Java names of the types and objects in
-the argument or return value list. Here are a few examples:
-
-=over 4
-
-=item *
-
-Two int arguments, void return type:
-
- $setSize = getmeth("setSize", ['int', 'int'], []);
-
-=item *
-
-One argument (java.awt.Component), with a return type of the same:
-
- $add = getmeth("add", ['java.awt.Component'],
-
- ['java.awt.Component']);
-
-=item *
-
-Two arguments, a String object and a boolean value, and a void return
-type:
-
- $new = getmeth("new",
-
- ['java.lang.String', 'boolean'], []);
-
-=item *
-
-A String argument with a java.lang.Class return type:
-
- $forName = getmeth("forName",
-
- ['java.lang.String'],
-
- ['java.lang.Class']);
-
-=item *
-
-No arguments, but a boolean return value:
-
- $next = getmeth("next", [], ['boolean']);
-
-=back
-
-=head2 2.4.5 Instance Variables
-
-Java instance variables that belong to a class can be reached through
-$self and a method with the same name as the instance variables:
-
- $frame->$setSize( $self->width, $self->height );
-
-Here is an example:
-
- class VarDemo {
-
- int foo = 100;
-
- perl int perlChange() {{
- my $current_value = $self->foo;
-
- # Change foo to ten times itself.
-
- $self->foo( $current_value * 10 );
-
- }}
-
- void executeChange() {
-
- perlChange();
- System.out.println(foo);
-
- }
-
- public static void main(String[] args) {
-
- VarDemo demo = new VarDemo();
- demo.executeChange();
-
- }
-
- }
-
-Note. JPL creates these methods with the same name as the variable. You
-can also supply a value to set the variable's value. If you create a
-method with this name, it will collide with the one that JPL defines.
-
-FrameDemo.jpl
-
- /*
- * FrameDemo - create and show a Frame in Perl.
- *
- */
-
- public class FrameDemo {
-
- int height = 50;
- int width = 200;
- perl void make_frame () {{
-
- # Import two Java classes.
-
- use JPL::Class "java::awt::Frame";
- use JPL::Class "java::awt::Button";
-
- # Create a Frame and a Button. The two calls to new()
- # have the same signature.
-
- my $new = getmeth("new", ['java.lang.String'], []);
- my $frame = java::awt::Frame->$new( "Frame Demo" );
- my $btn = java::awt::Button->$new( "Do Not Press Me" );
-
- # Add the button to the frame.
-
- my $add = getmeth("add", ['java.awt.Component'],
- ['java.awt.Component']);
- $frame->$add( $btn );
-
- # Set the size of the frame and show it.
-
- my $setSize = getmeth("setSize", ['int', 'int'], []);
- $frame->$setSize($self->width, $self->height);
- $frame->show;
-
- }}
-
- public static void main(String[] argv) {
-
- FrameDemo demo = new FrameDemo();
- demo.make_frame();
-
- }
-
- }
-
-=head2 2.4.6 Summary: Calling Java from Perl
-
-=over 4
-
-=item 1
-
-Use JPL::Class to specify a Java class to import.
-
-=item 2
-
-You can directly invoke constructors and methods that take no arguments.
-
-=item 3
-
-If the constructor or method takes arguments, use getmeth to look up its
-signature.
-
-=item 4
-
-Use $self to access Java instance variables and methods.
-
-=back
-
-=head1 COPYRIGHT
-
-Copyright (c) 1999, Brian Jepson
-
-You may distribute this file under the same terms as Perl itself.
-
-Converted from FrameMaker by Kevin Falcone.
-
-=cut
+++ /dev/null
-
-This archive contains the following files:
-README - the README file which explains how to use this program (this file)
-get_jdk.pl - the program to download JDK
-jdk_hosts - the descriptor file required by the program
-
-Nate Patwardhan (nvp@oreilly.com) wrote get_jdk.pl to automate the
-download of JDK (Java Development Kit) from a distribution site based
-on your Unix flavor. This program is based on some of the examples
-found in the LWP cookbook that was included with your LWP distribution.
-
-Current Unix flavors that appear in the descriptor file (more
-suggestions from Beta testers will be welcomed):
- Solaris
- Linux
- FreeBSD
-
-To use get_jdk.pl properly, you *must* have LWP (libwww) and its
-dependencies installed. Once you've installed LWP, you should be able
-to use this module without any problems on any Unix flavor.
-
-By default, get_jdk.pl uses #!/usr/local/bin/perl in its shebang path,
-so you may have to execute get_jdk.pl like:
-
- perl get_jdk.pl
-
--OR-
-
- perl5 get_jdk.pl
-
-based on your site's Perl installation.
-
-get_jdk.pl reads the $^O to determine what Unix flavor you're using,
-and compares the value of $^O to the first field shown in the
-descriptor file, jdk_hosts. For example, $^O for Solaris versions of
-Perl is: 'solaris'; Solaris is represented in the descriptor file
-like:
-
- solaris=>ftp://ftp.javasoft.com/pub/jdk1.1/jdk1.1.3-solaris2-sparc.bin
-
-When get_jdk.pl reads the descriptor file, it splits the fields on
-'=>', and reads them into a hash, %HOSTS. get_jdk.pl then compares
-the value of $^O to $HOSTS{'osname'}, and returns the address of the
-JDK distribution site if $^O eq $HOSTS{'osname'}. If there is not a
-match, get_jdk.pl fails.
-
-get_jdk.pl represents the hostname of distribution sites in URL
-format: protocol://hostname.some.com/path/filename.extension
-When a URL is found, get_jdk.pl parses out the filename; this is
-significant, because the output from the remote host is directed to
-the file parsed from the URL.
-
-When you execute get_jdk.pl, you'll know it's working correctly if it
-outputs something like:
-
- A JDK port for your OS has been found.
- Contacting:
- ftp://ftp.javasoft.com/pub/jdk1.1/jdk1.1.3-solaris2-sparc.bin
- Attempting to download: jdk1.1.3-solaris2-sparc.bin
- 0% - 1460 bytes received
- 0% - 4380 bytes received
- 0% - 7300 bytes received
- 0% - 8192 bytes received
- [etc etc etc until you reach 100%]
-
-Future (PRK release) versions of get_jdk.pl will allow the user to
-update the descriptor file from the ora.com (oreilly.com) FTP/WWW
-site. This version does not support the -update flag.
-
-Happy JDK'ing! :-)
-
---
-Nate Patwardhan
-nvp@oreilly.com
+++ /dev/null
-#!/usr/bin/perl -w
-
-# Based on an ftp client found in the LWP Cookbook and
-# revised by Nathan V. Patwardhan <nvp@ora.com>.
-
-# Copyright 1997 O'Reilly and Associates
-# This package may be copied under the same terms as Perl itself.
-#
-# Code appears in the Unix version of the Perl Resource Kit
-
-use LWP::UserAgent;
-use URI::URL;
-
-my $ua = new LWP::UserAgent;
-
-# check to see if a JDK port exists for the OS. i'd say
-# that we should use solaris by default, but a 9meg tarfile
-# is a hard pill to swallow if it won't work for somebody. :-)
-my $os_type = $^O; my $URL = lookup_jdk_port($os_type);
-die("No JDK port found. Contact your vendor for details. Exiting.\n")
- if $URL eq '';
-
-print "A JDK port for your OS has been found.\nContacting: ".$URL."\n";
-
-# Now, parse the URL using URI::URL
-my($jdk_file) = (url($URL)->crack)[5];
-$jdk_file =~ /(.+)\/(.+)/; $jdk_file = $2;
-
-print "Attempting to download: $jdk_file\n";
-
-my $expected_length;
-my $bytes_received = 0;
-
-open(OUT, ">".$jdk_file) or die("Can't open $jdk_file: $!");
-$ua->request(HTTP::Request->new('GET', $URL),
- sub {
- my($chunk, $res) = @_;
-
- $bytes_received += length($chunk);
- unless (defined $expected_length) {
- $expected_length = $res->content_length || 0;
- }
- if ($expected_length) {
- printf STDERR "%d%% - ",
- 100 * $bytes_received / $expected_length;
- }
- print STDERR "$bytes_received bytes received\n";
-
- print OUT $chunk;
- }
-);
-close(OUT);
-
-sub lookup_jdk_port {
- my($port_os) = @_;
- my $jdk_hosts = 'jdk_hosts';
- my %HOSTS = ();
-
- open(CFG, $jdk_hosts) or die("hosts error: $!");
- while(<CFG>) {
- chop;
- ($os, $host) = split(/\s*=>\s*/, $_);
- next unless $os eq $port_os;
- push(@HOSTS, $host);
- }
- close(CFG);
-
- return "" unless @HOSTS;
- return $HOSTS[rand @HOSTS]; # Pick one at random.
-}
-
+++ /dev/null
-solaris => ftp://ftp.javasoft.com/pub/jdk1.1/jdk1.1.3-solaris2-sparc.bin
-linux => ftp://ftp.infomagic.com/pub/mirrors/linux/Java/JDK-1.1.3/linux-jdk.1.1.3-v2.tar.gz
-linux => ftp://ftp.connectnet.com/pub/java/JDK-1.1.3/linux-jdk.1.1.3-v2.tar.gz
-freebsd => http://www.csi.uottawa.ca/~kwhite/jdkbinaries/jdk1.1-FreeBSD.tar.gz
+++ /dev/null
-#!/usr/bin/perl
-
-print <<'END' if $>;
-NOTE: Since you're not running as root, the installation will su at
-the appropriate time later. You will need to supply the root password
-for the su program.
-
-END
-
-# Gather data.
-
-# JPL_SRC
-
-chop($JPL_SRC = `pwd`);
-print "JPL_SRC = $JPL_SRC\n";
-
-# JAVA_HOME
-
-foreach $dir (
- $ENV{JAVA_HOME},
- "/usr/java",
- "/usr/local/java",
- "/usr/lib/java",
- "/usr/local/lib/java",
-) {
- $JAVA_HOME = $dir, last if $dir and -d "$dir/bin";
-}
-die "You must set the \$JAVA_HOME environment variable first.\n"
- unless $JAVA_HOME;
-print "JAVA_HOME = $JAVA_HOME\n";
-
-# JPL_HOME
-
-($likelyjpl = $JAVA_HOME) =~ s#(.*)/.*#$1/jpl#;
-
-print <<"END";
-
-You need to decide which directory JPL files are to be installed in.
-Applications will look in subdirectories of this directory for any JPL
-related files.
-
-You may use the current directory ($JPL_SRC)
-or you may use a directory such as $likelyjpl.
-
-END
-
-$| = 1;
-until (-d $JPL_HOME) {
- print "Install JPL files where: [$JPL_SRC] ";
- chop($JPL_HOME = <STDIN>);
- $JPL_HOME ||= $JPL_SRC;
- unless (-d $JPL_HOME) {
- print "Warning: $JPL_HOME doesn't exist yet!\n\n";
- print "Do you want to create it? [y] ";
- chop($ans = <STDIN>);
- $ans ||= 'y';
- next unless $ans =~ /^y/i;
-
- system "mkdir -p $JPL_HOME";
- if ($> and not -d $JPL_HOME) {
- warn "Couldn't create $JPL_HOME!\nTrying again as root...running su...\n";
- system "set -x
-su root -c 'mkdir -p $JPL_HOME && chown $> $JPL_HOME && chmod 0755 $JPL_HOME'";
- warn "Couldn't create $JPL_HOME!\n" unless -d $JPL_HOME;
- }
- }
-}
-print "JPL_HOME = $JPL_HOME\n";
-
-#########################################################################
-# Spit out setvars.
-
-print "Writing setvars...\n";
-
-unlink "$JPL_SRC/setvars";
-open(SETVARS, ">$JPL_HOME/setvars") or die "Can't create setvars: $!\n";
-while (<DATA>) {
- s/^JPL_SRC=.*/JPL_SRC='$JPL_SRC'/;
- s/^JAVA_HOME=.*/JAVA_HOME='$JAVA_HOME'/;
- s/^JPL_HOME=.*/JPL_HOME='$JPL_HOME'/;
- print SETVARS $_;
-}
-close SETVARS;
-chmod 0755, "$JPL_HOME/setvars";
-symlink "$JPL_HOME/setvars", "$JPL_SRC/setvars" if $JPL_HOME ne $JPL_SRC;
-
-#########################################################################
-# Pretend we're make.
-
-eval `./setvars -perl`; # Take our own medicine.
-
-print "\n\nStarting install...\n";
-
-system <<'END' and die "Couldn't install JPL\n";
-set -x
-cd JPL
-perl Makefile.PL
-make clean
-perl Makefile.PL
-make install
-END
-
-print "\nInstalling PerlInterpreter class\n";
-
-system <<'END' and die "Couldn't install PerlInterpreter\n";
-set -x
-cd PerlInterpreter
-perl Makefile.PL
-make clean
-perl Makefile.PL
-make install
-END
-
-print "\nInstalling JNI module\n";
-
-system <<'END' and die "Couldn't install JNI\n";
-set -x
-cd JNI
-perl Makefile.PL -e
-make clean
-perl Makefile.PL -e
-make
-echo 'Attempting to install JNI as root'
-su root -c "make install"
-END
-
-#touch Makefile
-#make -f makefile.jv
-## These should be executed as root
-#rm -rf /usr/lib/perl5/site_perl/i586-linux/auto/JNI
-#rm -rf /usr/lib/perl5/site_perl/auto/JNI
-#rm -f /usr/lib/perl5/site_perl/JNI.pm
-#make -f makefile.jv install UNINST=1
-
-print "\nInstalling Sample JPL program\n";
-
-system <<'END' and die "Couldn't install Sample\n";
-set -x
-cd Sample
-perl Makefile.PL
-make clean
-perl Makefile.PL
-make install
-END
-
-# Test
-print "\n\nTesting Sample...\n";
-system <<'END' and die "Couldn't run Sample\n";
-set -x
-cd Sample
-JPLDEBUG=1
-export JPLDEBUG
-java Sample
-END
-
-__END__
-#!/bin/sh
-
-# You can edit this, but your changes will only last until the next
-# time you run install-jpl.
-
-# Where jpl is currently installed
-
-cd `dirname $0`
-JPL_SRC=`pwd`
-
-# Where java is installed
-
-JAVA_HOME=/usr/local/java
-export JAVA_HOME
-
-# Where jpl will be installed
-
-JPL_HOME="$JPL_SRC"
-export JPL_HOME
-
-# Which perl to run
-
-JPLPERL=perl`perl -e "print $]"`
-#JPLPERL=perl5.00404
-export JPLPERL
-
-# Some derivative variables
-archname=`$JPLPERL -MConfig -e 'print $Config{archname}'`
- archlib=`$JPLPERL -MConfig -e 'print $Config{archlib}'`
-
-CLASSPATH=".:$JPL_HOME/lib${CLASSPATH:+:$CLASSPATH}"
-export CLASSPATH
-
-LD_LIBRARY_PATH=".:$JPL_HOME/lib/$archname:$archlib/CORE${LD_LIBRARY_PATH:+:$LD_LIBRARY_PATH}"
-export LD_LIBRARY_PATH
-
-PERL5LIB="$JPL_HOME/perl${PERL5LIB:+:$PERL5LIB}"
-export PERL5LIB
-
-# Make sure the right java programs are selected.
-PATH="$JAVA_HOME/bin:$PATH"
-export PATH
-
-case "$1" in
--perl)
- cat <<END
-\$ENV{PATH} = '$PATH';
-\$ENV{JAVA_HOME} = '$JAVA_HOME';
-\$ENV{JPL_HOME} = '$JPL_HOME';
-\$ENV{JPLPERL} = '$JPLPERL';
-\$ENV{CLASSPATH} = '$CLASSPATH';
-\$ENV{LD_LIBRARY_PATH} = '$LD_LIBRARY_PATH';
-\$ENV{PERL5LIB} = '$PERL5LIB';
-END
- ;;
--sh)
- cat <<END
- PATH='$PATH';export PATH;JAVA_HOME='$JAVA_HOME';export JAVA_HOME;JPL_HOME='$JPL_HOME';export JPL_HOME;JPLPERL='$JPLPERL';export JPLPERL;CLASSPATH='$CLASSPATH';export CLASSPATH;LD_LIBRARY_PATH='$LD_LIBRARY_PATH';export LD_LIBRARY_PATH;PERL5LIB='$PERL5LIB';export PERL5LIB
-END
- ;;
--csh)
- cat <<END
-setenv PATH '$PATH';
-setenv JAVA_HOME '$JAVA_HOME';
-setenv JPL_HOME '$JPL_HOME';
-setenv JPLPERL '$JPLPERL';
-setenv CLASSPATH '$CLASSPATH';
-setenv LD_LIBRARY_PATH '$LD_LIBRARY_PATH';
-setenv PERL5LIB '$PERL5LIB';
-END
- ;;
-esac
-
projects / p5sagit/p5-mst-13.2.git / commitdiff