newspaint

Documenting Problems That Were Difficult To Find The Answer To

A CORBA Consumer In Perl

Lately I’ve discovered the OpalORB open source implementation of the Object Management Group (OMG) CORBA standard.

Given a set of interface definition language (IDL) files they can be compiled and the corresponding Perl classes can be used to communicate with a CORBA server.

There isn’t too much example code for this on the Internet – perhaps because the documentation for OpalORB is rather light – and perhaps because CORBA isn’t widely used these days save for some specialist applications in private industry.

Installing

Download the OpalORB tarball and extract.

You probably will need to edit Makefile and remove the spaces after the equal signs and all trailing space and comments after the variable definitions for COPY, MKDIR, DESTINATION, and TARGET.

Then, as root, run make install.

Copy your custom IDL files into /usr/local/opalORB/idl/myidl.

Compile your IDLs:

cd /usr/local/opalORB/idl/myidl
for i in *.idl; do echo ===$i===; ../idl.pl --client $i; done

Change all references to Object to MyCompany::Object:

find . -type f -name '*.pm' \
  -exec perl -i.bak \
  -pe 's{(?<=[^:A-Za-z0-9.])(Object)(?=[^:A-Za-z0-9.])}{MyCompany::$1}g' {} \;

Running Your Perl Scripts

You’ll probably want to run your Perl scripts in such as way so as they’ll find your OpalORB and custom classes. To do this prepend your Perl executable with the PERL5LIB environment variable, e.g.:

PERL5LIB=/usr/local/opalORB:/usr/local/opalORB/Naming:/usr/lodcal/opalORB/idl/myidl \
  perl script

Examples

First of all let’s solve some simple problems in Perl.

Connecting to a CORBA Server and Getting a Repository/Channel/etc

You may have a IOR reference which looks something like IOR:010000002600000049444c… (for 3 or 4 lines of hexadecimal digits). If that’s the case here is how you can get your repository or channel or whatever…

use CORBA;

# compiled from my own IDL files
use MyCompany::Repository;

sub get_repository_from_ior {
    my ( $ior ) = @_;

    my $orb = CORBA::ORB_init( +[ "MyORBInstance" ] );

    my $repositoryObject = $orb->string_to_object( $ior );
    my $repository = MyCompany::Repository::_narrow( $repositoryObject );
    return( $orb, $repository );
}

Or alternatively if you have a corbaloc string you could use the following function:

use CORBA;
use CosNaming::NamingContextExt;

# compiled from my own IDL files
use MyCompany::Repository;

sub get_repository_from_iiop_and_path {
    my ( $corbaloc, $path ) = @_;

    my $orb = CORBA::ORB_init( +[ "-ORBInitRef", "MyServiceID=$corbaloc" ] );

    my $namingContextObject = $orb->resolve_initial_references('MyServiceID');
    my $namingContext = CosNaming::NamingContextExt::_narrow( $namingContextObject );

    my $name = $namingContext->to_name( $path );
    my $repositoryObject = $namingContext->resolve( $name );
    my $repository = MyCompany::Repository::_narrow( $repositoryObject );
    return( $orb, $repository );
}

Exception Handling

CORBA servers frequently express inability to perform an action through exceptions. I recommend explicitly including the Error CPAN module with debugging turned on so that you can produce a stacktrace pinpointing the line in your code that resulted in the triggered exception.

use Error qw(:try);
$Error::Debug = 1;

use strict;

my $orb = undef;

try {
    ( $orb, $repository ) = get_repository_from_iiop_and_path(
        "corbaloc:iiop:10.15.16.17:3900/NameService",
        "MyCompany/Repositories/MyDB"
    );

    my $version = $repository->get_version();
    my $version_string = $version->version_string;
    print( "My database version: $version_string\n" );
}
catch Error::Simple with {
    my $e = shift;
    print( STDERR "File " . $e->file . ", line " . $e->line . ": $e" );
    warn( $e->stacktrace );
}; # semi-colon MUST be here

# clean up before quitting
$orb->shutdown() if ( $orb );

POA Server

You might have need to receive events from a CORBA server. To this end you will have to run your own infinite-running thread that registers a class to receive messages.

It is VERY important that any dependent classes used in decoding received messages must be included in the script with the “use” pragma otherwise POA may generate exceptions about being unable to find the new method in the sequence or struct objects. To this end I recommend editing the CORBA/TypeCode.pm module and adding the following bold line in the _id_to_name() function during debugging so you can become aware of which classes you need to include in your main script:

return $$id_name{$id} if (defined $$id_name{$id});
warn( "Unknown id \"$id\"" );
###############################################################################

package ConsumerImpl;

# parent classes
use MyCompany::Consumer;
use PortableServer::ServantBase;

push( @ISA, 'MyCompany::Consumer', 'PortableServer::ServantBase' );

sub new {
    my $class = shift;
    my $self = $class->SUPER::new();
    return( $self );
}

sub msg_push {
    my $self = shift;

    my ( $event ) = @_;

    printf( "%s: %s\n", $event->name, join( ", ", @{$event->items} ) );
}

###############################################################################

package main;

# setting up naming context and channel
use CosNaming::NamingContextExt;
use MyCompany::Channel;

# POA and dependent classes (must be loaded to be recognised)
use PortableServer::POA;
use MyCompany::ext_event;
use MyCompany::ObjectInfo;

# pragmas
use Error qw(:try);
$Error::Debug = 1;

use strict;

sub get_channel_from_iiop_and_path {
    my ( $corbaloc, $path ) = @_;

    my $orb = CORBA::ORB_init( +[ "-ORBInitRef", "MyServiceID=$corbaloc" ] );

    my $namingContextObject = $orb->resolve_initial_references('MyServiceID');
    my $namingContext = CosNaming::NamingContextExt::_narrow( $namingContextObject );

    my $name = $namingContext->to_name( $path );
    my $object = $namingContext->resolve( $name );

    my $channel = MyCompany::Channel::_narrow( $channelObject );
    return( $orb, $channel );
}

my $orb = undef;

try {
    my $channel;

    ($orb, $channel) = get_channel_from_iiop_and_path(
        "corbaloc:iiop:10.15.16.17:3900/NameService",
        "MyCompany/Events/EventsService"
    );

    my $consumerImpl = ConsumerImpl->new();
    my $rootPOA = $orb->resolve_initial_references( "RootPOA" );
    my $poaManager = $rootPOA->the_POAManager();
    my $consumerId = $rootPOA->activate_object( $consumerImpl );
    $poaManager->activate();

    my $consumerRef = $rootPOA->id_to_reference( $consumerId );
    my $consumer = MyCompany::Consumer::_narrow( $consumerRef );

    $orb->run(); # never returns, but consumer will now receive messages
}
catch Error::Simple with {
    my $e = shift;
    print( STDERR "File " . $e->file . ", line " . $e->line . ": $e" );
    warn( $e->stacktrace );
};

# clean up before quitting
$orb->shutdown() if ( $orb );

One response to “A CORBA Consumer In Perl

  1. SamV November 7, 2014 at 2:17 am

    Reblogged this on Power to Build and commented:
    Really nice page! I was looking for some Perl script to monitor our Sybase EAServers and I stumbled on this. I am going to try these.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: