CORBA::omniORB - Perl module implementing CORBA 2.x via omniORB

  use CORBA:::omniORB ids => [ 'IDL:Account/Account:1.0' => undef,
                               'IDL:Account/Counter:1.0' => undef ];

package CORBA::omniORB;

use strict;
no strict qw(refs);
use vars qw($VERSION @ISA);

require DynaLoader;
require Error;

require CORBA::omniORB::Fixed;
require CORBA::omniORB::LongLong;
require CORBA::omniORB::ULongLong;
require CORBA::omniORB::LongDouble;

@ISA = qw(DynaLoader);

$VERSION = '0.9';

bootstrap CORBA::omniORB $VERSION;

sub import {
    my $pkg = shift;

    my %keys = @_;

    if (exists $keys{ids}) {
	my $orb = CORBA::ORB_init ("omniORB4");

	my @ids = @{$keys{ids}};
	while (@ids) {
	    my ($id, $idlfile) = splice(@ids, 0, 2);

	    eval { $orb->preload($id); };
	    if( $@ ) {
		require Carp;
		Carp::carp("Could not preload '$id'");
	    }
	}
    }

    if (exists $keys{'wait'}) {
	CORBA::omniORB::debug_wait();
    }

}

END {
    foreach my $repoid (keys %CORBA::omniORB::_interfaces) {
	CORBA::omniORB::clear_interface($repoid);
    }
    my $orb = CORBA::ORB_init ("omniORB4");
    $orb->destroy();
}

package CORBA::Object;

use Carp;

use vars qw($AUTOLOAD);
sub AUTOLOAD {
    my ($self, @rest) = @_;

    my ($method) = $AUTOLOAD =~ /.*::([^:]+)/;

    # Don't try to autoload DESTROY methods - for efficiency

    if ($method eq 'DESTROY') {
	return 1;
    }

    my $id = $self->_repoid;
    if (!defined $id || $id eq '') {
	croak "Can't locate object method $method"
	    . " for object with no repository ID";
    }

    my $newclass = CORBA::omniORB::find_interface ($id);

    if (!defined $newclass) {
	my $iface = $self->_get_interface;
	defined $iface || croak "Can't get interface '$id'\n";
	$newclass = CORBA::omniORB::load_interface ($iface);
    }

    defined $newclass or die "Can't get interface information";

    my ($oldclass) = "$self" =~ /:*([^=]*)/;
    $oldclass ne $newclass or
	croak qq(Can\'t locate object method "$method" via package "$oldclass");

    bless $self, $newclass;

#       The following goto doesn't work for some reason -
#       the mark stack isn't set correctly.
#	goto &{"$ {newclass}::$ {method}"};

# This is decent, but gets the call stack wrong
    $self->$method(@rest);
}

@POA_PortableServer::ServantActivator::ISA = qw(PortableServer::ServantBase);
@POA_PortableServer::ServantLocator::ISA = qw(PortableServer::ServantBase);
@POA_PortableServer::AdapterActivator::ISA = qw(PortableServer::ServantBase);

package CORBA::Exception;

@CORBA::Exception::ISA = qw(Error);

sub stringify {
    my $self = shift;
    "Exception: ".ref($self)." ('".$self->_repoid."')";
}

sub _repoid {
    no strict qw(refs);

    my $self = shift;
    $ {ref($self)."::_repoid"};
}

package CORBA::SystemException;

sub stringify {
    my $self = shift;
    my $retval = $self->SUPER::stringify;
    $retval .= "\n    ($self->{-minor}, $self->{-status})";
    if (exists $self->{-text}) {
	$retval .= "\n   $self->{-text}";
    }
    $retval;
}

package CORBA::UserException;

sub new {
    my $pkg = shift;
    if (@_ == 1 || ref($_[0]) eq 'ARRAY') {
	$pkg->SUPER::new(@{$_[0]});
    } else {
	$pkg->SUPER::new(@_);
    }
}

package DynamicAny;

package DynamicAny::DynAny;

package DynamicAny::DynFixed;
@DynamicAny::DynFixed::ISA    = qw(DynamicAny::DynAny);
package DynamicAny::DynEnum;
@DynamicAny::DynEnum::ISA     = qw(DynamicAny::DynAny);
package DynamicAny::DynStruct;
@DynamicAny::DynStruct::ISA   = qw(DynamicAny::DynAny);
package DynamicAny::DynUnion;
@DynamicAny::DynUnion::ISA    = qw(DynamicAny::DynAny);
package DynamicAny::DynSequence;
@DynamicAny::DynSequence::ISA = qw(DynamicAny::DynAny);
package DynamicAny::DynArray;
@DynamicAny::DynArray::ISA    = qw(DynamicAny::DynAny);
package DynamicAny::DynValue;
@DynamicAny::DynArray::ISA    = qw(DynamicAny::DynAny);

package DynamicAny::DynAnyFactory;

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__