# $Id: Servant.pm 1354 2006-06-14 00:27:26Z rvosa $
# Subversion: $Rev: 117 $

# Copyright (c) 1997 Secure Computing Corporation
# See the file "Artistic" in the distribution for licensing and
# (lack of) warranties.
use strict;
use Log::Log4perl;
use COPE::CORBA::ORB;
Log::Log4perl::init( COPE::CORBA::ORB->LOGPERLCONF );

package CORBA::BOA::_Servant;
use COPE::CORBA::BOA;

my $logger = Log::Log4perl::get_logger('CORBA.BOA._Servant');

=pod

=begin testing

ok( CORBA::BOA::_Servant->new, "Testing CORBA::BOA::_Servant constructor" );

=end testing

=cut

# A function like this one used to be generated identically by idl2perl
# for every implementation.
sub new {
    $logger->info("Creating \"CORBA::BOA::_Servant\" object");
    my $class = shift;
    my $self  = {@_};
    bless $self, $class;
    $CORBA::BOA::_The_Boa->activate_object($self);
    return $self;
}

=pod

=begin testing

ok( CORBA::BOA::_Servant->_nil, "Testing CORBA::BOA::_Servant _nil method" );

=end testing

=cut

sub _nil {
    $logger->debug("Returning 0");
    return 0;
}

=pod

=begin testing

ok( CORBA::BOA::_Servant->_interface, "Testing CORBA::BOA::_Servant _interface method" );

=end testing

=cut

sub _interface {
    $logger->debug("Returning servant's interface");
    $_[0]->_skelname()->_interface();
}

=pod

=begin testing

ok( CORBA::BOA::_Servant->_skelname, "Testing CORBA::BOA::_Servant _skelname method" );

=end testing

=cut

# Servers should never create a bare servant object - they must always
# work with subclasses
sub _skelname {
    my $self = shift;
    $logger->fatal("Attempt to get skeleton name of _Servant ($self). Probably a missing _skelname() method in class " . ref($self));
    die
"Attempt to get skeleton name of _Servant ($self).\nProbably a missing _skelname() method in class "
      . ref($self) . "\n";
}

=pod

=begin testing

ok( CORBA::BOA::_Servant->is_nil, "Testing CORBA::BOA::_Servant is_nil method" );

=end testing

=cut

sub is_nil {
    $logger->info("Returning is_nil");
    my ($self) = @_;
    return !( $self && ref($self) );
}

=pod

=begin testing

ok( CORBA::BOA::_Servant->_ior, "Testing CORBA::BOA::_Servant _ior method" );

=end testing

=cut

sub _ior {
    $logger->debug("Returning IOR");
    my $self = shift;

    # Find the skel for this object and ask it for its ior
    my $boa = $CORBA::BOA::_The_Boa;
    my $obj = $boa->{'__current_client'}->{'skeletons'}{$self};
    if ( !defined($obj) ) {

        # Look in other client's lists of objects
        #
        # This is some hanky-panky with another objects'
        # private variables, and should really be done in
        # the BOA object, not here.
        ( undef, $obj ) = CORBA::BOA::_find_obj_by_id( $self, 'skeletons' );
        if ($obj) {

            # Found it, add it to our list
            $boa->{'__current_client'}->{'objects'}{ $obj->{id} } = $obj;
            $boa->{'__current_client'}->{'skeletons'}{$self} = $obj;
        }
        else {
            return undef;
        }
    }
    return $obj->_ior;
}

=pod

=begin testing

ok( CORBA::BOA::_Servant->_client, "Testing CORBA::BOA::_Servant _client method" );

=end testing

=cut

# Get the client object associated with the current request
sub _client {
    $logger->debug("Retrieving client for request");
    my $self = shift;
    return $CORBA::BOA::_The_Boa->{'__current_client'};
}

=pod

=begin testing

ok( CORBA::BOA::_Servant->new_reference, "Testing CORBA::BOA::_Servant new_reference method" );

=end testing

=cut

# Class function create new references.
sub new_reference {
    $logger->info("Creating reference from ID");
    my ( $class, $id ) = @_;
    $CORBA::BOA::_The_Boa->create_reference_with_id( $id, $class->_interface );
}
1;

__END__

=head1 NAME

CORBA::BOA::_Servant

A class to ...

=head1 SYNOPSIS

use CORBA::BOA::_Servant;

=head1 DESCRIPTION

The CORBA::BOA::_Servant class implements ...

=head1 OPTIONS

 -D            - show debugging information
 -h            - show help
 -v            - show version
 Other options ...

=head1 SUBROUTINES

=head2 new (constructor)

Parameters:
    class

Insert description of constructor here...

=head2 _nil

Parameters:
    none

Insert description of subroutine here...

=head2 _interface (method)

Parameters:
    none

Arguments:
    $_[0]

Insert description of method here...

=head2 _skelname (method)

Parameters:
    none

Insert description of method here...

=head2 is_nil (method)

Parameters:
    none

Insert description of method here...

=head2 _ior (method)

Parameters:
    none

Insert description of method here...

=head2 _client (method)

Parameters:
    none

Insert description of method here...

=head2 new_reference

Parameters:
    class
    id

Insert description of subroutine here...

=head1 FILES

Files used by the CORBA::BOA::_Servant class ...

=head1 SEE ALSO

Related information ...

=head1 WARNINGS

...

=head1 NOTES

...

=head1 BUGS

What?

=cut