# Copyright (C) 1998 Tuomas J. Lukka
# DISTRIBUTED WITH NO WARRANTY, EXPRESS OR IMPLIED.
# See the GNU Library General Public License (file COPYING in the distribution)
# for conditions of use and redistribution.
# Implement VRMLPERL-JAVA communication.
package VRML::JavaCom::OHandle;
sub new {my($type,$handle) = @_; bless {Handle => $handle},$type;}
sub print {my $this = shift;
if($VRML::verbose::java) {
print "TO JAVA:\n---\n";
print @_; print "---\n";
}
$this->{Handle}->print(@_);}
sub flush {$_[0]{Handle}->flush}
package VRML::JavaCom::IHandle;
sub new {my($type,$handle) = @_; bless {Handle => $handle},$type;}
sub getline {
my $l = $_[0]{Handle}->getline;
print "FROM JAVA:\n---\n$l---\n" if $VRML::verbose::java;
return $l;
}
package VRML::JavaCom;
use FileHandle;
use IPC::Open2;
use Fcntl;
my $eid;
sub new {
my($type) = @_;
bless {
}, $type;
}
sub connect {
my($this) = @_;
# XXX java VM name
# my @cmd = split ' ','java_g TjlScript';
# $pid = system 1, @cmd;
unless ($pid = fork()) {
exec 'java_g -v TjlScript';
}
($this->{I} = FileHandle->new)->open("<.javapipej");
$this->{I}->setvbuf("",_IONBF,0);
($this->{O} = FileHandle->new)->open(">.javapipep");
# $pid = open3("<, $this->{O}, 'java_g -v TjlScript ');
$this->{O} = VRML::JavaCom::OHandle->new($this->{O});
$this->{I} = VRML::JavaCom::IHandle->new($this->{I});
$this->{O}->print( "TJL XXX PERL-JAVA 0.00\n" );
$this->{O}->flush();
$str = $this->{I}->getline; chomp $str;
if("TJL XXX JAVA-PERL 0.00" ne $str) {
die("Invalid response from java scripter: '$str'");
}
$this->{O}->print("\n"); # Directory - currently ""
}
sub initialize {return ()}
sub newscript {
my($this, $purl, $url, $node) = @_;
undef $1;
$purl =~ /^(.*\/)[^\/]+$/;
$url = $1.$url; # XXXX!!
if(!$this->{O}) {$this->connect}
$this->{Ids}{$node} = $node;
$this->{O}->print("NEWSCRIPT\n$node\n$url\n");
my $t = $node->{Type};
my @k = keys %{$t->{Defaults}};
$this->{O}->print(((scalar @k)-1)."\n");
for(@k) {
next if $_ eq "url";
$this->{O}->print("$t->{FieldKinds}{$_}\n$t->{FieldTypes}{$_}\n$_\n");
if($t->{FieldKinds}{$_} eq "field") {
my $ft = "VRML::Field::".$t->{FieldTypes}{$_};
$this->{O}->print($ft->toj($node->{RFields}{$_})."\n");
}
}
$this->{O}->flush();
}
sub sendinit {
my($this,$node) = @_;
$eid++;
$this->{O}->print("INITIALIZE\n$node\n$eid\n");
$this->{O}->flush();
return $this->receive($eid);
}
sub sendevent {
my($this,$node,$event,$value,$timestamp) = @_;
$eid++;
$this->{O}->print("SENDEVENT\n$node\n$eid\n$event\n");
$this->{O}->print(
"VRML::Field::$node->{Type}{FieldTypes}{$event}"->toj(
$value
)."\n"
);
$this->{O}->print("$timestamp\n");
$this->{O}->flush();
return $this->receive($eid);
}
sub sendeventsproc {
my($this,$node) = @_;
$eid++;
$this->{O}->print("EVENTSPROCESSED\n$node\n$eid\n");
$this->{O}->flush();
return $this->receive($eid);
}
sub receive {
my($this,$id) = @_;
my @a;
$i = $this->{I};
while(1) {
print "WAITING FOR JAVA EVENT...\n" if $VRML::verbose::java;
my $cmd = $i->getline;
die("EOF on java filehandle")
if !defined $cmd;
chomp $cmd;
print "JAVA EVENT '$cmd'\n" if $VRML::verbose::java;
if($cmd eq "FINISHED") {
my $ri = $i->getline; chomp $ri;
if($ri ne $id) {
die("Invalid request id from java scripter: '$ri' should be '$id'\n");
}
return @a;
} elsif($cmd eq "SENDEVENT") {
my $nid = $i->getline; chomp $nid;
my $field = $i->getline; chomp $field;
my $value = $i->getline; chomp $value;
my $node = $this->{Ids}{$nid};
$value = "VRML::Field::$node->{Type}{FieldTypes}{$field}"
-> fromj($value);
push @a, [$node, $field, $value];
} else {
die("Invalid Java event '$cmd'");
}
}
}
1;