# $Id: Extra1_impl.pm 1206 2006-05-31 07:11:53Z rvosa $
# Built from automatically generated sample implementation code
# Generated on Fri Jun 25 22:56:50 1999 by idl2perl 1.22 with command:
# bin/idl2perl -impl Extra.idl

use COPE::Extra1_types;
use COPE::Extra1_skel;

# interface Extra1 (IDL:cope/Extra1:1.0)

package Extra1_impl;
use COPE::CORBA::Servant;

use Exception::Class::TCF;

@Extra1_impl::ISA=qw(CORBA::BOA::_Servant);
sub _skelname($) { 'Extra1_skel' }

# Constructor takes an optional string argument for object key.

sub new {
    my ($class, $key, %content) = @_;
    my $self = \%content;
    my $boa = $CORBA::BOA::_The_Boa;

    bless $self, $class;
    if (defined($key)) {
	$boa->activate_object_with_id($key, $self, 1);
    } else {
	$boa->activate_object($self);
    }
    return $self;
}

# operation template (IDL:cope/Extra1/template:1.0)

sub template {
    my($self,$s1,$s2) = @_;

    $self->{'second'} = $s2;
    if ($s1 eq '') {
	throw new Extra1::empty;
    }
    if ($s2 eq '') {
	throw new Extra1::empty2;
    }
}

# operation real (IDL:cope/Extra1/real:1.0)

sub real ($$$) {
    # Use the same implementaion.

    template(@_);
}

# attribute second (IDL:cope/Extra1/second:1.0)

sub second ($) {
    my ($self) = @_;

    return $self->{'second'};
}

# operation cctest

# This is used to test handling of GIOP CloseConnection messages
# by the test program proto.t.  It is not called by the base tests.

sub cctest($) {
    my($self) = @_;

    my $count = ++$self->{cctcount};
    return $count unless ($count % 3);	# Third time lucky.

    # Send a Close Connetction GIOP message.

    my $giop_hdr = "GIOP\1\0";		# Identify GIOP version 1.0
    $giop_hdr .= "\0" . chr(GIOP::CloseConnection);
    $giop_hdr .= "\0\0\0\14";		# Big-endian message length = 12.

    my $client = $CORBA::BOA::_The_Boa->{__current_client};
    $client->{_sock}->syswrite($giop_hdr, 12, 0);

    # This is very rude, but should work.  Once the connection is broken
    # we will return a value and the BOA and Client.pm code will attempt
    # to send it back.  They should fail ... silently.

    $client->_disconnect;
    0;
}

1;