'+'
=> \
&add
,
'-'
=> \
&subtract
,
'*'
=> \
&mul
,
'/'
=> \
&div
,
'<=>'
=> \
&compare
,
'""'
=> \
&stringify
;
sub
_construct {
my
(
$class
,
$value
,
$scale
) =
@_
;
bless
{
v
=>
$value
,
's'
=>
$scale
,
},
$class
;
}
sub
from_string {
my
(
$class
,
$str
) =
@_
;
my
(
$leading
,
$rest
) =
$str
=~ /^(\s*[+-]?\d+)(?:\.(\d+)*)?/;
if
(!
defined
$leading
) {
return
CORBA::Fixed->_construct(0,0);
}
else
{
$rest
=
defined
$rest
?
$rest
:
""
;
$str
=
$leading
.
$rest
;
my
$n
= 0;
if
(
$str
=~ /(0+)$/) {
$n
=
length
($1);
if
(
$str
=~ /^\s*[+-]?0+$/) {
$n
--;
}
substr
(
$str
,-
$n
,
$n
) =
""
;
}
return
CORBA::Fixed->_construct (Math::BigInt->new(
$str
),
length
(
$rest
)-
$n
);
}
}
sub
new {
my
(
$class
,
$v
,
$scale
) =
@_
;
CORBA::Fixed->_construct (Math::BigInt->new(
$v
),
$scale
);
}
sub
add {
my
(
$a
,
$b
) =
@_
;
if
(!UNIVERSAL::isa(
$b
,
"CORBA::Fixed"
)) {
$b
= CORBA::Fixed->from_string(
$b
);
}
my
(
$v
,
$s
);
if
(
$a
->{
's'
} >
$b
->{
's'
}) {
$s
=
$a
->{
's'
};
$v
=
$a
->{v} + (
$b
->{v}.(
"0"
x (
$a
->{
's'
} -
$b
->{
's'
})));
}
else
{
$s
=
$b
->{
's'
};
$v
=
$b
->{v} + (
$a
->{v}.(
"0"
x (
$b
->{
's'
} -
$a
->{
's'
})));
}
CORBA::Fixed->_construct (
$v
,
$s
);
}
sub
subtract {
my
(
$a
,
$b
,
$reverse
) =
@_
;
if
(!UNIVERSAL::isa(
$b
,
"CORBA::Fixed"
)) {
$b
= CORBA::Fixed->from_string(
$b
);
}
if
(
$reverse
) {
(
$a
,
$b
) = (
$b
,
$a
);
}
my
(
$v
,
$s
);
{
local
$^W = 0;
if
(
$a
->{
's'
} >
$b
->{
's'
}) {
$s
=
$a
->{
's'
};
$v
=
$a
->{v} - (
$b
->{v}.(
"0"
x (
$a
->{
's'
} -
$b
->{
's'
})));
}
else
{
$s
=
$b
->{
's'
};
$v
= (
$a
->{v}.(
"0"
x (
$b
->{
's'
} -
$a
->{
's'
}))) -
$b
->{v};
}
}
CORBA::Fixed->_construct (
$v
,
$s
);
}
sub
compare {
my
(
$a
,
$b
,
$reverse
) =
@_
;
if
(!UNIVERSAL::isa(
$b
,
"CORBA::Fixed"
)) {
$b
= CORBA::Fixed->from_string(
$b
);
}
if
(
$reverse
) {
(
$a
,
$b
) = (
$b
,
$a
);
}
if
(
$a
->{
's'
} >
$b
->{
's'
}) {
$a
->{v} <=> (
$b
->{v}.(
"0"
x (
$a
->{
's'
} -
$b
->{
's'
})));
}
else
{
(
$a
->{v}.(
"0"
x (
$b
->{
's'
} -
$a
->{
's'
}))) <=>
$b
->{v};
}
}
sub
mul {
my
(
$a
,
$b
) =
@_
;
if
(!UNIVERSAL::isa(
$b
,
"CORBA::Fixed"
)) {
$b
= CORBA::Fixed->from_string(
$b
);
}
CORBA::Fixed->_construct (
$a
->{v}
*$b
->{v},
$a
->{
's'
}+
$b
->{
's'
});
}
sub
div {
my
(
$a
,
$b
) =
@_
;
if
(!UNIVERSAL::isa(
$b
,
"CORBA::Fixed"
)) {
$b
= CORBA::Fixed->from_string(
$b
);
}
if
(
$reverse
) {
(
$a
,
$b
) = (
$b
,
$a
);
}
my
$s
= (
$a
->{
's'
} -
$b
->{
's'
});
my
$v1
=
$a
->{v};
my
$v2
=
$b
->{v};
my
$pad
= (31 - (
length
(
$v1
) -
length
(
$v2
)));
if
(
$pad
> 0) {
$v1
= new Math::BigInt (
$v1
.(
"0"
x
$pad
));
$s
+=
$pad
;
}
{
local
$^W = 0;
CORBA::Fixed->_construct (
$v1
/
$v2
,
$s
);
}
}
sub
to_digits {
my
(
$self
,
$ndigits
,
$scale
) =
@_
;
my
$value
=
$self
->{v};
my
$vstr
=
"$value"
;
if
(
$self
->{
's'
} >
$scale
) {
my
$rest
=
substr
(
$vstr
, -(
$self
->{
's'
} -
$scale
));
substr
(
$vstr
, -(
$self
->{
's'
} -
$scale
)) =
""
;
if
(
length
(
$rest
) > 0) {
my
$half
= new Math::BigInt (
"5"
.(
'0'
x (
length
(
$rest
)-1)));
$rest
= new Math::BigInt (
$rest
);
$value
= new Math::BigInt (
$vstr
);
if
(
$rest
==
$half
) {
$vstr
=
""
. new Math::BigInt (
$value
+ ((
substr
(
$vstr
,-1) % 2) ? 1 : 0));
}
else
{
$vstr
=
""
. new Math::BigInt (
$value
+ ((
$rest
<
$half
) ? 0 : 1));
}
}
}
else
{
$vstr
.=
'0'
x (
$scale
-
$self
->{
's'
});
}
my
$len
=
length
(
$vstr
) - 1;
if
(
$len
<
$ndigits
) {
return
substr
(
$vstr
,0,1) . (
'0'
x (
$ndigits
-
$len
) ) .
substr
(
$vstr
,1);
}
else
{
return
substr
(
$vstr
,0,1) .
substr
(
$vstr
,-
$ndigits
);
}
}
sub
stringify {
my
$self
=
shift
;
my
$vstr
=
"$self->{v}"
;
my
$scale
=
$self
->{
's'
};
if
(
$scale
> 0) {
return
substr
(
$vstr
,0,
length
(
$vstr
)-
$scale
).
"."
.
substr
(
$vstr
,-
$scale
);
}
else
{
return
$vstr
. (
'0'
x -
$scale
);
}
}
1;