1256a93a4Safresh1# -*- mode: perl; -*- 2256a93a4Safresh1 3256a93a4Safresh1package Math::BigRat::Trace; 4256a93a4Safresh1 5256a93a4Safresh1use strict; 6256a93a4Safresh1use warnings; 7256a93a4Safresh1 8256a93a4Safresh1use Exporter; 9256a93a4Safresh1use Math::BigRat; 10256a93a4Safresh1 11256a93a4Safresh1our @ISA = qw(Exporter Math::BigRat); 12256a93a4Safresh1 13*5486feefSafresh1our $VERSION = '0.67'; 14256a93a4Safresh1 15256a93a4Safresh1use overload; # inherit overload from Math::BigRat 16256a93a4Safresh1 17256a93a4Safresh1# Globals 18256a93a4Safresh1our $accuracy = undef; 19256a93a4Safresh1our $precision = undef; 20256a93a4Safresh1our $round_mode = 'even'; 21256a93a4Safresh1our $div_scale = 40; 22256a93a4Safresh1 23256a93a4Safresh1sub new { 24256a93a4Safresh1 my $proto = shift; 25256a93a4Safresh1 my $class = ref($proto) || $proto; 26256a93a4Safresh1 27256a93a4Safresh1 my $value = shift; 28256a93a4Safresh1 29256a93a4Safresh1 my $a = $accuracy; 30256a93a4Safresh1 $a = $_[0] if defined $_[0]; 31256a93a4Safresh1 32256a93a4Safresh1 my $p = $precision; 33256a93a4Safresh1 $p = $_[1] if defined $_[1]; 34256a93a4Safresh1 35256a93a4Safresh1 my $self = $class -> SUPER::new($value, $a, $p, $round_mode); 36256a93a4Safresh1 37256a93a4Safresh1 printf "Math::BigRat new '%s' => '%s' (%s)\n", 38256a93a4Safresh1 $value, $self, ref($self); 39256a93a4Safresh1 40256a93a4Safresh1 return $self; 41256a93a4Safresh1} 42256a93a4Safresh1 43256a93a4Safresh1sub import { 44256a93a4Safresh1 my $class = shift; 45256a93a4Safresh1 46256a93a4Safresh1 printf "%s -> import(%s)\n", $class, join(", ", @_); 47256a93a4Safresh1 48256a93a4Safresh1 # we catch the constants, the rest goes to parent 49256a93a4Safresh1 50256a93a4Safresh1 my $constant = grep { $_ eq ':constant' } @_; 51256a93a4Safresh1 my @a = grep { $_ ne ':constant' } @_; 52256a93a4Safresh1 53256a93a4Safresh1 if ($constant) { 54256a93a4Safresh1 overload::constant 55256a93a4Safresh1 56256a93a4Safresh1 integer => sub { 57256a93a4Safresh1 $class -> new(shift); 58256a93a4Safresh1 }, 59256a93a4Safresh1 60256a93a4Safresh1 float => sub { 61256a93a4Safresh1 $class -> new(shift); 62256a93a4Safresh1 }, 63256a93a4Safresh1 64256a93a4Safresh1 binary => sub { 65256a93a4Safresh1 # E.g., a literal 0377 shall result in an object whose value 66256a93a4Safresh1 # is decimal 255, but new("0377") returns decimal 377. 67256a93a4Safresh1 return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/; 68256a93a4Safresh1 $class -> new(shift); 69256a93a4Safresh1 }; 70256a93a4Safresh1 } 71256a93a4Safresh1 72256a93a4Safresh1 $class -> SUPER::import(@a); # need it for subclasses 73256a93a4Safresh1 #$self -> export_to_level(1, $class, @_); # need this ? 74256a93a4Safresh1} 75256a93a4Safresh1 76256a93a4Safresh11; 77