bigrat.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

#
# "Tax the rat farms." - Lord Vetinari
#

# The following hash values are used:
#   sign : +,-,NaN,+inf,-inf
#   _d   : denominator
#   _n   : numeraotr (value = _n/_d)
#   _a   : accuracy
#   _p   : precision
# You should not look at the innards of a BigRat - use the methods for this.

package Math::BigRat;

# anythig older is untested, and unlikely to work
use 5.006;
use strict;

use Math::BigFloat;
use vars qw($VERSION @ISA $upgrade $downgrade
            $accuracy $precision $round_mode $div_scale $_trap_nan $_trap_inf);

@ISA = qw(Math::BigFloat);

$VERSION = '0.21';

use overload;			# inherit overload from Math::BigFloat

BEGIN
  { 
  *objectify = \&Math::BigInt::objectify; 	# inherit this from BigInt
  *AUTOLOAD = \&Math::BigFloat::AUTOLOAD;	# can't inherit AUTOLOAD
  # we inherit these from BigFloat because currently it is not possible
  # that MBF has a different $MBI variable than we, because MBF also uses
  # Math::BigInt::config->('lib'); (there is always only one library loaded)
  *_e_add = \&Math::BigFloat::_e_add;
  *_e_sub = \&Math::BigFloat::_e_sub;
  *as_int = \&as_number;
  *is_pos = \&is_positive;
  *is_neg = \&is_negative;
  }

##############################################################################
# Global constants and flags. Access these only via the accessor methods!

$accuracy = $precision = undef;
$round_mode = 'even';
$div_scale = 40;
$upgrade = undef;
$downgrade = undef;

# These are internally, and not to be used from the outside at all!

$_trap_nan = 0;                         # are NaNs ok? set w/ config()
$_trap_inf = 0;                         # are infs ok? set w/ config()

# the package we are using for our private parts, defaults to:
# Math::BigInt->config()->{lib}
my $MBI = 'Math::BigInt::Calc';

my $nan = 'NaN';
my $class = 'Math::BigRat';

sub isa
  {
  return 0 if $_[1] =~ /^Math::Big(Int|Float)/;		# we aren't
  UNIVERSAL::isa(@_);
  }

##############################################################################

sub _new_from_float
  {
  # turn a single float input into a rational number (like '0.1')
  my ($self,$f) = @_;

  return $self->bnan() if $f->is_nan();
  return $self->binf($f->{sign}) if $f->{sign} =~ /^[+-]inf$/;

  $self->{_n} = $MBI->_copy( $f->{_m} );	# mantissa
  $self->{_d} = $MBI->_one();
  $self->{sign} = $f->{sign} || '+';
  if ($f->{_es} eq '-')
    {
    # something like Math::BigRat->new('0.1');
    # 1 / 1 => 1/10
    $MBI->_lsft ( $self->{_d}, $f->{_e} ,10);	
    }
  else
    {
    # something like Math::BigRat->new('10');
    # 1 / 1 => 10/1
    $MBI->_lsft ( $self->{_n}, $f->{_e} ,10) unless 
      $MBI->_is_zero($f->{_e});	
    }
  $self;
  }

sub new
  {
  # create a Math::BigRat
  my $class = shift;

  my ($n,$d) = @_;

  my $self = { }; bless $self,$class;
 
  # input like (BigInt) or (BigFloat):
  if ((!defined $d) && (ref $n) && (!$n->isa('Math::BigRat')))
    {
    if ($n->isa('Math::BigFloat'))
      {
      $self->_new_from_float($n);
      }
    if ($n->isa('Math::BigInt'))
      {
      # TODO: trap NaN, inf
      $self->{_n} = $MBI->_copy($n->{value});		# "mantissa" = N
      $self->{_d} = $MBI->_one();			# d => 1
      $self->{sign} = $n->{sign};
      }
    if ($n->isa('Math::BigInt::Lite'))
      {
      # TODO: trap NaN, inf
      $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
      $self->{_n} = $MBI->_new(abs($$n));		# "mantissa" = N
      $self->{_d} = $MBI->_one();			# d => 1
      }
    return $self->bnorm();				# normalize (120/1 => 12/10)
    }

  # input like (BigInt,BigInt) or (BigLite,BigLite):
  if (ref($d) && ref($n))
    {
    # do N first (for $self->{sign}):
    if ($n->isa('Math::BigInt'))
      {
      # TODO: trap NaN, inf
      $self->{_n} = $MBI->_copy($n->{value});		# "mantissa" = N
      $self->{sign} = $n->{sign};
      }
    elsif ($n->isa('Math::BigInt::Lite'))
      {
      # TODO: trap NaN, inf
      $self->{sign} = '+'; $self->{sign} = '-' if $$n < 0;
      $self->{_n} = $MBI->_new(abs($$n));		# "mantissa" = $n
      }
    else
      {
      require Carp;
      Carp::croak(ref($n) . " is not a recognized object format for Math::BigRat->new");
      }
    # now D:
    if ($d->isa('Math::BigInt'))
      {
      # TODO: trap NaN, inf
      $self->{_d} = $MBI->_copy($d->{value});		# "mantissa" = D
      # +/+ or -/- => +, +/- or -/+ => -
      $self->{sign} = $d->{sign} ne $self->{sign} ? '-' : '+';
      }
    elsif ($d->isa('Math::BigInt::Lite'))
      {
      # TODO: trap NaN, inf
      $self->{_d} = $MBI->_new(abs($$d));		# "mantissa" = D
      my $ds = '+'; $ds = '-' if $$d < 0;
      # +/+ or -/- => +, +/- or -/+ => -
      $self->{sign} = $ds ne $self->{sign} ? '-' : '+';
      }
    else
      {
      require Carp;
      Carp::croak(ref($d) . " is not a recognized object format for Math::BigRat->new");
      }
    return $self->bnorm();				# normalize (120/1 => 12/10)
    }
  return $n->copy() if ref $n;				# already a BigRat

  if (!defined $n)
    {
    $self->{_n} = $MBI->_zero();			# undef => 0
    $self->{_d} = $MBI->_one();
    $self->{sign} = '+';
    return $self;
    }

  # string input with / delimiter
  if ($n =~ /\s*\/\s*/)
    {
    return $class->bnan() if $n =~ /\/.*\//;	# 1/2/3 isn't valid
    return $class->bnan() if $n =~ /\/\s*$/;	# 1/ isn't valid
    ($n,$d) = split (/\//,$n);
    # try as BigFloats first
    if (($n =~ /[\.eE]/) || ($d =~ /[\.eE]/))
      {
      local $Math::BigFloat::accuracy = undef;
      local $Math::BigFloat::precision = undef;

      # one of them looks like a float 
      my $nf = Math::BigFloat->new($n,undef,undef);
      $self->{sign} = '+';
      return $self->bnan() if $nf->is_nan();

      $self->{_n} = $MBI->_copy( $nf->{_m} );	# get mantissa

      # now correct $self->{_n} due to $n
      my $f = Math::BigFloat->new($d,undef,undef);
      return $self->bnan() if $f->is_nan();
      $self->{_d} = $MBI->_copy( $f->{_m} );

      # calculate the difference between nE and dE
      my $diff_e = $nf->exponent()->bsub( $f->exponent);
      if ($diff_e->is_negative())
	{
        # < 0: mul d with it
        $MBI->_lsft( $self->{_d}, $MBI->_new( $diff_e->babs()), 10);
	}
      elsif (!$diff_e->is_zero())
        {
        # > 0: mul n with it
        $MBI->_lsft( $self->{_n}, $MBI->_new( $diff_e), 10);
        }
      }
    else
      {
      # both d and n look like (big)ints

      $self->{sign} = '+';					# no sign => '+'
      $self->{_n} = undef;
      $self->{_d} = undef;
      if ($n =~ /^([+-]?)0*([0-9]+)\z/)				# first part ok?
	{
	$self->{sign} = $1 || '+';				# no sign => '+'
	$self->{_n} = $MBI->_new($2 || 0);
        }

      if ($d =~ /^([+-]?)0*([0-9]+)\z/)				# second part ok?
	{
	$self->{sign} =~ tr/+-/-+/ if ($1 || '') eq '-';	# negate if second part neg.
	$self->{_d} = $MBI->_new($2 || 0);
        }

      if (!defined $self->{_n} || !defined $self->{_d})
	{
        $d = Math::BigInt->new($d,undef,undef) unless ref $d;
        $n = Math::BigInt->new($n,undef,undef) unless ref $n;

        if ($n->{sign} =~ /^[+-]$/ && $d->{sign} =~ /^[+-]$/)
	  { 
	  # both parts are ok as integers (wierd things like ' 1e0'
          $self->{_n} = $MBI->_copy($n->{value});
          $self->{_d} = $MBI->_copy($d->{value});
          $self->{sign} = $n->{sign};
          $self->{sign} =~ tr/+-/-+/ if $d->{sign} eq '-';	# -1/-2 => 1/2
          return $self->bnorm();
	  }

        $self->{sign} = '+';					# a default sign
        return $self->bnan() if $n->is_nan() || $d->is_nan();

	# handle inf cases:
        if ($n->is_inf() || $d->is_inf())
	  {
	  if ($n->is_inf())
	    {
	    return $self->bnan() if $d->is_inf();		# both are inf => NaN
	    my $s = '+'; 		# '+inf/+123' or '-inf/-123'
	    $s = '-' if substr($n->{sign},0,1) ne $d->{sign};
	    # +-inf/123 => +-inf
	    return $self->binf($s);
	    }
          # 123/inf => 0
          return $self->bzero();
	  }
	}
      }

    return $self->bnorm();
    }

  # simple string input
  if (($n =~ /[\.eE]/))
    {
    # looks like a float, quacks like a float, so probably is a float
    $self->{sign} = 'NaN';
    local $Math::BigFloat::accuracy = undef;
    local $Math::BigFloat::precision = undef;
    $self->_new_from_float(Math::BigFloat->new($n,undef,undef));
    }
  else
    {
    # for simple forms, use $MBI directly
    if ($n =~ /^([+-]?)0*([0-9]+)\z/)
      {
      $self->{sign} = $1 || '+';
      $self->{_n} = $MBI->_new($2 || 0);
      $self->{_d} = $MBI->_one();
      }
    else
      {
      my $n = Math::BigInt->new($n,undef,undef);
      $self->{_n} = $MBI->_copy($n->{value});
      $self->{_d} = $MBI->_one();
      $self->{sign} = $n->{sign};
      return $self->bnan() if $self->{sign} eq 'NaN';
      return $self->binf($self->{sign}) if $self->{sign} =~ /^[+-]inf$/;
      }
    }
  $self->bnorm();
  }

sub copy
  {
  # if two arguments, the first one is the class to "swallow" subclasses
  my ($c,$x) = @_;

  if (scalar @_ == 1)
    {
    $x = $_[0];
    $c = ref($x);
    }
  return unless ref($x); # only for objects

  my $self = bless {}, $c;

  $self->{sign} = $x->{sign};
  $self->{_d} = $MBI->_copy($x->{_d});
  $self->{_n} = $MBI->_copy($x->{_n});
  $self->{_a} = $x->{_a} if defined $x->{_a};
  $self->{_p} = $x->{_p} if defined $x->{_p};
  $self;
  }

##############################################################################

sub config
  {
  # return (later set?) configuration data as hash ref
  my $class = shift || 'Math::BigRat';

  if (@_ == 1 && ref($_[0]) ne 'HASH')
    {
    my $cfg = $class->SUPER::config();
    return $cfg->{$_[0]};
    }

  my $cfg = $class->SUPER::config(@_);

  # now we need only to override the ones that are different from our parent
  $cfg->{class} = $class;
  $cfg->{with} = $MBI;
  $cfg;
  }

##############################################################################

sub bstr
  {
  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  if ($x->{sign} !~ /^[+-]$/)		# inf, NaN etc
    {
    my $s = $x->{sign}; $s =~ s/^\+//; 	# +inf => inf
    return $s;
    }

  my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';	# '+3/2' => '3/2'

  return $s . $MBI->_str($x->{_n}) if $MBI->_is_one($x->{_d});
  $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
  }

sub bsstr
  {
  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  if ($x->{sign} !~ /^[+-]$/)		# inf, NaN etc
    {
    my $s = $x->{sign}; $s =~ s/^\+//; 	# +inf => inf
    return $s;
    }
  
  my $s = ''; $s = $x->{sign} if $x->{sign} ne '+';	# +3 vs 3
  $s . $MBI->_str($x->{_n}) . '/' . $MBI->_str($x->{_d});
  }

sub bnorm
  {
  # reduce the number to the shortest form
  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  # Both parts must be objects of whatever we are using today.
  if ( my $c = $MBI->_check($x->{_n}) )
    {
    require Carp; Carp::croak ("n did not pass the self-check ($c) in bnorm()");
    }
  if ( my $c = $MBI->_check($x->{_d}) )
    {
    require Carp; Carp::croak ("d did not pass the self-check ($c) in bnorm()");
    }

  # no normalize for NaN, inf etc.
  return $x if $x->{sign} !~ /^[+-]$/;

  # normalize zeros to 0/1
  if ($MBI->_is_zero($x->{_n}))
    {
    $x->{sign} = '+';					# never leave a -0
    $x->{_d} = $MBI->_one() unless $MBI->_is_one($x->{_d});
    return $x;
    }

  return $x if $MBI->_is_one($x->{_d});			# no need to reduce

  # reduce other numbers
  my $gcd = $MBI->_copy($x->{_n});
  $gcd = $MBI->_gcd($gcd,$x->{_d});
  
  if (!$MBI->_is_one($gcd))
    {
    $x->{_n} = $MBI->_div($x->{_n},$gcd);
    $x->{_d} = $MBI->_div($x->{_d},$gcd);
    }
  $x;
  }

##############################################################################
# sign manipulation

sub bneg
  {
  # (BRAT or num_str) return BRAT
  # negate number or make a negated number from string
  my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_);

  return $x if $x->modify('bneg');

  # for +0 dont negate (to have always normalized +0). Does nothing for 'NaN'
  $x->{sign} =~ tr/+-/-+/ unless ($x->{sign} eq '+' && $MBI->_is_zero($x->{_n}));
  $x;
  }

##############################################################################
# special values

sub _bnan
  {
  # used by parent class bnan() to initialize number to NaN
  my $self = shift;

  if ($_trap_nan)
    {
    require Carp;
    my $class = ref($self);
    # "$self" below will stringify the object, this blows up if $self is a
    # partial object (happens under trap_nan), so fix it beforehand
    $self->{_d} = $MBI->_zero() unless defined $self->{_d};
    $self->{_n} = $MBI->_zero() unless defined $self->{_n};
    Carp::croak ("Tried to set $self to NaN in $class\::_bnan()");
    }
  $self->{_n} = $MBI->_zero();
  $self->{_d} = $MBI->_zero();
  }

sub _binf
  {
  # used by parent class bone() to initialize number to +inf/-inf
  my $self = shift;

  if ($_trap_inf)
    {
    require Carp;
    my $class = ref($self);
    # "$self" below will stringify the object, this blows up if $self is a
    # partial object (happens under trap_nan), so fix it beforehand
    $self->{_d} = $MBI->_zero() unless defined $self->{_d};
    $self->{_n} = $MBI->_zero() unless defined $self->{_n};
    Carp::croak ("Tried to set $self to inf in $class\::_binf()");
    }
  $self->{_n} = $MBI->_zero();
  $self->{_d} = $MBI->_zero();
  }

sub _bone
  {
  # used by parent class bone() to initialize number to +1/-1
  my $self = shift;
  $self->{_n} = $MBI->_one();
  $self->{_d} = $MBI->_one();
  }

sub _bzero
  {
  # used by parent class bzero() to initialize number to 0