# $Id: Any.pm 1354 2006-06-14 00:27:26Z rvosa $
# Subversion: $Rev: 117 $

# Copyright 1999 Giles Atkinson
# See the file "Artistic" in the distribution for licensing and
# (lack of) warranties.
use strict;
use Log::Log4perl;
use COPE::CORBA::ORB;
Log::Log4perl::init( COPE::CORBA::ORB->LOGPERLCONF );
my $logger = Log::Log4perl::get_logger('CORBA.Any');

package CORBA::Any;

=pod

=begin testing

use COPE::CORBA::Any;

ok( COPE::CORBA::Any::ANY_TC  == 0, "Testing constant ANY_TC"  );
ok( COPE::CORBA::Any::ANY_VAL == 1, "Testing constant ANY_VAL" );

=end testing

=cut

# A value of type Any is represented as a reference to a two-element array
# containing a type code reference and value.
sub ANY_TC  { $logger->debug(0); 0 }
sub ANY_VAL { $logger->debug(1); 1 }

=pod

=begin testing

ok( CORBA::Any->new->isa('CORBA::Any'), "Testing constructor for CORBA::Any" );

=end testing

=cut

# Constructor takes one or two optional initialisation values.
# If used as an object method, without arguments, it duplicates the object.
sub new {
    my $class = ref( $_[0] ) || $_[0];
    my $any;
    if ( ref( $_[1] ) eq 'CORBA::TypeCode' ) {
        $any = [ $_[1], $_[2] ];
    }
    elsif ( ref( $_[0] ) ) {
        $any = [ $_[0]->type, $_[0]->value ];
    }
    else {
        $any = [ $CORBA::_tc_null, undef ];
    }
    $logger->info("Creating \"$class\" object");
    return bless $any, $class;
}

=pod

=begin testing

ok( CORBA::Any->new->type->isa('CORBA::TypeCode'), "Checking type code for CORBA::Any" );

=end testing

=cut

# Method functions to get/set the elements.
sub type {
    my $this = $_[0];
    $logger->debug("Looking up \"any\" type code");
    my $tc   = $this->[ANY_TC];
    $this->[ANY_TC] = $_[1] if ( @_ > 1 );
    return $tc;
}

=pod

=begin testing

ok( CORBA::Any->new->value(1), "Checking value for CORBA::Any" );

=end testing

=cut

sub value {
    my $this = $_[0];
    $logger->debug("Looking up \"any\" value");
    my $val  = $this->[ANY_VAL];
    $this->[ANY_VAL] = $_[1] if ( @_ > 1 );
    return $val;
}

# Marshalling functions are in the ORB package.
package CORBA::ORB;
use subs qw(CORBA::Any::ANY_TC CORBA::Any::ANY_VAL);

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

=pod

=begin testing

ok( CORBA::ORB->_marshal_any, "Marshalling any" );

=end testing

=cut

sub _marshal_any {
    $logger->debug("Marshalling \"any\"");
    pop;    # Discard TC.
    my $data = pop;    # sic
    _marshal_typecode( @_, $data->[CORBA::Any::ANY_TC], $CORBA::_tc_TypeCode );
    _marshal_using_tc(
        @_,
        $data->[CORBA::Any::ANY_VAL],
        $data->[CORBA::Any::ANY_TC]
    );
}

=pod

=begin testing

ok( CORBA::ORB->_unmarshal_any, "Unmarshalling any" );

=end testing

=cut

sub _unmarshal_any {
    $logger->debug("Unmarshalling \"any\"");
    my $tc = CORBA::TypeCode::_unmarshal(@_);
    pop;               # Original type code
    return bless [ $tc, _unmarshal_using_tc( @_, $tc ) ], 'CORBA::Any';
}
1;

__END__

=head1 NAME

CORBA::ORB

A class to ...

=head1 SYNOPSIS

use CORBA::ORB;

=head1 DESCRIPTION

The CORBA::ORB class implements ...

=head1 OPTIONS

 -D            - show debugging information
 -h            - show help
 -v            - show version
 Other options ...

=head1 SUBROUTINES

=head2 new (constructor)

Parameters:
    none

Arguments:
    $_[0]
    $_[1]
    $_[2]

Insert description of constructor here...

=head2 type (method)

Parameters:
    none

Arguments:
    $_[0]
    $_[1]

Insert description of method here...

=head2 value (method)

Parameters:
    none

Arguments:
    $_[0]
    $_[1]

Insert description of method here...

=head2 _marshal_any

Parameters:
    none

Insert description of subroutine here...

=head2 _unmarshal_any (constructor)

Parameters:
    none

Insert description of constructor here...

=head1 FILES

Files used by the CORBA::ORB class ...

=head1 SEE ALSO

Related information ...

=head1 WARNINGS

...

=head1 NOTES

...

=head1 BUGS

What?

=cut