1 package JPL::AutoLoader;
5 use vars qw(@ISA @EXPORT $AUTOLOAD);
9 @EXPORT = ("AUTOLOAD", "getmeth");
23 # A lookup table to convert the data types that Java
24 # developers are used to seeing into the JNI-mangled
27 # bjepson 13 August 1997
41 # A cache for method ids.
43 # bjepson 13 August 1997
47 # A cache for methods.
49 # bjepson 13 August 1997
55 # XXX We're assuming for the moment that method ids are persistent...
59 print "AUTOLOAD $AUTOLOAD(@_)\n" if $JPL::DEBUG;
60 my ($classname, $methodsig) = $AUTOLOAD =~ /^(.*)::(.*)/;
61 print "class = $classname, method = $methodsig\n" if $JPL::DEBUG;
63 if ($methodsig eq "DESTROY") {
64 print "sub $AUTOLOAD {}\n" if $JPL::DEBUG;
65 eval "sub $AUTOLOAD {}";
69 (my $jclassname = $classname) =~ s/^JPL:://;
70 $jclassname =~ s{::}{/}g;
71 my $class = JNI::FindClass($jclassname)
72 or die "Can't find Java class $jclassname\n";
74 # This method lookup allows the user to pass in
75 # references to two array that contain the input and
76 # output data types of the method.
78 # bjepson 13 August 1997
80 my ($methodname, $sig, $retsig, $slow_way);
81 if (ref $_[1] eq 'ARRAY' && ref $_[2] eq 'ARRAY') {
85 # First we strip out the input and output args.
87 my ($in,$out) = splice(@_, 1, 2);
89 # let's mangle up the input argument types.
91 my @in = jni_mangle($in);
93 # if they didn't hand us any output values types, make
94 # them void by default.
100 # mangle the output types
102 my @out = jni_mangle($out);
104 $methodname = $methodsig;
105 $retsig = join("", @out);
106 $sig = "(" . join("", @in) . ")" . $retsig;
110 ($methodname, $sig) = split /__/, $methodsig, 2;
111 $sig ||= "__V"; # default is void return
113 # Now demangle the signature.
122 ? "Ljava/lang/String;"
123 : (($tmp = $1) =~ tr[_][/], $tmp)
125 if ($sig =~ s/(.*)__(.*)/($1)$2/) {
128 else { # void return is assumed
134 print "sig = $sig\n" if $JPL::DEBUG;
136 # Now look up the method's ID somehow or other.
138 $methodname = "<init>" if $methodname eq 'new';
141 # Added a method id cache to compensate for avoiding
142 # Perl's method cache...
144 if ($MID_CACHE{qq[$classname:$methodname:$sig]}) {
146 $mid = $MID_CACHE{qq[$classname:$methodname:$sig]};
147 print "got method " . ($mid + 0) . " from cache.\n" if $JPL::DEBUG;
149 } elsif (ref $_[0] or $methodname eq '<init>') {
151 # Look up an instance method or a constructor
153 $mid = JNI::GetMethodID($class, $methodname, $sig);
157 # Look up a static method
159 $mid = JNI::GetStaticMethodID($class, $methodname, $sig);
163 # Add this method to the cache.
165 # bjepson 13 August 1997
167 $MID_CACHE{qq[$classname:$methodname:$sig]} = $mid if $slow_way;
171 JNI::ExceptionClear();
172 # Could do some guessing here on return type...
173 die "Can't get method id for $AUTOLOAD($sig)\n";
177 print "mid = ", $mid + 0, ", $mid\n" if $JPL::DEBUG;
178 my $rettype = $callmethod{$retsig} || "Object";
179 print "*** rettype = $rettype\n" if $JPL::DEBUG;
183 if ($rettype eq "Object") {
184 $blesspack = $retsig;
185 $blesspack =~ s/^L//;
186 $blesspack =~ s/;$//;
187 $blesspack =~ s#/#::#g;
188 print "*** Some sort of wizardry...\n" if $JPL::DEBUG;
189 print %{$blesspack . "::"}, "\n" if $JPL::DEBUG;
190 print defined %{$blesspack . "::"}, "\n" if $JPL::DEBUG;
191 if (not defined %{$blesspack . "::"}) {
192 #if ($blesspack eq "java::lang::String") {
193 if ($blesspack =~ /java::/) {
194 eval <<"END" . <<'ENDQ';
199 '""' => sub { JNI::GetStringUTFChars($_[0]) },
200 '0+' => sub { 0 + "$_[0]" },
213 # Finally, call the method. Er, somehow...
217 my $real_mid = $mid + 0; # weird overloading that I
218 # don't understand ?!
219 if (ref ${$METHOD_CACHE{qq[$real_mid]}} eq 'CODE') {
221 $METHOD = ${$METHOD_CACHE{qq[$real_mid]}};
222 print qq[Pulled $classname, $methodname, $sig from cache.\n] if $JPL::DEBUG;
224 } elsif ($methodname eq "<init>") {
227 my $class = JNI::FindClass($jclassname);
228 bless $class->JNI::NewObjectA($mid, \@_), $classname;
235 if (ref $self eq $classname) {
236 my $callmethod = "JNI::Call${rettype}MethodA";
237 bless $self->$callmethod($mid, \@_), $blesspack;
240 my $callmethod = "JNI::CallNonvirtual${rettype}MethodA";
241 bless $self->$callmethod($class, $mid, \@_), $blesspack;
248 if (ref $self eq $classname) {
249 my $callmethod = "JNI::Call${rettype}MethodA";
250 $self->$callmethod($mid, \@_);
253 my $callmethod = "JNI::CallNonvirtual${rettype}MethodA";
254 $self->$callmethod($class, $mid, \@_);
260 my $callmethod = "JNI::CallStatic${rettype}MethodA";
264 bless $class->$callmethod($mid, \@_), $blesspack;
270 $class->$callmethod($mid, \@_);
275 $METHOD_CACHE{qq[$real_mid]} = \$METHOD;
279 *$AUTOLOAD = $METHOD;
289 foreach my $arg (@{ $arr }) {
293 # Count the dangling []s.
295 $ret = '[' x $arg =~ s/\[\]//g;
297 # Is it a primitive type?
299 if ($type_table{$arg}) {
300 $ret .= $type_table{$arg};
316 my ($meth, $in, $out) = @_;
317 my @in = jni_mangle($in);
319 # if they didn't hand us any output values types, make
320 # them void by default.
322 unless ($out and @$out) {
326 # mangle the output types
328 my @out = jni_mangle($out);
330 my $sig = join("", '#', @in, '#', @out);
336 ($tmp = $1) =~ tr[/][_], $tmp
338 $sig =~ s{Ljava/lang/String;}{s}g;
346 package java::lang::String;
348 '""' => sub { JNI::GetStringUTFChars($_[0]) },
349 '0+' => sub { 0 + "$_[0]" },