# $Id: Test3_impl.pm 1206 2006-05-31 07:11:53Z rvosa $
#
# Generated on Thu Nov 19 20:52:43 1998 with the following command:
# bin/idl2perl -impl Test.idl

use COPE::Test::Test2_skel;
use COPE::Test::Test3_skel;

use COPE::Test::Test2_impl;

# interface Test3 (IDL:smop.org/Test/Test3:1.0)
package Test::Test3_impl;
use COPE::CORBA::Servant
@Test::Test3_impl::ISA=qw(Test::Test2_impl CORBA::BOA::_Servant);
sub _skelname($) { 'Test::Test3_skel' }

# operation check3 (IDL:smop.org/Test/Test3/check3:1.0)

sub check3 ($) {
    my($self) = @_;
    'herring';
}

# operation get_test4

sub get_test4 ($) {
    Test::Test4_impl->new();
}

# operation get_forwarder (IDL:smop.org/Test/Test3/get_forwarder:1.0)

sub get_forwarder ($$) {
    my($self,$target) = @_;

    # Make a Forwarder object to be returned (see end of this file).

    my $ret = {};
    $ret->{'fwd_to'} = $target;
    bless $ret, 'Forwarder';
    $CORBA::BOA::_The_Boa->activate_object($ret);
    return $ret;
}

# This is used for testing the GIOP Location Forward message.
# Calls to the anattr attribute function throw a ForwardException
# and that causes the BOA to send a message to forward the invocation.

package Forwarder;

use Exception::Class::TCF;
use COPE::CORBA::Exception;
@Forwarder::ISA = qw(Test::Test3_impl);
sub _skelname($) { 'Forwarder_skel' }

sub anattr ($;$) {
    my($self,$newval) = @_;

    throw(bless($self->{'fwd_to'}, 'CORBA::ForwardRequest'));
}

# Forwarder objects need a skeleton to be activated in the BOA

package Forwarder_skel;
use base qw(Test::Test3_skel);
$Forwarder_skel::_interface = $Test::Test3_skel::_interface;
1;