1#!/usr/bin/perl -w
2
3# Copyright 1997, O'Reilly & Associate, Inc.
4#
5# This package may be copied under the same terms as Perl itself.
6
7package JPL::Compile;
8use Exporter ();
9@ISA = qw(Exporter);
10@EXPORT = qw(files file);
11
12use strict;
13
14
15warn "You don't have a recent JDK kit your PATH, so this may fail.\n"
16    unless $ENV{PATH} =~ /(java|jdk1.[1-9])/;
17
18sub emit;
19
20my $PERL = "";
21my $LASTCLASS = "";
22my $PERLLINE = 0;
23my $PROTO;
24
25my @protos;
26
27my $plfile;
28my $jpfile;
29my $hfile;
30my $h_file;
31my $cfile;
32my $jfile;
33my $classfile;
34
35my $DEBUG = $ENV{JPLDEBUG};
36
37my %ptype = qw(
38	Z boolean
39	B byte
40	C char
41	S short
42	I int
43	J long
44	F float
45	D double
46);
47
48$ENV{CLASSPATH} =~ s/^/.:/ unless $ENV{CLASSPATH} =~ /^\.(?::|$)/;
49
50unless (caller) {
51    files(@ARGV);
52}
53
54#######################################################################
55
56sub files {
57    foreach my $jpfile (@_) {
58	file($jpfile);
59    }
60    print "make\n";
61    system "make";
62}
63
64sub file {
65    my $jpfile = shift;
66    my $JAVA = "";
67    my $lastpos = 0;
68    my $linenum = 2;
69    my %classseen;
70    my %fieldsig;
71    my %staticfield;
72
73    (my $file = $jpfile) =~ s/\.jpl$//;
74    $jpfile = "$file.jpl";
75    $jfile = "$file.java";
76    $hfile = "$file.h";
77    $cfile = "$file.c";
78    $plfile = "$file.pl";
79    $classfile = "$file.class";
80
81    ($h_file = $hfile) =~ s/_/_0005f/g;
82
83    emit_c_header();
84
85    # Extract out arg names from .java file, since .class doesn't have 'em.
86
87    open(JPFILE, $jpfile) or die "Can't open $jpfile: $!\n";
88    undef $/;
89    $_ = <JPFILE>;
90    close JPFILE;
91
92    die "$jpfile doesn't seem to define class $file!\n"
93	unless /class\s+\b$file\b[\w\s.,]*{/;
94
95    @protos = ();
96    open(JFILE, ">$jfile") or die "Can't create $jfile: $!\n";
97
98    while (m/\bperl\b([^\n]*?\b(\w+)\s*\(\s*(.*?)\s*\)[\s\w.,]*)\{\{(.*?)\}\}/sg) {
99	$JAVA = substr($`, $lastpos);
100	$lastpos = pos $_;
101	$JAVA .= "native";
102	$JAVA .= $1;
103
104	my $method = $2;
105
106	my $proto = $3;
107
108	my $perl = $4;
109	(my $repl = $4) =~ tr/\n//cd;
110	$JAVA .= ';';
111	$linenum += $JAVA =~ tr/\n/\n/;
112	$JAVA .= $repl;
113	print JFILE $JAVA;
114
115	$proto =~ s/\s+/ /g;
116	$perl =~ s/^[ \t]+\Z//m;
117	$perl =~ s/^[ \t]*\n//;
118	push(@protos, [$method, $proto, $perl, $linenum]);
119
120	$linenum += $repl =~ tr/\n/\n/;
121    }
122
123    print JFILE <<"END";
124    static {
125	System.loadLibrary("$file");
126        PerlInterpreter pi = new PerlInterpreter().fetch();
127        // pi.eval("\$JPL::DEBUG = \$ENV{JPLDEBUG};");
128	pi.eval("warn qq{loading $file\\n} if \$JPL::DEBUG");
129	pi.eval("eval {require '$plfile'}; print \$@ if \$@;");
130    }
131END
132
133    print JFILE substr($_, $lastpos);
134
135    close JFILE;
136
137    # Produce the corresponding .h file.  Should really use make...
138
139    if (not -s $hfile or -M $hfile > -M $jfile) {
140	if (not -s $classfile or -M $classfile > -M $jfile) {
141	    unlink $classfile;
142	    print  "javac $jfile\n";
143	    system "javac $jfile" and die "Couldn't run javac: exit $?\n";
144	    if (not -s $classfile or -M $classfile > -M $jfile) {
145		die "Couldn't produce $classfile from $jfile!";
146	    }
147	}
148	unlink $hfile;
149	print  "javah -jni $file\n";
150	system "javah -jni $file" and die "Couldn't run javah: exit $?\n";
151	if (not -s $hfile and -s $h_file) {
152	    rename $h_file, $hfile;
153	}
154	if (not -s $hfile or -M $hfile > -M $jfile) {
155	    die "Couldn't produce $hfile from $classfile!";
156	}
157    }
158
159    # Easiest place to get fields is from javap.
160
161    print  "javap -s $file\n";
162    open(JP, "javap -s $file|");
163    $/ = "\n";
164    while (<JP>) {
165	if (/^\s+([A-Za-z_].*) (\w+)[\[\d\]]*;/) {
166	    my $jtype = $1;
167	    my $name = $2;
168	    $_ = <JP>;
169	    s!^\s*/\*\s*!!;
170	    s!\s*\*/\s*!!;
171	    print "Field $jtype $name $_\n" if $DEBUG;
172	    $fieldsig{$name} = $_;
173	    $staticfield{$name} = $jtype =~ /\bstatic\b/;
174	}
175	while (m/L([^;]*);/g) {
176	    my $pclass = j2p_class($1);
177	    $classseen{$pclass}++;
178	}
179    }
180    close JP;
181
182    open(HFILE, $hfile) or die "Couldn't open $hfile: $!\n";
183    undef $/;
184    $_ = <HFILE>;
185    close HFILE;
186
187    die "panic: native method mismatch" if @protos != s/^JNIEXPORT/JNIEXPORT/gm;
188
189    $PROTO = 0;
190    while (m{
191	\*\s*Class:\s*(\w+)\s*
192	\*\s*Method:\s*(\w+)\s*
193	\*\s*Signature:\s*(\S+)\s*\*/\s*
194	JNIEXPORT\s*(.*?)\s*JNICALL\s*(\w+)\s*\((.*?)\)
195    }gx) {
196	my $class = $1;
197	my $method = $2;
198	my $signature = $3;
199	my $rettype = $4;
200	my $cname = $5;
201	my $ctypes = $6;
202	$class =~ s/_0005f/_/g;
203	if ($method ne $protos[$PROTO][0]) {
204	    die "Method name mismatch: $method vs $protos[$PROTO][0]\n";
205	}
206	print "$class.$method($protos[$PROTO][1]) =>
207	$signature
208	$rettype $cname($ctypes)\n" if $DEBUG;
209
210	# Insert argument names into parameter list.
211
212	my $env = "env";
213	my $obj = "obj";
214	my @jargs = split(/\s*,\s*/, $protos[$PROTO][1]);
215	foreach my $arg (@jargs) {
216	    $arg =~ s/^.*\b(\w+).*$/${1}/;
217	}
218	my @tmpargs = @jargs;
219	unshift(@tmpargs, $env, $obj);
220	print "\t@tmpargs\n" if $DEBUG;
221	$ctypes .= ",";
222	$ctypes =~ s/,/' ' . shift(@tmpargs) . '_,'/eg;
223	$ctypes =~ s/,$//;
224	$ctypes =~ s/env_/env/;
225	$ctypes =~ s/obj_/obj/;
226	print "\t$ctypes\n" if $DEBUG;
227
228	my $jlen = @jargs + 1;
229
230	(my $mangclass = $class) =~ s/_/_1/g;
231	(my $mangmethod = $method) =~ s/_/_1/g;
232	my $plname = $cname;
233	$plname =~ s/^Java_${mangclass}_${mangmethod}/JPL::${class}::${method}/;
234	$plname =~ s/Ljava_lang_String_2/s/g;
235
236	# Make glue code for each argument.
237
238	(my $sig = $signature) =~ s/^\(//;
239
240	my $decls = "";
241	my $glue = "";
242
243	foreach my $jarg (@jargs) {
244	    if ($sig =~ s/^[ZBCSI]//) {
245		$glue .= <<"";
246!    /* $jarg */
247!    PUSHs(sv_2mortal(newSViv(${jarg}_)));
248!
249
250	    }
251	    elsif ($sig =~ s/^[JFD]//) {
252		$glue .= <<"";
253!    /* $jarg */
254!    PUSHs(sv_2mortal(newSVnv(${jarg}_)));
255!
256
257	    }
258	    elsif ($sig =~ s#^Ljava/lang/String;##) {
259		$glue .= <<"";
260!    /* $jarg */
261!    tmpjb = (jbyte*)(*env)->GetStringUTFChars(env,${jarg}_,0);
262!    PUSHs(sv_2mortal(newSVpv((char*)tmpjb,0)));
263!    (*env)->ReleaseStringUTFChars(env,${jarg}_,tmpjb);
264!
265
266	    }
267	    elsif ($sig =~ s/^L([^;]*);//) {
268		my $pclass = j2p_class($1);
269		$classseen{$pclass}++;
270		$glue .= <<"";
271!    /* $jarg */
272!    if (!${jarg}_stashhv_)
273!	${jarg}_stashhv_ = gv_stashpv("$pclass", TRUE);
274!
275!    PUSHs(sv_bless(
276!	sv_setref_iv(sv_newmortal(), Nullch, (IV)(void*)${jarg}_),
277!	${jarg}_stashhv_));
278!    if (jpldebug)
279!	fprintf(stderr, "Done with $jarg\\n");
280!
281
282		$decls .= <<"";
283!    static HV* ${jarg}_stashhv_ = 0;
284
285
286	    }
287	    elsif ($sig =~ s/^\[+([ZBCSIJFD]|L[^;]*;)//) {
288		my $pclass = "jarray";
289		$classseen{$pclass}++;
290		$glue .= <<"";
291!    /* $jarg */
292!    if (!${jarg}_stashhv_)
293!	${jarg}_stashhv_ = gv_stashpv("$pclass", TRUE);
294!
295!    PUSHs(sv_bless(
296!	sv_setref_iv(sv_newmortal(), Nullch, (IV)(void*)${jarg}_),
297!	${jarg}_stashhv_));
298!    if (jpldebug)
299!	fprintf(stderr, "Done with $jarg\\n");
300!
301
302		$decls .= <<"";
303!    static HV* ${jarg}_stashhv_ = 0;
304
305	    }
306	    else {
307		die "Short signature: $signature\n" if $sig eq "";
308		die "Unrecognized letter '" . substr($sig, 0, 1) . "' in signature $signature\n";
309	    }
310	}
311
312	$sig =~ s/^\)// or die "Argument mismatch in signature: $method$signature\n";
313
314	my $void = $signature =~ /\)V$/;
315
316	$decls .= <<"" if $signature =~ m#java/lang/String#;
317!    jbyte* tmpjb;
318
319	$decls .= <<"" unless $void;
320!    SV* retsv;
321!    $rettype retval;
322!
323!    if (jpldebug)
324!	fprintf(stderr, "Got to $cname\\n");
325!    ENTER;
326!    SAVETMPS;
327
328	emit <<"";
329!JNIEXPORT $rettype JNICALL
330!$cname($ctypes)
331!{
332!    static SV* methodsv = 0;
333!    static HV* stashhv = 0;
334!    dSP;
335$decls
336!    PUSHMARK(sp);
337!    EXTEND(sp,$jlen);
338!
339!    sv_setiv(perl_get_sv("JPL::_env_", 1), (IV)(void*)env);
340!    jplcurenv = env;
341!
342!    if (jpldebug)
343!	fprintf(stderr, "env = %lx\\n", (long)$env);
344!
345!    if (!methodsv)
346!	methodsv = (SV*)perl_get_cv("$plname", TRUE);
347!    if (!stashhv)
348!	stashhv = gv_stashpv("JPL::$class", TRUE);
349!
350!    if (jpldebug)
351!	fprintf(stderr, "blessing obj = %lx\\n", obj);
352!    PUSHs(sv_bless(
353!	sv_setref_iv(sv_newmortal(), Nullch, (IV)(void*)obj),
354!	stashhv));
355!
356$glue
357
358	# Finally, call the subroutine.
359
360	my $mod;
361	$mod = "|G_DISCARD" if $void;
362
363	if ($void) {
364	    emit <<"";
365!    PUTBACK;
366!    perl_call_sv(methodsv, G_EVAL|G_KEEPERR|G_DISCARD);
367!
368
369	}
370	else {
371	    emit <<"";
372!    PUTBACK;
373!    if (perl_call_sv(methodsv, G_EVAL|G_KEEPERR))
374!	retsv = *PL_stack_sp--;
375!    else
376!	retsv = &PL_sv_undef;
377!
378
379	}
380
381	emit <<"";
382!    if (SvTRUE(ERRSV)) {
383!	jthrowable newExcCls;
384!
385!	(*env)->ExceptionDescribe(env);
386!	(*env)->ExceptionClear(env);
387!
388!	newExcCls = (*env)->FindClass(env, "java/lang/RuntimeException");
389!	if (newExcCls)
390!	    (*env)->ThrowNew(env, newExcCls, SvPV(ERRSV,PL_na));
391!    }
392!
393
394	# Fix up the return value, if any.
395
396	if ($sig =~ s/^V//) {
397	    emit <<"";
398!    return;
399
400	}
401	elsif ($sig =~ s/^[ZBCSI]//) {
402	    emit <<"";
403!    retval = ($rettype)SvIV(retsv);
404!    FREETMPS;
405!    LEAVE;
406!    return retval;
407
408	}
409	elsif ($sig =~ s/^[JFD]//) {
410	    emit <<"";
411!    retval = ($rettype)SvNV(retsv);
412!    FREETMPS;
413!    LEAVE;
414!    return retval;
415
416	}
417	elsif ($sig =~ s#^Ljava/lang/String;##) {
418	    emit <<"";
419!    retval = (*env)->NewStringUTF(env, SvPV(retsv,PL_na));
420!    FREETMPS;
421!    LEAVE;
422!    return retval;
423
424	}
425	elsif ($sig =~ s/^L[^;]*;//) {
426	    emit <<"";
427!    if (SvROK(retsv)) {
428!	SV* rv = (SV*)SvRV(retsv);
429!	if (SvOBJECT(rv))
430!	    retval = ($rettype)(void*)SvIV(rv);
431!	else
432!	    retval = ($rettype)(void*)0;
433!    }
434!    else
435!	retval = ($rettype)(void*)0;
436!    FREETMPS;
437!    LEAVE;
438!    return retval;
439
440	}
441	elsif ($sig =~ s/^\[([ZBCSIJFD])//) {
442	    my $elemtype = $1;
443	    my $ptype = "\u$ptype{$elemtype}";
444	    my $ntype = "j$ptype{$elemtype}";
445	    my $in = $elemtype =~ /^[JFD]/ ? "N" : "I";
446	    emit <<"";
447!    if (SvROK(retsv)) {
448!	SV* rv = (SV*)SvRV(retsv);
449!	if (SvOBJECT(rv))
450!	    retval = ($rettype)(void*)SvIV(rv);
451!	else if (SvTYPE(rv) == SVt_PVAV) {
452!	    jsize len = av_len((AV*)rv) + 1;
453!	    $ntype* buf = ($ntype*)malloc(len * sizeof($ntype));
454!	    int i;
455!	    SV** esv;
456!
457!	    ${ntype}Array ja = (*env)->New${ptype}Array(env, len);
458!	    for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++)
459!		buf[i] = ($ntype)Sv${in}V(*esv);
460!	    (*env)->Set${ptype}ArrayRegion(env, ja, 0, len, buf);
461!	    free((void*)buf);
462!	    retval = ($rettype)ja;
463!	}
464!	else
465!	    retval = ($rettype)(void*)0;
466!    }
467!    else if (SvPOK(retsv)) {
468!	jsize len = sv_len(retsv) / sizeof($ntype);
469!
470!	${ntype}Array ja = (*env)->New${ptype}Array(env, len);
471!	(*env)->Set${ptype}ArrayRegion(env, ja, 0, len, ($ntype*)SvPV(retsv,PL_na));
472!	retval = ($rettype)ja;
473!    }
474!    else
475!	retval = ($rettype)(void*)0;
476!    FREETMPS;
477!    LEAVE;
478!    return retval;
479
480	}
481	elsif ($sig =~ s!^\[Ljava/lang/String;!!) {
482	    emit <<"";
483!    if (SvROK(retsv)) {
484!	SV* rv = (SV*)SvRV(retsv);
485!	if (SvOBJECT(rv))
486!	    retval = ($rettype)(void*)SvIV(rv);
487!	else if (SvTYPE(rv) == SVt_PVAV) {
488!	    jsize len = av_len((AV*)rv) + 1;
489!	    int i;
490!	    SV** esv;
491!           static jclass jcl = 0;
492!	    jarray ja;
493!
494!	    if (!jcl)
495!		jcl = (*env)->FindClass(env, "java/lang/String");
496!	    ja = (*env)->NewObjectArray(env, len, jcl, 0);
497!	    for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++) {
498!		jobject str = (jobject)(*env)->NewStringUTF(env, SvPV(*esv,PL_na));
499!		(*env)->SetObjectArrayElement(env, ja, i, str);
500!	    }
501!	    retval = ($rettype)ja;
502!	}
503!	else
504!	    retval = ($rettype)(void*)0;
505!    }
506!    else
507!	retval = ($rettype)(void*)0;
508!    FREETMPS;
509!    LEAVE;
510!    return retval;
511
512	}
513	elsif ($sig =~ s/^(\[+)([ZBCSIJFD]|L[^;]*;)//) {
514	    my $arity = length $1;
515	    my $elemtype = $2;
516	    emit <<"";
517!    if (SvROK(retsv)) {
518!	SV* rv = (SV*)SvRV(retsv);
519!	if (SvOBJECT(rv))
520!	    retval = ($rettype)(void*)SvIV(rv);
521!	else if (SvTYPE(rv) == SVt_PVAV) {
522!	    jsize len = av_len((AV*)rv) + 1;
523!	    int i;
524!	    SV** esv;
525!           static jclass jcl = 0;
526!	    jarray ja;
527!
528!	    if (!jcl)
529!		jcl = (*env)->FindClass(env, "java/lang/Object");
530!	    ja = (*env)->NewObjectArray(env, len, jcl, 0);
531!	    for (esv = AvARRAY((AV*)rv), i = 0; i < len; esv++, i++) {
532!		if (SvROK(*esv) && (rv = SvRV(*esv)) && SvOBJECT(rv)) {
533!		    (*env)->SetObjectArrayElement(env, ja, i,
534!			(jobject)(void*)SvIV(rv));
535!		}
536!		else {
537!		    jobject str = (jobject)(*env)->NewStringUTF(env,
538!			SvPV(*esv,PL_na));
539!		    (*env)->SetObjectArrayElement(env, ja, i, str);
540!		}
541!	    }
542!	    retval = ($rettype)ja;
543!	}
544!	else
545!	    retval = ($rettype)(void*)0;
546!    }
547!    else
548!	retval = ($rettype)(void*)0;
549!    FREETMPS;
550!    LEAVE;
551!    return retval;
552
553	}
554	else {
555	    die "No return type: $signature\n" if $sig eq "";
556	    die "Unrecognized return type '" . substr($sig, 0, 1) . "' in signature $signature\n";
557	}
558
559	emit <<"";
560!}
561!
562
563	my $perl = "";
564
565	if ($class ne $LASTCLASS) {
566	    $LASTCLASS = $class;
567	    $perl .= <<"";
568package JPL::${class};
569use JNI;
570use JPL::AutoLoader;
571\@ISA = qw(jobject);
572\$clazz = JNI::FindClass("$file");\n
573
574	    foreach my $field (sort keys %fieldsig) {
575		my $sig = $fieldsig{$field};
576		my $ptype = $ptype{$sig};
577		if ($ptype) {
578		    $ptype = "\u$ptype";
579		    if ($staticfield{$field}) {
580			$perl .= <<"";
581\$${field}_FieldID = JNI::GetStaticFieldID(\$clazz, "$field", "$sig");
582sub $field (\$;\$) {
583    my \$self = shift;
584    if (\@_) {
585	JNI::SetStatic${ptype}Field(\$clazz, \$${field}_FieldID, \$_[0]);
586    }
587    else {
588	JNI::GetStatic${ptype}Field(\$clazz, \$${field}_FieldID);
589    }
590}\n
591
592		    }
593		    else {
594			$perl .= <<"";
595\$${field}_FieldID = JNI::GetFieldID(\$clazz, "$field", "$sig");
596sub $field (\$;\$) {
597    my \$self = shift;
598    if (\@_) {
599	JNI::Set${ptype}Field(\$self, \$${field}_FieldID, \$_[0]);
600    }
601    else {
602	JNI::Get${ptype}Field(\$self, \$${field}_FieldID);
603    }
604}\n
605
606		    }
607		}
608		else {
609		    my $pltype = $sig;
610		    if ($pltype =~ s/^L(.*);/$1/) {
611			$pltype =~ s!/!::!g;
612		    }
613		    else {
614			$pltype = 'jarray';
615		    }
616		    if ($pltype eq "java::lang::String") {
617			if ($staticfield{$field}) {
618			    $perl .= <<"";
619\$${field}_FieldID = JNI::GetStaticFieldID(\$clazz, "$field", "$sig");
620sub $field (\$;\$) {
621    my \$self = shift;
622    if (\@_) {
623	JNI::SetStaticObjectField(\$clazz, \$${field}_FieldID,
624	    ref \$_[0] ? \$_[0] : JNI::NewStringUTF(\$_[0]));
625    }
626    else {
627	JNI::GetStringUTFChars(JNI::GetStaticObjectField(\$clazz, \$${field}_FieldID));
628    }
629}\n
630
631			}
632			else {
633			    $perl .= <<"";
634\$${field}_FieldID = JNI::GetFieldID(\$clazz, "$field", "$sig");
635sub $field (\$;\$) {
636    my \$self = shift;
637    if (\@_) {
638	JNI::SetObjectField(\$self, \$${field}_FieldID,
639	    ref \$_[0] ? \$_[0] : JNI::NewStringUTF(\$_[0]));
640    }
641    else {
642	JNI::GetStringUTFChars(JNI::GetObjectField(\$self, \$${field}_FieldID));
643    }
644}\n
645
646			}
647		    }
648		    else {
649			if ($staticfield{$field}) {
650			    $perl .= <<"";
651\$${field}_FieldID = JNI::GetStaticFieldID(\$clazz, "$field", "$sig");
652sub $field (\$;\$) {
653    my \$self = shift;
654    if (\@_) {
655	JNI::SetStaticObjectField(\$clazz, \$${field}_FieldID, \$_[0]);
656    }
657    else {
658	bless JNI::GetStaticObjectField(\$clazz, \$${field}_FieldID), "$pltype";
659    }
660}\n
661
662			}
663			else {
664			    $perl .= <<"";
665\$${field}_FieldID = JNI::GetFieldID(\$clazz, "$field", "$sig");
666sub $field (\$;\$) {
667    my \$self = shift;
668    if (\@_) {
669	JNI::SetObjectField(\$self, \$${field}_FieldID, \$_[0]);
670    }
671    else {
672	bless JNI::GetObjectField(\$self, \$${field}_FieldID), "$pltype";
673    }
674}\n
675
676			}
677		    }
678		}
679	    }
680	}
681
682	$plname =~ s/^JPL::${class}:://;
683
684	my $proto = '$' x (@jargs + 1);
685	$perl .= "sub $plname ($proto) {\n";
686	$perl .= '    my ($self, ';
687	foreach my $jarg (@jargs) {
688	    $perl .= "\$$jarg, ";
689	}
690	$perl =~ s/, $/) = \@_;\n/;
691	$perl .= <<"END";
692	warn "JPL::${class}::$plname(\@_)\\n" if \$JPL::DEBUG;
693#line $protos[$PROTO][3] "$jpfile"
694$protos[$PROTO][2]}
695
696END
697
698	$PERLLINE += $perl =~ tr/\n/\n/ + 2;
699	$perl .= <<"END";
700#line $PERLLINE ""
701END
702	$PERLLINE--;
703
704	$PERL .= $perl;
705    }
706    continue {
707	$PROTO++;
708	print "\n" if $DEBUG;
709    }
710
711    emit_c_footer();
712
713    rename $cfile, "$cfile.old";
714    rename "$cfile.new", $cfile;
715
716    open(PLFILE, ">$plfile") or die "Can't create $plfile: $!\n";
717    print PLFILE "BEGIN { \$JPL::_env_ ||= 1; }	# suppress bogus embedding\n\n";
718    if (%classseen) {
719	my @classes = sort keys %classseen;
720	print PLFILE "use JPL::Class qw(@classes);\n\n";
721    }
722    print PLFILE $PERL;
723    print PLFILE "1;\n";
724    close PLFILE;
725
726    print "perl -c $plfile\n";
727    system "perl -c $plfile" and die "jpl stopped\n";
728}
729
730sub emit_c_header {
731    open(CFILE, ">$cfile.new") or die "Can't create $cfile.new: $!\n";
732    emit <<"";
733!/* This file is automatically generated.  Do not modify! */
734!
735!#include "$hfile"
736!
737!#include "EXTERN.h"
738!#include "perl.h"
739!
740!#ifndef EXTERN_C
741!#  ifdef __cplusplus
742!#    define EXTERN_C extern "C"
743!#  else
744!#    define EXTERN_C extern
745!#  endif
746!#endif
747!
748!extern int jpldebug;
749!extern JNIEnv* jplcurenv;
750!
751
752}
753
754
755sub emit_c_footer {
756    close CFILE;
757}
758
759sub emit {
760    my $string = shift;
761    $string =~ s/^!//mg;
762    print CFILE $string;
763}
764
765sub j2p_class {
766    my $jclass = shift;
767    $jclass =~ s#/#::#g;
768    $jclass;
769}
770