From - Thu Dec  2 16:34:26 1999
Return-Path: <cope-request@lunatech.com>
Received: from localhost (root@localhost [127.0.0.1])
        by swand.lake.de (8.9.3/8.9.3) with ESMTP id QAA05821
        for <xmlBlaster@marcelruff.info>; Thu, 2 Dec 1999 16:24:51 +0100
Received: from ferry.lake.de
        by localhost with POP3 (fetchmail-5.0.3)
        for xmlBlaster@marcelruff.info (multi-drop); Thu, 02 Dec 1999 16:24:51 +0100 (MET)
Received: from fw.lunatech.com (smtp-user@fw.lunatech.com [194.151.25.136])
        by ferry.lake.de (8.9.3/8.9.3) with ESMTP id QAA27316
        for <xmlBlaster@marcelruff.info>; Thu, 2 Dec 1999 16:13:25 +0100
Received: from tanglefoot.lunatech.com (root@tanglefoot.lunatech.com [193.172.191.161])
        by fw.lunatech.com (8.9.3/8.9.1/Debian/GNU) with ESMTP id QAA19244;
        Thu, 2 Dec 1999 16:00:50 +0100
Received: (from list@localhost)
        by tanglefoot.lunatech.com (8.9.3/8.9.3/Debian/GNU) id QAA09920;
        Thu, 2 Dec 1999 16:00:44 +0100
Resent-Date: Thu, 2 Dec 1999 16:00:44 +0100
From: Pekka Ahmavuo <pekka@netland.fi>
Message-Id: <199912021500.RAA07651@netland.fi>
Subject: Re: Howto realize a Callback to Perl (fwd)
To: cope@lunatech.com
Date: Thu, 2 Dec 1999 17:00:40 +0200 (EET)
Content-Type: text
Resent-Message-ID: <jbLX3B.A.9aC.cmoR4@tanglefoot>
Resent-From: cope@lunatech.com
X-Mailing-List: <cope@lunatech.com> archive/latest/493
X-Loop: cope@lunatech.com
Precedence: list
Resent-Sender: cope-request@lunatech.com
X-Mozilla-Status: 8011
X-Mozilla-Status2: 00000000
X-UIDL: 519c7bfceb1b7e6216e4294c08dc1d88

>From below you can find a simple example how callbacks can be
implemented with threaded Perl and COPE. It is actually quite trivial
as you can see.

If you want to try it, compile first callback.idl. Then start
server.pl. The client reads the server's ior from a file, so it should
be started in the same directory with the server.


Rick, 

handling simultaneous CGI and CORBA request is a bit different
problem. A least in my case the tricky part was to synchronize the
CORBA and CGI-requests. I you think it might help you I can write an
exmple of that too.

> 
> That sounds like something I've wanted for a long time.  Can you
> share any code with us, or describe the gist of your changes?
> It would be much appreciated.
> 
> -Rick Nicoletti
> 
> At 11:10 AM 12/02/1999 +0200, Pekka Ahmavuo wrote:
> >I have used COPE witb threaded Perl 5.005_03 without problems. My
> >server has to handle simultaneous CGI- and CORBA-requests and using
> >threads was the only feasible solution I could figure out.
> >

--- callback.idl ----

interface hello
{
  void Hello(in string msg);
};

interface callback
{
  void CallMe(in hello caller);
};                                    

--------------------------------------------
-------- client.pl ------------------------
#!/usr/bin/perl

use strict;

use COPE::CORBA::ORB;
use Thread;
use hello_impl;
use callback;

$| = 1;

sub hello_thread
{
    my $boa = shift;
    $boa->impl_is_ready();
}

my $orb    = CORBA::ORB_init();
my $boa    = $orb->BOA_init();

my $hello = new hello_impl;

############################################
# start the hello_impl in a separate thread
my $t = new Thread (\&hello_thread, $boa);

open (IOR, "ior.txt");
my $ior = <IOR>;
close (IOR);

my $server = $orb->string_to_object($ior);
$server = callback->_narrow($server);

while (1)
{
    ##################################################
    # call the callback-server and pass a reference to
    # the hello object as a parameter
    $server->CallMe($hello);
    sleep(3);
}

# newer comes here
$t->join();              

------------------------------------------
------------- server.pl ------------------

#!/usr/bin/perl

use strict;

use COPE::CORBA::ORB;
use Thread;
use callback_impl;

$| = 1;

my $orb = CORBA::ORB_init();
my $boa = $orb->BOA_init();

my $callback = new callback_impl;

my $ior  = $orb->object_to_string($callback);
open (IOR, ">ior.txt");
print IOR $ior;
close (IOR);
$boa->impl_is_ready();              

----------------------------------------------
---------- hello_impl.pm --------------------

use hello_types;
use hello_skel;

# interface hello (IDL:hello:1.0)

package hello_impl;
use COPE::CORBA::Servant;
@hello_impl::ISA=qw(CORBA::BOA::_Servant);
sub _skelname($) { 'hello_skel' }

sub new {
    my($class,@args) = @_;
    my $self = {@args};
    bless $self, $class;
    $CORBA::BOA::_The_Boa->activate_object($self);
    return $self;
}

# operation Hello (IDL:hello/Hello:1.0)

sub Hello ($$) {
    my($self,$msg) = @_;

    print "Got $msg!!!\n";
}
                           
------------------------------------
------- callback_impl.pm -----------

use callback_types;
use callback_skel;

use hello;

# interface callback (IDL:callback:1.0)

package callback_impl;
use COPE::CORBA::Servant;
@callback_impl::ISA=qw(CORBA::BOA::_Servant);
sub _skelname($) { 'callback_skel' }

sub new {
    my($class,@args) = @_;
    my $self = {@args};
    bless $self, $class;
    $CORBA::BOA::_The_Boa->activate_object($self);
    return $self;
}

# operation CallMe (IDL:callback/CallMe:1.0)

sub CallMe ($$) {
    my($self,$caller) = @_;
    print "--> CallMe\n";
    $caller->Hello("Greetings, earthling");
    print "<-- CallMe\n";
}


1;