#!/usr/bin/perl

use IPC::SysV   qw(IPC_PRIVATE S_IRWXU S_IRWXG S_IRWXO);
use IPC::Msg;
use Data::Dumper;

my $channel1 = shift || die;
my $channel2 = shift || die;

$a1= `xmsession --list | grep $channel1`;
if ($a1=~ /\("$channel1",(\d+),(\d+)\)/) { $c1=$1 }
print "Innput queue number is $c1 \n";

$a2 = `xmsession --list | grep $channel2`;
if ($a2=~ /\("$channel2",(\d+),(\d+)\)/) { $c2=$1 }
print "Output queue number is $c2 \n";

# this one doent work because we dont hava a key
# $msg1 = new IPC::Msg($c1, 0); 

# ... but we have the key number... :)
$msg1 = bless \$c1, IPC::Msg ;
$msg2 = bless \$c2, IPC::Msg ;

$SEQ = 2;
$SYM = 3;
$INT = 4;
$STR = 5;
$SET = 7;
$FF  = 9;
$FUN = 10;
$END = 257;

$m = "Viva o Salgueiros";

sub srpc { 
   ssym(shift);
   rsend([$SEQ,[@_]]);
   rrec()
}

sub sstr { $msg1->snd($STR,pack("a100",$_[0]),0);}
sub ssym { $msg1->snd($SYM,pack("a100",$_[0]),0);}
sub sint { $msg1->snd($INT,pack("i",$_[0]),0);}
sub slistint { my @x = @_;
   $msg1->snd($SEQ,0,0);
   for (@x) { sint($_); }
   $msg1->snd($END,0,0);
}

sub rsend {
   my ($type, $b) = @{$_[0]};
   if($type == $INT) {$msg1->snd($INT,pack("i",$b),0);}
   if($type == $STR) {$msg1->snd($STR,pack("a100",$b),0);}
   if($type == $SYM) {$msg1->snd($SYM,pack("a100",$b),0);}
   if($type == $SEQ or $type == $SET or $type == $FUN ) {
       $msg1->snd($type,0,0);
       for( @$b ) { rsend($_);}
       $msg1->snd($END,0,0);
   }
   if($type == $FF)  {$b = "NOT YET IMPLEMENTED";}
   }

sub rrec {
   my ($b, $v,@b); 
   my $buf="";  
   my $type= $msg2->rcv($buf,256); 
   if($type == $INT) {$b = unpack("i",$buf);}
   if($type == $STR) {$b = unpack("Z100",$buf);}
   if($type == $SYM) {$b = unpack("Z100",$buf);}
   if($type == $SEQ or $type == $SET or $type == $FUN ) {
       @b=();
       while( $v=rrec() and $v->[0] != $END) { push(@b,$v);}
       $b = [@b];
   }
   if($type == $FF)  {$b = "NOT YET IMPLEMENTED";}
   [$type,$b] }


print Dumper(srpc("add", [$INT,4]  ,[$INT,5]));
print Dumper(srpc("def", [$SYM,"z"],[$INT,100]));
print Dumper(srpc("add", [$INT,4]  ,srpc("mul",[$SYM,"z"],[$INT,5])));
__END__
$g = rrec();
print Dumper($g);

print Dumper(srpc("add", 4,5));
sstr("$m");   
ssym("oblist");   
sint(33);   
slistint( 102, 103, 104, 105 );
