xref: /openbsd-src/gnu/usr.bin/perl/cpan/bignum/lib/Math/BigRat/Trace.pm (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33)
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