bignum.pm

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

package bignum;
use 5.006002;

$VERSION = '0.22';
use Exporter;
@ISA 		= qw( bigint );
@EXPORT_OK	= qw( PI e bexp bpi ); 
@EXPORT 	= qw( inf NaN ); 

use strict;
use overload;
require bigint;		# no "use" to avoid import being called

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

BEGIN 
  {
  *inf = \&bigint::inf;
  *NaN = \&bigint::NaN;
  }

# These are all alike, and thus faked by AUTOLOAD

my @faked = qw/round_mode accuracy precision div_scale/;
use vars qw/$VERSION $AUTOLOAD $_lite/;		# _lite for testsuite

sub AUTOLOAD
  {
  my $name = $AUTOLOAD;

  $name =~ s/.*:://;    # split package
  no strict 'refs';
  foreach my $n (@faked)
    {
    if ($n eq $name)
      {
      *{"bignum::$name"} = sub 
        {
        my $self = shift;
        no strict 'refs';
        if (defined $_[0])
          {
          Math::BigInt->$name($_[0]);
          return Math::BigFloat->$name($_[0]);
          }
        return Math::BigInt->$name();
        };
      return &$name;
      }
    }
 
  # delayed load of Carp and avoid recursion
  require Carp;
  Carp::croak ("Can't call bignum\-\>$name, not a valid method");
  }

sub unimport
  {
  $^H{bignum} = undef;					# no longer in effect
  overload::remove_constant('binary','','float','','integer');
  }

sub in_effect
  {
  my $level = shift || 0;
  my $hinthash = (caller($level))[10];
  $hinthash->{bignum};
  }

#############################################################################
# the following two routines are for Perl 5.9.4 or later and are lexical

sub _hex
  {
  return CORE::hex($_[0]) unless in_effect(1);
  my $i = $_[0];
  $i = '0x'.$i unless $i =~ /^0x/;
  Math::BigInt->new($i);
  }

sub _oct
  {
  return CORE::oct($_[0]) unless in_effect(1);
  my $i = $_[0];
  return Math::BigInt->from_oct($i) if $i =~ /^0[0-7]/;
  Math::BigInt->new($i);
  }

sub import 
  {
  my $self = shift;

  $^H{bignum} = 1;					# we are in effect

  my ($hex,$oct);

  # for newer Perls override hex() and oct() with a lexical version:
  if ($] > 5.009003)
    {
    $hex = \&_hex;
    $oct = \&_oct;
    }

  # some defaults
  my $lib = ''; my $lib_kind = 'try';
  my $upgrade = 'Math::BigFloat';
  my $downgrade = 'Math::BigInt';

  my @import = ( ':constant' );				# drive it w/ constant
  my @a = @_; my $l = scalar @_; my $j = 0;
  my ($ver,$trace);					# version? trace?
  my ($a,$p);						# accuracy, precision
  for ( my $i = 0; $i < $l ; $i++,$j++ )
    {
    if ($_[$i] eq 'upgrade')
      {
      # this causes upgrading
      $upgrade = $_[$i+1];		# or undef to disable
      my $s = 2; $s = 1 if @a-$j < 2;	# avoid "can not modify non-existant..."
      splice @a, $j, $s; $j -= $s; $i++;
      }
    elsif ($_[$i] eq 'downgrade')
      {
      # this causes downgrading
      $downgrade = $_[$i+1];		# or undef to disable
      my $s = 2; $s = 1 if @a-$j < 2;	# avoid "can not modify non-existant..."
      splice @a, $j, $s; $j -= $s; $i++;
      }
    elsif ($_[$i] =~ /^(l|lib|try|only)$/)
      {
      # this causes a different low lib to take care...
      $lib_kind = $1; $lib_kind = 'lib' if $lib_kind eq 'l';
      $lib = $_[$i+1] || '';
      my $s = 2; $s = 1 if @a-$j < 2;	# avoid "can not modify non-existant..."
      splice @a, $j, $s; $j -= $s; $i++;
      }
    elsif ($_[$i] =~ /^(a|accuracy)$/)
      {
      $a = $_[$i+1];
      my $s = 2; $s = 1 if @a-$j < 2;	# avoid "can not modify non-existant..."
      splice @a, $j, $s; $j -= $s; $i++;
      }
    elsif ($_[$i] =~ /^(p|precision)$/)
      {
      $p = $_[$i+1];
      my $s = 2; $s = 1 if @a-$j < 2;	# avoid "can not modify non-existant..."
      splice @a, $j, $s; $j -= $s; $i++;
      }
    elsif ($_[$i] =~ /^(v|version)$/)
      {
      $ver = 1;
      splice @a, $j, 1; $j --;
      }
    elsif ($_[$i] =~ /^(t|trace)$/)
      {
      $trace = 1;
      splice @a, $j, 1; $j --;
      }
    elsif ($_[$i] eq 'hex')
      {
      splice @a, $j, 1; $j --;
      $hex = \&bigint::_hex_global;
      }
    elsif ($_[$i] eq 'oct')
      {
      splice @a, $j, 1; $j --;
      $oct = \&bigint::_oct_global;
      }
    elsif ($_[$i] !~ /^(PI|e|bexp|bpi)\z/)
      {
      die ("unknown option $_[$i]");
      }
    }
  my $class;
  $_lite = 0;					# using M::BI::L ?
  if ($trace)
    {
    require Math::BigInt::Trace; $class = 'Math::BigInt::Trace';
    $upgrade = 'Math::BigFloat::Trace';	
    }
  else
    {
    # see if we can find Math::BigInt::Lite
    if (!defined $a && !defined $p)		# rounding won't work to well
      {
      eval 'require Math::BigInt::Lite;';
      if ($@ eq '')
        {
        @import = ( );				# :constant in Lite, not MBI
        Math::BigInt::Lite->import( ':constant' );
        $_lite= 1;				# signal okay
        }
      }
    require Math::BigInt if $_lite == 0;	# not already loaded?
    $class = 'Math::BigInt';			# regardless of MBIL or not
    }
  push @import, $lib_kind => $lib if $lib ne ''; 
  # Math::BigInt::Trace or plain Math::BigInt
  $class->import(@import, upgrade => $upgrade);

  if ($trace)
    {
    require Math::BigFloat::Trace; $class = 'Math::BigFloat::Trace';
    $downgrade = 'Math::BigInt::Trace';	
    }
  else
    {
    require Math::BigFloat; $class = 'Math::BigFloat';
    }
  $class->import(':constant','downgrade',$downgrade);

  bignum->accuracy($a) if defined $a;
  bignum->precision($p) if defined $p;
  if ($ver)
    {
    print "bignum\t\t\t v$VERSION\n";
    print "Math::BigInt::Lite\t v$Math::BigInt::Lite::VERSION\n" if $_lite;
    print "Math::BigInt\t\t v$Math::BigInt::VERSION";
    my $config = Math::BigInt->config();
    print " lib => $config->{lib} v$config->{lib_version}\n";
    print "Math::BigFloat\t\t v$Math::BigFloat::VERSION\n";
    exit;
    }

  # Take care of octal/hexadecimal constants
  overload::constant binary => sub { bigint::_binary_constant(shift) };

  # if another big* was already loaded:
  my ($package) = caller();

  no strict 'refs';
  if (!defined *{"${package}::inf"})
    {
    $self->export_to_level(1,$self,@a);           # export inf and NaN
    }
  {
    no warnings 'redefine';
    *CORE::GLOBAL::oct = $oct if $oct;
    *CORE::GLOBAL::hex = $hex if $hex;
  }
  }

sub PI () { Math::BigFloat->new('3.141592653589793238462643383279502884197'); }
sub e () { Math::BigFloat->new('2.718281828459045235360287471352662497757'); }
sub bpi ($) { Math::BigFloat::bpi(@_); }
sub bexp ($$) { my $x = Math::BigFloat->new($_[0]); $x->bexp($_[1]); }

1;

__END__

=head1 NAME

bignum - Transparent BigNumber support for Perl

=head1 SYNOPSIS

  use bignum;

  $x = 2 + 4.5,"\n";			# BigFloat 6.5
  print 2 ** 512 * 0.1,"\n";		# really is what you think it is
  print inf * inf,"\n";			# prints inf
  print NaN * 3,"\n";			# prints NaN

  {
    no bignum;
    print 2 ** 256,"\n";		# a normal Perl scalar now
  }

  # for older Perls, note that this will be global:
  use bignum qw/hex oct/;
  print hex("0x1234567890123490"),"\n";
  print oct("01234567890123490"),"\n";

=head1 DESCRIPTION

All operators (including basic math operations) are overloaded. Integer and
floating-point constants are created as proper BigInts or BigFloats,
respectively.

If you do 

        use bignum;

at the top of your script, Math::BigFloat and Math::BigInt will be loaded
and any constant number will be converted to an object (Math::BigFloat for
floats like 3.1415 and Math::BigInt for integers like 1234).

So, the following line:

        $x = 1234;

creates actually a Math::BigInt and stores a reference to in $x.
This happens transparently and behind your back, so to speak.

You can see this with the following:

        perl -Mbignum -le 'print ref(1234)'

Don't worry if it says Math::BigInt::Lite, bignum and friends will use Lite
if it is installed since it is faster for some operations. It will be
automatically upgraded to BigInt whenever necessary:

        perl -Mbignum -le 'print ref(2**255)'

This also means it is a bad idea to check for some specific package, since
the actual contents of $x might be something unexpected. Due to the
transparent way of bignum C<ref()> should not be necessary, anyway.

Since Math::BigInt and BigFloat also overload the normal math operations,
the following line will still work:

        perl -Mbignum -le 'print ref(1234+1234)'

Since numbers are actually objects, you can call all the usual methods from
BigInt/BigFloat on them. This even works to some extent on expressions:

        perl -Mbignum -le '$x = 1234; print $x->bdec()'
        perl -Mbignum -le 'print 1234->copy()->binc();'
        perl -Mbignum -le 'print 1234->copy()->binc->badd(6);'
        perl -Mbignum -le 'print +(1234)->copy()->binc()'

(Note that print doesn't do what you expect if the expression starts with
'(' hence the C<+>)

You can even chain the operations together as usual:

        perl -Mbignum -le 'print 1234->copy()->binc->badd(6);'
        1241

Under bignum (or bigint or bigrat), Perl will "upgrade" the numbers
appropriately. This means that:

        perl -Mbignum -le 'print 1234+4.5'
        1238.5

will work correctly. These mixed cases don't do always work when using
Math::BigInt or Math::BigFloat alone, or at least not in the way normal Perl
scalars work. 

If you do want to work with large integers like under C<use integer;>, try