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

# Copyright (c) 1999
# See the file "Artistic" in the distribution for licensing and
# (lack of) warranties.
use Log::Log4perl;
use COPE::CORBA::ORB;
Log::Log4perl::init( COPE::CORBA::ORB->LOGPERLCONF );

package CORBA::ORB;
use strict;

my $logger = Log::Log4perl::get_logger('CORBA.ORB');
my $pack_str = ( $COPE::_byte_order ? 'Ll' : 'lL' );

=begin testing

ok( CORBA::ORB::_marshal_longlong, "Testing long long marshalling" );

=end testing

sub _marshal_longlong {
    $logger->debug("Marshalling long long");
    _marshal_ll_type( $pack_str, @_ );
}

=begin testing

ok( CORBA::ORB::_marshal_ulonglong, "Testing unsigned long long marshalling" );

=end testing

sub _marshal_ulonglong {
    $logger->debug("Marshalling unsigned long long");
    _marshal_ll_type( 'LL', @_ );
}

=begin testing

ok( CORBA::ORB::_marshal_ll_type, "Testing long long type marshalling" );

=end testing

sub _marshal_ll_type {
	$logger->debug("Marshalling long long type");
    my ( $fmt, $out, $index, $byte_order, $data ) = @_;
    if ( !defined($data) ) {
        $logger->fatal("CORBA::CompletionStatus::COMPLETED_MAYBE");
        CORBA::MARSHAL->new(
            'minor'     => &tk_longlong,
            'completed' => &CORBA::CompletionStatus::COMPLETED_MAYBE
        )->throw();
    }
    my $previndex = $$index;
    $$index = ( 7 + $$index ) & ~7;
    $$out .= "\0" x ( $$index - $previndex );
    {
        use Math::BigInt;
        my $bigData = Math::BigInt->new($data);
        my @bigVal  = $bigData->bdiv( 2**32 );

        # print "bdiv: @bigVal\n";
        # Unfortunately Math::BigInt::bdiv does not give consistent remainders.
        if ( $bigVal[1] < 0 ) {
            $bigVal[0] = -1;
            $bigVal[1] += 2**32;
        }
        elsif ( $bigVal[0] < 0 ) {

            # This makes no sense ... but it works.
            $bigVal[0]--;
            $bigVal[1] = 2**32 - $bigVal[1];
        }
        @bigVal = reverse(@bigVal) if $COPE::_byte_order;
        use integer;

        #print "Marshal values @bigVal = $data\n" ;
        my $rep = pack( $fmt, @bigVal );
        $rep = reverse($rep) if $byte_order xor $COPE::_byte_order;  #Redundant?
        $$out .= $rep;
    }
    $$index += 8;
}

=begin testing

ok( CORBA::ORB::_unmarshal_longlong, "Testing long long unmarshalling" );

=end testing

sub _unmarshal_longlong {
	$logger->debug("Unmarshalling long long");
    _unmarshal_ll_type( $pack_str, @_ );
}

=begin testing

ok( CORBA::ORB::_unmarshal_ulonglong, "Testing unsigned long long unmarshalling" );

=end testing

sub _unmarshal_ulonglong {
    $logger->debug("Unmarshalling unsigned long long");
    _unmarshal_ll_type( 'LL', @_ );
}

=begin testing

ok( CORBA::ORB::_unmarshal_ll_type, "Testing unsigned long long type unmarshalling" );

=end testing

sub _unmarshal_ll_type {
	$logger->debug("Unmarshalling long long type");
    my ( $fmt, $in, $index, $byte_order ) = @_;
    if ( !$$in ) {
        $logger->fatal("CORBA::CompletionStatus::COMPLETED_MAYBE");
        CORBA::MARSHAL->new(
            minor     => &tk_longlong,
            completed => &CORBA::CompletionStatus::COMPLETED_MAYBE
        )->throw();
    }
    $$index = ( 7 + $$index ) & ~7;
    my $tmp = substr( $$in, $$index, 8 );
    if ( $byte_order xor $COPE::_byte_order ) {
        $tmp = reverse($tmp);
    }
    $$index += 8;
    my @val = unpack( $fmt, $tmp );
    @val = reverse(@val) unless $COPE::_byte_order;
    use Math::BigInt;
    my $retVal = Math::BigInt->new( $val[1] );
    $retVal *= 2**32;
    $retVal += $val[0];

    #print STDERR "Unmarshalled @val = ", $retVal, "\n";
    return $retVal;
}

__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 _marshal_longlong

Parameters:
    none

Insert description of subroutine here...

=head2 _marshal_ulonglong

Parameters:
    none

Insert description of subroutine here...

=head2 _marshal_ll_type

Parameters:
    fmt
    out
    index
    byte_order
    data

Insert description of subroutine here...

=head2 _unmarshal_longlong

Parameters:
    none

Insert description of subroutine here...

=head2 _unmarshal_ulonglong

Parameters:
    none

Insert description of subroutine here...

=head2 _unmarshal_ll_type

Parameters:
    fmt
    in
    index
    byte_order

Insert description of subroutine here...

=head1 FILES

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

=head1 SEE ALSO

Related information ...

=head1 WARNINGS

...

=head1 NOTES

...

=head1 BUGS

What?

=cut