# $Id: Exception.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.
# Modified Giles Atkinson 1998-99, tidy up and share system exception data.
# The standard CORBA exception types
# The base exception type; every CORBA exception inherits from this

use Log::Log4perl;
use COPE::CORBA::ORB;
Log::Log4perl::init( COPE::CORBA::ORB->LOGPERLCONF );

package CORBA::Exception;
use strict;
use Exception::Class::TCF;
use COPE::CORBA::TypeCode;
use COPE::CORBA::Object;
@CORBA::Exception::ISA = qw(Exception::Class::TCF);
$CORBA::Exception::_tc =
  CORBA::TypeCode::_create_exception_tc( 'IDL:omg.org/CORBA/Exception:1.0',
    'Exception', [] );
CORBA::TypeCode::_type_impl( 'IDL:omg.org/CORBA/Exception:1.0',
    'CORBA::Exception' );

# User exceptions.  All IDL defined exceptions inherit from this.
package CORBA::UserException;
@CORBA::UserException::ISA = qw(CORBA::Exception);
$CORBA::UserException::_tc =
  CORBA::TypeCode::_create_exception_tc( 'IDL:omg.org/CORBA/UserException:1.0',
    'UserException', [] );
CORBA::TypeCode::_type_impl( 'IDL:omg.org/CORBA/UserException:1.0',
    'CORBA::UserException' );

# Forwarding request exceptions are defined by CORBA 2.2 as part of the POA
# for servant managers to return a location forward response.
# To do this, re-bless the target implementation
# object reference as a COPE::ForwardException and throw it.
# This is a local exception, so it has no type code etc.
package CORBA::ForwardRequest;
@CORBA::ForwardRequest::ISA = qw(CORBA::Object Exception::Class::TCF);
$CORBA::ForwardRequest::_tc = $CORBA::Object::_tc;

# System exceptions.  These correspond to the IDL definition:
#
# module CORBA {
#   enum CompletionStatus {COMPLETED_YES, COMPLETED_NO, COMPLETED_MAYBE};
#   exception SystemException : Exception {
#   	ulong minor;		// impl. defined minor number
#   	CompletionStatus completed;
#   };
package CORBA::CompletionStatus;
$CORBA::CompletionStatus::_tc =
  CORBA::TypeCode::_create_enum_tc( 'IDL:omg.org/CORBA/CompletionStatus:1.0',
    'CompletionStatus',
    [ 'COMPLETED_YES', 'COMPLETED_NO', 'COMPLETED_MAYBE' ] );

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

=pod

=begin testing

ok( CORBA::CompletionStatus::COMPLETED_YES   == 0, "Testing COMPLETED_YES constant"   );
ok( CORBA::CompletionStatus::COMPLETED_NO    == 1, "Testing COMPLETED_NO constant"    );
ok( CORBA::CompletionStatus::COMPLETED_MAYBE == 2, "Testing COMPLETED_MAYBE constant" );

=end testing

=cut

sub COMPLETED_YES   () { $logger->debug(0); 0 }
sub COMPLETED_NO    () { $logger->debug(1); 1 }
sub COMPLETED_MAYBE () { $logger->debug(2); 2 }

# This description of exception parameters is shared by all system exceptions.
my $sysexinfo = [
    'minor'     => $CORBA::_tc_ulong,
    'completed' => $CORBA::CompletionStatus::_tc
];

package CORBA::SystemException;

@CORBA::SystemException::ISA = qw(CORBA::Exception);
$CORBA::SystemException::_tc =
  CORBA::TypeCode::_create_exception_tc(
    'IDL:omg.org/CORBA/SystemException:1.0',
    'SystemException', $sysexinfo );
CORBA::TypeCode::_type_impl( 'IDL:omg.org/CORBA/SystemException:1.0',
    'CORBA::SystemException' );

$logger = Log::Log4perl::get_logger('CORBA.SystemException');

=pod

=begin testing

ok( CORBA::SystemException->new->isa('CORBA::SystemException'), "Testing exception constructor" );

=end testing

=cut

# Make a new system exception. Arguments may include the keywords
# 'minor' and 'completed'.  Mixed argument styles will not work.
# This seems a little over-complex, but will allow a slow tidy up
# of messy code elsewhere.
sub new {
    $logger->info("Creating new exception");
    my $class = shift;
    my $self  = {
        'minor'     => 0,
        'completed' => CORBA::CompletionStatus::COMPLETED_NO
    };
    my ( $arg, $count );
    while ( $arg = shift ) {
        if ( $arg eq 'minor' ) {
            $self->{'minor'} = shift;
        }
        elsif ( $arg eq 'completed' ) {
            $self->{'completed'} = shift;
        }
        elsif ( $count++ == 0 ) {
            $self->{'minor'} = $arg;
        }
        else {
            $self->{'completed'} = $arg;
        }
    }
    return bless( $self, $class );
}

=pod

=begin testing

ok( CORBA::SystemException::makesysex('UNKNOWN'), "Testing makesysex exception factory" );

=end testing

=cut

# This subroutine is used only at initialisation to build the
# system exception packages.
sub makesysex {
    my $name = shift;
    $logger->debug("Initializing \"$name\" exception");
    my $id   = 'IDL:omg.org/CORBA/' . $name . ':1.0';
    eval <<EOT
	package CORBA::$name;
	\@CORBA::${name}::ISA = qw(CORBA::SystemException);
        \$CORBA::${name}::_tc = CORBA::TypeCode::_create_exception_tc(
						'$id', '$name', \$sysexinfo);
	CORBA::TypeCode::_type_impl('$id', 'CORBA::$name');
EOT
}

# The defined CORBA system exceptions.
makesysex('UNKNOWN');
makesysex('BAD_PARAM');

#makesysex('NO_MEMORY');
#makesysex('IMP_LIMIT');
makesysex('COMM_FAILURE');
makesysex('INV_OBJREF');
makesysex('NO_PERMISSION');

#makesysex('INTERNAL');
makesysex('MARSHAL');

#makesysex('INITIALIZE');
makesysex('NO_IMPLEMENT');

#makesysex('BAD_TYPECODE');
makesysex('BAD_OPERATION');
makesysex('NO_RESOURCES');

#makesysex('NO_RESPONSE');
makesysex('PERSIST_STORE');

#makesysex('BAD_INV_ORDER');
makesysex('TRANSIENT');

#makesysex('FREE_MEM');
makesysex('INV_IDENT');

#makesysex('INV_FLAG');
#makesysex('INTF_REPOS');
#makesysex('BAD_CONTEXT');
makesysex('OBJ_ADAPTER');

#makesysex('DATA_CONVERSION');
makesysex('OBJECT_NOT_EXIST');
undef &makesysex;
1;