#!/opt/perl/bin/perl -w
#
# $Id: naming.t,v 1.6 1997/07/31 11:04:00 schuller Exp $
# Copyright (c) 1997 Lunatech Research / Bart Schuller <schuller@lunatech.com>
# See the file "Artistic" in the distribution for licensing and
# (lack of) warranties.
use Carp;
BEGIN { $SIG{__WARN__} = $SIG{__DIE__} = sub { confess @_ } }
use strict;
use lib 't';
use COPE::CORBA::ORB;
use COPE::CosNaming;
use COPE::LName;
use COPE::CORBA::Exception;
use IO::Handle;
use Config;
$| = 1;
my $orb = CORBA::ORB_init();
my $includes = join(' ', map {"-I$_"} @INC);
my $nameserver = "$Config{perlpath} $includes bin/cope-ns --ior";
# my $nameserver = "nsserv --ior";
my $serverfh = new IO::Handle;
my $pid = open($serverfh, '-|');
if (!$pid) {
exec $nameserver;
die "exec failed: $!";
}
my $nsref = <$serverfh>;
chomp $nsref;
END {
kill 'TERM', $pid;
$serverfh->close;
exit 0;
}
my $obj = $orb->string_to_object($nsref);
my $ns = CosNaming::NamingContext->_narrow($obj);
my $testnum = 1;
sub test ($) {
my($condition) = @_;
if (!$condition) {
print "not ";
}
print "ok ", $testnum++, "\n";
}
BEGIN { print "1..6\n" }
my $name = [ CosNaming::NameComponent->new('id' => 'lunatech.com', 'kind' => '') ];
my $lnc = new LNameComponent;
$lnc->id('lunatech.com');
$lnc->kind('');
my $ln = new LName;
$ln->insert_component(1, $lnc);
my $ln2 = LName->new;
$ln2->from_idl_form($name);
# 1
test($ln->equal($ln2));
my $ctx = $ns->bind_new_context($name);
# 2
test($ctx);
my $bindinglist = [];
my $iterator;
$ns->list(4, $bindinglist, \$iterator);
# 3
test($bindinglist->[0]{binding_name}[0]{id} eq 'lunatech.com');
$ln = new LName;
$ln->insert_component(1, $lnc);
$lnc->id('NamingService');
$ln->insert_component(2, $lnc);
$name = $ln->to_idl_form;
# 4
test($name->[0]{id} eq 'lunatech.com');
$ns->bind($name, $ns);
$ctx->list(4, $bindinglist, \$iterator);
# 5
test($bindinglist->[0]{binding_name}[0]{id} eq 'NamingService');
my $ns2;
try {
$ns2 = $ctx->resolve([$lnc]);
} catch 'CosNaming::NamingContext::NotFound' => sub {
print "why => $_[0]->{why}\n";
print "rest_of_name => $_[0]->{rest_of_name}[0]{id}\n";
};
# 6
test($ns2);