#! perl

# Getopt::Long.pm -- Universal options parsing
# Author          : Johan Vromans
# Created On      : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
# Last Modified On: Tue Aug 18 14:48:05 2020
# Update Count    : 1739
# Status          : Released

################ Module Preamble ################

use 5.004;

use strict;
use warnings;

package Getopt::Long;

use vars qw($VERSION);
$VERSION        =  2.52;
# For testing versions only.
use vars qw($VERSION_STRING);
$VERSION_STRING = "2.52";

use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK);
@ISA = qw(Exporter);

# Exported subroutines.
sub GetOptions(@);		# always
sub GetOptionsFromArray(@);	# on demand
sub GetOptionsFromString(@);	# on demand
sub Configure(@);		# on demand
sub HelpMessage(@);		# on demand
sub VersionMessage(@);		# in demand

BEGIN {
    # Init immediately so their contents can be used in the 'use vars' below.
    @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
    @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure
		    &GetOptionsFromArray &GetOptionsFromString);
}

# User visible variables.
use vars @EXPORT, @EXPORT_OK;
use vars qw($error $debug $major_version $minor_version);
# Deprecated visible variables.
use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
	    $passthrough);
# Official invisible variables.
use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);

# Really invisible variables.
my $bundling_values;

# Public subroutines.
sub config(@);			# deprecated name

# Private subroutines.
sub ConfigDefaults();
sub ParseOptionSpec($$);
sub OptCtl($);
sub FindOption($$$$$);
sub ValidValue ($$$$$);

################ Local Variables ################

# $requested_version holds the version that was mentioned in the 'use'
# or 'require', if any. It can be used to enable or disable specific
# features.
my $requested_version = 0;

################ Resident subroutines ################

sub ConfigDefaults() {
    # Handle POSIX compliancy.
    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
	$genprefix = "(--|-)";
	$autoabbrev = 0;		# no automatic abbrev of options
	$bundling = 0;			# no bundling of single letter switches
	$getopt_compat = 0;		# disallow '+' to start options
	$order = $REQUIRE_ORDER;
    }
    else {
	$genprefix = "(--|-|\\+)";
	$autoabbrev = 1;		# automatic abbrev of options
	$bundling = 0;			# bundling off by default
	$getopt_compat = 1;		# allow '+' to start options
	$order = $PERMUTE;
    }
    # Other configurable settings.
    $debug = 0;			# for debugging
    $error = 0;			# error tally
    $ignorecase = 1;		# ignore case when matching options
    $passthrough = 0;		# leave unrecognized options alone
    $gnu_compat = 0;		# require --opt=val if value is optional
    $longprefix = "(--)";       # what does a long prefix look like
    $bundling_values = 0;	# no bundling of values
}

# Override import.
sub import {
    my $pkg = shift;		# package
    my @syms = ();		# symbols to import
    my @config = ();		# configuration
    my $dest = \@syms;		# symbols first
    for ( @_ ) {
	if ( $_ eq ':config' ) {
	    $dest = \@config;	# config next
	    next;
	}
	push(@$dest, $_);	# push
    }
    # Hide one level and call super.
    local $Exporter::ExportLevel = 1;
    push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
    $requested_version = 0;
    $pkg->SUPER::import(@syms);
    # And configure.
    Configure(@config) if @config;
}

################ Initialization ################

# Values for $order. See GNU getopt.c for details.
($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
# Version major/minor numbers.
($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;

ConfigDefaults();

################ OO Interface ################

package Getopt::Long::Parser;

# Store a copy of the default configuration. Since ConfigDefaults has
# just been called, what we get from Configure is the default.
my $default_config = do {
    Getopt::Long::Configure ()
};

sub new {
    my $that = shift;
    my $class = ref($that) || $that;
    my %atts = @_;

    # Register the callers package.
    my $self = { caller_pkg => (caller)[0] };

    bless ($self, $class);

    # Process config attributes.
    if ( defined $atts{config} ) {
	my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
	$self->{settings} = Getopt::Long::Configure ($save);
	delete ($atts{config});
    }
    # Else use default config.
    else {
	$self->{settings} = $default_config;
    }

    if ( %atts ) {		# Oops
	die(__PACKAGE__.": unhandled attributes: ".
	    join(" ", sort(keys(%atts)))."\n");
    }

    $self;
}

sub configure {
    my ($self) = shift;

    # Restore settings, merge new settings in.
    my $save = Getopt::Long::Configure ($self->{settings}, @_);

    # Restore orig config and save the new config.
    $self->{settings} = Getopt::Long::Configure ($save);
}

sub getoptions {
    my ($self) = shift;

    return $self->getoptionsfromarray(\@ARGV, @_);
}

sub getoptionsfromarray {
    my ($self) = shift;

    # Restore config settings.
    my $save = Getopt::Long::Configure ($self->{settings});

    # Call main routine.
    my $ret = 0;
    $Getopt::Long::caller = $self->{caller_pkg};

    eval {
	# Locally set exception handler to default, otherwise it will
	# be called implicitly here, and again explicitly when we try
	# to deliver the messages.
	local ($SIG{__DIE__}) = 'DEFAULT';
	$ret = Getopt::Long::GetOptionsFromArray (@_);
    };

    # Restore saved settings.
    Getopt::Long::Configure ($save);

    # Handle errors and return value.
    die ($@) if $@;
    return $ret;
}

package Getopt::Long;

################ Back to Normal ################

# Indices in option control info.
# Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
use constant CTL_TYPE    => 0;
#use constant   CTL_TYPE_FLAG   => '';
#use constant   CTL_TYPE_NEG    => '!';
#use constant   CTL_TYPE_INCR   => '+';
#use constant   CTL_TYPE_INT    => 'i';
#use constant   CTL_TYPE_INTINC => 'I';
#use constant   CTL_TYPE_XINT   => 'o';
#use constant   CTL_TYPE_FLOAT  => 'f';
#use constant   CTL_TYPE_STRING => 's';

use constant CTL_CNAME   => 1;

use constant CTL_DEFAULT => 2;

use constant CTL_DEST    => 3;
 use constant   CTL_DEST_SCALAR => 0;
 use constant   CTL_DEST_ARRAY  => 1;
 use constant   CTL_DEST_HASH   => 2;
 use constant   CTL_DEST_CODE   => 3;

use constant CTL_AMIN    => 4;
use constant CTL_AMAX    => 5;

# FFU.
#use constant CTL_RANGE   => ;
#use constant CTL_REPEAT  => ;

# Rather liberal patterns to match numbers.
use constant PAT_INT   => "[-+]?_*[0-9][0-9_]*";
use constant PAT_XINT  =>
  "(?:".
	  "[-+]?_*[1-9][0-9_]*".
  "|".
	  "0x_*[0-9a-f][0-9a-f_]*".
  "|".
	  "0b_*[01][01_]*".
  "|".
	  "0[0-7_]*".
  ")";
use constant PAT_FLOAT =>
  "[-+]?".			# optional sign
  "(?=[0-9.])".			# must start with digit or dec.point
  "[0-9_]*".			# digits before the dec.point
  "(\.[0-9_]+)?".		# optional fraction
  "([eE][-+]?[0-9_]+)?";	# optional exponent

sub GetOptions(@) {
    # Shift in default array.
    unshift(@_, \@ARGV);
    # Try to keep caller() and Carp consistent.
    goto &GetOptionsFromArray;
}

sub GetOptionsFromString(@) {
    my ($string) = shift;
    require Text::ParseWords;
    my $args = [ Text::ParseWords::shellwords($string) ];
    $caller ||= (caller)[0];	# current context
    my $ret = GetOptionsFromArray($args, @_);
    return ( $ret, $args ) if wantarray;
    if ( @$args ) {
	$ret = 0;
	warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
    }
    $ret;
}

sub GetOptionsFromArray(@) {

    my ($argv, @optionlist) = @_;	# local copy of the option descriptions
    my $argend = '--';		# option list terminator
    my %opctl = ();		# table of option specs
    my $pkg = $caller || (caller)[0];	# current context
				# Needed if linkage is omitted.
    my @ret = ();		# accum for non-options
    my %linkage;		# linkage
    my $userlinkage;		# user supplied HASH
    my $opt;			# current option
    my $prefix = $genprefix;	# current prefix

    $error = '';

    if ( $debug ) {
	# Avoid some warnings if debugging.
	local ($^W) = 0;
	print STDERR
	  ("Getopt::Long $Getopt::Long::VERSION_STRING ",
	   "called from package \"$pkg\".",
	   "\n  ",
	   "argv: ",
	   defined($argv)
	   ? UNIVERSAL::isa( $argv, 'ARRAY' ) ? "(@$argv)" : $argv
	   : "<undef>",
	   "\n  ",
	   "autoabbrev=$autoabbrev,".
	   "bundling=$bundling,",
	   "bundling_values=$bundling_values,",
	   "getopt_compat=$getopt_compat,",
	   "gnu_compat=$gnu_compat,",
	   "order=$order,",
	   "\n  ",
	   "ignorecase=$ignorecase,",
	   "requested_version=$requested_version,",
	   "passthrough=$passthrough,",
	   "genprefix=\"$genprefix\",",
	   "longprefix=\"$longprefix\".",
	   "\n");
    }

    # Check for ref HASH as first argument.
    # First argument may be an object. It's OK to use this as long
    # as it is really a hash underneath.
    $userlinkage = undef;
    if ( @optionlist && ref($optionlist[0]) and
	 UNIVERSAL::isa($optionlist[0],'HASH') ) {
	$userlinkage = shift (@optionlist);
	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
    }

    # See if the first element of the optionlist contains option
    # starter characters.
    # Be careful not to interpret '<>' as option starters.
    if ( @optionlist && $optionlist[0] =~ /^\W+$/
	 && !($optionlist[0] eq '<>'
	      && @optionlist > 0
	      && ref($optionlist[1])) ) {
	$prefix = shift (@optionlist);
	# Turn into regexp. Needs to be parenthesized!
	$prefix =~ s/(\W)/\\$1/g;
	$prefix = "([" . $prefix . "])";
	print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
    }

    # Verify correctness of optionlist.
    %opctl = ();
    while ( @optionlist ) {
	my $opt = shift (@optionlist);

	unless ( defined($opt) ) {
	    $error .= "Undefined argument in option spec\n";
	    next;
	}

	# Strip leading prefix so people can specify "--foo=i" if they like.
	$opt = $+ if $opt =~ /^$prefix+(.*)$/s;

	if ( $opt eq '<>' ) {
	    if ( (defined $userlinkage)
		&& !(@optionlist > 0 && ref($optionlist[0]))
		&& (exists $userlinkage->{$opt})
		&& ref($userlinkage->{$opt}) ) {
		unshift (@optionlist, $userlinkage->{$opt});
	    }
	    unless ( @optionlist > 0
		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
		$error .= "Option spec <> requires a reference to a subroutine\n";
		# Kill the linkage (to avoid another error).
		shift (@optionlist)
		  if @optionlist && ref($optionlist[0]);
		next;
	    }
	    $linkage{'<>'} = shift (@optionlist);
	    next;
	}

	# Parse option spec.
	my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
	unless ( defined $name ) {
	    # Failed. $orig contains the error message. Sorry for the abuse.
	    $error .= $orig;
	    # Kill the linkage (to avoid another error).
	    shift (@optionlist)
	      if @optionlist && ref($optionlist[0]);
	    next;
	}

	# If no linkage is supplied in the @optionlist, copy it from
	# the userlinkage if available.
	if ( defined $userlinkage ) {
	    unless ( @optionlist > 0 && ref($optionlist[0]) ) {
		if ( exists $userlinkage->{$orig} &&
		     ref($userlinkage->{$orig}) ) {
		    print STDERR ("=> found userlinkage for \"$orig\": ",
				  "$userlinkage->{$orig}\n")
			if $debug;
		    unshift (@optionlist, $userlinkage->{$orig});
		}
		else {
		    # Do nothing. Being undefined will be handled later.
		    next;
		}
	    }
	}

	# Copy the linkage. If omitted, link to global variable.
	if ( @optionlist > 0 && ref($optionlist[0]) ) {
	    print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
		if $debug;
	    my $rl = ref($linkage{$orig} = shift (@optionlist));

	    if ( $rl eq "ARRAY" ) {
		$opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
	    }
	    elsif ( $rl eq "HASH" ) {
		$opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
	    }
	    elsif ( $rl eq "SCALAR" || $rl eq "REF" ) {
#		if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
#		    my $t = $linkage{$orig};
#		    $$t = $linkage{$orig} = [];
#		}
#		elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
#		}
#		else {
		    # Ok.
#		}
	    }
	    elsif ( $rl eq "CODE" ) {
		# Ok.
	    }
	    else {
		$error .= "Invalid option linkage for \"$opt\"\n";
	    }
	}
	else {
	    # Link to global $opt_XXX variable.
	    # Make sure a valid perl identifier results.
	    my $ov = $orig;
	    $ov =~ s/\W/_/g;
	    if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
		print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
		    if $debug;
		eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
	    }
	    elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
		print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
		    if $debug;
		eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
	    }
	    else {
		print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
		    if $debug;
		eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
	    }
	}

	if ( $opctl{$name}[CTL_TYPE] eq 'I'
	     && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY
		  || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH )
	   ) {
	    $error .= "Invalid option linkage for \"$opt\"\n";
	}

    }

    $error .= "GetOptionsFromArray: 1st parameter is not an array reference\n"
      unless $argv && UNIVERSAL::isa( $argv, 'ARRAY' );

    # Bail out if errors found.
    die ($error) if $error;
    $error = 0;

    # Supply --version and --help support, if needed and allowed.
    if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
	if ( !defined($opctl{version}) ) {
	    $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
	    $linkage{version} = \&VersionMessage;
	}
	$auto_version = 1;
    }
    if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
	if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
	    $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
	    $linkage{help} = \&HelpMessage;
	}
	$auto_help = 1;
    }

    # Show the options tables if debugging.
    if ( $debug ) {
	my ($arrow, $k, $v);
	$arrow = "=> ";
	while ( ($k,$v) = each(%opctl) ) {
	    print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
	    $arrow = "   ";
	}
    }

    # Process argument list
    my $goon = 1;
    while ( $goon && @$argv > 0 ) {

	# Get next argument.
	$opt = shift (@$argv);
	print STDERR ("=> arg \"", $opt, "\"\n") if $debug;

	# Double dash is option list terminator.
	if ( defined($opt) && $opt eq $argend ) {
	  push (@ret, $argend) if $passthrough;
	  last;
	}

	# Look it up.
	my $tryopt = $opt;
	my $found;		# success status
	my $key;		# key (if hash type)
	my $arg;		# option argument
	my $ctl;		# the opctl entry

	($found, $opt, $ctl, $arg, $key) =
	  FindOption ($argv, $prefix, $argend, $opt, \%opctl);

	if ( $found ) {

	    # FindOption undefines $opt in case of errors.
	    next unless defined $opt;

	    my $argcnt = 0;
	    while ( defined $arg ) {

		# Get the canonical name.
		my $given = $opt;
		print STDERR ("=> cname for \"$opt\" is ") if $debug;
		$opt = $ctl->[CTL_CNAME];
		print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;

		if ( defined $linkage{$opt} ) {
		    print STDERR ("=> ref(\$L{$opt}) -> ",
				  ref($linkage{$opt}), "\n") if $debug;

		    if ( ref($linkage{$opt}) eq 'SCALAR'
			 || ref($linkage{$opt}) eq 'REF' ) {
			if ( $ctl->[CTL_TYPE] eq '+' ) {
			    print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
			      if $debug;
			    if ( defined ${$linkage{$opt}} ) {
			        ${$linkage{$opt}} += $arg;
			    }
		            else {
			        ${$linkage{$opt}} = $arg;
			    }
			}
			elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
					  " to ARRAY\n")
			      if $debug;
			    my $t = $linkage{$opt};
			    $$t = $linkage{$opt} = [];
			    print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
			      if $debug;
			    push (@{$linkage{$opt}}, $arg);
			}
			elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
					  " to HASH\n")
			      if $debug;
			    my $t = $linkage{$opt};
			    $$t = $linkage{$opt} = {};
			    print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
			      if $debug;
			    $linkage{$opt}->{$key} = $arg;
			}
			else {
			    print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
			      if $debug;
			    ${$linkage{$opt}} = $arg;
		        }
		    }
		    elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
			print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
			    if $debug;
			push (@{$linkage{$opt}}, $arg);
		    }
		    elsif ( ref($linkage{$opt}) eq 'HASH' ) {
			print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
			    if $debug;
			$linkage{$opt}->{$key} = $arg;
		    }
		    elsif ( ref($linkage{$opt}) eq 'CODE' ) {
			print STDERR ("=> &L{$opt}(\"$opt\"",
				      $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
				      ", \"$arg\")\n")
			    if $debug;
			my $eval_error = do {
			    local $@;
			    local $SIG{__DIE__}  = 'DEFAULT';
			    eval {
				&{$linkage{$opt}}
				  (Getopt::Long::CallBack->new
				   (name    => $opt,
				    given   => $given,
				    ctl     => $ctl,
				    opctl   => \%opctl,
				    linkage => \%linkage,
				    prefix  => $prefix,
				   ),
				   $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
				   $arg);
			    };
			    $@;
			};
			print STDERR ("=> die($eval_error)\n")
			  if $debug && $eval_error ne '';
			if ( $eval_error =~ /^!/ ) {
			    if ( $eval_error =~ /^!FINISH\b/ ) {
				$goon = 0;
			    }
			}
			elsif ( $eval_error ne '' ) {
			    warn ($eval_error);
			    $error++;
			}
		    }
		    else {
			print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
				      "\" in linkage\n");
			die("Getopt::Long -- internal error!\n");
		    }
		}
		# No entry in linkage means entry in userlinkage.
		elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
		    if ( defined $userlinkage->{$opt} ) {
			print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
			    if $debug;
			push (@{$userlinkage->{$opt}}, $arg);
		    }
		    else {
			print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
			    if $debug;
			$userlinkage->{$opt} = [$arg];
		    }
		}
		elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
		    if ( defined $userlinkage->{$opt} ) {
			print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
			    if $debug;
			$userlinkage->{$opt}->{$key} = $arg;
		    }
		    else {
			print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
			    if $debug;
			$userlinkage->{$opt} = {$key => $arg};
		    }
		}
		else {
		    if ( $ctl->[CTL_TYPE] eq '+' ) {
			print STDERR ("=> \$L{$opt} += \"$arg\"\n")
			  if $debug;
			if ( defined $userlinkage->{$opt} ) {
			    $userlinkage->{$opt} += $arg;
			}
			else {
			    $userlinkage->{$opt} = $arg;
			}
		    }
		    else {
			print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
			$userlinkage->{$opt} = $arg;
		    }
		}

		$argcnt++;
		last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
		undef($arg);

		# Need more args?
		if ( $argcnt < $ctl->[CTL_AMIN] ) {
		    if ( @$argv ) {
			if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) {
			    $arg = shift(@$argv);
			    if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
				$arg =~ tr/_//d;
				$arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
				  ? oct($arg)
				  : 0+$arg
			    }
			    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
			      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
			    next;
			}
			warn("Value \"$$argv[0]\" invalid for option $opt\n");
			$error++;
		    }
		    else {
			warn("Insufficient arguments for option $opt\n");
			$error++;
		    }
		}

		# Any more args?
		if ( @$argv && ValidValue($ctl, $argv->[0], 0, $argend, $prefix) ) {
		    $arg = shift(@$argv);
		    if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
			$arg =~ tr/_//d;
			$arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
			  ? oct($arg)
			  : 0+$arg
		    }
		    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
		      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
		    next;
		}
	    }
	}

	# Not an option. Save it if we $PERMUTE and don't have a <>.
	elsif ( $order == $PERMUTE ) {
	    # Try non-options call-back.
	    my $cb;
	    if ( defined ($cb = $linkage{'<>'}) ) {
		print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
		  if $debug;
		my $eval_error = do {
		    local $@;
		    local $SIG{__DIE__}  = 'DEFAULT';
		    eval {
			# The arg to <> cannot be the CallBack object
			# since it may be passed to other modules that
			# get confused (e.g., Archive::Tar). Well,
			# it's not relevant for this callback anyway.
			&$cb($tryopt);
		    };
		    $@;
		};
		print STDERR ("=> die($eval_error)\n")
		  if $debug && $eval_error ne '';
		if ( $eval_error =~ /^!/ ) {
		    if ( $eval_error =~ /^!FINISH\b/ ) {
			$goon = 0;
		    }
		}
		elsif ( $eval_error ne '' ) {
		    warn ($eval_error);
		    $error++;
		}
	    }
	    else {
		print STDERR ("=> saving \"$tryopt\" ",
			      "(not an option, may permute)\n") if $debug;
		push (@ret, $tryopt);
	    }
	    next;
	}

	# ...otherwise, terminate.
	else {
	    # Push this one back and exit.
	    unshift (@$argv, $tryopt);
	    return ($error == 0);
	}

    }

    # Finish.
    if ( @ret && ( $order == $PERMUTE || $passthrough ) ) {
	#  Push back accumulated arguments
	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
	    if $debug;
	unshift (@$argv, @ret);
    }

    return ($error == 0);
}

# A readable representation of what's in an optbl.
sub OptCtl ($) {
    my ($v) = @_;
    my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
    "[".
      join(",",
	   "\"$v[CTL_TYPE]\"",
	   "\"$v[CTL_CNAME]\"",
	   "\"$v[CTL_DEFAULT]\"",
	   ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
	   $v[CTL_AMIN] || '',
	   $v[CTL_AMAX] || '',
#	   $v[CTL_RANGE] || '',
#	   $v[CTL_REPEAT] || '',
	  ). "]";
}

# Parse an option specification and fill the tables.
sub ParseOptionSpec ($$) {
    my ($opt, $opctl) = @_;

    # Match option spec.
    if ( $opt !~ m;^
		   (
		     # Option name
		     (?: \w+[-\w]* )
		     # Aliases
		     (?: \| (?: . [^|!+=:]* )? )*
		   )?
		   (
		     # Either modifiers ...
		     [!+]
		     |
		     # ... or a value/dest/repeat specification
		     [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
		     |
		     # ... or an optional-with-default spec
		     : (?: -?\d+ | \+ ) [@%]?
		   )?
		   $;x ) {
	return (undef, "Error in option spec: \"$opt\"\n");
    }

    my ($names, $spec) = ($1, $2);
    $spec = '' unless defined $spec;

    # $orig keeps track of the primary name the user specified.
    # This name will be used for the internal or external linkage.
    # In other words, if the user specifies "FoO|BaR", it will
    # match any case combinations of 'foo' and 'bar', but if a global
    # variable needs to be set, it will be $opt_FoO in the exact case
    # as specified.
    my $orig;

    my @names;
    if ( defined $names ) {
	@names =  split (/\|/, $names);
	$orig = $names[0];
    }
    else {
	@names = ('');
	$orig = '';
    }

    # Construct the opctl entries.
    my $entry;
    if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
	# Fields are hard-wired here.
	$entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
    }
    elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
	my $def = $1;
	my $dest = $2;
	my $type = $def eq '+' ? 'I' : 'i';
	$dest ||= '$';
	$dest = $dest eq '@' ? CTL_DEST_ARRAY
	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
	# Fields are hard-wired here.
	$entry = [$type,$orig,$def eq '+' ? undef : $def,
		  $dest,0,1];
    }
    else {
	my ($mand, $type, $dest) =
	  $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
	return (undef, "Cannot repeat while bundling: \"$opt\"\n")
	  if $bundling && defined($4);
	my ($mi, $cm, $ma) = ($5, $6, $7);
	return (undef, "{0} is useless in option spec: \"$opt\"\n")
	  if defined($mi) && !$mi && !defined($ma) && !defined($cm);

	$type = 'i' if $type eq 'n';
	$dest ||= '$';
	$dest = $dest eq '@' ? CTL_DEST_ARRAY
	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
	# Default minargs to 1/0 depending on mand status.
	$mi = $mand eq '=' ? 1 : 0 unless defined $mi;
	# Adjust mand status according to minargs.
	$mand = $mi ? '=' : ':';
	# Adjust maxargs.
	$ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
	return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
	  if defined($ma) && !$ma;
	return (undef, "Max less than min in option spec: \"$opt\"\n")
	  if defined($ma) && $ma < $mi;

	# Fields are hard-wired here.
	$entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
    }

    # Process all names. First is canonical, the rest are aliases.
    my $dups = '';
    foreach ( @names ) {

	$_ = lc ($_)
	  if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);

	if ( exists $opctl->{$_} ) {
	    $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
	}

	if ( $spec eq '!' ) {
	    $opctl->{"no$_"} = $entry;
	    $opctl->{"no-$_"} = $entry;
	    $opctl->{$_} = [@$entry];
	    $opctl->{$_}->[CTL_TYPE] = '';
	}
	else {
	    $opctl->{$_} = $entry;
	}
    }

    if ( $dups && $^W ) {
	foreach ( split(/\n+/, $dups) ) {
	    warn($_."\n");
	}
    }
    ($names[0], $orig);
}

# Option lookup.
sub FindOption ($$$$$) {

    # returns (1, $opt, $ctl, $arg, $key) if okay,
    # returns (1, undef) if option in error,
    # returns (0) otherwise.

    my ($argv, $prefix, $argend, $opt, $opctl) = @_;

    print STDERR ("=> find \"$opt\"\n") if $debug;

    return (0) unless defined($opt);
    return (0) unless $opt =~ /^($prefix)(.*)$/s;
    return (0) if $opt eq "-" && !defined $opctl->{''};

    $opt = substr( $opt, length($1) ); # retain taintedness
    my $starter = $1;

    print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;

    my $optarg;			# value supplied with --opt=value
    my $rest;			# remainder from unbundling

    # If it is a long option, it may include the value.
    # With getopt_compat, only if not bundling.
    if ( ($starter=~/^$longprefix$/
	  || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
	 && (my $oppos = index($opt, '=', 1)) > 0) {
	my $optorg = $opt;
	$opt = substr($optorg, 0, $oppos);
	$optarg = substr($optorg, $oppos + 1); # retain tainedness
	print STDERR ("=> option \"", $opt,
		      "\", optarg = \"$optarg\"\n") if $debug;
    }

    #### Look it up ###

    my $tryopt = $opt;		# option to try

    if ( ( $bundling || $bundling_values ) && $starter eq '-' ) {

	# To try overrides, obey case ignore.
	$tryopt = $ignorecase ? lc($opt) : $opt;

	# If bundling == 2, long options can override bundles.
	if ( $bundling == 2 && length($tryopt) > 1
	     && defined ($opctl->{$tryopt}) ) {
	    print STDERR ("=> $starter$tryopt overrides unbundling\n")
	      if $debug;
	}

	# If bundling_values, option may be followed by the value.
	elsif ( $bundling_values ) {
	    $tryopt = $opt;
	    # Unbundle single letter option.
	    $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
	    $tryopt = substr ($tryopt, 0, 1);
	    $tryopt = lc ($tryopt) if $ignorecase > 1;
	    print STDERR ("=> $starter$tryopt unbundled from ",
			  "$starter$tryopt$rest\n") if $debug;
	    # Whatever remains may not be considered an option.
	    $optarg = $rest eq '' ? undef : $rest;
	    $rest = undef;
	}

	# Split off a single letter and leave the rest for
	# further processing.
	else {
	    $tryopt = $opt;
	    # Unbundle single letter option.
	    $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
	    $tryopt = substr ($tryopt, 0, 1);
	    $tryopt = lc ($tryopt) if $ignorecase > 1;
	    print STDERR ("=> $starter$tryopt unbundled from ",
			  "$starter$tryopt$rest\n") if $debug;
	    $rest = undef unless $rest ne '';
	}
    }

    # Try auto-abbreviation.
    elsif ( $autoabbrev && $opt ne "" ) {
	# Sort the possible long option names.
	my @names = sort(keys (%$opctl));
	# Downcase if allowed.
	$opt = lc ($opt) if $ignorecase;
	$tryopt = $opt;
	# Turn option name into pattern.
	my $pat = quotemeta ($opt);
	# Look up in option names.
	my @hits = grep (/^$pat/, @names);
	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
		      "out of ", scalar(@names), "\n") if $debug;

	# Check for ambiguous results.
	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
	    # See if all matches are for the same option.
	    my %hit;
	    foreach ( @hits ) {
		my $hit = $opctl->{$_}->[CTL_CNAME]
		  if defined $opctl->{$_}->[CTL_CNAME];
		$hit = "no" . $hit if $opctl->{$_}->[CTL_TYPE] eq '!';
		$hit{$hit} = 1;
	    }
	    # Remove auto-supplied options (version, help).
	    if ( keys(%hit) == 2 ) {
		if ( $auto_version && exists($hit{version}) ) {
		    delete $hit{version};
		}
		elsif ( $auto_help && exists($hit{help}) ) {
		    delete $hit{help};
		}
	    }
	    # Now see if it really is ambiguous.
	    unless ( keys(%hit) == 1 ) {
		return (0) if $passthrough;
		warn ("Option ", $opt, " is ambiguous (",
		      join(", ", @hits), ")\n");
		$error++;
		return (1, undef);
	    }
	    @hits = keys(%hit);
	}

	# Complete the option name, if appropriate.
	if ( @hits == 1 && $hits[0] ne $opt ) {
	    $tryopt = $hits[0];
	    $tryopt = lc ($tryopt)
	      if $ignorecase > (($bundling && length($tryopt) == 1) ? 1 : 0);
	    print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
		if $debug;
	}
    }

    # Map to all lowercase if ignoring case.
    elsif ( $ignorecase ) {
	$tryopt = lc ($opt);
    }

    # Check validity by fetching the info.
    my $ctl = $opctl->{$tryopt};
    unless  ( defined $ctl ) {
	return (0) if $passthrough;
	# Pretend one char when bundling.
	if ( $bundling == 1 && length($starter) == 1 ) {
	    $opt = substr($opt,0,1);
            unshift (@$argv, $starter.$rest) if defined $rest;
	}
	if ( $opt eq "" ) {
	    warn ("Missing option after ", $starter, "\n");
	}
	else {
	    warn ("Unknown option: ", $opt, "\n");
	}
	$error++;
	return (1, undef);
    }
    # Apparently valid.
    $opt = $tryopt;
    print STDERR ("=> found ", OptCtl($ctl),
		  " for \"", $opt, "\"\n") if $debug;

    #### Determine argument status ####

    # If it is an option w/o argument, we're almost finished with it.
    my $type = $ctl->[CTL_TYPE];
    my $arg;

    if ( $type eq '' || $type eq '!' || $type eq '+' ) {
	if ( defined $optarg ) {
	    return (0) if $passthrough;
	    warn ("Option ", $opt, " does not take an argument\n");
	    $error++;
	    undef $opt;
	    undef $optarg if $bundling_values;
	}
	elsif ( $type eq '' || $type eq '+' ) {
	    # Supply explicit value.
	    $arg = 1;
	}
	else {
	    $opt =~ s/^no-?//i;	# strip NO prefix
	    $arg = 0;		# supply explicit value
	}
	unshift (@$argv, $starter.$rest) if defined $rest;
	return (1, $opt, $ctl, $arg);
    }

    # Get mandatory status and type info.
    my $mand = $ctl->[CTL_AMIN];

    # Check if there is an option argument available.
    if ( $gnu_compat ) {
	my $optargtype = 0; # none, 1 = empty, 2 = nonempty, 3 = aux
	if ( defined($optarg) ) {
	    $optargtype = (length($optarg) == 0) ? 1 : 2;
	}
	elsif ( defined $rest || @$argv > 0 ) {
	    # GNU getopt_long() does not accept the (optional)
	    # argument to be passed to the option without = sign.
	    # We do, since not doing so breaks existing scripts.
	    $optargtype = 3;
	}
	if(($optargtype == 0) && !$mand) {
	    if ( $type eq 'I' ) {
		# Fake incremental type.
		my @c = @$ctl;
		$c[CTL_TYPE] = '+';
		return (1, $opt, \@c, 1);
	    }
	    my $val
	      = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT]
	      : $type eq 's'                 ? ''
	      :                                0;
	    return (1, $opt, $ctl, $val);
	}
	return (1, $opt, $ctl, $type eq 's' ? '' : 0)
	  if $optargtype == 1;  # --foo=  -> return nothing
    }

    # Check if there is an option argument available.
    if ( defined $optarg
	 ? ($optarg eq '')
	 : !(defined $rest || @$argv > 0) ) {
	# Complain if this option needs an argument.
#	if ( $mand && !($type eq 's' ? defined($optarg) : 0) ) {
	if ( $mand || $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
	    return (0) if $passthrough;
	    warn ("Option ", $opt, " requires an argument\n");
	    $error++;
	    return (1, undef);
	}
	if ( $type eq 'I' ) {
	    # Fake incremental type.
	    my @c = @$ctl;
	    $c[CTL_TYPE] = '+';
	    return (1, $opt, \@c, 1);
	}
	return (1, $opt, $ctl,
		defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
		$type eq 's' ? '' : 0);
    }

    # Get (possibly optional) argument.
    $arg = (defined $rest ? $rest
	    : (defined $optarg ? $optarg : shift (@$argv)));

    # Get key if this is a "name=value" pair for a hash option.
    my $key;
    if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
	($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
	  : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
	     ($mand ? undef : ($type eq 's' ? "" : 1)));
	if (! defined $arg) {
	    warn ("Option $opt, key \"$key\", requires a value\n");
	    $error++;
	    # Push back.
	    unshift (@$argv, $starter.$rest) if defined $rest;
	    return (1, undef);
	}
    }

    #### Check if the argument is valid for this option ####

    my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";

    if ( $type eq 's' ) {	# string
	# A mandatory string takes anything.
	return (1, $opt, $ctl, $arg, $key) if $mand;

	# Same for optional string as a hash value
	return (1, $opt, $ctl, $arg, $key)
	  if $ctl->[CTL_DEST] == CTL_DEST_HASH;

	# An optional string takes almost anything.
	return (1, $opt, $ctl, $arg, $key)
	  if defined $optarg || defined $rest;
	return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??

	# Check for option or option list terminator.
	if ($arg eq $argend ||
	    $arg =~ /^$prefix.+/) {
	    # Push back.
	    unshift (@$argv, $arg);
	    # Supply empty value.
	    $arg = '';
	}
    }

    elsif ( $type eq 'i'	# numeric/integer
            || $type eq 'I'	# numeric/integer w/ incr default
	    || $type eq 'o' ) { # dec/oct/hex/bin value

	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;

	if ( $bundling && defined $rest
	     && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
	    ($key, $arg, $rest) = ($1, $2, $+);
	    chop($key) if $key;
	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
	}
	elsif ( $arg =~ /^$o_valid$/si ) {
	    $arg =~ tr/_//d;
	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
	}
	else {
	    if ( defined $optarg || $mand ) {
		if ( $passthrough ) {
		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
		      unless defined $optarg;
		    return (0);
		}
		warn ("Value \"", $arg, "\" invalid for option ",
		      $opt, " (",
		      $type eq 'o' ? "extended " : '',
		      "number expected)\n");
		$error++;
		# Push back.
		unshift (@$argv, $starter.$rest) if defined $rest;
		return (1, undef);
	    }
	    else {
		# Push back.
		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
		if ( $type eq 'I' ) {
		    # Fake incremental type.
		    my @c = @$ctl;
		    $c[CTL_TYPE] = '+';
		    return (1, $opt, \@c, 1);
		}
		# Supply default value.
		$arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
	    }
	}
    }

    elsif ( $type eq 'f' ) { # real number, int is also ok
	my $o_valid = PAT_FLOAT;
	if ( $bundling && defined $rest &&
	     $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
	    $arg =~ tr/_//d;
	    ($key, $arg, $rest) = ($1, $2, $+);
	    chop($key) if $key;
	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
	}
	elsif ( $arg =~ /^$o_valid$/ ) {
	    $arg =~ tr/_//d;
	}
	else {
	    if ( defined $optarg || $mand ) {
		if ( $passthrough ) {
		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
		      unless defined $optarg;
		    return (0);
		}
		warn ("Value \"", $arg, "\" invalid for option ",
		      $opt, " (real number expected)\n");
		$error++;
		# Push back.
		unshift (@$argv, $starter.$rest) if defined $rest;
		return (1, undef);
	    }
	    else {
		# Push back.
		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
		# Supply default value.
		$arg = 0.0;
	    }
	}
    }
    else {
	die("Getopt::Long internal error (Can't happen)\n");
    }
    return (1, $opt, $ctl, $arg, $key);
}

sub ValidValue ($$$$$) {
    my ($ctl, $arg, $mand, $argend, $prefix) = @_;

    if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
	return 0 unless $arg =~ /[^=]+=(.*)/;
	$arg = $1;
    }

    my $type = $ctl->[CTL_TYPE];

    if ( $type eq 's' ) {	# string
	# A mandatory string takes anything.
	return (1) if $mand;

	return (1) if $arg eq "-";

	# Check for option or option list terminator.
	return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
	return 1;
    }

    elsif ( $type eq 'i'	# numeric/integer
            || $type eq 'I'	# numeric/integer w/ incr default
	    || $type eq 'o' ) { # dec/oct/hex/bin value

	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
	return $arg =~ /^$o_valid$/si;
    }

    elsif ( $type eq 'f' ) { # real number, int is also ok
	my $o_valid = PAT_FLOAT;
	return $arg =~ /^$o_valid$/;
    }
    die("ValidValue: Cannot happen\n");
}

# Getopt::Long Configuration.
sub Configure (@) {
    my (@options) = @_;

    my $prevconfig =
      [ $error, $debug, $major_version, $minor_version, $caller,
	$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
	$longprefix, $bundling_values ];

    if ( ref($options[0]) eq 'ARRAY' ) {
	( $error, $debug, $major_version, $minor_version, $caller,
	  $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
	  $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
	  $longprefix, $bundling_values ) = @{shift(@options)};
    }

    my $opt;
    foreach $opt ( @options ) {
	my $try = lc ($opt);
	my $action = 1;
	if ( $try =~ /^no_?(.*)$/s ) {
	    $action = 0;
	    $try = $+;
	}
	if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
	    ConfigDefaults ();
	}
	elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
	    local $ENV{POSIXLY_CORRECT};
	    $ENV{POSIXLY_CORRECT} = 1 if $action;
	    ConfigDefaults ();
	}
	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
	    $autoabbrev = $action;
	}
	elsif ( $try eq 'getopt_compat' ) {
	    $getopt_compat = $action;
            $genprefix = $action ? "(--|-|\\+)" : "(--|-)";
	}
	elsif ( $try eq 'gnu_getopt' ) {
	    if ( $action ) {
		$gnu_compat = 1;
		$bundling = 1;
		$getopt_compat = 0;
                $genprefix = "(--|-)";
		$order = $PERMUTE;
		$bundling_values = 0;
	    }
	}
	elsif ( $try eq 'gnu_compat' ) {
	    $gnu_compat = $action;
	    $bundling = 0;
	    $bundling_values = 1;
	}
	elsif ( $try =~ /^(auto_?)?version$/ ) {
	    $auto_version = $action;
	}
	elsif ( $try =~ /^(auto_?)?help$/ ) {
	    $auto_help = $action;
	}
	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
	    $ignorecase = $action;
	}
	elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) {
	    $ignorecase = $action ? 2 : 0;
	}
	elsif ( $try eq 'bundling' ) {
	    $bundling = $action;
	    $bundling_values = 0 if $action;
	}
	elsif ( $try eq 'bundling_override' ) {
	    $bundling = $action ? 2 : 0;
	    $bundling_values = 0 if $action;
	}
	elsif ( $try eq 'bundling_values' ) {
	    $bundling_values = $action;
	    $bundling = 0 if $action;
	}
	elsif ( $try eq 'require_order' ) {
	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
	}
	elsif ( $try eq 'permute' ) {
	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
	}
	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
	    $passthrough = $action;
	}
	elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
	    $genprefix = $1;
	    # Turn into regexp. Needs to be parenthesized!
	    $genprefix = "(" . quotemeta($genprefix) . ")";
	    eval { '' =~ /$genprefix/; };
	    die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
	}
	elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
	    $genprefix = $1;
	    # Parenthesize if needed.
	    $genprefix = "(" . $genprefix . ")"
	      unless $genprefix =~ /^\(.*\)$/;
	    eval { '' =~ m"$genprefix"; };
	    die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
	}
	elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
	    $longprefix = $1;
	    # Parenthesize if needed.
	    $longprefix = "(" . $longprefix . ")"
	      unless $longprefix =~ /^\(.*\)$/;
	    eval { '' =~ m"$longprefix"; };
	    die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n") if $@;
	}
	elsif ( $try eq 'debug' ) {
	    $debug = $action;
	}
	else {
	    die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")
	}
    }
    $prevconfig;
}

# Deprecated name.
sub config (@) {
    Configure (@_);
}

# Issue a standard message for --version.
#
# The arguments are mostly the same as for Pod::Usage::pod2usage:
#
#  - a number (exit value)
#  - a string (lead in message)
#  - a hash with options. See Pod::Usage for details.
#
sub VersionMessage(@) {
    # Massage args.
    my $pa = setup_pa_args("version", @_);

    my $v = $main::VERSION;
    my $fh = $pa->{-output} ||
      ( ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR );

    print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
	       $0, defined $v ? " version $v" : (),
	       "\n",
	       "(", __PACKAGE__, "::", "GetOptions",
	       " version ",
	       defined($Getopt::Long::VERSION_STRING)
	         ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
	       " Perl version ",
	       $] >= 5.006 ? sprintf("%vd", $^V) : $],
	       ")\n");
    exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
}

# Issue a standard message for --help.
#
# The arguments are the same as for Pod::Usage::pod2usage:
#
#  - a number (exit value)
#  - a string (lead in message)
#  - a hash with options. See Pod::Usage for details.
#
sub HelpMessage(@) {
    eval {
	require Pod::Usage;
	import Pod::Usage;
	1;
    } || die("Cannot provide help: cannot load Pod::Usage\n");

    # Note that pod2usage will issue a warning if -exitval => NOEXIT.
    pod2usage(setup_pa_args("help", @_));

}

# Helper routine to set up a normalized hash ref to be used as
# argument to pod2usage.
sub setup_pa_args($@) {
    my $tag = shift;		# who's calling

    # If called by direct binding to an option, it will get the option
    # name and value as arguments. Remove these, if so.
    @_ = () if @_ == 2 && $_[0] eq $tag;

    my $pa;
    if ( @_ > 1 ) {
	$pa = { @_ };
    }
    else {
	$pa = shift || {};
    }

    # At this point, $pa can be a number (exit value), string
    # (message) or hash with options.

    if ( UNIVERSAL::isa($pa, 'HASH') ) {
	# Get rid of -msg vs. -message ambiguity.
	$pa->{-message} = $pa->{-msg};
	delete($pa->{-msg});
    }
    elsif ( $pa =~ /^-?\d+$/ ) {
	$pa = { -exitval => $pa };
    }
    else {
	$pa = { -message => $pa };
    }

    # These are _our_ defaults.
    $pa->{-verbose} = 0 unless exists($pa->{-verbose});
    $pa->{-exitval} = 0 unless exists($pa->{-exitval});
    $pa;
}

# Sneak way to know what version the user requested.
sub VERSION {
    $requested_version = $_[1] if @_ > 1;
    shift->SUPER::VERSION(@_);
}

package Getopt::Long::CallBack;

sub new {
    my ($pkg, %atts) = @_;
    bless { %atts }, $pkg;
}

sub name {
    my $self = shift;
    ''.$self->{name};
}

sub given {
    my $self = shift;
    $self->{given};
}

use overload
  # Treat this object as an ordinary string for legacy API.
  '""'	   => \&name,
  fallback => 1;

1;

################ Documentation ################

=head1 NAME

Getopt::Long - Extended processing of command line options

=head1 SYNOPSIS

  use Getopt::Long;
  my $data   = "file.dat";
  my $length = 24;
  my $verbose;
  GetOptions ("length=i" => \$length,    # numeric
              "file=s"   => \$data,      # string
              "verbose"  => \$verbose)   # flag
  or die("Error in command line arguments\n");

=head1 DESCRIPTION

The Getopt::Long module implements an extended getopt function called
GetOptions(). It parses the command line from C<@ARGV>, recognizing
and removing specified options and their possible values.

This function adheres to the POSIX syntax for command
line options, with GNU extensions. In general, this means that options
have long names instead of single letters, and are introduced with a
double dash "--". Support for bundling of command line options, as was
the case with the more traditional single-letter approach, is provided
but not enabled by default.

=head1 Command Line Options, an Introduction

Command line operated programs traditionally take their arguments from
the command line, for example filenames or other information that the
program needs to know. Besides arguments, these programs often take
command line I<options> as well. Options are not necessary for the
program to work, hence the name 'option', but are used to modify its
default behaviour. For example, a program could do its job quietly,
but with a suitable option it could provide verbose information about
what it did.

Command line options come in several flavours. Historically, they are
preceded by a single dash C<->, and consist of a single letter.

    -l -a -c

Usually, these single-character options can be bundled:

    -lac

Options can have values, the value is placed after the option
character. Sometimes with whitespace in between, sometimes not:

    -s 24 -s24

Due to the very cryptic nature of these options, another style was
developed that used long names. So instead of a cryptic C<-l> one
could use the more descriptive C<--long>. To distinguish between a
bundle of single-character options and a long one, two dashes are used
to precede the option name. Early implementations of long options used
a plus C<+> instead. Also, option values could be specified either
like

    --size=24

or

    --size 24

The C<+> form is now obsolete and strongly deprecated.

=head1 Getting Started with Getopt::Long

Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
first Perl module that provided support for handling the new style of
command line options, in particular long option names, hence the Perl5
name Getopt::Long. This module also supports single-character options
and bundling.

To use Getopt::Long from a Perl program, you must include the
following line in your Perl program:

    use Getopt::Long;

This will load the core of the Getopt::Long module and prepare your
program for using it. Most of the actual Getopt::Long code is not
loaded until you really call one of its functions.

In the default configuration, options names may be abbreviated to
uniqueness, case does not matter, and a single dash is sufficient,
even for long option names. Also, options may be placed between
non-option arguments. See L<Configuring Getopt::Long> for more
details on how to configure Getopt::Long.

=head2 Simple options

The most simple options are the ones that take no values. Their mere
presence on the command line enables the option. Popular examples are:

    --all --verbose --quiet --debug

Handling simple options is straightforward:

    my $verbose = '';	# option variable with default value (false)
    my $all = '';	# option variable with default value (false)
    GetOptions ('verbose' => \$verbose, 'all' => \$all);

The call to GetOptions() parses the command line arguments that are
present in C<@ARGV> and sets the option variable to the value C<1> if
the option did occur on the command line. Otherwise, the option
variable is not touched. Setting the option value to true is often
called I<enabling> the option.

The option name as specified to the GetOptions() function is called
the option I<specification>. Later we'll see that this specification
can contain more than just the option name. The reference to the
variable is called the option I<destination>.

GetOptions() will return a true value if the command line could be
processed successfully. Otherwise, it will write error messages using
die() and warn(), and return a false result.

=head2 A little bit less simple options

Getopt::Long supports two useful variants of simple options:
I<negatable> options and I<incremental> options.

A negatable option is specified with an exclamation mark C<!> after the
option name:

    my $verbose = '';	# option variable with default value (false)
    GetOptions ('verbose!' => \$verbose);

Now, using C<--verbose> on the command line will enable C<$verbose>,
as expected. But it is also allowed to use C<--noverbose>, which will
disable C<$verbose> by setting its value to C<0>. Using a suitable
default value, the program can find out whether C<$verbose> is false
by default, or disabled by using C<--noverbose>.

An incremental option is specified with a plus C<+> after the
option name:

    my $verbose = '';	# option variable with default value (false)
    GetOptions ('verbose+' => \$verbose);

Using C<--verbose> on the command line will increment the value of
C<$verbose>. This way the program can keep track of how many times the
option occurred on the command line. For example, each occurrence of
C<--verbose> could increase the verbosity level of the program.

=head2 Mixing command line option with other arguments

Usually programs take command line options as well as other arguments,
for example, file names. It is good practice to always specify the
options first, and the other arguments last. Getopt::Long will,
however, allow the options and arguments to be mixed and 'filter out'
all the options before passing the rest of the arguments to the
program. To stop Getopt::Long from processing further arguments,
insert a double dash C<--> on the command line:

    --size 24 -- --all

In this example, C<--all> will I<not> be treated as an option, but
passed to the program unharmed, in C<@ARGV>.

=head2 Options with values

For options that take values it must be specified whether the option
value is required or not, and what kind of value the option expects.

Three kinds of values are supported: integer numbers, floating point
numbers, and strings.

If the option value is required, Getopt::Long will take the
command line argument that follows the option and assign this to the
option variable. If, however, the option value is specified as
optional, this will only be done if that value does not look like a
valid command line option itself.

    my $tag = '';	# option variable with default value
    GetOptions ('tag=s' => \$tag);

In the option specification, the option name is followed by an equals
sign C<=> and the letter C<s>. The equals sign indicates that this
option requires a value. The letter C<s> indicates that this value is
an arbitrary string. Other possible value types are C<i> for integer
values, and C<f> for floating point values. Using a colon C<:> instead
of the equals sign indicates that the option value is optional. In
this case, if no suitable value is supplied, string valued options get
an empty string C<''> assigned, while numeric options are set to C<0>.

=head2 Options with multiple values

Options sometimes take several values. For example, a program could
use multiple directories to search for library files:

    --library lib/stdlib --library lib/extlib

To accomplish this behaviour, simply specify an array reference as the
destination for the option:

    GetOptions ("library=s" => \@libfiles);

Alternatively, you can specify that the option can have multiple
values by adding a "@", and pass a reference to a scalar as the
destination:

    GetOptions ("library=s@" => \$libfiles);

Used with the example above, C<@libfiles> c.q. C<@$libfiles> would
contain two strings upon completion: C<"lib/stdlib"> and
C<"lib/extlib">, in that order. It is also possible to specify that
only integer or floating point numbers are acceptable values.

Often it is useful to allow comma-separated lists of values as well as
multiple occurrences of the options. This is easy using Perl's split()
and join() operators:

    GetOptions ("library=s" => \@libfiles);
    @libfiles = split(/,/,join(',',@libfiles));

Of course, it is important to choose the right separator string for
each purpose.

Warning: What follows is an experimental feature.

Options can take multiple values at once, for example

    --coordinates 52.2 16.4 --rgbcolor 255 255 149

This can be accomplished by adding a repeat specifier to the option
specification. Repeat specifiers are very similar to the C<{...}>
repeat specifiers that can be used with regular expression patterns.
For example, the above command line would be handled as follows:

    GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);

The destination for the option must be an array or array reference.

It is also possible to specify the minimal and maximal number of
arguments an option takes. C<foo=s{2,4}> indicates an option that
takes at least two and at most 4 arguments. C<foo=s{1,}> indicates one
or more values; C<foo:s{,}> indicates zero or more option values.

=head2 Options with hash values

If the option destination is a reference to a hash, the option will
take, as value, strings of the form I<key>C<=>I<value>. The value will
be stored with the specified key in the hash.

    GetOptions ("define=s" => \%defines);

Alternatively you can use:

    GetOptions ("define=s%" => \$defines);

When used with command line options:

    --define os=linux --define vendor=redhat

the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
with value C<"linux"> and C<"vendor"> with value C<"redhat">. It is
also possible to specify that only integer or floating point numbers
are acceptable values. The keys are always taken to be strings.

=head2 User-defined subroutines to handle options

Ultimate control over what should be done when (actually: each time)
an option is encountered on the command line can be achieved by
designating a reference to a subroutine (or an anonymous subroutine)
as the option destination. When GetOptions() encounters the option, it
will call the subroutine with two or three arguments. The first
argument is the name of the option. (Actually, it is an object that
stringifies to the name of the option.) For a scalar or array destination,
the second argument is the value to be stored. For a hash destination,
the second argument is the key to the hash, and the third argument
the value to be stored. It is up to the subroutine to store the value,
or do whatever it thinks is appropriate.

A trivial application of this mechanism is to implement options that
are related to each other. For example:

    my $verbose = '';	# option variable with default value (false)
    GetOptions ('verbose' => \$verbose,
	        'quiet'   => sub { $verbose = 0 });

Here C<--verbose> and C<--quiet> control the same variable
C<$verbose>, but with opposite values.

If the subroutine needs to signal an error, it should call die() with
the desired error message as its argument. GetOptions() will catch the
die(), issue the error message, and record that an error result must
be returned upon completion.

If the text of the error message starts with an exclamation mark C<!>
it is interpreted specially by GetOptions(). There is currently one
special command implemented: C<die("!FINISH")> will cause GetOptions()
to stop processing options, as if it encountered a double dash C<-->.

Here is an example of how to access the option name and value from within
a subroutine:

    GetOptions ('opt=i' => \&handler);
    sub handler {
        my ($opt_name, $opt_value) = @_;
        print("Option name is $opt_name and value is $opt_value\n");
    }

=head2 Options with multiple names

Often it is user friendly to supply alternate mnemonic names for
options. For example C<--height> could be an alternate name for
C<--length>. Alternate names can be included in the option
specification, separated by vertical bar C<|> characters. To implement
the above example:

    GetOptions ('length|height=f' => \$length);

The first name is called the I<primary> name, the other names are
called I<aliases>. When using a hash to store options, the key will
always be the primary name.

Multiple alternate names are possible.

=head2 Case and abbreviations

Without additional configuration, GetOptions() will ignore the case of
option names, and allow the options to be abbreviated to uniqueness.

    GetOptions ('length|height=f' => \$length, "head" => \$head);

This call will allow C<--l> and C<--L> for the length option, but
requires a least C<--hea> and C<--hei> for the head and height options.

=head2 Summary of Option Specifications

Each option specifier consists of two parts: the name specification
and the argument specification.

The name specification contains the name of the option, optionally
followed by a list of alternative names separated by vertical bar
characters.

    length	      option name is "length"
    length|size|l     name is "length", aliases are "size" and "l"

The argument specification is optional. If omitted, the option is
considered boolean, a value of 1 will be assigned when the option is
used on the command line.

The argument specification can be

=over 4

=item !

The option does not take an argument and may be negated by prefixing
it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
1 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of
0 will be assigned). If the option has aliases, this applies to the
aliases as well.

Using negation on a single letter option when bundling is in effect is
pointless and will result in a warning.

=item +

The option does not take an argument and will be incremented by 1
every time it appears on the command line. E.g. C<"more+">, when used
with C<--more --more --more>, will increment the value three times,
resulting in a value of 3 (provided it was 0 or undefined at first).

The C<+> specifier is ignored if the option destination is not a scalar.

=item = I<type> [ I<desttype> ] [ I<repeat> ]

The option requires an argument of the given type. Supported types
are:

=over 4

=item s

String. An arbitrary sequence of characters. It is valid for the
argument to start with C<-> or C<-->.

=item i

Integer. An optional leading plus or minus sign, followed by a
sequence of digits.

=item o

Extended integer, Perl style. This can be either an optional leading
plus or minus sign, followed by a sequence of digits, or an octal
string (a zero, optionally followed by '0', '1', .. '7'), or a
hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
insensitive), or a binary string (C<0b> followed by a series of '0'
and '1').

=item f

Real number. For example C<3.14>, C<-6.23E24> and so on.

=back

The I<desttype> can be C<@> or C<%> to specify that the option is
list or a hash valued. This is only needed when the destination for
the option value is not otherwise specified. It should be omitted when
not needed.

The I<repeat> specifies the number of values this option takes per
occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.

I<min> denotes the minimal number of arguments. It defaults to 1 for
options with C<=> and to 0 for options with C<:>, see below. Note that
I<min> overrules the C<=> / C<:> semantics.

I<max> denotes the maximum number of arguments. It must be at least
I<min>. If I<max> is omitted, I<but the comma is not>, there is no
upper bound to the number of argument values taken.

=item : I<type> [ I<desttype> ]

Like C<=>, but designates the argument as optional.
If omitted, an empty string will be assigned to string values options,
and the value zero to numeric options.

Note that if a string argument starts with C<-> or C<-->, it will be
considered an option on itself.

=item : I<number> [ I<desttype> ]

Like C<:i>, but if the value is omitted, the I<number> will be assigned.

=item : + [ I<desttype> ]

Like C<:i>, but if the value is omitted, the current value for the
option will be incremented.

=back

=head1 Advanced Possibilities

=head2 Object oriented interface

Getopt::Long can be used in an object oriented way as well:

    use Getopt::Long;
    $p = Getopt::Long::Parser->new;
    $p->configure(...configuration options...);
    if ($p->getoptions(...options descriptions...)) ...
    if ($p->getoptionsfromarray( \@array, ...options descriptions...)) ...

Configuration options can be passed to the constructor:

    $p = new Getopt::Long::Parser
             config => [...configuration options...];

=head2 Callback object

In version 2.37 the first argument to the callback function was
changed from string to object. This was done to make room for
extensions and more detailed control. The object stringifies to the
option name so this change should not introduce compatibility
problems.

The callback object has the following methods:

=over

=item name

The name of the option, unabbreviated. For an option with multiple
names it return the first (canonical) name.

=item given

The name of the option as actually used, unabbreveated.

=back

=head2 Thread Safety

Getopt::Long is thread safe when using ithreads as of Perl 5.8.  It is
I<not> thread safe when using the older (experimental and now
obsolete) threads implementation that was added to Perl 5.005.

=head2 Documentation and help texts

Getopt::Long encourages the use of Pod::Usage to produce help
messages. For example:

    use Getopt::Long;
    use Pod::Usage;

    my $man = 0;
    my $help = 0;

    GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
    pod2usage(1) if $help;
    pod2usage(-exitval => 0, -verbose => 2) if $man;

    __END__

    =head1 NAME

    sample - Using Getopt::Long and Pod::Usage

    =head1 SYNOPSIS

    sample [options] [file ...]

     Options:
       -help            brief help message
       -man             full documentation

    =head1 OPTIONS

    =over 8

    =item B<-help>

    Print a brief help message and exits.

    =item B<-man>

    Prints the manual page and exits.

    =back

    =head1 DESCRIPTION

    B<This program> will read the given input file(s) and do something
    useful with the contents thereof.

    =cut

See L<Pod::Usage> for details.

=head2 Parsing options from an arbitrary array

By default, GetOptions parses the options that are present in the
global array C<@ARGV>. A special entry C<GetOptionsFromArray> can be
used to parse options from an arbitrary array.

    use Getopt::Long qw(GetOptionsFromArray);
    $ret = GetOptionsFromArray(\@myopts, ...);

When used like this, options and their possible values are removed
from C<@myopts>, the global C<@ARGV> is not touched at all.

The following two calls behave identically:

    $ret = GetOptions( ... );
    $ret = GetOptionsFromArray(\@ARGV, ... );

This also means that a first argument hash reference now becomes the
second argument:

    $ret = GetOptions(\%opts, ... );
    $ret = GetOptionsFromArray(\@ARGV, \%opts, ... );

=head2 Parsing options from an arbitrary string

A special entry C<GetOptionsFromString> can be used to parse options
from an arbitrary string.

    use Getopt::Long qw(GetOptionsFromString);
    $ret = GetOptionsFromString($string, ...);

The contents of the string are split into arguments using a call to
C<Text::ParseWords::shellwords>. As with C<GetOptionsFromArray>, the
global C<@ARGV> is not touched.

It is possible that, upon completion, not all arguments in the string
have been processed. C<GetOptionsFromString> will, when called in list
context, return both the return status and an array reference to any
remaining arguments:

    ($ret, $args) = GetOptionsFromString($string, ... );

If any arguments remain, and C<GetOptionsFromString> was not called in
list context, a message will be given and C<GetOptionsFromString> will
return failure.

As with GetOptionsFromArray, a first argument hash reference now
becomes the second argument. See the next section.

=head2 Storing options values in a hash

Sometimes, for example when there are a lot of options, having a
separate variable for each of them can be cumbersome. GetOptions()
supports, as an alternative mechanism, storing options values in a
hash.

To obtain this, a reference to a hash must be passed I<as the first
argument> to GetOptions(). For each option that is specified on the
command line, the option value will be stored in the hash with the
option name as key. Options that are not actually used on the command
line will not be put in the hash, on other words,
C<exists($h{option})> (or defined()) can be used to test if an option
was used. The drawback is that warnings will be issued if the program
runs under C<use strict> and uses C<$h{option}> without testing with
exists() or defined() first.

    my %h = ();
    GetOptions (\%h, 'length=i');	# will store in $h{length}

For options that take list or hash values, it is necessary to indicate
this by appending an C<@> or C<%> sign after the type:

    GetOptions (\%h, 'colours=s@');	# will push to @{$h{colours}}

To make things more complicated, the hash may contain references to
the actual destinations, for example:

    my $len = 0;
    my %h = ('length' => \$len);
    GetOptions (\%h, 'length=i');	# will store in $len

This example is fully equivalent with:

    my $len = 0;
    GetOptions ('length=i' => \$len);	# will store in $len

Any mixture is possible. For example, the most frequently used options
could be stored in variables while all other options get stored in the
hash:

    my $verbose = 0;			# frequently referred
    my $debug = 0;			# frequently referred
    my %h = ('verbose' => \$verbose, 'debug' => \$debug);
    GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
    if ( $verbose ) { ... }
    if ( exists $h{filter} ) { ... option 'filter' was specified ... }

=head2 Bundling

With bundling it is possible to set several single-character options
at once. For example if C<a>, C<v> and C<x> are all valid options,

    -vax

will set all three.

Getopt::Long supports three styles of bundling. To enable bundling, a
call to Getopt::Long::Configure is required.

The simplest style of bundling can be enabled with:

    Getopt::Long::Configure ("bundling");

Configured this way, single-character options can be bundled but long
options (and any of their auto-abbreviated shortened forms) B<must>
always start with a double dash C<--> to avoid ambiguity. For example,
when C<vax>, C<a>, C<v> and C<x> are all valid options,

    -vax

will set C<a>, C<v> and C<x>, but

    --vax

will set C<vax>.

The second style of bundling lifts this restriction. It can be enabled
with:

    Getopt::Long::Configure ("bundling_override");

Now, C<-vax> will set the option C<vax>.

In all of the above cases, option values may be inserted in the
bundle. For example:

    -h24w80

is equivalent to

    -h 24 -w 80

A third style of bundling allows only values to be bundled with
options. It can be enabled with:

    Getopt::Long::Configure ("bundling_values");

Now, C<-h24> will set the option C<h> to C<24>, but option bundles
like C<-vxa> and C<-h24w80> are flagged as errors.

Enabling C<bundling_values> will disable the other two styles of
bundling.

When configured for bundling, single-character options are matched
case sensitive while long options are matched case insensitive. To
have the single-character options matched case insensitive as well,
use:

    Getopt::Long::Configure ("bundling", "ignorecase_always");

It goes without saying that bundling can be quite confusing.

=head2 The lonesome dash

Normally, a lone dash C<-> on the command line will not be considered
an option. Option processing will terminate (unless "permute" is
configured) and the dash will be left in C<@ARGV>.

It is possible to get special treatment for a lone dash. This can be
achieved by adding an option specification with an empty name, for
example:

    GetOptions ('' => \$stdio);

A lone dash on the command line will now be a legal option, and using
it will set variable C<$stdio>.

=head2 Argument callback

A special option 'name' C<< <> >> can be used to designate a subroutine
to handle non-option arguments. When GetOptions() encounters an
argument that does not look like an option, it will immediately call this
subroutine and passes it one parameter: the argument name.

For example:

    my $width = 80;
    sub process { ... }
    GetOptions ('width=i' => \$width, '<>' => \&process);

When applied to the following command line:

    arg1 --width=72 arg2 --width=60 arg3

This will call
C<process("arg1")> while C<$width> is C<80>,
C<process("arg2")> while C<$width> is C<72>, and
C<process("arg3")> while C<$width> is C<60>.

This feature requires configuration option B<permute>, see section
L<Configuring Getopt::Long>.

=head1 Configuring Getopt::Long

Getopt::Long can be configured by calling subroutine
Getopt::Long::Configure(). This subroutine takes a list of quoted
strings, each specifying a configuration option to be enabled, e.g.
C<ignore_case>. To disable, prefix with C<no> or C<no_>, e.g.
C<no_ignore_case>. Case does not matter. Multiple calls to Configure()
are possible.

Alternatively, as of version 2.24, the configuration options may be
passed together with the C<use> statement:

    use Getopt::Long qw(:config no_ignore_case bundling);

The following options are available:

=over 12

=item default

This option causes all configuration options to be reset to their
default values.

=item posix_default

This option causes all configuration options to be reset to their
default values as if the environment variable POSIXLY_CORRECT had
been set.

=item auto_abbrev

Allow option names to be abbreviated to uniqueness.
Default is enabled unless environment variable
POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.

=item getopt_compat

Allow C<+> to start options.
Default is enabled unless environment variable
POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.

=item gnu_compat

C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
C<--opt=> will give option C<opt> and empty value.
This is the way GNU getopt_long() does it.

Note that C<--opt value> is still accepted, even though GNU
getopt_long() doesn't.

=item gnu_getopt

This is a short way of setting C<gnu_compat> C<bundling> C<permute>
C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
reasonably compatible with GNU getopt_long().

=item require_order

Whether command line arguments are allowed to be mixed with options.
Default is disabled unless environment variable
POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.

See also C<permute>, which is the opposite of C<require_order>.

=item permute

Whether command line arguments are allowed to be mixed with options.
Default is enabled unless environment variable
POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
Note that C<permute> is the opposite of C<require_order>.

If C<permute> is enabled, this means that

    --foo arg1 --bar arg2 arg3

is equivalent to

    --foo --bar arg1 arg2 arg3

If an argument callback routine is specified, C<@ARGV> will always be
empty upon successful return of GetOptions() since all options have been
processed. The only exception is when C<--> is used:

    --foo arg1 --bar arg2 -- arg3

This will call the callback routine for arg1 and arg2, and then
terminate GetOptions() leaving C<"arg3"> in C<@ARGV>.

If C<require_order> is enabled, options processing
terminates when the first non-option is encountered.

    --foo arg1 --bar arg2 arg3

is equivalent to

    --foo -- arg1 --bar arg2 arg3

If C<pass_through> is also enabled, options processing will terminate
at the first unrecognized option, or non-option, whichever comes
first.

=item bundling (default: disabled)

Enabling this option will allow single-character options to be
bundled. To distinguish bundles from long option names, long options
(and any of their auto-abbreviated shortened forms) I<must> be
introduced with C<--> and bundles with C<->.

Note that, if you have options C<a>, C<l> and C<all>, and
auto_abbrev enabled, possible arguments and option settings are:

    using argument               sets option(s)
    ------------------------------------------
    -a, --a                      a
    -l, --l                      l
    -al, -la, -ala, -all,...     a, l
    --al, --all                  all

The surprising part is that C<--a> sets option C<a> (due to auto
completion), not C<all>.

Note: disabling C<bundling> also disables C<bundling_override>.

=item bundling_override (default: disabled)

If C<bundling_override> is enabled, bundling is enabled as with
C<bundling> but now long option names override option bundles.

Note: disabling C<bundling_override> also disables C<bundling>.

B<Note:> Using option bundling can easily lead to unexpected results,
especially when mixing long options and bundles. Caveat emptor.

=item ignore_case  (default: enabled)

If enabled, case is ignored when matching option names. If, however,
bundling is enabled as well, single character options will be treated
case-sensitive.

With C<ignore_case>, option specifications for options that only
differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
duplicates.

Note: disabling C<ignore_case> also disables C<ignore_case_always>.

=item ignore_case_always (default: disabled)

When bundling is in effect, case is ignored on single-character
options also.

Note: disabling C<ignore_case_always> also disables C<ignore_case>.

=item auto_version (default:disabled)

Automatically provide support for the B<--version> option if
the application did not specify a handler for this option itself.

Getopt::Long will provide a standard version message that includes the
program name, its version (if $main::VERSION is defined), and the
versions of Getopt::Long and Perl. The message will be written to
standard output and processing will terminate.

C<auto_version> will be enabled if the calling program explicitly
specified a version number higher than 2.32 in the C<use> or
C<require> statement.

=item auto_help (default:disabled)

Automatically provide support for the B<--help> and B<-?> options if
the application did not specify a handler for this option itself.

Getopt::Long will provide a help message using module L<Pod::Usage>. The
message, derived from the SYNOPSIS POD section, will be written to
standard output and processing will terminate.

C<auto_help> will be enabled if the calling program explicitly
specified a version number higher than 2.32 in the C<use> or
C<require> statement.

=item pass_through (default: disabled)

With C<pass_through> anything that is unknown, ambiguous or supplied with
an invalid option will not be flagged as an error. Instead the unknown
option(s) will be passed to the catchall C<< <> >> if present, otherwise
through to C<@ARGV>. This makes it possible to write wrapper scripts that
process only part of the user supplied command line arguments, and pass the
remaining options to some other program.

If C<require_order> is enabled, options processing will terminate at the
first unrecognized option, or non-option, whichever comes first and all
remaining arguments are passed to C<@ARGV> instead of the catchall
C<< <> >> if present.  However, if C<permute> is enabled instead, results
can become confusing.

Note that the options terminator (default C<-->), if present, will
also be passed through in C<@ARGV>.

=item prefix

The string that starts options. If a constant string is not
sufficient, see C<prefix_pattern>.

=item prefix_pattern

A Perl pattern that identifies the strings that introduce options.
Default is C<--|-|\+> unless environment variable
POSIXLY_CORRECT has been set, in which case it is C<--|->.

=item long_prefix_pattern

A Perl pattern that allows the disambiguation of long and short
prefixes. Default is C<-->.

Typically you only need to set this if you are using nonstandard
prefixes and want some or all of them to have the same semantics as
'--' does under normal circumstances.

For example, setting prefix_pattern to C<--|-|\+|\/> and
long_prefix_pattern to C<--|\/> would add Win32 style argument
handling.

=item debug (default: disabled)

Enable debugging output.

=back

=head1 Exportable Methods

=over

=item VersionMessage

This subroutine provides a standard version message. Its argument can be:

=over 4

=item *

A string containing the text of a message to print I<before> printing
the standard message.

=item *

A numeric value corresponding to the desired exit status.

=item *

A reference to a hash.

=back

If more than one argument is given then the entire argument list is
assumed to be a hash.  If a hash is supplied (either as a reference or
as a list) it should contain one or more elements with the following
keys:

=over 4

=item C<-message>

=item C<-msg>

The text of a message to print immediately prior to printing the
program's usage message.

=item C<-exitval>

The desired exit status to pass to the B<exit()> function.
This should be an integer, or else the string "NOEXIT" to
indicate that control should simply be returned without
terminating the invoking process.

=item C<-output>

A reference to a filehandle, or the pathname of a file to which the
usage message should be written. The default is C<\*STDERR> unless the
exit value is less than 2 (in which case the default is C<\*STDOUT>).

=back

You cannot tie this routine directly to an option, e.g.:

    GetOptions("version" => \&VersionMessage);

Use this instead:

    GetOptions("version" => sub { VersionMessage() });

=item HelpMessage

This subroutine produces a standard help message, derived from the
program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
arguments as VersionMessage(). In particular, you cannot tie it
directly to an option, e.g.:

    GetOptions("help" => \&HelpMessage);

Use this instead:

    GetOptions("help" => sub { HelpMessage() });

=back

=head1 Return values and Errors

Configuration errors and errors in the option definitions are
signalled using die() and will terminate the calling program unless
the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
}>, or die() was trapped using C<$SIG{__DIE__}>.

GetOptions returns true to indicate success.
It returns false when the function detected one or more errors during
option parsing. These errors are signalled using warn() and can be
trapped with C<$SIG{__WARN__}>.

=head1 Legacy

The earliest development of C<newgetopt.pl> started in 1990, with Perl
version 4. As a result, its development, and the development of
Getopt::Long, has gone through several stages. Since backward
compatibility has always been extremely important, the current version
of Getopt::Long still supports a lot of constructs that nowadays are
no longer necessary or otherwise unwanted. This section describes
briefly some of these 'features'.

=head2 Default destinations

When no destination is specified for an option, GetOptions will store
the resultant value in a global variable named C<opt_>I<XXX>, where
I<XXX> is the primary name of this option. When a program executes
under C<use strict> (recommended), these variables must be
pre-declared with our() or C<use vars>.

    our $opt_length = 0;
    GetOptions ('length=i');	# will store in $opt_length

To yield a usable Perl variable, characters that are not part of the
syntax for variables are translated to underscores. For example,
C<--fpp-struct-return> will set the variable
C<$opt_fpp_struct_return>. Note that this variable resides in the
namespace of the calling program, not necessarily C<main>. For
example:

    GetOptions ("size=i", "sizes=i@");

with command line "-size 10 -sizes 24 -sizes 48" will perform the
equivalent of the assignments

    $opt_size = 10;
    @opt_sizes = (24, 48);

=head2 Alternative option starters

A string of alternative option starter characters may be passed as the
first argument (or the first argument after a leading hash reference
argument).

    my $len = 0;
    GetOptions ('/', 'length=i' => $len);

Now the command line may look like:

    /length 24 -- arg

Note that to terminate options processing still requires a double dash
C<-->.

GetOptions() will not interpret a leading C<< "<>" >> as option starters
if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
option starters, use C<< "><" >>. Confusing? Well, B<using a starter
argument is strongly deprecated> anyway.

=head2 Configuration variables

Previous versions of Getopt::Long used variables for the purpose of
configuring. Although manipulating these variables still work, it is
strongly encouraged to use the C<Configure> routine that was introduced
in version 2.17. Besides, it is much easier.

=head1 Tips and Techniques

=head2 Pushing multiple values in a hash option

Sometimes you want to combine the best of hashes and arrays. For
example, the command line:

  --list add=first --list add=second --list add=third

where each successive 'list add' option will push the value of add
into array ref $list->{'add'}. The result would be like

  $list->{add} = [qw(first second third)];

This can be accomplished with a destination routine:

  GetOptions('list=s%' =>
               sub { push(@{$list{$_[1]}}, $_[2]) });

=head1 Troubleshooting

=head2 GetOptions does not return a false result when an option is not supplied

That's why they're called 'options'.

=head2 GetOptions does not split the command line correctly

The command line is not split by GetOptions, but by the command line
interpreter (CLI). On Unix, this is the shell. On Windows, it is
COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.

It is important to know that these CLIs may behave different when the
command line contains special characters, in particular quotes or
backslashes. For example, with Unix shells you can use single quotes
(C<'>) and double quotes (C<">) to group words together. The following
alternatives are equivalent on Unix:

    "two words"
    'two words'
    two\ words

In case of doubt, insert the following statement in front of your Perl
program:

    print STDERR (join("|",@ARGV),"\n");

to verify how your CLI passes the arguments to the program.

=head2 Undefined subroutine &main::GetOptions called

Are you running Windows, and did you write

    use GetOpt::Long;

(note the capital 'O')?

=head2 How do I put a "-?" option into a Getopt::Long?

You can only obtain this using an alias, and Getopt::Long of at least
version 2.13.

    use Getopt::Long;
    GetOptions ("help|?");    # -help and -? will both set $opt_help

Other characters that can't appear in Perl identifiers are also
supported in aliases with Getopt::Long of at version 2.39. Note that
the characters C<!>, C<|>, C<+>, C<=>, and C<:> can only appear as the
first (or only) character of an alias.

As of version 2.32 Getopt::Long provides auto-help, a quick and easy way
to add the options --help and -? to your program, and handle them.

See C<auto_help> in section L<Configuring Getopt::Long>.

=head1 AUTHOR

Johan Vromans <jvromans@squirrel.nl>

=head1 COPYRIGHT AND DISCLAIMER

This program is Copyright 1990,2015 by Johan Vromans.
This program is free software; you can redistribute it and/or
modify it under the terms of the Perl Artistic License or the
GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any
later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

If you do not have a copy of the GNU General Public License write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
MA 02139, USA.

=cut

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       # vim: ts=4 sts=4 sw=4 et:
package HTTP::Tiny;
use strict;
use warnings;
# ABSTRACT: A small, simple, correct HTTP/1.1 client

our $VERSION = '0.080';

sub _croak { require Carp; Carp::croak(@_) }

#pod =method new
#pod
#pod     $http = HTTP::Tiny->new( %attributes );
#pod
#pod This constructor returns a new HTTP::Tiny object.  Valid attributes include:
#pod
#pod =for :list
#pod * C<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If
#pod   C<agent> — ends in a space character, the default user-agent string is
#pod   appended.
#pod * C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class
#pod   that supports the C<add> and C<cookie_header> methods
#pod * C<default_headers> — A hashref of default headers to apply to requests
#pod * C<local_address> — The local IP address to bind to
#pod * C<keep_alive> — Whether to reuse the last connection (if for the same
#pod   scheme, host and port) (defaults to 1)
#pod * C<max_redirect> — Maximum number of redirects allowed (defaults to 5)
#pod * C<max_size> — Maximum response size in bytes (only when not using a data
#pod   callback).  If defined, requests with responses larger than this will return
#pod   a 599 status code.
#pod * C<http_proxy> — URL of a proxy server to use for HTTP connections
#pod   (default is C<$ENV{http_proxy}> — if set)
#pod * C<https_proxy> — URL of a proxy server to use for HTTPS connections
#pod   (default is C<$ENV{https_proxy}> — if set)
#pod * C<proxy> — URL of a generic proxy server for both HTTP and HTTPS
#pod   connections (default is C<$ENV{all_proxy}> — if set)
#pod * C<no_proxy> — List of domain suffixes that should not be proxied.  Must
#pod   be a comma-separated string or an array reference. (default is
#pod   C<$ENV{no_proxy}> —)
#pod * C<timeout> — Request timeout in seconds (default is 60) If a socket open,
#pod   read or write takes longer than the timeout, the request response status code
#pod   will be 599.
#pod * C<verify_SSL> — A boolean that indicates whether to validate the SSL
#pod   certificate of an C<https> — connection (default is false)
#pod * C<SSL_options> — A hashref of C<SSL_*> — options to pass through to
#pod   L<IO::Socket::SSL>
#pod
#pod An accessor/mutator method exists for each attribute.
#pod
#pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
#pod prevent getting the corresponding proxies from the environment.
#pod
#pod Errors during request execution will result in a pseudo-HTTP status code of 599
#pod and a reason of "Internal Exception". The content field in the response will
#pod contain the text of the error.
#pod
#pod The C<keep_alive> parameter enables a persistent connection, but only to a
#pod single destination scheme, host and port.  If any connection-relevant
#pod attributes are modified via accessor, or if the process ID or thread ID change,
#pod the persistent connection will be dropped.  If you want persistent connections
#pod across multiple destinations, use multiple HTTP::Tiny objects.
#pod
#pod See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
#pod
#pod =cut

my @attributes;
BEGIN {
    @attributes = qw(
        cookie_jar default_headers http_proxy https_proxy keep_alive
        local_address max_redirect max_size proxy no_proxy
        SSL_options verify_SSL
    );
    my %persist_ok = map {; $_ => 1 } qw(
        cookie_jar default_headers max_redirect max_size
    );
    no strict 'refs';
    no warnings 'uninitialized';
    for my $accessor ( @attributes ) {
        *{$accessor} = sub {
            @_ > 1
                ? do {
                    delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
                    $_[0]->{$accessor} = $_[1]
                }
                : $_[0]->{$accessor};
        };
    }
}

sub agent {
    my($self, $agent) = @_;
    if( @_ > 1 ){
        $self->{agent} =
            (defined $agent && $agent =~ / $/) ? $agent . $self->_agent : $agent;
    }
    return $self->{agent};
}

sub timeout {
    my ($self, $timeout) = @_;
    if ( @_ > 1 ) {
        $self->{timeout} = $timeout;
        if ($self->{handle}) {
            $self->{handle}->timeout($timeout);
        }
    }
    return $self->{timeout};
}

sub new {
    my($class, %args) = @_;

    my $self = {
        max_redirect => 5,
        timeout      => defined $args{timeout} ? $args{timeout} : 60,
        keep_alive   => 1,
        verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
        no_proxy     => $ENV{no_proxy},
    };

    bless $self, $class;

    $class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};

    for my $key ( @attributes ) {
        $self->{$key} = $args{$key} if exists $args{$key}
    }

    $self->agent( exists $args{agent} ? $args{agent} : $class->_agent );

    $self->_set_proxies;

    return $self;
}

sub _set_proxies {
    my ($self) = @_;

    # get proxies from %ENV only if not provided; explicit undef will disable
    # getting proxies from the environment

    # generic proxy
    if (! exists $self->{proxy} ) {
        $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
    }

    if ( defined $self->{proxy} ) {
        $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
    }
    else {
        delete $self->{proxy};
    }

    # http proxy
    if (! exists $self->{http_proxy} ) {
        # under CGI, bypass HTTP_PROXY as request sets it from Proxy header
        local $ENV{HTTP_PROXY} = ($ENV{CGI_HTTP_PROXY} || "") if $ENV{REQUEST_METHOD};
        $self->{http_proxy} = $ENV{http_proxy} || $ENV{HTTP_PROXY} || $self->{proxy};
    }

    if ( defined $self->{http_proxy} ) {
        $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
        $self->{_has_proxy}{http} = 1;
    }
    else {
        delete $self->{http_proxy};
    }

    # https proxy
    if (! exists $self->{https_proxy} ) {
        $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
    }

    if ( $self->{https_proxy} ) {
        $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
        $self->{_has_proxy}{https} = 1;
    }
    else {
        delete $self->{https_proxy};
    }

    # Split no_proxy to array reference if not provided as such
    unless ( ref $self->{no_proxy} eq 'ARRAY' ) {
        $self->{no_proxy} =
            (defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
    }

    return;
}

#pod =method get|head|put|post|patch|delete
#pod
#pod     $response = $http->get($url);
#pod     $response = $http->get($url, \%options);
#pod     $response = $http->head($url);
#pod
#pod These methods are shorthand for calling C<request()> for the given method.  The
#pod URL must have unsafe characters escaped and international domain names encoded.
#pod See C<request()> for valid options and a description of the response.
#pod
#pod The C<success> field of the response will be true if the status code is 2XX.
#pod
#pod =cut

for my $sub_name ( qw/get head put post patch delete/ ) {
    my $req_method = uc $sub_name;
    no strict 'refs';
    eval <<"HERE"; ## no critic
    sub $sub_name {
        my (\$self, \$url, \$args) = \@_;
        \@_ == 2 || (\@_ == 3 && ref \$args eq 'HASH')
        or _croak(q/Usage: \$http->$sub_name(URL, [HASHREF])/ . "\n");
        return \$self->request('$req_method', \$url, \$args || {});
    }
HERE
}

#pod =method post_form
#pod
#pod     $response = $http->post_form($url, $form_data);
#pod     $response = $http->post_form($url, $form_data, \%options);
#pod
#pod This method executes a C<POST> request and sends the key/value pairs from a
#pod form data hash or array reference to the given URL with a C<content-type> of
#pod C<application/x-www-form-urlencoded>.  If data is provided as an array
#pod reference, the order is preserved; if provided as a hash reference, the terms
#pod are sorted on key and value for consistency.  See documentation for the
#pod C<www_form_urlencode> method for details on the encoding.
#pod
#pod The URL must have unsafe characters escaped and international domain names
#pod encoded.  See C<request()> for valid options and a description of the response.
#pod Any C<content-type> header or content in the options hashref will be ignored.
#pod
#pod The C<success> field of the response will be true if the status code is 2XX.
#pod
#pod =cut

sub post_form {
    my ($self, $url, $data, $args) = @_;
    (@_ == 3 || @_ == 4 && ref $args eq 'HASH')
        or _croak(q/Usage: $http->post_form(URL, DATAREF, [HASHREF])/ . "\n");

    my $headers = {};
    while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
        $headers->{lc $key} = $value;
    }
    delete $args->{headers};

    return $self->request('POST', $url, {
            %$args,
            content => $self->www_form_urlencode($data),
            headers => {
                %$headers,
                'content-type' => 'application/x-www-form-urlencoded'
            },
        }
    );
}

#pod =method mirror
#pod
#pod     $response = $http->mirror($url, $file, \%options)
#pod     if ( $response->{success} ) {
#pod         print "$file is up to date\n";
#pod     }
#pod
#pod Executes a C<GET> request for the URL and saves the response body to the file
#pod name provided.  The URL must have unsafe characters escaped and international
#pod domain names encoded.  If the file already exists, the request will include an
#pod C<If-Modified-Since> header with the modification timestamp of the file.  You
#pod may specify a different C<If-Modified-Since> header yourself in the C<<
#pod $options->{headers} >> hash.
#pod
#pod The C<success> field of the response will be true if the status code is 2XX
#pod or if the status code is 304 (unmodified).
#pod
#pod If the file was modified and the server response includes a properly
#pod formatted C<Last-Modified> header, the file modification time will
#pod be updated accordingly.
#pod
#pod =cut

sub mirror {
    my ($self, $url, $file, $args) = @_;
    @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
      or _croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");

    if ( exists $args->{headers} ) {
        my $headers = {};
        while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
            $headers->{lc $key} = $value;
        }
        $args->{headers} = $headers;
    }

    if ( -e $file and my $mtime = (stat($file))[9] ) {
        $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
    }
    my $tempfile = $file . int(rand(2**31));

    require Fcntl;
    sysopen my $fh, $tempfile, Fcntl::O_CREAT()|Fcntl::O_EXCL()|Fcntl::O_WRONLY()
       or _croak(qq/Error: Could not create temporary file $tempfile for downloading: $!\n/);
    binmode $fh;
    $args->{data_callback} = sub { print {$fh} $_[0] };
    my $response = $self->request('GET', $url, $args);
    close $fh
        or _croak(qq/Error: Caught error closing temporary file $tempfile: $!\n/);

    if ( $response->{success} ) {
        rename $tempfile, $file
            or _croak(qq/Error replacing $file with $tempfile: $!\n/);
        my $lm = $response->{headers}{'last-modified'};
        if ( $lm and my $mtime = $self->_parse_http_date($lm) ) {
            utime $mtime, $mtime, $file;
        }
    }
    $response->{success} ||= $response->{status} eq '304';
    unlink $tempfile;
    return $response;
}

#pod =method request
#pod
#pod     $response = $http->request($method, $url);
#pod     $response = $http->request($method, $url, \%options);
#pod
#pod Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
#pod 'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
#pod international domain names encoded.
#pod
#pod B<NOTE>: Method names are B<case-sensitive> per the HTTP/1.1 specification.
#pod Don't use C<get> when you really want C<GET>.  See L<LIMITATIONS> for
#pod how this applies to redirection.
#pod
#pod If the URL includes a "user:password" stanza, they will be used for Basic-style
#pod authorization headers.  (Authorization headers will not be included in a
#pod redirected request.) For example:
#pod
#pod     $http->request('GET', 'http://Aladdin:open sesame@example.com/');
#pod
#pod If the "user:password" stanza contains reserved characters, they must
#pod be percent-escaped:
#pod
#pod     $http->request('GET', 'http://john%40example.com:password@example.com/');
#pod
#pod A hashref of options may be appended to modify the request.
#pod
#pod Valid options are:
#pod
#pod =for :list
#pod * C<headers> —
#pod     A hashref containing headers to include with the request.  If the value for
#pod     a header is an array reference, the header will be output multiple times with
#pod     each value in the array.  These headers over-write any default headers.
#pod * C<content> —
#pod     A scalar to include as the body of the request OR a code reference
#pod     that will be called iteratively to produce the body of the request
#pod * C<trailer_callback> —
#pod     A code reference that will be called if it exists to provide a hashref
#pod     of trailing headers (only used with chunked transfer-encoding)
#pod * C<data_callback> —
#pod     A code reference that will be called for each chunks of the response
#pod     body received.
#pod * C<peer> —
#pod     Override host resolution and force all connections to go only to a
#pod     specific peer address, regardless of the URL of the request.  This will
#pod     include any redirections!  This options should be used with extreme
#pod     caution (e.g. debugging or very special circumstances). It can be given as
#pod     either a scalar or a code reference that will receive the hostname and
#pod     whose response will be taken as the address.
#pod
#pod The C<Host> header is generated from the URL in accordance with RFC 2616.  It
#pod is a fatal error to specify C<Host> in the C<headers> option.  Other headers
#pod may be ignored or overwritten if necessary for transport compliance.
#pod
#pod If the C<content> option is a code reference, it will be called iteratively
#pod to provide the content body of the request.  It should return the empty
#pod string or undef when the iterator is exhausted.
#pod
#pod If the C<content> option is the empty string, no C<content-type> or
#pod C<content-length> headers will be generated.
#pod
#pod If the C<data_callback> option is provided, it will be called iteratively until
#pod the entire response body is received.  The first argument will be a string
#pod containing a chunk of the response body, the second argument will be the
#pod in-progress response hash reference, as described below.  (This allows
#pod customizing the action of the callback based on the C<status> or C<headers>
#pod received prior to the content body.)
#pod
#pod The C<request> method returns a hashref containing the response.  The hashref
#pod will have the following keys:
#pod
#pod =for :list
#pod * C<success> —
#pod     Boolean indicating whether the operation returned a 2XX status code
#pod * C<url> —
#pod     URL that provided the response. This is the URL of the request unless
#pod     there were redirections, in which case it is the last URL queried
#pod     in a redirection chain
#pod * C<status> —
#pod     The HTTP status code of the response
#pod * C<reason> —
#pod     The response phrase returned by the server
#pod * C<content> —
#pod     The body of the response.  If the response does not have any content
#pod     or if a data callback is provided to consume the response body,
#pod     this will be the empty string
#pod * C<headers> —
#pod     A hashref of header fields.  All header field names will be normalized
#pod     to be lower case. If a header is repeated, the value will be an arrayref;
#pod     it will otherwise be a scalar string containing the value
#pod * C<protocol> -
#pod     If this field exists, it is the protocol of the response
#pod     such as HTTP/1.0 or HTTP/1.1
#pod * C<redirects>
#pod     If this field exists, it is an arrayref of response hash references from
#pod     redirects in the same order that redirections occurred.  If it does
#pod     not exist, then no redirections occurred.
#pod
#pod On an error during the execution of the request, the C<status> field will
#pod contain 599, and the C<content> field will contain the text of the error.
#pod
#pod =cut

my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;

sub request {
    my ($self, $method, $url, $args) = @_;
    @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
      or _croak(q/Usage: $http->request(METHOD, URL, [HASHREF])/ . "\n");
    $args ||= {}; # we keep some state in this during _request

    # RFC 2616 Section 8.1.4 mandates a single retry on broken socket
    my $response;
    for ( 0 .. 1 ) {
        $response = eval { $self->_request($method, $url, $args) };
        last unless $@ && $idempotent{$method}
            && $@ =~ m{^(?:Socket closed|Unexpected end|SSL read error)};
    }

    if (my $e = $@) {
        # maybe we got a response hash thrown from somewhere deep
        if ( ref $e eq 'HASH' && exists $e->{status} ) {
            $e->{redirects} = delete $args->{_redirects} if @{ $args->{_redirects} || []};
            return $e;
        }

        # otherwise, stringify it
        $e = "$e";
        $response = {
            url     => $url,
            success => q{},
            status  => 599,
            reason  => 'Internal Exception',
            content => $e,
            headers => {
                'content-type'   => 'text/plain',
                'content-length' => length $e,
            },
            ( @{$args->{_redirects} || []} ? (redirects => delete $args->{_redirects}) : () ),
        };
    }
    return $response;
}

#pod =method www_form_urlencode
#pod
#pod     $params = $http->www_form_urlencode( $data );
#pod     $response = $http->get("http://example.com/query?$params");
#pod
#pod This method converts the key/value pairs from a data hash or array reference
#pod into a C<x-www-form-urlencoded> string.  The keys and values from the data
#pod reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
#pod array reference, the key will be repeated with each of the values of the array
#pod reference.  If data is provided as a hash reference, the key/value pairs in the
#pod resulting string will be sorted by key and value for consistent ordering.
#pod
#pod =cut

sub www_form_urlencode {
    my ($self, $data) = @_;
    (@_ == 2 && ref $data)
        or _croak(q/Usage: $http->www_form_urlencode(DATAREF)/ . "\n");
    (ref $data eq 'HASH' || ref $data eq 'ARRAY')
        or _croak("form data must be a hash or array reference\n");

    my @params = ref $data eq 'HASH' ? %$data : @$data;
    @params % 2 == 0
        or _croak("form data reference must have an even number of terms\n");

    my @terms;
    while( @params ) {
        my ($key, $value) = splice(@params, 0, 2);
        _croak("form data keys must not be undef")
            if !defined($key);
        if ( ref $value eq 'ARRAY' ) {
            unshift @params, map { $key => $_ } @$value;
        }
        else {
            push @terms, join("=", map { $self->_uri_escape($_) } $key, $value);
        }
    }

    return join("&", (ref $data eq 'ARRAY') ? (@terms) : (sort @terms) );
}

#pod =method can_ssl
#pod
#pod     $ok         = HTTP::Tiny->can_ssl;
#pod     ($ok, $why) = HTTP::Tiny->can_ssl;
#pod     ($ok, $why) = $http->can_ssl;
#pod
#pod Indicates if SSL support is available.  When called as a class object, it
#pod checks for the correct version of L<Net::SSLeay> and L<IO::Socket::SSL>.
#pod When called as an object methods, if C<SSL_verify> is true or if C<SSL_verify_mode>
#pod is set in C<SSL_options>, it checks that a CA file is available.
#pod
#pod In scalar context, returns a boolean indicating if SSL is available.
#pod In list context, returns the boolean and a (possibly multi-line) string of
#pod errors indicating why SSL isn't available.
#pod
#pod =cut

sub can_ssl {
    my ($self) = @_;

    my($ok, $reason) = (1, '');

    # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
    local @INC = @INC;
    pop @INC if $INC[-1] eq '.';
    unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) {
        $ok = 0;
        $reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/;
    }

    # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
    unless (eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)}) {
        $ok = 0;
        $reason .= qq/Net::SSLeay 1.49 must be installed for https support\n/;
    }

    # If an object, check that SSL config lets us get a CA if necessary
    if ( ref($self) && ( $self->{verify_SSL} || $self->{SSL_options}{SSL_verify_mode} ) ) {
        my $handle = HTTP::Tiny::Handle->new(
            SSL_options => $self->{SSL_options},
            verify_SSL  => $self->{verify_SSL},
        );
        unless ( eval { $handle->_find_CA_file; 1 } ) {
            $ok = 0;
            $reason .= "$@";
        }
    }

    wantarray ? ($ok, $reason) : $ok;
}

#pod =method connected
#pod
#pod     $host = $http->connected;
#pod     ($host, $port) = $http->connected;
#pod
#pod Indicates if a connection to a peer is being kept alive, per the C<keep_alive>
#pod option.
#pod
#pod In scalar context, returns the peer host and port, joined with a colon, or
#pod C<undef> (if no peer is connected).
#pod In list context, returns the peer host and port or an empty list (if no peer
#pod is connected).
#pod
#pod B<Note>: This method cannot reliably be used to discover whether the remote
#pod host has closed its end of the socket.
#pod
#pod =cut

sub connected {
    my ($self) = @_;

    if ( $self->{handle} ) {
        return $self->{handle}->connected;
    }
    return;
}

#--------------------------------------------------------------------------#
# private methods
#--------------------------------------------------------------------------#

my %DefaultPort = (
    http => 80,
    https => 443,
);

sub _agent {
    my $class = ref($_[0]) || $_[0];
    (my $default_agent = $class) =~ s{::}{-}g;
    my $version = $class->VERSION;
    $default_agent .= "/$version" if defined $version;
    return $default_agent;
}

sub _request {
    my ($self, $method, $url, $args) = @_;

    my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);

    if ($scheme ne 'http' && $scheme ne 'https') {
      die(qq/Unsupported URL scheme '$scheme'\n/);
    }

    my $request = {
        method    => $method,
        scheme    => $scheme,
        host      => $host,
        port      => $port,
        host_port => ($port == $DefaultPort{$scheme} ? $host : "$host:$port"),
        uri       => $path_query,
        headers   => {},
    };

    my $peer = $args->{peer} || $host;

    # Allow 'peer' to be a coderef.
    if ('CODE' eq ref $peer) {
        $peer = $peer->($host);
    }

    # We remove the cached handle so it is not reused in the case of redirect.
    # If all is well, it will be recached at the end of _request.  We only
    # reuse for the same scheme, host and port
    my $handle = delete $self->{handle};
    if ( $handle ) {
        unless ( $handle->can_reuse( $scheme, $host, $port, $peer ) ) {
            $handle->close;
            undef $handle;
        }
    }
    $handle ||= $self->_open_handle( $request, $scheme, $host, $port, $peer );

    $self->_prepare_headers_and_cb($request, $args, $url, $auth);
    $handle->write_request($request);

    my $response;
    do { $response = $handle->read_response_header }
        until (substr($response->{status},0,1) ne '1');

    $self->_update_cookie_jar( $url, $response ) if $self->{cookie_jar};
    my @redir_args = $self->_maybe_redirect($request, $response, $args);

    my $known_message_length;
    if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
        # response has no message body
        $known_message_length = 1;
    }
    else {
        # Ignore any data callbacks during redirection.
        my $cb_args = @redir_args ? +{} : $args;
        my $data_cb = $self->_prepare_data_cb($response, $cb_args);
        $known_message_length = $handle->read_body($data_cb, $response);
    }

    if ( $self->{keep_alive}
        && $handle->connected
        && $known_message_length
        && $response->{protocol} eq 'HTTP/1.1'
        && ($response->{headers}{connection} || '') ne 'close'
    ) {
        $self->{handle} = $handle;
    }
    else {
        $handle->close;
    }

    $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
    $response->{url} = $url;

    # Push the current response onto the stack of redirects if redirecting.
    if (@redir_args) {
        push @{$args->{_redirects}}, $response;
        return $self->_request(@redir_args, $args);
    }

    # Copy the stack of redirects into the response before returning.
    $response->{redirects} = delete $args->{_redirects}
      if @{$args->{_redirects}};
    return $response;
}

sub _open_handle {
    my ($self, $request, $scheme, $host, $port, $peer) = @_;

    my $handle  = HTTP::Tiny::Handle->new(
        timeout         => $self->{timeout},
        SSL_options     => $self->{SSL_options},
        verify_SSL      => $self->{verify_SSL},
        local_address   => $self->{local_address},
        keep_alive      => $self->{keep_alive}
    );

    if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
        return $self->_proxy_connect( $request, $handle );
    }
    else {
        return $handle->connect($scheme, $host, $port, $peer);
    }
}

sub _proxy_connect {
    my ($self, $request, $handle) = @_;

    my @proxy_vars;
    if ( $request->{scheme} eq 'https' ) {
        _croak(qq{No https_proxy defined}) unless $self->{https_proxy};
        @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
        if ( $proxy_vars[0] eq 'https' ) {
            _croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
        }
    }
    else {
        _croak(qq{No http_proxy defined}) unless $self->{http_proxy};
        @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
    }

    my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;

    if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
        $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
    }

    $handle->connect($p_scheme, $p_host, $p_port, $p_host);

    if ($request->{scheme} eq 'https') {
        $self->_create_proxy_tunnel( $request, $handle );
    }
    else {
        # non-tunneled proxy requires absolute URI
        $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
    }

    return $handle;
}

sub _split_proxy {
    my ($self, $type, $proxy) = @_;

    my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };

    unless(
        defined($scheme) && length($scheme) && length($host) && length($port)
        && $path_query eq '/'
    ) {
        _croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
    }

    return ($scheme, $host, $port, $auth);
}

sub _create_proxy_tunnel {
    my ($self, $request, $handle) = @_;

    $handle->_assert_ssl;

    my $agent = exists($request->{headers}{'user-agent'})
        ? $request->{headers}{'user-agent'} : $self->{agent};

    my $connect_request = {
        method    => 'CONNECT',
        uri       => "$request->{host}:$request->{port}",
        headers   => {
            host => "$request->{host}:$request->{port}",
            'user-agent' => $agent,
        }
    };

    if ( $request->{headers}{'proxy-authorization'} ) {
        $connect_request->{headers}{'proxy-authorization'} =
            delete $request->{headers}{'proxy-authorization'};
    }

    $handle->write_request($connect_request);
    my $response;
    do { $response = $handle->read_response_header }
        until (substr($response->{status},0,1) ne '1');

    # if CONNECT failed, throw the response so it will be
    # returned from the original request() method;
    unless (substr($response->{status},0,1) eq '2') {
        die $response;
    }

    # tunnel established, so start SSL handshake
    $handle->start_ssl( $request->{host} );

    return;
}

sub _prepare_headers_and_cb {
    my ($self, $request, $args, $url, $auth) = @_;

    for ($self->{default_headers}, $args->{headers}) {
        next unless defined;
        while (my ($k, $v) = each %$_) {
            $request->{headers}{lc $k} = $v;
            $request->{header_case}{lc $k} = $k;
        }
    }

    if (exists $request->{headers}{'host'}) {
        die(qq/The 'Host' header must not be provided as header option\n/);
    }

    $request->{headers}{'host'}         = $request->{host_port};
    $request->{headers}{'user-agent'} ||= $self->{agent};
    $request->{headers}{'connection'}   = "close"
        unless $self->{keep_alive};

    # Some servers error on an empty-body PUT/POST without a content-length
    if ( $request->{method} eq 'PUT' || $request->{method} eq 'POST' ) {
        if (!defined($args->{content}) || !length($args->{content}) ) {
            $request->{headers}{'content-length'} = 0;
        }
    }

    if ( defined $args->{content} ) {
        if ( ref $args->{content} eq 'CODE' ) {
            if ( exists $request->{'content-length'} && $request->{'content-length'} == 0 ) {
                $request->{cb} = sub { "" };
            }
            else {
                $request->{headers}{'content-type'} ||= "application/octet-stream";
                $request->{headers}{'transfer-encoding'} = 'chunked'
                  unless exists $request->{headers}{'content-length'}
                  || $request->{headers}{'transfer-encoding'};
                $request->{cb} = $args->{content};
            }
        }
        elsif ( length $args->{content} ) {
            my $content = $args->{content};
            if ( $] ge '5.008' ) {
                utf8::downgrade($content, 1)
                    or die(qq/Wide character in request message body\n/);
            }
            $request->{headers}{'content-type'} ||= "application/octet-stream";
            $request->{headers}{'content-length'} = length $content
              unless $request->{headers}{'content-length'}
                  || $request->{headers}{'transfer-encoding'};
            $request->{cb} = sub { substr $content, 0, length $content, '' };
        }
        $request->{trailer_cb} = $args->{trailer_callback}
            if ref $args->{trailer_callback} eq 'CODE';
    }

    ### If we have a cookie jar, then maybe add relevant cookies
    if ( $self->{cookie_jar} ) {
        my $cookies = $self->cookie_jar->cookie_header( $url );
        $request->{headers}{cookie} = $cookies if length $cookies;
    }

    # if we have Basic auth parameters, add them
    if ( length $auth && ! defined $request->{headers}{authorization} ) {
        $self->_add_basic_auth_header( $request, 'authorization' => $auth );
    }

    return;
}

sub _add_basic_auth_header {
    my ($self, $request, $header, $auth) = @_;
    require MIME::Base64;
    $request->{headers}{$header} =
        "Basic " . MIME::Base64::encode_base64($auth, "");
    return;
}

sub _prepare_data_cb {
    my ($self, $response, $args) = @_;
    my $data_cb = $args->{data_callback};
    $response->{content} = '';

    if (!$data_cb || $response->{status} !~ /^2/) {
        if (defined $self->{max_size}) {
            $data_cb = sub {
                $_[1]->{content} .= $_[0];
                die(qq/Size of response body exceeds the maximum allowed of $self->{max_size}\n/)
                  if length $_[1]->{content} > $self->{max_size};
            };
        }
        else {
            $data_cb = sub { $_[1]->{content} .= $_[0] };
        }
    }
    return $data_cb;
}

sub _update_cookie_jar {
    my ($self, $url, $response) = @_;

    my $cookies = $response->{headers}->{'set-cookie'};
    return unless defined $cookies;

    my @cookies = ref $cookies ? @$cookies : $cookies;

    $self->cookie_jar->add( $url, $_ ) for @cookies;

    return;
}

sub _validate_cookie_jar {
    my ($class, $jar) = @_;

    # duck typing
    for my $method ( qw/add cookie_header/ ) {
        _croak(qq/Cookie jar must provide the '$method' method\n/)
            unless ref($jar) && ref($jar)->can($method);
    }

    return;
}

sub _maybe_redirect {
    my ($self, $request, $response, $args) = @_;
    my $headers = $response->{headers};
    my ($status, $method) = ($response->{status}, $request->{method});
    $args->{_redirects} ||= [];

    if (($status eq '303' or ($status =~ /^30[1278]/ && $method =~ /^GET|HEAD$/))
        and $headers->{location}
        and @{$args->{_redirects}} < $self->{max_redirect}
    ) {
        my $location = ($headers->{location} =~ /^\//)
            ? "$request->{scheme}://$request->{host_port}$headers->{location}"
            : $headers->{location} ;
        return (($status eq '303' ? 'GET' : $method), $location);
    }
    return;
}

sub _split_url {
    my $url = pop;

    # URI regex adapted from the URI module
    my ($scheme, $host, $path_query) = $url =~ m<\A([^:/?#]+)://([^/?#]*)([^#]*)>
      or die(qq/Cannot parse URL: '$url'\n/);

    $scheme     = lc $scheme;
    $path_query = "/$path_query" unless $path_query =~ m<\A/>;

    my $auth = '';
    if ( (my $i = index $host, '@') != -1 ) {
        # user:pass@host
        $auth = substr $host, 0, $i, ''; # take up to the @ for auth
        substr $host, 0, 1, '';          # knock the @ off the host

        # userinfo might be percent escaped, so recover real auth info
        $auth =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
    }
    my $port = $host =~ s/:(\d*)\z// && length $1 ? $1
             : $scheme eq 'http'                  ? 80
             : $scheme eq 'https'                 ? 443
             : undef;

    return ($scheme, (length $host ? lc $host : "localhost") , $port, $path_query, $auth);
}

# Date conversions adapted from HTTP::Date
my $DoW = "Sun|Mon|Tue|Wed|Thu|Fri|Sat";
my $MoY = "Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec";
sub _http_date {
    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($_[1]);
    return sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
        substr($DoW,$wday*4,3),
        $mday, substr($MoY,$mon*4,3), $year+1900,
        $hour, $min, $sec
    );
}

sub _parse_http_date {
    my ($self, $str) = @_;
    require Time::Local;
    my @tl_parts;
    if ($str =~ /^[SMTWF][a-z]+, +(\d{1,2}) ($MoY) +(\d\d\d\d) +(\d\d):(\d\d):(\d\d) +GMT$/) {
        @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
    }
    elsif ($str =~ /^[SMTWF][a-z]+, +(\d\d)-($MoY)-(\d{2,4}) +(\d\d):(\d\d):(\d\d) +GMT$/ ) {
        @tl_parts = ($6, $5, $4, $1, (index($MoY,$2)/4), $3);
    }
    elsif ($str =~ /^[SMTWF][a-z]+ +($MoY) +(\d{1,2}) +(\d\d):(\d\d):(\d\d) +(?:[^0-9]+ +)?(\d\d\d\d)$/ ) {
        @tl_parts = ($5, $4, $3, $2, (index($MoY,$1)/4), $6);
    }
    return eval {
        my $t = @tl_parts ? Time::Local::timegm(@tl_parts) : -1;
        $t < 0 ? undef : $t;
    };
}

# URI escaping adapted from URI::Escape
# c.f. http://www.w3.org/TR/html4/interact/forms.html#h-17.13.4.1
# perl 5.6 ready UTF-8 encoding adapted from JSON::PP
my %escapes = map { chr($_) => sprintf("%%%02X", $_) } 0..255;
$escapes{' '}="+";
my $unsafe_char = qr/[^A-Za-z0-9\-\._~]/;

sub _uri_escape {
    my ($self, $str) = @_;
    return "" if !defined $str;
    if ( $] ge '5.008' ) {
        utf8::encode($str);
    }
    else {
        $str = pack("U*", unpack("C*", $str)) # UTF-8 encode a byte string
            if ( length $str == do { use bytes; length $str } );
        $str = pack("C*", unpack("C*", $str)); # clear UTF-8 flag
    }
    $str =~ s/($unsafe_char)/$escapes{$1}/g;
    return $str;
}

package
    HTTP::Tiny::Handle; # hide from PAUSE/indexers
use strict;
use warnings;

use Errno      qw[EINTR EPIPE];
use IO::Socket qw[SOCK_STREAM];
use Socket     qw[SOL_SOCKET SO_KEEPALIVE];

# PERL_HTTP_TINY_IPV4_ONLY is a private environment variable to force old
# behavior if someone is unable to boostrap CPAN from a new perl install; it is
# not intended for general, per-client use and may be removed in the future
my $SOCKET_CLASS =
    $ENV{PERL_HTTP_TINY_IPV4_ONLY} ? 'IO::Socket::INET' :
    eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.32) } ? 'IO::Socket::IP' :
    'IO::Socket::INET';

sub BUFSIZE () { 32768 } ## no critic

my $Printable = sub {
    local $_ = shift;
    s/\r/\\r/g;
    s/\n/\\n/g;
    s/\t/\\t/g;
    s/([^\x20-\x7E])/sprintf('\\x%.2X', ord($1))/ge;
    $_;
};

my $Token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
my $Field_Content = qr/[[:print:]]+ (?: [\x20\x09]+ [[:print:]]+ )*/x;

sub new {
    my ($class, %args) = @_;
    return bless {
        rbuf             => '',
        timeout          => 60,
        max_line_size    => 16384,
        max_header_lines => 64,
        verify_SSL       => 0,
        SSL_options      => {},
        %args
    }, $class;
}

sub timeout {
    my ($self, $timeout) = @_;
    if ( @_ > 1 ) {
        $self->{timeout} = $timeout;
        if ( $self->{fh} && $self->{fh}->can('timeout') ) {
            $self->{fh}->timeout($timeout);
        }
    }
    return $self->{timeout};
}

sub connect {
    @_ == 5 || die(q/Usage: $handle->connect(scheme, host, port, peer)/ . "\n");
    my ($self, $scheme, $host, $port, $peer) = @_;

    if ( $scheme eq 'https' ) {
        $self->_assert_ssl;
    }

    $self->{fh} = $SOCKET_CLASS->new(
        PeerHost  => $peer,
        PeerPort  => $port,
        $self->{local_address} ?
            ( LocalAddr => $self->{local_address} ) : (),
        Proto     => 'tcp',
        Type      => SOCK_STREAM,
        Timeout   => $self->{timeout},
    ) or die(qq/Could not connect to '$host:$port': $@\n/);

    binmode($self->{fh})
      or die(qq/Could not binmode() socket: '$!'\n/);

    if ( $self->{keep_alive} ) {
        unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) {
            CORE::close($self->{fh});
            die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/);
        }
    }

    $self->start_ssl($host) if $scheme eq 'https';

    $self->{scheme} = $scheme;
    $self->{host} = $host;
    $self->{peer} = $peer;
    $self->{port} = $port;
    $self->{pid} = $$;
    $self->{tid} = _get_tid();

    return $self;
}

sub connected {
    my ($self) = @_;
    if ( $self->{fh} && $self->{fh}->connected ) {
        return wantarray
          ? ( $self->{fh}->peerhost, $self->{fh}->peerport )
          : join( ':', $self->{fh}->peerhost, $self->{fh}->peerport );
    }
    return;
}

sub start_ssl {
    my ($self, $host) = @_;

    # As this might be used via CONNECT after an SSL session
    # to a proxy, we shut down any existing SSL before attempting
    # the handshake
    if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
        unless ( $self->{fh}->stop_SSL ) {
            my $ssl_err = IO::Socket::SSL->errstr;
            die(qq/Error halting prior SSL connection: $ssl_err/);
        }
    }

    my $ssl_args = $self->_ssl_args($host);
    IO::Socket::SSL->start_SSL(
        $self->{fh},
        %$ssl_args,
        SSL_create_ctx_callback => sub {
            my $ctx = shift;
            Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
        },
    );

    unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
        my $ssl_err = IO::Socket::SSL->errstr;
        die(qq/SSL connection failed for $host: $ssl_err\n/);
    }
}

sub close {
    @_ == 1 || die(q/Usage: $handle->close()/ . "\n");
    my ($self) = @_;
    CORE::close($self->{fh})
      or die(qq/Could not close socket: '$!'\n/);
}

sub write {
    @_ == 2 || die(q/Usage: $handle->write(buf)/ . "\n");
    my ($self, $buf) = @_;

    if ( $] ge '5.008' ) {
        utf8::downgrade($buf, 1)
            or die(qq/Wide character in write()\n/);
    }

    my $len = length $buf;
    my $off = 0;

    local $SIG{PIPE} = 'IGNORE';

    while () {
        $self->can_write
          or die(qq/Timed out while waiting for socket to become ready for writing\n/);
        my $r = syswrite($self->{fh}, $buf, $len, $off);
        if (defined $r) {
            $len -= $r;
            $off += $r;
            last unless $len > 0;
        }
        elsif ($! == EPIPE) {
            die(qq/Socket closed by remote server: $!\n/);
        }
        elsif ($! != EINTR) {
            if ($self->{fh}->can('errstr')){
                my $err = $self->{fh}->errstr();
                die (qq/Could not write to SSL socket: '$err'\n /);
            }
            else {
                die(qq/Could not write to socket: '$!'\n/);
            }

        }
    }
    return $off;
}

sub read {
    @_ == 2 || @_ == 3 || die(q/Usage: $handle->read(len [, allow_partial])/ . "\n");
    my ($self, $len, $allow_partial) = @_;

    my $buf  = '';
    my $got = length $self->{rbuf};

    if ($got) {
        my $take = ($got < $len) ? $got : $len;
        $buf  = substr($self->{rbuf}, 0, $take, '');
        $len -= $take;
    }

    # Ignore SIGPIPE because SSL reads can result in writes that might error.
    # See "Expecting exactly the same behavior as plain sockets" in
    # https://metacpan.org/dist/IO-Socket-SSL/view/lib/IO/Socket/SSL.pod#Common-Usage-Errors
    local $SIG{PIPE} = 'IGNORE';

    while ($len > 0) {
        $self->can_read
          or die(q/Timed out while waiting for socket to become ready for reading/ . "\n");
        my $r = sysread($self->{fh}, $buf, $len, length $buf);
        if (defined $r) {
            last unless $r;
            $len -= $r;
        }
        elsif ($! != EINTR) {
            if ($self->{fh}->can('errstr')){
                my $err = $self->{fh}->errstr();
                die (qq/Could not read from SSL socket: '$err'\n /);
            }
            else {
                die(qq/Could not read from socket: '$!'\n/);
            }
        }
    }
    if ($len && !$allow_partial) {
        die(qq/Unexpected end of stream\n/);
    }
    return $buf;
}

sub readline {
    @_ == 1 || die(q/Usage: $handle->readline()/ . "\n");
    my ($self) = @_;

    while () {
        if ($self->{rbuf} =~ s/\A ([^\x0D\x0A]* \x0D?\x0A)//x) {
            return $1;
        }
        if (length $self->{rbuf} >= $self->{max_line_size}) {
            die(qq/Line size exceeds the maximum allowed size of $self->{max_line_size}\n/);
        }
        $self->can_read
          or die(qq/Timed out while waiting for socket to become ready for reading\n/);
        my $r = sysread($self->{fh}, $self->{rbuf}, BUFSIZE, length $self->{rbuf});
        if (defined $r) {
            last unless $r;
        }
        elsif ($! != EINTR) {
            if ($self->{fh}->can('errstr')){
                my $err = $self->{fh}->errstr();
                die (qq/Could not read from SSL socket: '$err'\n /);
            }
            else {
                die(qq/Could not read from socket: '$!'\n/);
            }
        }
    }
    die(qq/Unexpected end of stream while looking for line\n/);
}

sub read_header_lines {
    @_ == 1 || @_ == 2 || die(q/Usage: $handle->read_header_lines([headers])/ . "\n");
    my ($self, $headers) = @_;
    $headers ||= {};
    my $lines   = 0;
    my $val;

    while () {
         my $line = $self->readline;

         if (++$lines >= $self->{max_header_lines}) {
             die(qq/Header lines exceeds maximum number allowed of $self->{max_header_lines}\n/);
         }
         elsif ($line =~ /\A ([^\x00-\x1F\x7F:]+) : [\x09\x20]* ([^\x0D\x0A]*)/x) {
             my ($field_name) = lc $1;
             if (exists $headers->{$field_name}) {
                 for ($headers->{$field_name}) {
                     $_ = [$_] unless ref $_ eq "ARRAY";
                     push @$_, $2;
                     $val = \$_->[-1];
                 }
             }
             else {
                 $val = \($headers->{$field_name} = $2);
             }
         }
         elsif ($line =~ /\A [\x09\x20]+ ([^\x0D\x0A]*)/x) {
             $val
               or die(qq/Unexpected header continuation line\n/);
             next unless length $1;
             $$val .= ' ' if length $$val;
             $$val .= $1;
         }
         elsif ($line =~ /\A \x0D?\x0A \z/x) {
            last;
         }
         else {
            die(q/Malformed header line: / . $Printable->($line) . "\n");
         }
    }
    return $headers;
}

sub write_request {
    @_ == 2 || die(q/Usage: $handle->write_request(request)/ . "\n");
    my($self, $request) = @_;
    $self->write_request_header(@{$request}{qw/method uri headers header_case/});
    $self->write_body($request) if $request->{cb};
    return;
}

# Standard request header names/case from HTTP/1.1 RFCs
my @rfc_request_headers = qw(
  Accept Accept-Charset Accept-Encoding Accept-Language Authorization
  Cache-Control Connection Content-Length Expect From Host
  If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
  Max-Forwards Pragma Proxy-Authorization Range Referer TE Trailer
  Transfer-Encoding Upgrade User-Agent Via
);

my @other_request_headers = qw(
  Content-Encoding Content-MD5 Content-Type Cookie DNT Date Origin
  X-XSS-Protection
);

my %HeaderCase = map { lc($_) => $_ } @rfc_request_headers, @other_request_headers;

# to avoid multiple small writes and hence nagle, you can pass the method line or anything else to
# combine writes.
sub write_header_lines {
    (@_ >= 2 && @_ <= 4 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers, [header_case, prefix])/ . "\n");
    my($self, $headers, $header_case, $prefix_data) = @_;
    $header_case ||= {};

    my $buf = (defined $prefix_data ? $prefix_data : '');

    # Per RFC, control fields should be listed first
    my %seen;
    for my $k ( qw/host cache-control expect max-forwards pragma range te/ ) {
        next unless exists $headers->{$k};
        $seen{$k}++;
        my $field_name = $HeaderCase{$k};
        my $v = $headers->{$k};
        for (ref $v eq 'ARRAY' ? @$v : $v) {
            $_ = '' unless defined $_;
            $buf .= "$field_name: $_\x0D\x0A";
        }
    }

    # Other headers sent in arbitrary order
    while (my ($k, $v) = each %$headers) {
        my $field_name = lc $k;
        next if $seen{$field_name};
        if (exists $HeaderCase{$field_name}) {
            $field_name = $HeaderCase{$field_name};
        }
        else {
            if (exists $header_case->{$field_name}) {
                $field_name = $header_case->{$field_name};
            }
            else {
                $field_name =~ s/\b(\w)/\u$1/g;
            }
            $field_name =~ /\A $Token+ \z/xo
              or die(q/Invalid HTTP header field name: / . $Printable->($field_name) . "\n");
            $HeaderCase{lc $field_name} = $field_name;
        }
        for (ref $v eq 'ARRAY' ? @$v : $v) {
            # unwrap a field value if pre-wrapped by user
            s/\x0D?\x0A\s+/ /g;
            die(qq/Invalid HTTP header field value ($field_name): / . $Printable->($_). "\n")
              unless $_ eq '' || /\A $Field_Content \z/xo;
            $_ = '' unless defined $_;
            $buf .= "$field_name: $_\x0D\x0A";
        }
    }
    $buf .= "\x0D\x0A";
    return $self->write($buf);
}

# return value indicates whether message length was defined; this is generally
# true unless there was no content-length header and we just read until EOF.
# Other message length errors are thrown as exceptions
sub read_body {
    @_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
    my ($self, $cb, $response) = @_;
    my $te = $response->{headers}{'transfer-encoding'} || '';
    my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
    return $chunked
        ? $self->read_chunked_body($cb, $response)
        : $self->read_content_body($cb, $response);
}

sub write_body {
    @_ == 2 || die(q/Usage: $handle->write_body(request)/ . "\n");
    my ($self, $request) = @_;
    if (exists $request->{headers}{'content-length'}) {
        return unless $request->{headers}{'content-length'};
        return $self->write_content_body($request);
    }
    else {
        return $self->write_chunked_body($request);
    }
}

sub read_content_body {
    @_ == 3 || @_ == 4 || die(q/Usage: $handle->read_content_body(callback, response, [read_length])/ . "\n");
    my ($self, $cb, $response, $content_length) = @_;
    $content_length ||= $response->{headers}{'content-length'};

    if ( defined $content_length ) {
        my $len = $content_length;
        while ($len > 0) {
            my $read = ($len > BUFSIZE) ? BUFSIZE : $len;
            $cb->($self->read($read, 0), $response);
            $len -= $read;
        }
        return length($self->{rbuf}) == 0;
    }

    my $chunk;
    $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );

    return;
}

sub write_content_body {
    @_ == 2 || die(q/Usage: $handle->write_content_body(request)/ . "\n");
    my ($self, $request) = @_;

    my ($len, $content_length) = (0, $request->{headers}{'content-length'});
    while () {
        my $data = $request->{cb}->();

        defined $data && length $data
          or last;

        if ( $] ge '5.008' ) {
            utf8::downgrade($data, 1)
                or die(qq/Wide character in write_content()\n/);
        }

        $len += $self->write($data);
    }

    $len == $content_length
      or die(qq/Content-Length mismatch (got: $len expected: $content_length)\n/);

    return $len;
}

sub read_chunked_body {
    @_ == 3 || die(q/Usage: $handle->read_chunked_body(callback, $response)/ . "\n");
    my ($self, $cb, $response) = @_;

    while () {
        my $head = $self->readline;

        $head =~ /\A ([A-Fa-f0-9]+)/x
          or die(q/Malformed chunk head: / . $Printable->($head) . "\n");

        my $len = hex($1)
          or last;

        $self->read_content_body($cb, $response, $len);

        $self->read(2) eq "\x0D\x0A"
          or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
    }
    $self->read_header_lines($response->{headers});
    return 1;
}

sub write_chunked_body {
    @_ == 2 || die(q/Usage: $handle->write_chunked_body(request)/ . "\n");
    my ($self, $request) = @_;

    my $len = 0;
    while () {
        my $data = $request->{cb}->();

        defined $data && length $data
          or last;

        if ( $] ge '5.008' ) {
            utf8::downgrade($data, 1)
                or die(qq/Wide character in write_chunked_body()\n/);
        }

        $len += length $data;

        my $chunk  = sprintf '%X', length $data;
           $chunk .= "\x0D\x0A";
           $chunk .= $data;
           $chunk .= "\x0D\x0A";

        $self->write($chunk);
    }
    $self->write("0\x0D\x0A");
    if ( ref $request->{trailer_cb} eq 'CODE' ) {
        $self->write_header_lines($request->{trailer_cb}->())
    }
    else {
        $self->write("\x0D\x0A");
    }
    return $len;
}

sub read_response_header {
    @_ == 1 || die(q/Usage: $handle->read_response_header()/ . "\n");
    my ($self) = @_;

    my $line = $self->readline;

    $line =~ /\A (HTTP\/(0*\d+\.0*\d+)) [\x09\x20]+ ([0-9]{3}) (?: [\x09\x20]+ ([^\x0D\x0A]*) )? \x0D?\x0A/x
      or die(q/Malformed Status-Line: / . $Printable->($line). "\n");

    my ($protocol, $version, $status, $reason) = ($1, $2, $3, $4);
    $reason = "" unless defined $reason;

    die (qq/Unsupported HTTP protocol: $protocol\n/)
        unless $version =~ /0*1\.0*[01]/;

    return {
        status       => $status,
        reason       => $reason,
        headers      => $self->read_header_lines,
        protocol     => $protocol,
    };
}

sub write_request_header {
    @_ == 5 || die(q/Usage: $handle->write_request_header(method, request_uri, headers, header_case)/ . "\n");
    my ($self, $method, $request_uri, $headers, $header_case) = @_;

    return $self->write_header_lines($headers, $header_case, "$method $request_uri HTTP/1.1\x0D\x0A");
}

sub _do_timeout {
    my ($self, $type, $timeout) = @_;
    $timeout = $self->{timeout}
        unless defined $timeout && $timeout >= 0;

    my $fd = fileno $self->{fh};
    defined $fd && $fd >= 0
      or die(qq/select(2): 'Bad file descriptor'\n/);

    my $initial = time;
    my $pending = $timeout;
    my $nfound;

    vec(my $fdset = '', $fd, 1) = 1;

    while () {
        $nfound = ($type eq 'read')
            ? select($fdset, undef, undef, $pending)
            : select(undef, $fdset, undef, $pending) ;
        if ($nfound == -1) {
            $! == EINTR
              or die(qq/select(2): '$!'\n/);
            redo if !$timeout || ($pending = $timeout - (time - $initial)) > 0;
            $nfound = 0;
        }
        last;
    }
    $! = 0;
    return $nfound;
}

sub can_read {
    @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
    my $self = shift;
    if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
        return 1 if $self->{fh}->pending;
    }
    return $self->_do_timeout('read', @_)
}

sub can_write {
    @_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
    my $self = shift;
    return $self->_do_timeout('write', @_)
}

sub _assert_ssl {
    my($ok, $reason) = HTTP::Tiny->can_ssl();
    die $reason unless $ok;
}

sub can_reuse {
    my ($self,$scheme,$host,$port,$peer) = @_;
    return 0 if
        $self->{pid} != $$
        || $self->{tid} != _get_tid()
        || length($self->{rbuf})
        || $scheme ne $self->{scheme}
        || $host ne $self->{host}
        || $port ne $self->{port}
        || $peer ne $self->{peer}
        || eval { $self->can_read(0) }
        || $@ ;
        return 1;
}

# Try to find a CA bundle to validate the SSL cert,
# prefer Mozilla::CA or fallback to a system file
sub _find_CA_file {
    my $self = shift();

    my $ca_file =
      defined( $self->{SSL_options}->{SSL_ca_file} )
      ? $self->{SSL_options}->{SSL_ca_file}
      : $ENV{SSL_CERT_FILE};

    if ( defined $ca_file ) {
        unless ( -r $ca_file ) {
            die qq/SSL_ca_file '$ca_file' not found or not readable\n/;
        }
        return $ca_file;
    }

    local @INC = @INC;
    pop @INC if $INC[-1] eq '.';
    return Mozilla::CA::SSL_ca_file()
        if eval { require Mozilla::CA; 1 };

    # cert list copied from golang src/crypto/x509/root_unix.go
    foreach my $ca_bundle (
        "/etc/ssl/certs/ca-certificates.crt",     # Debian/Ubuntu/Gentoo etc.
        "/etc/pki/tls/certs/ca-bundle.crt",       # Fedora/RHEL
        "/etc/ssl/ca-bundle.pem",                 # OpenSUSE
        "/etc/openssl/certs/ca-certificates.crt", # NetBSD
        "/etc/ssl/cert.pem",                      # OpenBSD
        "/usr/local/share/certs/ca-root-nss.crt", # FreeBSD/DragonFly
        "/etc/pki/tls/cacert.pem",                # OpenELEC
        "/etc/certs/ca-certificates.crt",         # Solaris 11.2+
    ) {
        return $ca_bundle if -e $ca_bundle;
    }

    die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
      . qq/Try installing Mozilla::CA from CPAN\n/;
}

# for thread safety, we need to know thread id if threads are loaded
sub _get_tid {
    no warnings 'reserved'; # for 'threads'
    return threads->can("tid") ? threads->tid : 0;
}

sub _ssl_args {
    my ($self, $host) = @_;

    my %ssl_args;

    # This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
    # added until IO::Socket::SSL 1.84
    if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
        $ssl_args{SSL_hostname} = $host,          # Sane SNI support
    }

    if ($self->{verify_SSL}) {
        $ssl_args{SSL_verifycn_scheme}  = 'http'; # enable CN validation
        $ssl_args{SSL_verifycn_name}    = $host;  # set validation hostname
        $ssl_args{SSL_verify_mode}      = 0x01;   # enable cert validation
        $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
    }
    else {
        $ssl_args{SSL_verifycn_scheme}  = 'none'; # disable CN validation
        $ssl_args{SSL_verify_mode}      = 0x00;   # disable cert validation
    }

    # user options override settings from verify_SSL
    for my $k ( keys %{$self->{SSL_options}} ) {
        $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
    }

    return \%ssl_args;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

HTTP::Tiny - A small, simple, correct HTTP/1.1 client

=head1 VERSION

version 0.080

=head1 SYNOPSIS

    use HTTP::Tiny;

    my $response = HTTP::Tiny->new->get('http://example.com/');

    die "Failed!\n" unless $response->{success};

    print "$response->{status} $response->{reason}\n";

    while (my ($k, $v) = each %{$response->{headers}}) {
        for (ref $v eq 'ARRAY' ? @$v : $v) {
            print "$k: $_\n";
        }
    }

    print $response->{content} if length $response->{content};

=head1 DESCRIPTION

This is a very simple HTTP/1.1 client, designed for doing simple
requests without the overhead of a large framework like L<LWP::UserAgent>.

It is more correct and more complete than L<HTTP::Lite>.  It supports
proxies and redirection.  It also correctly resumes after EINTR.

If L<IO::Socket::IP> 0.25 or later is installed, HTTP::Tiny will use it instead
of L<IO::Socket::INET> for transparent support for both IPv4 and IPv6.

Cookie support requires L<HTTP::CookieJar> or an equivalent class.

=head1 METHODS

=head2 new

    $http = HTTP::Tiny->new( %attributes );

This constructor returns a new HTTP::Tiny object.  Valid attributes include:

=over 4

=item *

C<agent> — A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> — ends in a space character, the default user-agent string is appended.

=item *

C<cookie_jar> — An instance of L<HTTP::CookieJar> — or equivalent class that supports the C<add> and C<cookie_header> methods

=item *

C<default_headers> — A hashref of default headers to apply to requests

=item *

C<local_address> — The local IP address to bind to

=item *

C<keep_alive> — Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)

=item *

C<max_redirect> — Maximum number of redirects allowed (defaults to 5)

=item *

C<max_size> — Maximum response size in bytes (only when not using a data callback).  If defined, requests with responses larger than this will return a 599 status code.

=item *

C<http_proxy> — URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> — if set)

=item *

C<https_proxy> — URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> — if set)

=item *

C<proxy> — URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> — if set)

=item *

C<no_proxy> — List of domain suffixes that should not be proxied.  Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}> —)

=item *

C<timeout> — Request timeout in seconds (default is 60) If a socket open, read or write takes longer than the timeout, the request response status code will be 599.

=item *

C<verify_SSL> — A boolean that indicates whether to validate the SSL certificate of an C<https> — connection (default is false)

=item *

C<SSL_options> — A hashref of C<SSL_*> — options to pass through to L<IO::Socket::SSL>

=back

An accessor/mutator method exists for each attribute.

Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
prevent getting the corresponding proxies from the environment.

Errors during request execution will result in a pseudo-HTTP status code of 599
and a reason of "Internal Exception". The content field in the response will
contain the text of the error.

The C<keep_alive> parameter enables a persistent connection, but only to a
single destination scheme, host and port.  If any connection-relevant
attributes are modified via accessor, or if the process ID or thread ID change,
the persistent connection will be dropped.  If you want persistent connections
across multiple destinations, use multiple HTTP::Tiny objects.

See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.

=head2 get|head|put|post|patch|delete

    $response = $http->get($url);
    $response = $http->get($url, \%options);
    $response = $http->head($url);

These methods are shorthand for calling C<request()> for the given method.  The
URL must have unsafe characters escaped and international domain names encoded.
See C<request()> for valid options and a description of the response.

The C<success> field of the response will be true if the status code is 2XX.

=head2 post_form

    $response = $http->post_form($url, $form_data);
    $response = $http->post_form($url, $form_data, \%options);

This method executes a C<POST> request and sends the key/value pairs from a
form data hash or array reference to the given URL with a C<content-type> of
C<application/x-www-form-urlencoded>.  If data is provided as an array
reference, the order is preserved; if provided as a hash reference, the terms
are sorted on key and value for consistency.  See documentation for the
C<www_form_urlencode> method for details on the encoding.

The URL must have unsafe characters escaped and international domain names
encoded.  See C<request()> for valid options and a description of the response.
Any C<content-type> header or content in the options hashref will be ignored.

The C<success> field of the response will be true if the status code is 2XX.

=head2 mirror

    $response = $http->mirror($url, $file, \%options)
    if ( $response->{success} ) {
        print "$file is up to date\n";
    }

Executes a C<GET> request for the URL and saves the response body to the file
name provided.  The URL must have unsafe characters escaped and international
domain names encoded.  If the file already exists, the request will include an
C<If-Modified-Since> header with the modification timestamp of the file.  You
may specify a different C<If-Modified-Since> header yourself in the C<<
$options->{headers} >> hash.

The C<success> field of the response will be true if the status code is 2XX
or if the status code is 304 (unmodified).

If the file was modified and the server response includes a properly
formatted C<Last-Modified> header, the file modification time will
be updated accordingly.

=head2 request

    $response = $http->request($method, $url);
    $response = $http->request($method, $url, \%options);

Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
'PUT', etc.) on the given URL.  The URL must have unsafe characters escaped and
international domain names encoded.

B<NOTE>: Method names are B<case-sensitive> per the HTTP/1.1 specification.
Don't use C<get> when you really want C<GET>.  See L<LIMITATIONS> for
how this applies to redirection.

If the URL includes a "user:password" stanza, they will be used for Basic-style
authorization headers.  (Authorization headers will not be included in a
redirected request.) For example:

    $http->request('GET', 'http://Aladdin:open sesame@example.com/');

If the "user:password" stanza contains reserved characters, they must
be percent-escaped:

    $http->request('GET', 'http://john%40example.com:password@example.com/');

A hashref of options may be appended to modify the request.

Valid options are:

=over 4

=item *

C<headers> — A hashref containing headers to include with the request.  If the value for a header is an array reference, the header will be output multiple times with each value in the array.  These headers over-write any default headers.

=item *

C<content> — A scalar to include as the body of the request OR a code reference that will be called iteratively to produce the body of the request

=item *

C<trailer_callback> — A code reference that will be called if it exists to provide a hashref of trailing headers (only used with chunked transfer-encoding)

=item *

C<data_callback> — A code reference that will be called for each chunks of the response body received.

=item *

C<peer> — Override host resolution and force all connections to go only to a specific peer address, regardless of the URL of the request.  This will include any redirections!  This options should be used with extreme caution (e.g. debugging or very special circumstances). It can be given as either a scalar or a code reference that will receive the hostname and whose response will be taken as the address.

=back

The C<Host> header is generated from the URL in accordance with RFC 2616.  It
is a fatal error to specify C<Host> in the C<headers> option.  Other headers
may be ignored or overwritten if necessary for transport compliance.

If the C<content> option is a code reference, it will be called iteratively
to provide the content body of the request.  It should return the empty
string or undef when the iterator is exhausted.

If the C<content> option is the empty string, no C<content-type> or
C<content-length> headers will be generated.

If the C<data_callback> option is provided, it will be called iteratively until
the entire response body is received.  The first argument will be a string
containing a chunk of the response body, the second argument will be the
in-progress response hash reference, as described below.  (This allows
customizing the action of the callback based on the C<status> or C<headers>
received prior to the content body.)

The C<request> method returns a hashref containing the response.  The hashref
will have the following keys:

=over 4

=item *

C<success> — Boolean indicating whether the operation returned a 2XX status code

=item *

C<url> — URL that provided the response. This is the URL of the request unless there were redirections, in which case it is the last URL queried in a redirection chain

=item *

C<status> — The HTTP status code of the response

=item *

C<reason> — The response phrase returned by the server

=item *

C<content> — The body of the response.  If the response does not have any content or if a data callback is provided to consume the response body, this will be the empty string

=item *

C<headers> — A hashref of header fields.  All header field names will be normalized to be lower case. If a header is repeated, the value will be an arrayref; it will otherwise be a scalar string containing the value

=item *

C<protocol> - If this field exists, it is the protocol of the response such as HTTP/1.0 or HTTP/1.1

=item *

C<redirects> If this field exists, it is an arrayref of response hash references from redirects in the same order that redirections occurred.  If it does not exist, then no redirections occurred.

=back

On an error during the execution of the request, the C<status> field will
contain 599, and the C<content> field will contain the text of the error.

=head2 www_form_urlencode

    $params = $http->www_form_urlencode( $data );
    $response = $http->get("http://example.com/query?$params");

This method converts the key/value pairs from a data hash or array reference
into a C<x-www-form-urlencoded> string.  The keys and values from the data
reference will be UTF-8 encoded and escaped per RFC 3986.  If a value is an
array reference, the key will be repeated with each of the values of the array
reference.  If data is provided as a hash reference, the key/value pairs in the
resulting string will be sorted by key and value for consistent ordering.

=head2 can_ssl

    $ok         = HTTP::Tiny->can_ssl;
    ($ok, $why) = HTTP::Tiny->can_ssl;
    ($ok, $why) = $http->can_ssl;

Indicates if SSL support is available.  When called as a class object, it
checks for the correct version of L<Net::SSLeay> and L<IO::Socket::SSL>.
When called as an object methods, if C<SSL_verify> is true or if C<SSL_verify_mode>
is set in C<SSL_options>, it checks that a CA file is available.

In scalar context, returns a boolean indicating if SSL is available.
In list context, returns the boolean and a (possibly multi-line) string of
errors indicating why SSL isn't available.

=head2 connected

    $host = $http->connected;
    ($host, $port) = $http->connected;

Indicates if a connection to a peer is being kept alive, per the C<keep_alive>
option.

In scalar context, returns the peer host and port, joined with a colon, or
C<undef> (if no peer is connected).
In list context, returns the peer host and port or an empty list (if no peer
is connected).

B<Note>: This method cannot reliably be used to discover whether the remote
host has closed its end of the socket.

=for Pod::Coverage SSL_options
agent
cookie_jar
default_headers
http_proxy
https_proxy
keep_alive
local_address
max_redirect
max_size
no_proxy
proxy
timeout
verify_SSL

=head1 SSL SUPPORT

Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
greater and L<Net::SSLeay> 1.49 or greater are installed. An error will occur
if new enough versions of these modules are not installed or if the SSL
encryption fails. You can also use C<HTTP::Tiny::can_ssl()> utility function
that returns boolean to see if the required modules are installed.

An C<https> connection may be made via an C<http> proxy that supports the CONNECT
command (i.e. RFC 2817).  You may not proxy C<https> via a proxy that itself
requires C<https> to communicate.

SSL provides two distinct capabilities:

=over 4

=item *

Encrypted communication channel

=item *

Verification of server identity

=back

B<By default, HTTP::Tiny does not verify server identity>.

Server identity verification is controversial and potentially tricky because it
depends on a (usually paid) third-party Certificate Authority (CA) trust model
to validate a certificate as legitimate.  This discriminates against servers
with self-signed certificates or certificates signed by free, community-driven
CA's such as L<CAcert.org|http://cacert.org>.

By default, HTTP::Tiny does not make any assumptions about your trust model,
threat level or risk tolerance.  It just aims to give you an encrypted channel
when you need one.

Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
that an SSL connection has a valid SSL certificate corresponding to the host
name of the connection and that the SSL certificate has been verified by a CA.
Assuming you trust the CA, this will protect against a L<man-in-the-middle
attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>.  If you are
concerned about security, you should enable this option.

Certificate verification requires a file containing trusted CA certificates.

If the environment variable C<SSL_CERT_FILE> is present, HTTP::Tiny
will try to find a CA certificate file in that location.

If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
included with it as a source of trusted CA's.  (This means you trust Mozilla,
the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
toolchain used to install it, and your operating system security, right?)

If that module is not available, then HTTP::Tiny will search several
system-specific default locations for a CA certificate file:

=over 4

=item *

/etc/ssl/certs/ca-certificates.crt

=item *

/etc/pki/tls/certs/ca-bundle.crt

=item *

/etc/ssl/ca-bundle.pem

=back

An error will be occur if C<verify_SSL> is true and no CA certificate file
is available.

If you desire complete control over SSL connections, the C<SSL_options> attribute
lets you provide a hash reference that will be passed through to
C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
example, to provide your own trusted CA file:

    SSL_options => {
        SSL_ca_file => $file_path,
    }

The C<SSL_options> attribute could also be used for such things as providing a
client certificate for authentication to a server or controlling the choice of
cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
details.

=head1 PROXY SUPPORT

HTTP::Tiny can proxy both C<http> and C<https> requests.  Only Basic proxy
authorization is supported and it must be provided as part of the proxy URL:
C<http://user:pass@proxy.example.com/>.

HTTP::Tiny supports the following proxy environment variables:

=over 4

=item *

http_proxy or HTTP_PROXY

=item *

https_proxy or HTTPS_PROXY

=item *

all_proxy or ALL_PROXY

=back

If the C<REQUEST_METHOD> environment variable is set, then this might be a CGI
process and C<HTTP_PROXY> would be set from the C<Proxy:> header, which is a
security risk.  If C<REQUEST_METHOD> is set, C<HTTP_PROXY> (the upper case
variant only) is ignored, but C<CGI_HTTP_PROXY> is considered instead.

Tunnelling C<https> over an C<http> proxy using the CONNECT method is
supported.  If your proxy uses C<https> itself, you can not tunnel C<https>
over it.

Be warned that proxying an C<https> connection opens you to the risk of a
man-in-the-middle attack by the proxy server.

The C<no_proxy> environment variable is supported in the format of a
comma-separated list of domain extensions proxy should not be used for.

Proxy arguments passed to C<new> will override their corresponding
environment variables.

=head1 LIMITATIONS

HTTP::Tiny is I<conditionally compliant> with the
L<HTTP/1.1 specifications|http://www.w3.org/Protocols/>:

=over 4

=item *

"Message Syntax and Routing" [RFC7230]

=item *

"Semantics and Content" [RFC7231]

=item *

"Conditional Requests" [RFC7232]

=item *

"Range Requests" [RFC7233]

=item *

"Caching" [RFC7234]

=item *

"Authentication" [RFC7235]

=back

It attempts to meet all "MUST" requirements of the specification, but does not
implement all "SHOULD" requirements.  (Note: it was developed against the
earlier RFC 2616 specification and may not yet meet the revised RFC 7230-7235
spec.) Additionally, HTTP::Tiny supports the C<PATCH> method of RFC 5789.

Some particular limitations of note include:

=over

=item *

HTTP::Tiny focuses on correct transport.  Users are responsible for ensuring
that user-defined headers and content are compliant with the HTTP/1.1
specification.

=item *

Users must ensure that URLs are properly escaped for unsafe characters and that
international domain names are properly encoded to ASCII. See L<URI::Escape>,
L<URI::_punycode> and L<Net::IDN::Encode>.

=item *

Redirection is very strict against the specification.  Redirection is only
automatic for response codes 301, 302, 307 and 308 if the request method is
'GET' or 'HEAD'.  Response code 303 is always converted into a 'GET'
redirection, as mandated by the specification.  There is no automatic support
for status 305 ("Use proxy") redirections.

=item *

There is no provision for delaying a request body using an C<Expect> header.
Unexpected C<1XX> responses are silently ignored as per the specification.

=item *

Only 'chunked' C<Transfer-Encoding> is supported.

=item *

There is no support for a Request-URI of '*' for the 'OPTIONS' request.

=item *

Headers mentioned in the RFCs and some other, well-known headers are
generated with their canonical case.  Other headers are sent in the
case provided by the user.  Except for control headers (which are sent first),
headers are sent in arbitrary order.

=back

Despite the limitations listed above, HTTP::Tiny is considered
feature-complete.  New feature requests should be directed to
L<HTTP::Tiny::UA>.

=head1 SEE ALSO

=over 4

=item *

L<HTTP::Tiny::UA> - Higher level UA features for HTTP::Tiny

=item *

L<HTTP::Thin> - HTTP::Tiny wrapper with L<HTTP::Request>/L<HTTP::Response> compatibility

=item *

L<HTTP::Tiny::Mech> - Wrap L<WWW::Mechanize> instance in HTTP::Tiny compatible interface

=item *

L<IO::Socket::IP> - Required for IPv6 support

=item *

L<IO::Socket::SSL> - Required for SSL support

=item *

L<LWP::UserAgent> - If HTTP::Tiny isn't enough for you, this is the "standard" way to do things

=item *

L<Mozilla::CA> - Required if you want to validate SSL certificates

=item *

L<Net::SSLeay> - Required for SSL support

=back

=for :stopwords cpan testmatrix url bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan

=head1 SUPPORT

=head2 Bugs / Feature Requests

Please report any bugs or feature requests through the issue tracker
at L<https://github.com/chansen/p5-http-tiny/issues>.
You will be notified automatically of any progress on your issue.

=head2 Source Code

This is open source software.  The code repository is available for
public review and contribution under the terms of the license.

L<https://github.com/chansen/p5-http-tiny>

  git clone https://github.com/chansen/p5-http-tiny.git

=head1 AUTHORS

=over 4

=item *

Christian Hansen <chansen@cpan.org>

=item *

David Golden <dagolden@cpan.org>

=back

=head1 CONTRIBUTORS

=for stopwords Alan Gardner Alessandro Ghedini A. Sinan Unur Brad Gilbert brian m. carlson Chris Nehren Weyl Claes Jakobsson Clinton Gormley Craig Berry David Golden Mitchell Dean Pearce Edward Zborowski Felipe Gasper Greg Kennedy James E Keenan Raspass Jeremy Mates Jess Robinson Karen Etheridge Lukas Eklund Martin J. Evans Martin-Louis Bright Matthew Horsfall Michael R. Davis Mike Doherty Nicolas Rochelemagne Olaf Alders Olivier Mengué Petr Písař sanjay-cpu Serguei Trouchelle Shoichi Kaji SkyMarshal Sören Kornetzki Steve Grazzini Syohei YOSHIDA Tatsuhiko Miyagawa Tom Hukins Tony Cook Xavier Guimard

=over 4

=item *

Alan Gardner <gardner@pythian.com>

=item *

Alessandro Ghedini <al3xbio@gmail.com>

=item *

A. Sinan Unur <nanis@cpan.org>

=item *

Brad Gilbert <bgills@cpan.org>

=item *

brian m. carlson <sandals@crustytoothpaste.net>

=item *

Chris Nehren <apeiron@cpan.org>

=item *

Chris Weyl <cweyl@alumni.drew.edu>

=item *

Claes Jakobsson <claes@surfar.nu>

=item *

Clinton Gormley <clint@traveljury.com>

=item *

Craig A. Berry <craigberry@mac.com>

=item *

Craig Berry <cberry@cpan.org>

=item *

David Golden <xdg@xdg.me>

=item *

David Mitchell <davem@iabyn.com>

=item *

Dean Pearce <pearce@pythian.com>

=item *

Edward Zborowski <ed@rubensteintech.com>

=item *

Felipe Gasper <felipe@felipegasper.com>

=item *

Greg Kennedy <kennedy.greg@gmail.com>

=item *

James E Keenan <jkeenan@cpan.org>

=item *

James Raspass <jraspass@gmail.com>

=item *

Jeremy Mates <jmates@cpan.org>

=item *

Jess Robinson <castaway@desert-island.me.uk>

=item *

Karen Etheridge <ether@cpan.org>

=item *

Lukas Eklund <leklund@gmail.com>

=item *

Martin J. Evans <mjegh@ntlworld.com>

=item *

Martin-Louis Bright <mlbright@gmail.com>

=item *

Matthew Horsfall <wolfsage@gmail.com>

=item *

Michael R. Davis <mrdvt92@users.noreply.github.com>

=item *

Mike Doherty <doherty@cpan.org>

=item *

Nicolas Rochelemagne <rochelemagne@cpanel.net>

=item *

Olaf Alders <olaf@wundersolutions.com>

=item *

Olivier Mengué <dolmen@cpan.org>

=item *

Petr Písař <ppisar@redhat.com>

=item *

sanjay-cpu <snjkmr32@gmail.com>

=item *

Serguei Trouchelle <stro@cpan.org>

=item *

Shoichi Kaji <skaji@cpan.org>

=item *

SkyMarshal <skymarshal1729@gmail.com>

=item *

Sören Kornetzki <soeren.kornetzki@delti.com>

=item *

Steve Grazzini <steve.grazzini@grantstreet.com>

=item *

Syohei YOSHIDA <syohex@gmail.com>

=item *

Tatsuhiko Miyagawa <miyagawa@bulknews.net>

=item *

Tom Hukins <tom@eborcom.com>

=item *

Tony Cook <tony@develop-help.com>

=item *

Xavier Guimard <yadd@debian.org>

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2021 by Christian Hansen.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              package IPC::Cmd;

use strict;

BEGIN {

    use constant IS_VMS         => $^O eq 'VMS'                       ? 1 : 0;
    use constant IS_WIN32       => $^O eq 'MSWin32'                   ? 1 : 0;
    use constant IS_HPUX        => $^O eq 'hpux'                      ? 1 : 0;
    use constant IS_WIN98       => (IS_WIN32 and !Win32::IsWinNT())   ? 1 : 0;
    use constant ALARM_CLASS    => __PACKAGE__ . '::TimeOut';
    use constant SPECIAL_CHARS  => qw[< > | &];
    use constant QUOTE          => do { IS_WIN32 ? q["] : q['] };

    use Exporter    ();
    use vars        qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $DEBUG
                        $USE_IPC_RUN $USE_IPC_OPEN3 $CAN_USE_RUN_FORKED $WARN
                        $INSTANCES $ALLOW_NULL_ARGS
                        $HAVE_MONOTONIC
                    ];

    $VERSION        = '1.04';
    $VERBOSE        = 0;
    $DEBUG          = 0;
    $WARN           = 1;
    $USE_IPC_RUN    = IS_WIN32 && !IS_WIN98;
    $USE_IPC_OPEN3  = not IS_VMS;
    $ALLOW_NULL_ARGS = 0;

    $CAN_USE_RUN_FORKED = 0;
    eval {
        require POSIX; POSIX->import();
        require IPC::Open3; IPC::Open3->import();
        require IO::Select; IO::Select->import();
        require IO::Handle; IO::Handle->import();
        require FileHandle; FileHandle->import();
        require Socket;
        require Time::HiRes; Time::HiRes->import();
        require Win32 if IS_WIN32;
    };
    $CAN_USE_RUN_FORKED = $@ || !IS_VMS && !IS_WIN32;

    eval {
        my $wait_start_time = Time::HiRes::clock_gettime(&Time::HiRes::CLOCK_MONOTONIC);
    };
    if ($@) {
        $HAVE_MONOTONIC = 0;
    }
    else {
        $HAVE_MONOTONIC = 1;
    }

    @ISA            = qw[Exporter];
    @EXPORT_OK      = qw[can_run run run_forked QUOTE];
}

require Carp;
use File::Spec;
use Params::Check               qw[check];
use Text::ParseWords            ();             # import ONLY if needed!
use Module::Load::Conditional   qw[can_load];
use Locale::Maketext::Simple    Style => 'gettext';

local $Module::Load::Conditional::FORCE_SAFE_INC = 1;

=pod

=head1 NAME

IPC::Cmd - finding and running system commands made easy

=head1 SYNOPSIS

    use IPC::Cmd qw[can_run run run_forked];

    my $full_path = can_run('wget') or warn 'wget is not installed!';

    ### commands can be arrayrefs or strings ###
    my $cmd = "$full_path -b theregister.co.uk";
    my $cmd = [$full_path, '-b', 'theregister.co.uk'];

    ### in scalar context ###
    my $buffer;
    if( scalar run( command => $cmd,
                    verbose => 0,
                    buffer  => \$buffer,
                    timeout => 20 )
    ) {
        print "fetched webpage successfully: $buffer\n";
    }


    ### in list context ###
    my( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) =
            run( command => $cmd, verbose => 0 );

    if( $success ) {
        print "this is what the command printed:\n";
        print join "", @$full_buf;
    }

    ### run_forked example ###
    my $result = run_forked("$full_path -q -O - theregister.co.uk", {'timeout' => 20});
    if ($result->{'exit_code'} eq 0 && !$result->{'timeout'}) {
        print "this is what wget returned:\n";
        print $result->{'stdout'};
    }

    ### check for features
    print "IPC::Open3 available: "  . IPC::Cmd->can_use_ipc_open3;
    print "IPC::Run available: "    . IPC::Cmd->can_use_ipc_run;
    print "Can capture buffer: "    . IPC::Cmd->can_capture_buffer;

    ### don't have IPC::Cmd be verbose, ie don't print to stdout or
    ### stderr when running commands -- default is '0'
    $IPC::Cmd::VERBOSE = 0;


=head1 DESCRIPTION

IPC::Cmd allows you to run commands platform independently,
interactively if desired, but have them still work.

The C<can_run> function can tell you if a certain binary is installed
and if so where, whereas the C<run> function can actually execute any
of the commands you give it and give you a clear return value, as well
as adhere to your verbosity settings.

=head1 CLASS METHODS

=head2 $ipc_run_version = IPC::Cmd->can_use_ipc_run( [VERBOSE] )

Utility function that tells you if C<IPC::Run> is available.
If the C<verbose> flag is passed, it will print diagnostic messages
if L<IPC::Run> can not be found or loaded.

=cut


sub can_use_ipc_run     {
    my $self    = shift;
    my $verbose = shift || 0;

    ### IPC::Run doesn't run on win98
    return if IS_WIN98;

    ### if we don't have ipc::run, we obviously can't use it.
    return unless can_load(
                        modules => { 'IPC::Run' => '0.55' },
                        verbose => ($WARN && $verbose),
                    );

    ### otherwise, we're good to go
    return $IPC::Run::VERSION;
}

=head2 $ipc_open3_version = IPC::Cmd->can_use_ipc_open3( [VERBOSE] )

Utility function that tells you if C<IPC::Open3> is available.
If the verbose flag is passed, it will print diagnostic messages
if C<IPC::Open3> can not be found or loaded.

=cut


sub can_use_ipc_open3   {
    my $self    = shift;
    my $verbose = shift || 0;

    ### IPC::Open3 is not working on VMS because of a lack of fork.
    return if IS_VMS;

    ### IPC::Open3 works on every non-VMS platform, but it can't
    ### capture buffers on win32 :(
    return unless can_load(
        modules => { map {$_ => '0.0'} qw|IPC::Open3 IO::Select Symbol| },
        verbose => ($WARN && $verbose),
    );

    return $IPC::Open3::VERSION;
}

=head2 $bool = IPC::Cmd->can_capture_buffer

Utility function that tells you if C<IPC::Cmd> is capable of
capturing buffers in it's current configuration.

=cut

sub can_capture_buffer {
    my $self    = shift;

    return 1 if $USE_IPC_RUN    && $self->can_use_ipc_run;
    return 1 if $USE_IPC_OPEN3  && $self->can_use_ipc_open3;
    return;
}

=head2 $bool = IPC::Cmd->can_use_run_forked

Utility function that tells you if C<IPC::Cmd> is capable of
providing C<run_forked> on the current platform.

=head1 FUNCTIONS

=head2 $path = can_run( PROGRAM );

C<can_run> takes only one argument: the name of a binary you wish
to locate. C<can_run> works much like the unix binary C<which> or the bash
command C<type>, which scans through your path, looking for the requested
binary.

Unlike C<which> and C<type>, this function is platform independent and
will also work on, for example, Win32.

If called in a scalar context it will return the full path to the binary
you asked for if it was found, or C<undef> if it was not.

If called in a list context and the global variable C<$INSTANCES> is a true
value, it will return a list of the full paths to instances
of the binary where found in C<PATH>, or an empty list if it was not found.

=cut

sub can_run {
    my $command = shift;

    # a lot of VMS executables have a symbol defined
    # check those first
    if ( $^O eq 'VMS' ) {
        require VMS::DCLsym;
        my $syms = VMS::DCLsym->new;
        return $command if scalar $syms->getsym( uc $command );
    }

    require File::Spec;
    require ExtUtils::MakeMaker;

    my @possibles;

    if( File::Spec->file_name_is_absolute($command) ) {
        return MM->maybe_command($command);

    } else {
        for my $dir (
            File::Spec->path,
            ( IS_WIN32 ? File::Spec->curdir : () )
        ) {
            next if ! $dir || ! -d $dir;
            my $abs = File::Spec->catfile( IS_WIN32 ? Win32::GetShortPathName( $dir ) : $dir, $command);
            push @possibles, $abs if $abs = MM->maybe_command($abs);
        }
    }
    return @possibles if wantarray and $INSTANCES;
    return shift @possibles;
}

=head2 $ok | ($ok, $err, $full_buf, $stdout_buff, $stderr_buff) = run( command => COMMAND, [verbose => BOOL, buffer => \$SCALAR, timeout => DIGIT] );

C<run> takes 4 arguments:

=over 4

=item command

This is the command to execute. It may be either a string or an array
reference.
This is a required argument.

See L<"Caveats"> for remarks on how commands are parsed and their
limitations.

=item verbose

This controls whether all output of a command should also be printed
to STDOUT/STDERR or should only be trapped in buffers (NOTE: buffers
require L<IPC::Run> to be installed, or your system able to work with
L<IPC::Open3>).

It will default to the global setting of C<$IPC::Cmd::VERBOSE>,
which by default is 0.

=item buffer

This will hold all the output of a command. It needs to be a reference
to a scalar.
Note that this will hold both the STDOUT and STDERR messages, and you
have no way of telling which is which.
If you require this distinction, run the C<run> command in list context
and inspect the individual buffers.

Of course, this requires that the underlying call supports buffers. See
the note on buffers above.

=item timeout

Sets the maximum time the command is allowed to run before aborting,
using the built-in C<alarm()> call. If the timeout is triggered, the
C<errorcode> in the return value will be set to an object of the
C<IPC::Cmd::TimeOut> class. See the L<"error message"> section below for
details.

Defaults to C<0>, meaning no timeout is set.

=back

C<run> will return a simple C<true> or C<false> when called in scalar
context.
In list context, you will be returned a list of the following items:

=over 4

=item success

A simple boolean indicating if the command executed without errors or
not.

=item error message

If the first element of the return value (C<success>) was 0, then some
error occurred. This second element is the error message the command
you requested exited with, if available. This is generally a pretty
printed value of C<$?> or C<$@>. See C<perldoc perlvar> for details on
what they can contain.
If the error was a timeout, the C<error message> will be prefixed with
the string C<IPC::Cmd::TimeOut>, the timeout class.

=item full_buffer

This is an array reference containing all the output the command
generated.
Note that buffers are only available if you have L<IPC::Run> installed,
or if your system is able to work with L<IPC::Open3> -- see below).
Otherwise, this element will be C<undef>.

=item out_buffer

This is an array reference containing all the output sent to STDOUT the
command generated. The notes from L<"full_buffer"> apply.

=item error_buffer

This is an arrayreference containing all the output sent to STDERR the
command generated. The notes from L<"full_buffer"> apply.


=back

See the L<"HOW IT WORKS"> section below to see how C<IPC::Cmd> decides
what modules or function calls to use when issuing a command.

=cut

{   my @acc = qw[ok error _fds];

    ### autogenerate accessors ###
    for my $key ( @acc ) {
        no strict 'refs';
        *{__PACKAGE__."::$key"} = sub {
            $_[0]->{$key} = $_[1] if @_ > 1;
            return $_[0]->{$key};
        }
    }
}

sub can_use_run_forked {
    return $CAN_USE_RUN_FORKED eq "1";
}

sub get_monotonic_time {
    if ($HAVE_MONOTONIC) {
        return Time::HiRes::clock_gettime(&Time::HiRes::CLOCK_MONOTONIC);
    }
    else {
        return time();
    }
}

sub adjust_monotonic_start_time {
    my ($ref_vars, $now, $previous) = @_;

    # workaround only for those systems which don't have
    # Time::HiRes::CLOCK_MONOTONIC (Mac OSX in particular)
    return if $HAVE_MONOTONIC;

    # don't have previous monotonic value (only happens once
    # in the beginning of the program execution)
    return unless $previous;

    my $time_diff = $now - $previous;

    # adjust previously saved time with the skew value which is
    # either negative when clock moved back or more than 5 seconds --
    # assuming that event loop does happen more often than once
    # per five seconds, which might not be always true (!) but
    # hopefully that's ok, because it's just a workaround
    if ($time_diff > 5 || $time_diff < 0) {
        foreach my $ref_var (@{$ref_vars}) {
            if (defined($$ref_var)) {
                $$ref_var = $$ref_var + $time_diff;
            }
        }
    }
}

sub uninstall_signals {
		return unless defined($IPC::Cmd::{'__old_signals'});

		foreach my $sig_name (keys %{$IPC::Cmd::{'__old_signals'}}) {
				$SIG{$sig_name} = $IPC::Cmd::{'__old_signals'}->{$sig_name};
		}
}

# incompatible with POSIX::SigAction
#
sub install_layered_signal {
  my ($s, $handler_code) = @_;

  my %available_signals = map {$_ => 1} keys %SIG;

  Carp::confess("install_layered_signal got nonexistent signal name [$s]")
    unless defined($available_signals{$s});
  Carp::confess("install_layered_signal expects coderef")
    if !ref($handler_code) || ref($handler_code) ne 'CODE';

  $IPC::Cmd::{'__old_signals'} = {}
  		unless defined($IPC::Cmd::{'__old_signals'});
	$IPC::Cmd::{'__old_signals'}->{$s} = $SIG{$s};

  my $previous_handler = $SIG{$s};

  my $sig_handler = sub {
    my ($called_sig_name, @sig_param) = @_;

    # $s is a closure referring to real signal name
    # for which this handler is being installed.
    # it is used to distinguish between
    # real signal handlers and aliased signal handlers
    my $signal_name = $s;

    # $called_sig_name is a signal name which
    # was passed to this signal handler;
    # it doesn't equal $signal_name in case
    # some signal handlers in %SIG point
    # to other signal handler (CHLD and CLD,
    # ABRT and IOT)
    #
    # initial signal handler for aliased signal
    # calls some other signal handler which
    # should not execute the same handler_code again
    if ($called_sig_name eq $signal_name) {
      $handler_code->($signal_name);
    }

    # run original signal handler if any (including aliased)
    #
    if (ref($previous_handler)) {
      $previous_handler->($called_sig_name, @sig_param);
    }
  };

  $SIG{$s} = $sig_handler;
}

# give process a chance sending TERM,
# waiting for a while (2 seconds)
# and killing it with KILL
sub kill_gently {
  my ($pid, $opts) = @_;

  require POSIX;

  $opts = {} unless $opts;
  $opts->{'wait_time'} = 2 unless defined($opts->{'wait_time'});
  $opts->{'first_kill_type'} = 'just_process' unless $opts->{'first_kill_type'};
  $opts->{'final_kill_type'} = 'just_process' unless $opts->{'final_kill_type'};

  if ($opts->{'first_kill_type'} eq 'just_process') {
    kill(15, $pid);
  }
  elsif ($opts->{'first_kill_type'} eq 'process_group') {
    kill(-15, $pid);
  }

  my $do_wait = 1;
  my $child_finished = 0;

  my $wait_start_time = get_monotonic_time();
  my $now;
  my $previous_monotonic_value;

  while ($do_wait) {
    $previous_monotonic_value = $now;
    $now = get_monotonic_time();

    adjust_monotonic_start_time([\$wait_start_time], $now, $previous_monotonic_value);

    if ($now > $wait_start_time + $opts->{'wait_time'}) {
        $do_wait = 0;
        next;
    }

    my $waitpid = waitpid($pid, POSIX::WNOHANG);

    if ($waitpid eq -1) {
        $child_finished = 1;
        $do_wait = 0;
        next;
    }

    Time::HiRes::usleep(250000); # quarter of a second
  }

  if (!$child_finished) {
    if ($opts->{'final_kill_type'} eq 'just_process') {
      kill(9, $pid);
    }
    elsif ($opts->{'final_kill_type'} eq 'process_group') {
      kill(-9, $pid);
    }
  }
}

sub open3_run {
    my ($cmd, $opts) = @_;

    $opts = {} unless $opts;

    my $child_in = FileHandle->new;
    my $child_out = FileHandle->new;
    my $child_err = FileHandle->new;
    $child_out->autoflush(1);
    $child_err->autoflush(1);

    my $pid = open3($child_in, $child_out, $child_err, $cmd);
    Time::HiRes::usleep(1) if IS_HPUX;

    # will consider myself orphan if my ppid changes
    # from this one:
    my $original_ppid = $opts->{'original_ppid'};

    # push my child's pid to our parent
    # so in case i am killed parent
    # could stop my child (search for
    # child_child_pid in parent code)
    if ($opts->{'parent_info'}) {
      my $ps = $opts->{'parent_info'};
      print $ps "spawned $pid\n";
    }

    if ($child_in && $child_out->opened && $opts->{'child_stdin'}) {
        # If the child process dies for any reason,
        # the next write to CHLD_IN is likely to generate
        # a SIGPIPE in the parent, which is fatal by default.
        # So you may wish to handle this signal.
        #
        # from http://perldoc.perl.org/IPC/Open3.html,
        # absolutely needed to catch piped commands errors.
        #
        local $SIG{'PIPE'} = sub { 1; };

        print $child_in $opts->{'child_stdin'};
    }
    close($child_in);

    my $child_output = {
        'out' => $child_out->fileno,
        'err' => $child_err->fileno,
        $child_out->fileno => {
            'parent_socket' => $opts->{'parent_stdout'},
            'scalar_buffer' => "",
            'child_handle' => $child_out,
            'block_size' => ($child_out->stat)[11] || 1024,
          },
        $child_err->fileno => {
            'parent_socket' => $opts->{'parent_stderr'},
            'scalar_buffer' => "",
            'child_handle' => $child_err,
            'block_size' => ($child_err->stat)[11] || 1024,
          },
        };

    my $select = IO::Select->new();
    $select->add($child_out, $child_err);

    # pass any signal to the child
    # effectively creating process
    # strongly attached to the child:
    # it will terminate only after child
    # has terminated (except for SIGKILL,
    # which is specially handled)
    SIGNAL: foreach my $s (keys %SIG) {
        next SIGNAL if $s eq '__WARN__' or $s eq '__DIE__'; # Skip and don't clobber __DIE__ & __WARN__
        my $sig_handler;
        $sig_handler = sub {
            kill("$s", $pid);
            $SIG{$s} = $sig_handler;
        };
        $SIG{$s} = $sig_handler;
    }

    my $child_finished = 0;

    my $real_exit;
    my $exit_value;

    while(!$child_finished) {

        # parent was killed otherwise we would have got
        # the same signal as parent and process it same way
        if (getppid() != $original_ppid) {

          # end my process group with all the children
          # (i am the process group leader, so my pid
          # equals to the process group id)
          #
          # same thing which is done
          # with $opts->{'clean_up_children'}
          # in run_forked
          #
          kill(-9, $$);

          POSIX::_exit 1;
        }

        my $waitpid = waitpid($pid, POSIX::WNOHANG);

        # child finished, catch it's exit status
        if ($waitpid ne 0 && $waitpid ne -1) {
          $real_exit = $?;
          $exit_value = $? >> 8;
        }

        if ($waitpid eq -1) {
          $child_finished = 1;
        }


        my $ready_fds = [];
        push @{$ready_fds}, $select->can_read(1/100);

        READY_FDS: while (scalar(@{$ready_fds})) {
            my $fd = shift @{$ready_fds};
            $ready_fds = [grep {$_ ne $fd} @{$ready_fds}];

            my $str = $child_output->{$fd->fileno};
            Carp::confess("child stream not found: $fd") unless $str;

            my $data;
            my $count = $fd->sysread($data, $str->{'block_size'});

            if ($count) {
                if ($str->{'parent_socket'}) {
                    my $ph = $str->{'parent_socket'};
                    print $ph $data;
                }
                else {
                    $str->{'scalar_buffer'} .= $data;
                }
            }
            elsif ($count eq 0) {
                $select->remove($fd);
                $fd->close();
            }
            else {
                Carp::confess("error during sysread: " . $!);
            }

            push @{$ready_fds}, $select->can_read(1/100) if $child_finished;
        }

        Time::HiRes::usleep(1);
    }

    # since we've successfully reaped the child,
    # let our parent know about this.
    #
    if ($opts->{'parent_info'}) {
        my $ps = $opts->{'parent_info'};

        # child was killed, inform parent
        if ($real_exit & 127) {
          print $ps "$pid killed with " . ($real_exit & 127) . "\n";
        }

        print $ps "reaped $pid\n";
    }

    if ($opts->{'parent_stdout'} || $opts->{'parent_stderr'}) {
        return $exit_value;
    }
    else {
        return {
            'stdout' => $child_output->{$child_output->{'out'}}->{'scalar_buffer'},
            'stderr' => $child_output->{$child_output->{'err'}}->{'scalar_buffer'},
            'exit_code' => $exit_value,
            };
    }
}

=head2 $hashref = run_forked( COMMAND, { child_stdin => SCALAR, timeout => DIGIT, stdout_handler => CODEREF, stderr_handler => CODEREF} );

C<run_forked> is used to execute some program or a coderef,
optionally feed it with some input, get its return code
and output (both stdout and stderr into separate buffers).
In addition, it allows to terminate the program
if it takes too long to finish.

The important and distinguishing feature of run_forked
is execution timeout which at first seems to be
quite a simple task but if you think
that the program which you're spawning
might spawn some children itself (which
in their turn could do the same and so on)
it turns out to be not a simple issue.

C<run_forked> is designed to survive and
successfully terminate almost any long running task,
even a fork bomb in case your system has the resources
to survive during given timeout.

This is achieved by creating separate watchdog process
which spawns the specified program in a separate
process session and supervises it: optionally
feeds it with input, stores its exit code,
stdout and stderr, terminates it in case
it runs longer than specified.

Invocation requires the command to be executed or a coderef and optionally a hashref of options:

=over

=item C<timeout>

Specify in seconds how long to run the command before it is killed with SIG_KILL (9),
which effectively terminates it and all of its children (direct or indirect).

=item C<child_stdin>

Specify some text that will be passed into the C<STDIN> of the executed program.

=item C<stdout_handler>

Coderef of a subroutine to call when a portion of data is received on
STDOUT from the executing program.

=item C<stderr_handler>

Coderef of a subroutine to call when a portion of data is received on
STDERR from the executing program.

=item C<wait_loop_callback>

Coderef of a subroutine to call inside of the main waiting loop
(while C<run_forked> waits for the external to finish or fail).
It is useful to stop running external process before it ends
by itself, e.g.

  my $r = run_forked("some external command", {
	  'wait_loop_callback' => sub {
          if (condition) {
              kill(1, $$);
          }
	  },
	  'terminate_on_signal' => 'HUP',
	  });

Combined with C<stdout_handler> and C<stderr_handler> allows terminating
external command based on its output. Could also be used as a timer
without engaging with L<alarm> (signals).

Remember that this code could be called every millisecond (depending
on the output which external command generates), so try to make it
as lightweight as possible.

=item C<discard_output>

Discards the buffering of the standard output and standard errors for return by run_forked().
With this option you have to use the std*_handlers to read what the command outputs.
Useful for commands that send a lot of output.

=item C<terminate_on_parent_sudden_death>

Enable this option if you wish all spawned processes to be killed if the initially spawned
process (the parent) is killed or dies without waiting for child processes.

=back

C<run_forked> will return a HASHREF with the following keys:

=over

=item C<exit_code>

The exit code of the executed program.

=item C<timeout>

The number of seconds the program ran for before being terminated, or 0 if no timeout occurred.

=item C<stdout>

Holds the standard output of the executed command (or empty string if
there was no STDOUT output or if C<discard_output> was used; it's always defined!)

=item C<stderr>

Holds the standard error of the executed command (or empty string if
there was no STDERR output or if C<discard_output> was used; it's always defined!)

=item C<merged>

Holds the standard output and error of the executed command merged into one stream
(or empty string if there was no output at all or if C<discard_output> was used; it's always defined!)

=item C<err_msg>

Holds some explanation in the case of an error.

=back

=cut

sub run_forked {
    ### container to store things in
    my $self = bless {}, __PACKAGE__;

    if (!can_use_run_forked()) {
        Carp::carp("run_forked is not available: $CAN_USE_RUN_FORKED");
        return;
    }

    require POSIX;

    my ($cmd, $opts) = @_;
    if (ref($cmd) eq 'ARRAY') {
        $cmd = join(" ", @{$cmd});
    }

    if (!$cmd) {
        Carp::carp("run_forked expects command to run");
        return;
    }

    $opts = {} unless $opts;
    $opts->{'timeout'} = 0 unless $opts->{'timeout'};
    $opts->{'terminate_wait_time'} = 2 unless defined($opts->{'terminate_wait_time'});

    # turned on by default
    $opts->{'clean_up_children'} = 1 unless defined($opts->{'clean_up_children'});

    # sockets to pass child stdout to parent
    my $child_stdout_socket;
    my $parent_stdout_socket;

    # sockets to pass child stderr to parent
    my $child_stderr_socket;
    my $parent_stderr_socket;

    # sockets for child -> parent internal communication
    my $child_info_socket;
    my $parent_info_socket;

    socketpair($child_stdout_socket, $parent_stdout_socket, &Socket::AF_UNIX, &Socket::SOCK_STREAM, &Socket::PF_UNSPEC) ||
      Carp::confess ("socketpair: $!");
    socketpair($child_stderr_socket, $parent_stderr_socket, &Socket::AF_UNIX, &Socket::SOCK_STREAM, &Socket::PF_UNSPEC) ||
      Carp::confess ("socketpair: $!");
    socketpair($child_info_socket, $parent_info_socket, &Socket::AF_UNIX, &Socket::SOCK_STREAM, &Socket::PF_UNSPEC) ||
      Carp::confess ("socketpair: $!");

    $child_stdout_socket->autoflush(1);
    $parent_stdout_socket->autoflush(1);
    $child_stderr_socket->autoflush(1);
    $parent_stderr_socket->autoflush(1);
    $child_info_socket->autoflush(1);
    $parent_info_socket->autoflush(1);

    my $start_time = get_monotonic_time();

    my $pid;
    my $ppid = $$;
    if ($pid = fork) {

      # we are a parent
      close($parent_stdout_socket);
      close($parent_stderr_socket);
      close($parent_info_socket);

      my $flags;

      # prepare sockets to read from child

      $flags = fcntl($child_stdout_socket, POSIX::F_GETFL, 0) || Carp::confess "can't fnctl F_GETFL: $!";
      $flags |= POSIX::O_NONBLOCK;
      fcntl($child_stdout_socket, POSIX::F_SETFL, $flags) || Carp::confess "can't fnctl F_SETFL: $!";

      $flags = fcntl($child_stderr_socket, POSIX::F_GETFL, 0) || Carp::confess "can't fnctl F_GETFL: $!";
      $flags |= POSIX::O_NONBLOCK;
      fcntl($child_stderr_socket, POSIX::F_SETFL, $flags) || Carp::confess "can't fnctl F_SETFL: $!";

      $flags = fcntl($child_info_socket, POSIX::F_GETFL, 0) || Carp::confess "can't fnctl F_GETFL: $!";
      $flags |= POSIX::O_NONBLOCK;
      fcntl($child_info_socket, POSIX::F_SETFL, $flags) || Carp::confess "can't fnctl F_SETFL: $!";

  #    print "child $pid started\n";

      my $child_output = {
        $child_stdout_socket->fileno => {
          'scalar_buffer' => "",
          'child_handle' => $child_stdout_socket,
          'block_size' => ($child_stdout_socket->stat)[11] || 1024,
          'protocol' => 'stdout',
          },
        $child_stderr_socket->fileno => {
          'scalar_buffer' => "",
          'child_handle' => $child_stderr_socket,
          'block_size' => ($child_stderr_socket->stat)[11] || 1024,
          'protocol' => 'stderr',
          },
        $child_info_socket->fileno => {
          'scalar_buffer' => "",
          'child_handle' => $child_info_socket,
          'block_size' => ($child_info_socket->stat)[11] || 1024,
          'protocol' => 'info',
          },
        };

      my $select = IO::Select->new();
      $select->add($child_stdout_socket, $child_stderr_socket, $child_info_socket);

      my $child_timedout = 0;
      my $child_finished = 0;
      my $child_stdout = '';
      my $child_stderr = '';
      my $child_merged = '';
      my $child_exit_code = 0;
      my $child_killed_by_signal = 0;
      my $parent_died = 0;

      my $last_parent_check = 0;
      my $got_sig_child = 0;
      my $got_sig_quit = 0;
      my $orig_sig_child = $SIG{'CHLD'};

      $SIG{'CHLD'} = sub { $got_sig_child = get_monotonic_time(); };

      if ($opts->{'terminate_on_signal'}) {
        install_layered_signal($opts->{'terminate_on_signal'}, sub { $got_sig_quit = time(); });
      }

      my $child_child_pid;
      my $now;
      my $previous_monotonic_value;

      while (!$child_finished) {
        $previous_monotonic_value = $now;
        $now = get_monotonic_time();

        adjust_monotonic_start_time([\$start_time, \$last_parent_check, \$got_sig_child], $now, $previous_monotonic_value);

        if ($opts->{'terminate_on_parent_sudden_death'}) {
          # check for parent once each five seconds
          if ($now > $last_parent_check + 5) {
            if (getppid() eq "1") {
              kill_gently ($pid, {
                'first_kill_type' => 'process_group',
                'final_kill_type' => 'process_group',
                'wait_time' => $opts->{'terminate_wait_time'}
                });
              $parent_died = 1;
            }

            $last_parent_check = $now;
          }
        }

        # user specified timeout
        if ($opts->{'timeout'}) {
          if ($now > $start_time + $opts->{'timeout'}) {
            kill_gently ($pid, {
              'first_kill_type' => 'process_group',
              'final_kill_type' => 'process_group',
              'wait_time' => $opts->{'terminate_wait_time'}
              });
            $child_timedout = 1;
          }
        }

        # give OS 10 seconds for correct return of waitpid,
        # kill process after that and finish wait loop;
        # shouldn't ever happen -- remove this code?
        if ($got_sig_child) {
          if ($now > $got_sig_child + 10) {
            print STDERR "waitpid did not return -1 for 10 seconds after SIG_CHLD, killing [$pid]\n";
            kill (-9, $pid);
            $child_finished = 1;
          }
        }

        if ($got_sig_quit) {
          kill_gently ($pid, {
            'first_kill_type' => 'process_group',
            'final_kill_type' => 'process_group',
            'wait_time' => $opts->{'terminate_wait_time'}
            });
          $child_finished = 1;
        }

        my $waitpid = waitpid($pid, POSIX::WNOHANG);

        # child finished, catch it's exit status
        if ($waitpid ne 0 && $waitpid ne -1) {
          $child_exit_code = $? >> 8;
        }

        if ($waitpid eq -1) {
          $child_finished = 1;
        }

        my $ready_fds = [];
        push @{$ready_fds}, $select->can_read(1/100);

        READY_FDS: while (scalar(@{$ready_fds})) {
          my $fd = shift @{$ready_fds};
          $ready_fds = [grep {$_ ne $fd} @{$ready_fds}];

          my $str = $child_output->{$fd->fileno};
          Carp::confess("child stream not found: $fd") unless $str;

          my $data = "";
          my $count = $fd->sysread($data, $str->{'block_size'});

          if ($count) {
              # extract all the available lines and store the rest in temporary buffer
              if ($data =~ /(.+\n)([^\n]*)/so) {
                  $data = $str->{'scalar_buffer'} . $1;
                  $str->{'scalar_buffer'} = $2 || "";
              }
              else {
                  $str->{'scalar_buffer'} .= $data;
                  $data = "";
              }
          }
          elsif ($count eq 0) {
            $select->remove($fd);
            $fd->close();
            if ($str->{'scalar_buffer'}) {
                $data = $str->{'scalar_buffer'} . "\n";
            }
          }
          else {
            Carp::confess("error during sysread on [$fd]: " . $!);
          }

          # $data contains only full lines (or last line if it was unfinished read
          # or now new-line in the output of the child); dat is processed
          # according to the "protocol" of socket
          if ($str->{'protocol'} eq 'info') {
            if ($data =~ /^spawned ([0-9]+?)\n(.*?)/so) {
              $child_child_pid = $1;
              $data = $2;
            }
            if ($data =~ /^reaped ([0-9]+?)\n(.*?)/so) {
              $child_child_pid = undef;
              $data = $2;
            }
            if ($data =~ /^[\d]+ killed with ([0-9]+?)\n(.*?)/so) {
              $child_killed_by_signal = $1;
              $data = $2;
            }

            # we don't expect any other data in info socket, so it's
            # some strange violation of protocol, better know about this
            if ($data) {
              Carp::confess("info protocol violation: [$data]");
            }
          }
          if ($str->{'protocol'} eq 'stdout') {
            if (!$opts->{'discard_output'}) {
              $child_stdout .= $data;
              $child_merged .= $data;
            }

            if ($opts->{'stdout_handler'} && ref($opts->{'stdout_handler'}) eq 'CODE') {
              $opts->{'stdout_handler'}->($data);
            }
          }
          if ($str->{'protocol'} eq 'stderr') {
            if (!$opts->{'discard_output'}) {
              $child_stderr .= $data;
              $child_merged .= $data;
            }

            if ($opts->{'stderr_handler'} && ref($opts->{'stderr_handler'}) eq 'CODE') {
              $opts->{'stderr_handler'}->($data);
            }
          }
 
          # process may finish (waitpid returns -1) before
          # we've read all of its output because of buffering;
          # so try to read all the way it is possible to read
          # in such case - this shouldn't be too much (unless
          # the buffer size is HUGE -- should introduce
          # another counter in such case, maybe later)
          #
          push @{$ready_fds}, $select->can_read(1/100) if $child_finished;
        }

        if ($opts->{'wait_loop_callback'} && ref($opts->{'wait_loop_callback'}) eq 'CODE') {
          $opts->{'wait_loop_callback'}->();
        }

        Time::HiRes::usleep(1);
      }

      # $child_pid_pid is not defined in two cases:
      #  * when our child was killed before
      #    it had chance to tell us the pid
      #    of the child it spawned. we can do
      #    nothing in this case :(
      #  * our child successfully reaped its child,
      #    we have nothing left to do in this case
      #
      # defined $child_pid_pid means child's child
      # has not died but nobody is waiting for it,
      # killing it brutally.
      #
      if ($child_child_pid) {
        kill_gently($child_child_pid);
      }

      # in case there are forks in child which
      # do not forward or process signals (TERM) correctly
      # kill whole child process group, effectively trying
      # not to return with some children or their parts still running
      #
      # to be more accurate -- we need to be sure
      # that this is process group created by our child
      # (and not some other process group with the same pgid,
      # created just after death of our child) -- fortunately
      # this might happen only when process group ids
      # are reused quickly (there are lots of processes
      # spawning new process groups for example)
      #
      if ($opts->{'clean_up_children'}) {
        kill(-9, $pid);
      }

  #    print "child $pid finished\n";

      close($child_stdout_socket);
      close($child_stderr_socket);
      close($child_info_socket);

      my $o = {
        'stdout' => $child_stdout,
        'stderr' => $child_stderr,
        'merged' => $child_merged,
        'timeout' => $child_timedout ? $opts->{'timeout'} : 0,
        'exit_code' => $child_exit_code,
        'parent_died' => $parent_died,
        'killed_by_signal' => $child_killed_by_signal,
        'child_pgid' => $pid,
        'cmd' => $cmd,
        };

      my $err_msg = '';
      if ($o->{'exit_code'}) {
        $err_msg .= "exited with code [$o->{'exit_code'}]\n";
      }
      if ($o->{'timeout'}) {
        $err_msg .= "ran more than [$o->{'timeout'}] seconds\n";
      }
      if ($o->{'parent_died'}) {
        $err_msg .= "parent died\n";
      }
      if ($o->{'stdout'} && !$opts->{'non_empty_stdout_ok'}) {
        $err_msg .= "stdout:\n" . $o->{'stdout'} . "\n";
      }
      if ($o->{'stderr'}) {
        $err_msg .= "stderr:\n" . $o->{'stderr'} . "\n";
      }
      if ($o->{'killed_by_signal'}) {
        $err_msg .= "killed by signal [" . $o->{'killed_by_signal'} . "]\n";
      }
      $o->{'err_msg'} = $err_msg;

      if ($orig_sig_child) {
        $SIG{'CHLD'} = $orig_sig_child;
      }
      else {
        delete($SIG{'CHLD'});
      }

      uninstall_signals();

      return $o;
    }
    else {
      Carp::confess("cannot fork: $!") unless defined($pid);

      # create new process session for open3 call,
      # so we hopefully can kill all the subprocesses
      # which might be spawned in it (except for those
      # which do setsid theirselves -- can't do anything
      # with those)

      POSIX::setsid() == -1 and Carp::confess("Error running setsid: " . $!);

      if ($opts->{'child_BEGIN'} && ref($opts->{'child_BEGIN'}) eq 'CODE') {
        $opts->{'child_BEGIN'}->();
      }

      close($child_stdout_socket);
      close($child_stderr_socket);
      close($child_info_socket);

      my $child_exit_code;

      # allow both external programs
      # and internal perl calls
      if (!ref($cmd)) {
        $child_exit_code = open3_run($cmd, {
          'parent_info' => $parent_info_socket,
          'parent_stdout' => $parent_stdout_socket,
          'parent_stderr' => $parent_stderr_socket,
          'child_stdin' => $opts->{'child_stdin'},
          'original_ppid' => $ppid,
          });
      }
      elsif (ref($cmd) eq 'CODE') {
        # reopen STDOUT and STDERR for child code:
        # https://rt.cpan.org/Ticket/Display.html?id=85912
        open STDOUT, '>&', $parent_stdout_socket || Carp::confess("Unable to reopen STDOUT: $!\n");
        open STDERR, '>&', $parent_stderr_socket || Carp::confess("Unable to reopen STDERR: $!\n");

        $child_exit_code = $cmd->({
          'opts' => $opts,
          'parent_info' => $parent_info_socket,
          'parent_stdout' => $parent_stdout_socket,
          'parent_stderr' => $parent_stderr_socket,
          'child_stdin' => $opts->{'child_stdin'},
          });
      }
      else {
        print $parent_stderr_socket "Invalid command reference: " . ref($cmd) . "\n";
        $child_exit_code = 1;
      }

      close($parent_stdout_socket);
      close($parent_stderr_socket);
      close($parent_info_socket);

      if ($opts->{'child_END'} && ref($opts->{'child_END'}) eq 'CODE') {
        $opts->{'child_END'}->();
      }

      $| = 1;
      POSIX::_exit $child_exit_code;
    }
}

sub run {
    ### container to store things in
    my $self = bless {}, __PACKAGE__;

    my %hash = @_;

    ### if the user didn't provide a buffer, we'll store it here.
    my $def_buf = '';

    my($verbose,$cmd,$buffer,$timeout);
    my $tmpl = {
        verbose => { default  => $VERBOSE,  store => \$verbose },
        buffer  => { default  => \$def_buf, store => \$buffer },
        command => { required => 1,         store => \$cmd,
                     allow    => sub { !ref($_[0]) or ref($_[0]) eq 'ARRAY' },
        },
        timeout => { default  => 0,         store => \$timeout },
    };

    unless( check( $tmpl, \%hash, $VERBOSE ) ) {
        Carp::carp( loc( "Could not validate input: %1",
                         Params::Check->last_error ) );
        return;
    };

    $cmd = _quote_args_vms( $cmd ) if IS_VMS;

    ### strip any empty elements from $cmd if present
    if ( $ALLOW_NULL_ARGS ) {
      $cmd = [ grep { defined } @$cmd ] if ref $cmd;
    }
    else {
      $cmd = [ grep { defined && length } @$cmd ] if ref $cmd;
    }

    my $pp_cmd = (ref $cmd ? "@$cmd" : $cmd);
    print loc("Running [%1]...\n", $pp_cmd ) if $verbose;

    ### did the user pass us a buffer to fill or not? if so, set this
    ### flag so we know what is expected of us
    ### XXX this is now being ignored. in the future, we could add diagnostic
    ### messages based on this logic
    #my $user_provided_buffer = $buffer == \$def_buf ? 0 : 1;

    ### buffers that are to be captured
    my( @buffer, @buff_err, @buff_out );

    ### capture STDOUT
    my $_out_handler = sub {
        my $buf = shift;
        return unless defined $buf;

        print STDOUT $buf if $verbose;
        push @buffer,   $buf;
        push @buff_out, $buf;
    };

    ### capture STDERR
    my $_err_handler = sub {
        my $buf = shift;
        return unless defined $buf;

        print STDERR $buf if $verbose;
        push @buffer,   $buf;
        push @buff_err, $buf;
    };


    ### flag to indicate we have a buffer captured
    my $have_buffer = $self->can_capture_buffer ? 1 : 0;

    ### flag indicating if the subcall went ok
    my $ok;

    ### don't look at previous errors:
    local $?;
    local $@;
    local $!;

    ### we might be having a timeout set
    eval {
        local $SIG{ALRM} = sub { die bless sub {
            ALARM_CLASS .
            qq[: Command '$pp_cmd' aborted by alarm after $timeout seconds]
        }, ALARM_CLASS } if $timeout;
        alarm $timeout || 0;

        ### IPC::Run is first choice if $USE_IPC_RUN is set.
        if( !IS_WIN32 and $USE_IPC_RUN and $self->can_use_ipc_run( 1 ) ) {
            ### ipc::run handlers needs the command as a string or an array ref

            $self->_debug( "# Using IPC::Run. Have buffer: $have_buffer" )
                if $DEBUG;

            $ok = $self->_ipc_run( $cmd, $_out_handler, $_err_handler );

        ### since IPC::Open3 works on all platforms, and just fails on
        ### win32 for capturing buffers, do that ideally
        } elsif ( $USE_IPC_OPEN3 and $self->can_use_ipc_open3( 1 ) ) {

            $self->_debug("# Using IPC::Open3. Have buffer: $have_buffer")
                if $DEBUG;

            ### in case there are pipes in there;
            ### IPC::Open3 will call exec and exec will do the right thing

            my $method = IS_WIN32 ? '_open3_run_win32' : '_open3_run';

            $ok = $self->$method(
                                    $cmd, $_out_handler, $_err_handler, $verbose
                                );

        ### if we are allowed to run verbose, just dispatch the system command
        } else {
            $self->_debug( "# Using system(). Have buffer: $have_buffer" )
                if $DEBUG;
            $ok = $self->_system_run( $cmd, $verbose );
        }

        alarm 0;
    };

    ### restore STDIN after duping, or STDIN will be closed for
    ### this current perl process!
    $self->__reopen_fds( @{ $self->_fds} ) if $self->_fds;

    my $err;
    unless( $ok ) {
        ### alarm happened
        if ( $@ and ref $@ and $@->isa( ALARM_CLASS ) ) {
            $err = $@->();  # the error code is an expired alarm

        ### another error happened, set by the dispatchub
        } else {
            $err = $self->error;
        }
    }

    ### fill the buffer;
    $$buffer = join '', @buffer if @buffer;

    ### return a list of flags and buffers (if available) in list
    ### context, or just a simple 'ok' in scalar
    return wantarray
                ? $have_buffer
                    ? ($ok, $err, \@buffer, \@buff_out, \@buff_err)
                    : ($ok, $err )
                : $ok


}

sub _open3_run_win32 {
  my $self    = shift;
  my $cmd     = shift;
  my $outhand = shift;
  my $errhand = shift;

  require Socket;

  my $pipe = sub {
    socketpair($_[0], $_[1], &Socket::AF_UNIX, &Socket::SOCK_STREAM, &Socket::PF_UNSPEC)
        or return undef;
    shutdown($_[0], 1);  # No more writing for reader
    shutdown($_[1], 0);  # No more reading for writer
    return 1;
  };

  my $open3 = sub {
    local (*TO_CHLD_R,     *TO_CHLD_W);
    local (*FR_CHLD_R,     *FR_CHLD_W);
    local (*FR_CHLD_ERR_R, *FR_CHLD_ERR_W);

    $pipe->(*TO_CHLD_R,     *TO_CHLD_W    ) or die $^E;
    $pipe->(*FR_CHLD_R,     *FR_CHLD_W    ) or die $^E;
    $pipe->(*FR_CHLD_ERR_R, *FR_CHLD_ERR_W) or die $^E;

    my $pid = IPC::Open3::open3('>&TO_CHLD_R', '<&FR_CHLD_W', '<&FR_CHLD_ERR_W', @_);

    return ( $pid, *TO_CHLD_W, *FR_CHLD_R, *FR_CHLD_ERR_R );
  };

  $cmd = [ grep { defined && length } @$cmd ] if ref $cmd;
  $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd );

  my ($pid, $to_chld, $fr_chld, $fr_chld_err) =
    $open3->( ( ref $cmd ? @$cmd : $cmd ) );

  my $in_sel  = IO::Select->new();
  my $out_sel = IO::Select->new();

  my %objs;

  $objs{ fileno( $fr_chld ) } = $outhand;
  $objs{ fileno( $fr_chld_err ) } = $errhand;
  $in_sel->add( $fr_chld );
  $in_sel->add( $fr_chld_err );

  close($to_chld);

  while ($in_sel->count() + $out_sel->count()) {
    my ($ins, $outs) = IO::Select::select($in_sel, $out_sel, undef);

    for my $fh (@$ins) {
        my $obj = $objs{ fileno($fh) };
        my $buf;
        my $bytes_read = sysread($fh, $buf, 64*1024 ); #, length($buf));
        if (!$bytes_read) {
            $in_sel->remove($fh);
        }
        else {
            $obj->( "$buf" );
        }
      }

      for my $fh (@$outs) {
      }
  }

  waitpid($pid, 0);

  ### some error occurred
  if( $? ) {
        $self->error( $self->_pp_child_error( $cmd, $? ) );
        $self->ok( 0 );
        return;
  } else {
        return $self->ok( 1 );
  }
}

sub _open3_run {
    my $self            = shift;
    my $cmd             = shift;
    my $_out_handler    = shift;
    my $_err_handler    = shift;
    my $verbose         = shift || 0;

    ### Following code are adapted from Friar 'abstracts' in the
    ### Perl Monastery (http://www.perlmonks.org/index.pl?node_id=151886).
    ### XXX that code didn't work.
    ### we now use the following code, thanks to theorbtwo

    ### define them beforehand, so we always have defined FH's
    ### to read from.
    use Symbol;
    my $kidout      = Symbol::gensym();
    my $kiderror    = Symbol::gensym();

    ### Dup the filehandle so we can pass 'our' STDIN to the
    ### child process. This stops us from having to pump input
    ### from ourselves to the childprocess. However, we will need
    ### to revive the FH afterwards, as IPC::Open3 closes it.
    ### We'll do the same for STDOUT and STDERR. It works without
    ### duping them on non-unix derivatives, but not on win32.
    my @fds_to_dup = ( IS_WIN32 && !$verbose
                            ? qw[STDIN STDOUT STDERR]
                            : qw[STDIN]
                        );
    $self->_fds( \@fds_to_dup );
    $self->__dup_fds( @fds_to_dup );

    ### pipes have to come in a quoted string, and that clashes with
    ### whitespace. This sub fixes up such commands so they run properly
    $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd );

    ### don't stringify @$cmd, so spaces in filenames/paths are
    ### treated properly
    my $pid = eval {
        IPC::Open3::open3(
                    '<&STDIN',
                    (IS_WIN32 ? '>&STDOUT' : $kidout),
                    (IS_WIN32 ? '>&STDERR' : $kiderror),
                    ( ref $cmd ? @$cmd : $cmd ),
                );
    };

    ### open3 error occurred
    if( $@ and $@ =~ /^open3:/ ) {
        $self->ok( 0 );
        $self->error( $@ );
        return;
    };

    ### use OUR stdin, not $kidin. Somehow,
    ### we never get the input.. so jump through
    ### some hoops to do it :(
    my $selector = IO::Select->new(
                        (IS_WIN32 ? \*STDERR : $kiderror),
                        \*STDIN,
                        (IS_WIN32 ? \*STDOUT : $kidout)
                    );

    STDOUT->autoflush(1);   STDERR->autoflush(1);   STDIN->autoflush(1);
    $kidout->autoflush(1)   if UNIVERSAL::can($kidout,   'autoflush');
    $kiderror->autoflush(1) if UNIVERSAL::can($kiderror, 'autoflush');

    ### add an explicit break statement
    ### code courtesy of theorbtwo from #london.pm
    my $stdout_done = 0;
    my $stderr_done = 0;
    OUTER: while ( my @ready = $selector->can_read ) {

        for my $h ( @ready ) {
            my $buf;

            ### $len is the amount of bytes read
            my $len = sysread( $h, $buf, 4096 );    # try to read 4096 bytes

            ### see perldoc -f sysread: it returns undef on error,
            ### so bail out.
            if( not defined $len ) {
                warn(loc("Error reading from process: %1", $!));
                last OUTER;
            }

            ### check for $len. it may be 0, at which point we're
            ### done reading, so don't try to process it.
            ### if we would print anyway, we'd provide bogus information
            $_out_handler->( "$buf" ) if $len && $h == $kidout;
            $_err_handler->( "$buf" ) if $len && $h == $kiderror;

            ### Wait till child process is done printing to both
            ### stdout and stderr.
            $stdout_done = 1 if $h == $kidout   and $len == 0;
            $stderr_done = 1 if $h == $kiderror and $len == 0;
            last OUTER if ($stdout_done && $stderr_done);
        }
    }

    waitpid $pid, 0; # wait for it to die

    ### restore STDIN after duping, or STDIN will be closed for
    ### this current perl process!
    ### done in the parent call now
    # $self->__reopen_fds( @fds_to_dup );

    ### some error occurred
    if( $? ) {
        $self->error( $self->_pp_child_error( $cmd, $? ) );
        $self->ok( 0 );
        return;
    } else {
        return $self->ok( 1 );
    }
}

### Text::ParseWords::shellwords() uses unix semantics. that will break
### on win32
{   my $parse_sub = IS_WIN32
                        ? __PACKAGE__->can('_split_like_shell_win32')
                        : Text::ParseWords->can('shellwords');

    sub _ipc_run {
        my $self            = shift;
        my $cmd             = shift;
        my $_out_handler    = shift;
        my $_err_handler    = shift;

        STDOUT->autoflush(1); STDERR->autoflush(1);

        ### a command like:
        # [
        #     '/usr/bin/gzip',
        #     '-cdf',
        #     '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz',
        #     '|',
        #     '/usr/bin/tar',
        #     '-tf -'
        # ]
        ### needs to become:
        # [
        #     ['/usr/bin/gzip', '-cdf',
        #       '/Users/kane/sources/p4/other/archive-extract/t/src/x.tgz']
        #     '|',
        #     ['/usr/bin/tar', '-tf -']
        # ]


        my @command;
        my $special_chars;

        my $re = do { my $x = join '', SPECIAL_CHARS; qr/([$x])/ };
        if( ref $cmd ) {
            my $aref = [];
            for my $item (@$cmd) {
                if( $item =~ $re ) {
                    push @command, $aref, $item;
                    $aref = [];
                    $special_chars .= $1;
                } else {
                    push @$aref, $item;
                }
            }
            push @command, $aref;
        } else {
            @command = map { if( $_ =~ $re ) {
                                $special_chars .= $1; $_;
                             } else {
#                                [ split /\s+/ ]
                                 [ map { m/[ ]/ ? qq{'$_'} : $_ } $parse_sub->($_) ]
                             }
                        } split( /\s*$re\s*/, $cmd );
        }

        ### if there's a pipe in the command, *STDIN needs to
        ### be inserted *BEFORE* the pipe, to work on win32
        ### this also works on *nix, so we should do it when possible
        ### this should *also* work on multiple pipes in the command
        ### if there's no pipe in the command, append STDIN to the back
        ### of the command instead.
        ### XXX seems IPC::Run works it out for itself if you just
        ### don't pass STDIN at all.
        #     if( $special_chars and $special_chars =~ /\|/ ) {
        #         ### only add STDIN the first time..
        #         my $i;
        #         @command = map { ($_ eq '|' && not $i++)
        #                             ? ( \*STDIN, $_ )
        #                             : $_
        #                         } @command;
        #     } else {
        #         push @command, \*STDIN;
        #     }

        # \*STDIN is already included in the @command, see a few lines up
        my $ok = eval { IPC::Run::run(   @command,
                                fileno(STDOUT).'>',
                                $_out_handler,
                                fileno(STDERR).'>',
                                $_err_handler
                            )
                        };

        ### all is well
        if( $ok ) {
            return $self->ok( $ok );

        ### some error occurred
        } else {
            $self->ok( 0 );

            ### if the eval fails due to an exception, deal with it
            ### unless it's an alarm
            if( $@ and not UNIVERSAL::isa( $@, ALARM_CLASS ) ) {
                $self->error( $@ );

            ### if it *is* an alarm, propagate
            } elsif( $@ ) {
                die $@;

            ### some error in the sub command
            } else {
                $self->error( $self->_pp_child_error( $cmd, $? ) );
            }

            return;
        }
    }
}

sub _system_run {
    my $self    = shift;
    my $cmd     = shift;
    my $verbose = shift || 0;

    ### pipes have to come in a quoted string, and that clashes with
    ### whitespace. This sub fixes up such commands so they run properly
    $cmd = $self->__fix_cmd_whitespace_and_special_chars( $cmd );

    my @fds_to_dup = $verbose ? () : qw[STDOUT STDERR];
    $self->_fds( \@fds_to_dup );
    $self->__dup_fds( @fds_to_dup );

    ### system returns 'true' on failure -- the exit code of the cmd
    $self->ok( 1 );
    system( ref $cmd ? @$cmd : $cmd ) == 0 or do {
        $self->error( $self->_pp_child_error( $cmd, $? ) );
        $self->ok( 0 );
    };

    ### done in the parent call now
    #$self->__reopen_fds( @fds_to_dup );

    return unless $self->ok;
    return $self->ok;
}

{   my %sc_lookup = map { $_ => $_ } SPECIAL_CHARS;


    sub __fix_cmd_whitespace_and_special_chars {
        my $self = shift;
        my $cmd  = shift;

        ### command has a special char in it
        if( ref $cmd and grep { $sc_lookup{$_} } @$cmd ) {

            ### since we have special chars, we have to quote white space
            ### this *may* conflict with the parsing :(
            my $fixed;
            my @cmd = map { / / ? do { $fixed++; QUOTE.$_.QUOTE } : $_ } @$cmd;

            $self->_debug( "# Quoted $fixed arguments containing whitespace" )
                    if $DEBUG && $fixed;

            ### stringify it, so the special char isn't escaped as argument
            ### to the program
            $cmd = join ' ', @cmd;
        }

        return $cmd;
    }
}

### Command-line arguments (but not the command itself) must be quoted
### to ensure case preservation. Borrowed from Module::Build with adaptations.
### Patch for this supplied by Craig Berry, see RT #46288: [PATCH] Add argument
### quoting for run() on VMS
sub _quote_args_vms {
  ### Returns a command string with proper quoting so that the subprocess
  ### sees this same list of args, or if we get a single arg that is an
  ### array reference, quote the elements of it (except for the first)
  ### and return the reference.
  my @args = @_;
  my $got_arrayref = (scalar(@args) == 1
                      && UNIVERSAL::isa($args[0], 'ARRAY'))
                   ? 1
                   : 0;

  @args = split(/\s+/, $args[0]) unless $got_arrayref || scalar(@args) > 1;

  my $cmd = $got_arrayref ? shift @{$args[0]} : shift @args;

  ### Do not quote qualifiers that begin with '/' or previously quoted args.
  map { if (/^[^\/\"]/) {
          $_ =~ s/\"/""/g;     # escape C<"> by doubling
          $_ = q(").$_.q(");
        }
  }
    ($got_arrayref ? @{$args[0]}
                   : @args
    );

  $got_arrayref ? unshift(@{$args[0]}, $cmd) : unshift(@args, $cmd);

  return $got_arrayref ? $args[0]
                       : join(' ', @args);
}


### XXX this is cribbed STRAIGHT from M::B 0.30 here:
### http://search.cpan.org/src/KWILLIAMS/Module-Build-0.30/lib/Module/Build/Platform/Windows.pm:split_like_shell
### XXX this *should* be integrated into text::parsewords
sub _split_like_shell_win32 {
  # As it turns out, Windows command-parsing is very different from
  # Unix command-parsing.  Double-quotes mean different things,
  # backslashes don't necessarily mean escapes, and so on.  So we
  # can't use Text::ParseWords::shellwords() to break a command string
  # into words.  The algorithm below was bashed out by Randy and Ken
  # (mostly Randy), and there are a lot of regression tests, so we
  # should feel free to adjust if desired.

  local $_ = shift;

  my @argv;
  return @argv unless defined() && length();

  my $arg = '';
  my( $i, $quote_mode ) = ( 0, 0 );

  while ( $i < length() ) {

    my $ch      = substr( $_, $i  , 1 );
    my $next_ch = substr( $_, $i+1, 1 );

    if ( $ch eq '\\' && $next_ch eq '"' ) {
      $arg .= '"';
      $i++;
    } elsif ( $ch eq '\\' && $next_ch eq '\\' ) {
      $arg .= '\\';
      $i++;
    } elsif ( $ch eq '"' && $next_ch eq '"' && $quote_mode ) {
      $quote_mode = !$quote_mode;
      $arg .= '"';
      $i++;
    } elsif ( $ch eq '"' && $next_ch eq '"' && !$quote_mode &&
          ( $i + 2 == length()  ||
        substr( $_, $i + 2, 1 ) eq ' ' )
        ) { # for cases like: a"" => [ 'a' ]
      push( @argv, $arg );
      $arg = '';
      $i += 2;
    } elsif ( $ch eq '"' ) {
      $quote_mode = !$quote_mode;
    } elsif ( $ch eq ' ' && !$quote_mode ) {
      push( @argv, $arg ) if defined( $arg ) && length( $arg );
      $arg = '';
      ++$i while substr( $_, $i + 1, 1 ) eq ' ';
    } else {
      $arg .= $ch;
    }

    $i++;
  }

  push( @argv, $arg ) if defined( $arg ) && length( $arg );
  return @argv;
}



{   use File::Spec;
    use Symbol;

    my %Map = (
        STDOUT => [qw|>&|, \*STDOUT, Symbol::gensym() ],
        STDERR => [qw|>&|, \*STDERR, Symbol::gensym() ],
        STDIN  => [qw|<&|, \*STDIN,  Symbol::gensym() ],
    );

    ### dups FDs and stores them in a cache
    sub __dup_fds {
        my $self    = shift;
        my @fds     = @_;

        __PACKAGE__->_debug( "# Closing the following fds: @fds" ) if $DEBUG;

        for my $name ( @fds ) {
            my($redir, $fh, $glob) = @{$Map{$name}} or (
                Carp::carp(loc("No such FD: '%1'", $name)), next );

            ### MUST use the 2-arg version of open for dup'ing for
            ### 5.6.x compatibility. 5.8.x can use 3-arg open
            ### see perldoc5.6.2 -f open for details
            open $glob, $redir . fileno($fh) or (
                        Carp::carp(loc("Could not dup '$name': %1", $!)),
                        return
                    );

            ### we should re-open this filehandle right now, not
            ### just dup it
            ### Use 2-arg version of open, as 5.5.x doesn't support
            ### 3-arg version =/
            if( $redir eq '>&' ) {
                open( $fh, '>' . File::Spec->devnull ) or (
                    Carp::carp(loc("Could not reopen '$name': %1", $!)),
                    return
                );
            }
        }

        return 1;
    }

    ### reopens FDs from the cache
    sub __reopen_fds {
        my $self    = shift;
        my @fds     = @_;

        __PACKAGE__->_debug( "# Reopening the following fds: @fds" ) if $DEBUG;

        for my $name ( @fds ) {
            my($redir, $fh, $glob) = @{$Map{$name}} or (
                Carp::carp(loc("No such FD: '%1'", $name)), next );

            ### MUST use the 2-arg version of open for dup'ing for
            ### 5.6.x compatibility. 5.8.x can use 3-arg open
            ### see perldoc5.6.2 -f open for details
            open( $fh, $redir . fileno($glob) ) or (
                    Carp::carp(loc("Could not restore '$name': %1", $!)),
                    return
                );

            ### close this FD, we're not using it anymore
            close $glob;
        }
        return 1;

    }
}

sub _debug {
    my $self    = shift;
    my $msg     = shift or return;
    my $level   = shift || 0;

    local $Carp::CarpLevel += $level;
    Carp::carp($msg);

    return 1;
}

sub _pp_child_error {
    my $self    = shift;
    my $cmd     = shift or return;
    my $ce      = shift or return;
    my $pp_cmd  = ref $cmd ? "@$cmd" : $cmd;


    my $str;
    if( $ce == -1 ) {
        ### Include $! in the error message, so that the user can
        ### see 'No such file or directory' versus 'Permission denied'
        ### versus 'Cannot fork' or whatever the cause was.
        $str = "Failed to execute '$pp_cmd': $!";

    } elsif ( $ce & 127 ) {
        ### some signal
        $str = loc( "'%1' died with signal %2, %3 coredump",
               $pp_cmd, ($ce & 127), ($ce & 128) ? 'with' : 'without');

    } else {
        ### Otherwise, the command run but gave error status.
        $str = "'$pp_cmd' exited with value " . ($ce >> 8);
    }

    $self->_debug( "# Child error '$ce' translated to: $str" ) if $DEBUG;

    return $str;
}

1;

__END__

=head2 $q = QUOTE

Returns the character used for quoting strings on this platform. This is
usually a C<'> (single quote) on most systems, but some systems use different
quotes. For example, C<Win32> uses C<"> (double quote).

You can use it as follows:

  use IPC::Cmd qw[run QUOTE];
  my $cmd = q[echo ] . QUOTE . q[foo bar] . QUOTE;

This makes sure that C<foo bar> is treated as a string, rather than two
separate arguments to the C<echo> function.

=head1 HOW IT WORKS

C<run> will try to execute your command using the following logic:

=over 4

=item *

If you have C<IPC::Run> installed, and the variable C<$IPC::Cmd::USE_IPC_RUN>
is set to true (See the L<"Global Variables"> section) use that to execute
the command. You will have the full output available in buffers, interactive commands
are sure to work  and you are guaranteed to have your verbosity
settings honored cleanly.

=item *

Otherwise, if the variable C<$IPC::Cmd::USE_IPC_OPEN3> is set to true
(See the L<"Global Variables"> section), try to execute the command using
L<IPC::Open3>. Buffers will be available on all platforms,
interactive commands will still execute cleanly, and also your verbosity
settings will be adhered to nicely;

=item *

Otherwise, if you have the C<verbose> argument set to true, we fall back
to a simple C<system()> call. We cannot capture any buffers, but
interactive commands will still work.

=item *

Otherwise we will try and temporarily redirect STDERR and STDOUT, do a
C<system()> call with your command and then re-open STDERR and STDOUT.
This is the method of last resort and will still allow you to execute
your commands cleanly. However, no buffers will be available.

=back

=head1 Global Variables

The behaviour of IPC::Cmd can be altered by changing the following
global variables:

=head2 $IPC::Cmd::VERBOSE

This controls whether IPC::Cmd will print any output from the
commands to the screen or not. The default is 0.

=head2 $IPC::Cmd::USE_IPC_RUN

This variable controls whether IPC::Cmd will try to use L<IPC::Run>
when available and suitable.

=head2 $IPC::Cmd::USE_IPC_OPEN3

This variable controls whether IPC::Cmd will try to use L<IPC::Open3>
when available and suitable. Defaults to true.

=head2 $IPC::Cmd::WARN

This variable controls whether run-time warnings should be issued, like
the failure to load an C<IPC::*> module you explicitly requested.

Defaults to true. Turn this off at your own risk.

=head2 $IPC::Cmd::INSTANCES

This variable controls whether C<can_run> will return all instances of
the binary it finds in the C<PATH> when called in a list context.

Defaults to false, set to true to enable the described behaviour.

=head2 $IPC::Cmd::ALLOW_NULL_ARGS

This variable controls whether C<run> will remove any empty/null arguments
it finds in command arguments.

Defaults to false, so it will remove null arguments. Set to true to allow
them.

=head1 Caveats

=over 4

=item Whitespace and IPC::Open3 / system()

When using C<IPC::Open3> or C<system>, if you provide a string as the
C<command> argument, it is assumed to be appropriately escaped. You can
use the C<QUOTE> constant to use as a portable quote character (see above).
However, if you provide an array reference, special rules apply:

If your command contains B<special characters> (< > | &), it will
be internally stringified before executing the command, to avoid that these
special characters are escaped and passed as arguments instead of retaining
their special meaning.

However, if the command contained arguments that contained whitespace,
stringifying the command would lose the significance of the whitespace.
Therefore, C<IPC::Cmd> will quote any arguments containing whitespace in your
command if the command is passed as an arrayref and contains special characters.

=item Whitespace and IPC::Run

When using C<IPC::Run>, if you provide a string as the C<command> argument,
the string will be split on whitespace to determine the individual elements
of your command. Although this will usually just Do What You Mean, it may
break if you have files or commands with whitespace in them.

If you do not wish this to happen, you should provide an array
reference, where all parts of your command are already separated out.
Note however, if there are extra or spurious whitespaces in these parts,
the parser or underlying code may not interpret it correctly, and
cause an error.

Example:
The following code

    gzip -cdf foo.tar.gz | tar -xf -

should either be passed as

    "gzip -cdf foo.tar.gz | tar -xf -"

or as

    ['gzip', '-cdf', 'foo.tar.gz', '|', 'tar', '-xf', '-']

But take care not to pass it as, for example

    ['gzip -cdf foo.tar.gz', '|', 'tar -xf -']

Since this will lead to issues as described above.


=item IO Redirect

Currently it is too complicated to parse your command for IO
redirections. For capturing STDOUT or STDERR there is a work around
however, since you can just inspect your buffers for the contents.

=item Interleaving STDOUT/STDERR

Neither IPC::Run nor IPC::Open3 can interleave STDOUT and STDERR. For short
bursts of output from a program, e.g. this sample,

    for ( 1..4 ) {
        $_ % 2 ? print STDOUT $_ : print STDERR $_;
    }

IPC::[Run|Open3] will first read all of STDOUT, then all of STDERR, meaning
the output looks like '13' on STDOUT and '24' on STDERR, instead of

    1
    2
    3
    4

This has been recorded in L<rt.cpan.org> as bug #37532: Unable to interleave
STDOUT and STDERR.

=back

=head1 See Also

L<IPC::Run>, L<IPC::Open3>

=head1 ACKNOWLEDGEMENTS

Thanks to James Mastros and Martijn van der Streek for their
help in getting L<IPC::Open3> to behave nicely.

Thanks to Petya Kohts for the C<run_forked> code.

=head1 BUG REPORTS

Please report bugs or other issues to E<lt>bug-ipc-cmd@rt.cpan.orgE<gt>.

=head1 AUTHOR

Original author: Jos Boumans E<lt>kane@cpan.orgE<gt>.
Current maintainer: Chris Williams E<lt>bingos@cpan.orgE<gt>.

=head1 COPYRIGHT

This library is free software; you may redistribute and/or modify it
under the same terms as Perl itself.

=cut
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         package JSON::PP;

# JSON-2.0

use 5.005;
use strict;

use Exporter ();
BEGIN { @JSON::PP::ISA = ('Exporter') }

use overload ();
use JSON::PP::Boolean;

use Carp ();
#use Devel::Peek;

$JSON::PP::VERSION = '4.07';

@JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);

# instead of hash-access, i tried index-access for speed.
# but this method is not faster than what i expected. so it will be changed.

use constant P_ASCII                => 0;
use constant P_LATIN1               => 1;
use constant P_UTF8                 => 2;
use constant P_INDENT               => 3;
use constant P_CANONICAL            => 4;
use constant P_SPACE_BEFORE         => 5;
use constant P_SPACE_AFTER          => 6;
use constant P_ALLOW_NONREF         => 7;
use constant P_SHRINK               => 8;
use constant P_ALLOW_BLESSED        => 9;
use constant P_CONVERT_BLESSED      => 10;
use constant P_RELAXED              => 11;

use constant P_LOOSE                => 12;
use constant P_ALLOW_BIGNUM         => 13;
use constant P_ALLOW_BAREKEY        => 14;
use constant P_ALLOW_SINGLEQUOTE    => 15;
use constant P_ESCAPE_SLASH         => 16;
use constant P_AS_NONBLESSED        => 17;

use constant P_ALLOW_UNKNOWN        => 18;
use constant P_ALLOW_TAGS           => 19;

use constant OLD_PERL => $] < 5.008 ? 1 : 0;
use constant USE_B => $ENV{PERL_JSON_PP_USE_B} || 0;

BEGIN {
    if (USE_B) {
        require B;
    }
}

BEGIN {
    my @xs_compati_bit_properties = qw(
            latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink
            allow_blessed convert_blessed relaxed allow_unknown
            allow_tags
    );
    my @pp_bit_properties = qw(
            allow_singlequote allow_bignum loose
            allow_barekey escape_slash as_nonblessed
    );

    # Perl version check, Unicode handling is enabled?
    # Helper module sets @JSON::PP::_properties.
    if ( OLD_PERL ) {
        my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005';
        eval qq| require $helper |;
        if ($@) { Carp::croak $@; }
    }

    for my $name (@xs_compati_bit_properties, @pp_bit_properties) {
        my $property_id = 'P_' . uc($name);

        eval qq/
            sub $name {
                my \$enable = defined \$_[1] ? \$_[1] : 1;

                if (\$enable) {
                    \$_[0]->{PROPS}->[$property_id] = 1;
                }
                else {
                    \$_[0]->{PROPS}->[$property_id] = 0;
                }

                \$_[0];
            }

            sub get_$name {
                \$_[0]->{PROPS}->[$property_id] ? 1 : '';
            }
        /;
    }

}



# Functions

my $JSON; # cache

sub encode_json ($) { # encode
    ($JSON ||= __PACKAGE__->new->utf8)->encode(@_);
}


sub decode_json { # decode
    ($JSON ||= __PACKAGE__->new->utf8)->decode(@_);
}

# Obsoleted

sub to_json($) {
   Carp::croak ("JSON::PP::to_json has been renamed to encode_json.");
}


sub from_json($) {
   Carp::croak ("JSON::PP::from_json has been renamed to decode_json.");
}


# Methods

sub new {
    my $class = shift;
    my $self  = {
        max_depth   => 512,
        max_size    => 0,
        indent_length => 3,
    };

    $self->{PROPS}[P_ALLOW_NONREF] = 1;

    bless $self, $class;
}


sub encode {
    return $_[0]->PP_encode_json($_[1]);
}


sub decode {
    return $_[0]->PP_decode_json($_[1], 0x00000000);
}


sub decode_prefix {
    return $_[0]->PP_decode_json($_[1], 0x00000001);
}


# accessor


# pretty printing

sub pretty {
    my ($self, $v) = @_;
    my $enable = defined $v ? $v : 1;

    if ($enable) { # indent_length(3) for JSON::XS compatibility
        $self->indent(1)->space_before(1)->space_after(1);
    }
    else {
        $self->indent(0)->space_before(0)->space_after(0);
    }

    $self;
}

# etc

sub max_depth {
    my $max  = defined $_[1] ? $_[1] : 0x80000000;
    $_[0]->{max_depth} = $max;
    $_[0];
}


sub get_max_depth { $_[0]->{max_depth}; }


sub max_size {
    my $max  = defined $_[1] ? $_[1] : 0;
    $_[0]->{max_size} = $max;
    $_[0];
}


sub get_max_size { $_[0]->{max_size}; }

sub boolean_values {
    my $self = shift;
    if (@_) {
        my ($false, $true) = @_;
        $self->{false} = $false;
        $self->{true} = $true;
    } else {
        delete $self->{false};
        delete $self->{true};
    }
    return $self;
}

sub get_boolean_values {
    my $self = shift;
    if (exists $self->{true} and exists $self->{false}) {
        return @$self{qw/false true/};
    }
    return;
}

sub filter_json_object {
    if (defined $_[1] and ref $_[1] eq 'CODE') {
        $_[0]->{cb_object} = $_[1];
    } else {
        delete $_[0]->{cb_object};
    }
    $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
    $_[0];
}

sub filter_json_single_key_object {
    if (@_ == 1 or @_ > 3) {
        Carp::croak("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)");
    }
    if (defined $_[2] and ref $_[2] eq 'CODE') {
        $_[0]->{cb_sk_object}->{$_[1]} = $_[2];
    } else {
        delete $_[0]->{cb_sk_object}->{$_[1]};
        delete $_[0]->{cb_sk_object} unless %{$_[0]->{cb_sk_object} || {}};
    }
    $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0;
    $_[0];
}

sub indent_length {
    if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) {
        Carp::carp "The acceptable range of indent_length() is 0 to 15.";
    }
    else {
        $_[0]->{indent_length} = $_[1];
    }
    $_[0];
}

sub get_indent_length {
    $_[0]->{indent_length};
}

sub sort_by {
    $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1;
    $_[0];
}

sub allow_bigint {
    Carp::carp("allow_bigint() is obsoleted. use allow_bignum() instead.");
    $_[0]->allow_bignum;
}

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

###
### Perl => JSON
###


{ # Convert

    my $max_depth;
    my $indent;
    my $ascii;
    my $latin1;
    my $utf8;
    my $space_before;
    my $space_after;
    my $canonical;
    my $allow_blessed;
    my $convert_blessed;

    my $indent_length;
    my $escape_slash;
    my $bignum;
    my $as_nonblessed;
    my $allow_tags;

    my $depth;
    my $indent_count;
    my $keysort;


    sub PP_encode_json {
        my $self = shift;
        my $obj  = shift;

        $indent_count = 0;
        $depth        = 0;

        my $props = $self->{PROPS};

        ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed,
            $convert_blessed, $escape_slash, $bignum, $as_nonblessed, $allow_tags)
         = @{$props}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED,
                    P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED, P_ALLOW_TAGS];

        ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/};

        $keysort = $canonical ? sub { $a cmp $b } : undef;

        if ($self->{sort_by}) {
            $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by}
                     : $self->{sort_by} =~ /\D+/       ? $self->{sort_by}
                     : sub { $a cmp $b };
        }

        encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)")
             if(!ref $obj and !$props->[ P_ALLOW_NONREF ]);

        my $str  = $self->object_to_json($obj);

        $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible

        unless ($ascii or $latin1 or $utf8) {
            utf8::upgrade($str);
        }

        if ($props->[ P_SHRINK ]) {
            utf8::downgrade($str, 1);
        }

        return $str;
    }


    sub object_to_json {
        my ($self, $obj) = @_;
        my $type = ref($obj);

        if($type eq 'HASH'){
            return $self->hash_to_json($obj);
        }
        elsif($type eq 'ARRAY'){
            return $self->array_to_json($obj);
        }
        elsif ($type) { # blessed object?
            if (blessed($obj)) {

                return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') );

                if ( $allow_tags and $obj->can('FREEZE') ) {
                    my $obj_class = ref $obj || $obj;
                    $obj = bless $obj, $obj_class;
                    my @results = $obj->FREEZE('JSON');
                    if ( @results and ref $results[0] ) {
                        if ( refaddr( $obj ) eq refaddr( $results[0] ) ) {
                            encode_error( sprintf(
                                "%s::FREEZE method returned same object as was passed instead of a new one",
                                ref $obj
                            ) );
                        }
                    }
                    return '("'.$obj_class.'")['.join(',', @results).']';
                }

                if ( $convert_blessed and $obj->can('TO_JSON') ) {
                    my $result = $obj->TO_JSON();
                    if ( defined $result and ref( $result ) ) {
                        if ( refaddr( $obj ) eq refaddr( $result ) ) {
                            encode_error( sprintf(
                                "%s::TO_JSON method returned same object as was passed instead of a new one",
                                ref $obj
                            ) );
                        }
                    }

                    return $self->object_to_json( $result );
                }

                return "$obj" if ( $bignum and _is_bignum($obj) );

                if ($allow_blessed) {
                    return $self->blessed_to_json($obj) if ($as_nonblessed); # will be removed.
                    return 'null';
                }
                encode_error( sprintf("encountered object '%s', but neither allow_blessed, convert_blessed nor allow_tags settings are enabled (or TO_JSON/FREEZE method missing)", $obj)
                );
            }
            else {
                return $self->value_to_json($obj);
            }
        }
        else{
            return $self->value_to_json($obj);
        }
    }


    sub hash_to_json {
        my ($self, $obj) = @_;
        my @res;

        encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                         if (++$depth > $max_depth);

        my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');
        my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : '');

        for my $k ( _sort( $obj ) ) {
            if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized
            push @res, $self->string_to_json( $k )
                          .  $del
                          . ( ref $obj->{$k} ? $self->object_to_json( $obj->{$k} ) : $self->value_to_json( $obj->{$k} ) );
        }

        --$depth;
        $self->_down_indent() if ($indent);

        return '{}' unless @res;
        return '{' . $pre . join( ",$pre", @res ) . $post . '}';
    }


    sub array_to_json {
        my ($self, $obj) = @_;
        my @res;

        encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)")
                                         if (++$depth > $max_depth);

        my ($pre, $post) = $indent ? $self->_up_indent() : ('', '');

        for my $v (@$obj){
            push @res, ref($v) ? $self->object_to_json($v) : $self->value_to_json($v);
        }

        --$depth;
        $self->_down_indent() if ($indent);

        return '[]' unless @res;
        return '[' . $pre . join( ",$pre", @res ) . $post . ']';
    }

    sub _looks_like_number {
        my $value = shift;
        if (USE_B) {
            my $b_obj = B::svref_2object(\$value);
            my $flags = $b_obj->FLAGS;
            return 1 if $flags & ( B::SVp_IOK() | B::SVp_NOK() ) and !( $flags & B::SVp_POK() );
            return;
        } else {
            no warnings 'numeric';
            # if the utf8 flag is on, it almost certainly started as a string
            return if utf8::is_utf8($value);
            # detect numbers
            # string & "" -> ""
            # number & "" -> 0 (with warning)
            # nan and inf can detect as numbers, so check with * 0
            return unless length((my $dummy = "") & $value);
            return unless 0 + $value eq $value;
            return 1 if $value * 0 == 0;
            return -1; # inf/nan
        }
    }

    sub value_to_json {
        my ($self, $value) = @_;

        return 'null' if(!defined $value);

        my $type = ref($value);

        if (!$type) {
            if (_looks_like_number($value)) {
                return $value;
            }
            return $self->string_to_json($value);
        }
        elsif( blessed($value) and  $value->isa('JSON::PP::Boolean') ){
            return $$value == 1 ? 'true' : 'false';
        }
        else {
            if ((overload::StrVal($value) =~ /=(\w+)/)[0]) {
                return $self->value_to_json("$value");
            }

            if ($type eq 'SCALAR' and defined $$value) {
                return   $$value eq '1' ? 'true'
                       : $$value eq '0' ? 'false'
                       : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null'
                       : encode_error("cannot encode reference to scalar");
            }

            if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) {
                return 'null';
            }
            else {
                if ( $type eq 'SCALAR' or $type eq 'REF' ) {
                    encode_error("cannot encode reference to scalar");
                }
                else {
                    encode_error("encountered $value, but JSON can only represent references to arrays or hashes");
                }
            }

        }
    }


    my %esc = (
        "\n" => '\n',
        "\r" => '\r',
        "\t" => '\t',
        "\f" => '\f',
        "\b" => '\b',
        "\"" => '\"',
        "\\" => '\\\\',
        "\'" => '\\\'',
    );


    sub string_to_json {
        my ($self, $arg) = @_;

        $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g;
        $arg =~ s/\//\\\//g if ($escape_slash);
        $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg;

        if ($ascii) {
            $arg = JSON_PP_encode_ascii($arg);
        }

        if ($latin1) {
            $arg = JSON_PP_encode_latin1($arg);
        }

        if ($utf8) {
            utf8::encode($arg);
        }

        return '"' . $arg . '"';
    }


    sub blessed_to_json {
        my $reftype = reftype($_[1]) || '';
        if ($reftype eq 'HASH') {
            return $_[0]->hash_to_json($_[1]);
        }
        elsif ($reftype eq 'ARRAY') {
            return $_[0]->array_to_json($_[1]);
        }
        else {
            return 'null';
        }
    }


    sub encode_error {
        my $error  = shift;
        Carp::croak "$error";
    }


    sub _sort {
        defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]};
    }


    sub _up_indent {
        my $self  = shift;
        my $space = ' ' x $indent_length;

        my ($pre,$post) = ('','');

        $post = "\n" . $space x $indent_count;

        $indent_count++;

        $pre = "\n" . $space x $indent_count;

        return ($pre,$post);
    }


    sub _down_indent { $indent_count--; }


    sub PP_encode_box {
        {
            depth        => $depth,
            indent_count => $indent_count,
        };
    }

} # Convert


sub _encode_ascii {
    join('',
        map {
            $_ <= 127 ?
                chr($_) :
            $_ <= 65535 ?
                sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
        } unpack('U*', $_[0])
    );
}


sub _encode_latin1 {
    join('',
        map {
            $_ <= 255 ?
                chr($_) :
            $_ <= 65535 ?
                sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_));
        } unpack('U*', $_[0])
    );
}


sub _encode_surrogates { # from perlunicode
    my $uni = $_[0] - 0x10000;
    return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00);
}


sub _is_bignum {
    $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat');
}



#
# JSON => Perl
#

my $max_intsize;

BEGIN {
    my $checkint = 1111;
    for my $d (5..64) {
        $checkint .= 1;
        my $int   = eval qq| $checkint |;
        if ($int =~ /[eE]/) {
            $max_intsize = $d - 1;
            last;
        }
    }
}

{ # PARSE 

    my %escapes = ( #  by Jeremy Muhlich <jmuhlich [at] bitflood.org>
        b    => "\x8",
        t    => "\x9",
        n    => "\xA",
        f    => "\xC",
        r    => "\xD",
        '\\' => '\\',
        '"'  => '"',
        '/'  => '/',
    );

    my $text; # json data
    my $at;   # offset
    my $ch;   # first character
    my $len;  # text length (changed according to UTF8 or NON UTF8)
    # INTERNAL
    my $depth;          # nest counter
    my $encoding;       # json text encoding
    my $is_valid_utf8;  # temp variable
    my $utf8_len;       # utf8 byte length
    # FLAGS
    my $utf8;           # must be utf8
    my $max_depth;      # max nest number of objects and arrays
    my $max_size;
    my $relaxed;
    my $cb_object;
    my $cb_sk_object;

    my $F_HOOK;

    my $allow_bignum;   # using Math::BigInt/BigFloat
    my $singlequote;    # loosely quoting
    my $loose;          # 
    my $allow_barekey;  # bareKey
    my $allow_tags;

    my $alt_true;
    my $alt_false;

    sub _detect_utf_encoding {
        my $text = shift;
        my @octets = unpack('C4', $text);
        return 'unknown' unless defined $octets[3];
        return ( $octets[0] and  $octets[1]) ? 'UTF-8'
             : (!$octets[0] and  $octets[1]) ? 'UTF-16BE'
             : (!$octets[0] and !$octets[1]) ? 'UTF-32BE'
             : ( $octets[2]                ) ? 'UTF-16LE'
             : (!$octets[2]                ) ? 'UTF-32LE'
             : 'unknown';
    }

    sub PP_decode_json {
        my ($self, $want_offset);

        ($self, $text, $want_offset) = @_;

        ($at, $ch, $depth) = (0, '', 0);

        if ( !defined $text or ref $text ) {
            decode_error("malformed JSON string, neither array, object, number, string or atom");
        }

        my $props = $self->{PROPS};

        ($utf8, $relaxed, $loose, $allow_bignum, $allow_barekey, $singlequote, $allow_tags)
            = @{$props}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE, P_ALLOW_TAGS];

        ($alt_true, $alt_false) = @$self{qw/true false/};

        if ( $utf8 ) {
            $encoding = _detect_utf_encoding($text);
            if ($encoding ne 'UTF-8' and $encoding ne 'unknown') {
                require Encode;
                Encode::from_to($text, $encoding, 'utf-8');
            } else {
                utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry");
            }
        }
        else {
            utf8::upgrade( $text );
            utf8::encode( $text );
        }

        $len = length $text;

        ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK)
             = @{$self}{qw/max_depth  max_size cb_object cb_sk_object F_HOOK/};

        if ($max_size > 1) {
            use bytes;
            my $bytes = length $text;
            decode_error(
                sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s"
                    , $bytes, $max_size), 1
            ) if ($bytes > $max_size);
        }

        white(); # remove head white space

        decode_error("malformed JSON string, neither array, object, number, string or atom") unless defined $ch; # Is there a first character for JSON structure?

        my $result = value();

        if ( !$props->[ P_ALLOW_NONREF ] and !ref $result ) {
                decode_error(
                'JSON text must be an object or array (but found number, string, true, false or null,'
                       . ' use allow_nonref to allow this)', 1);
        }

        Carp::croak('something wrong.') if $len < $at; # we won't arrive here.

        my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length

        white(); # remove tail white space

        return ( $result, $consumed ) if $want_offset; # all right if decode_prefix

        decode_error("garbage after JSON object") if defined $ch;

        $result;
    }


    sub next_chr {
        return $ch = undef if($at >= $len);
        $ch = substr($text, $at++, 1);
    }


    sub value {
        white();
        return          if(!defined $ch);
        return object() if($ch eq '{');
        return array()  if($ch eq '[');
        return tag()    if($ch eq '(');
        return string() if($ch eq '"' or ($singlequote and $ch eq "'"));
        return number() if($ch =~ /[0-9]/ or $ch eq '-');
        return word();
    }

    sub string {
        my $utf16;
        my $is_utf8;

        ($is_valid_utf8, $utf8_len) = ('', 0);

        my $s = ''; # basically UTF8 flag on

        if($ch eq '"' or ($singlequote and $ch eq "'")){
            my $boundChar = $ch;

            OUTER: while( defined(next_chr()) ){

                if($ch eq $boundChar){
                    next_chr();

                    if ($utf16) {
                        decode_error("missing low surrogate character in surrogate pair");
                    }

                    utf8::decode($s) if($is_utf8);

                    return $s;
                }
                elsif($ch eq '\\'){
                    next_chr();
                    if(exists $escapes{$ch}){
                        $s .= $escapes{$ch};
                    }
                    elsif($ch eq 'u'){ # UNICODE handling
                        my $u = '';

                        for(1..4){
                            $ch = next_chr();
                            last OUTER if($ch !~ /[0-9a-fA-F]/);
                            $u .= $ch;
                        }

                        # U+D800 - U+DBFF
                        if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate?
                            $utf16 = $u;
                        }
                        # U+DC00 - U+DFFF
                        elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate?
                            unless (defined $utf16) {
                                decode_error("missing high surrogate character in surrogate pair");
                            }
                            $is_utf8 = 1;
                            $s .= JSON_PP_decode_surrogates($utf16, $u) || next;
                            $utf16 = undef;
                        }
                        else {
                            if (defined $utf16) {
                                decode_error("surrogate pair expected");
                            }

                            if ( ( my $hex = hex( $u ) ) > 127 ) {
                                $is_utf8 = 1;
                                $s .= JSON_PP_decode_unicode($u) || next;
                            }
                            else {
                                $s .= chr $hex;
                            }
                        }

                    }
                    else{
                        unless ($loose) {
                            $at -= 2;
                            decode_error('illegal backslash escape sequence in string');
                        }
                        $s .= $ch;
                    }
                }
                else{

                    if ( ord $ch  > 127 ) {
                        unless( $ch = is_valid_utf8($ch) ) {
                            $at -= 1;
                            decode_error("malformed UTF-8 character in JSON string");
                        }
                        else {
                            $at += $utf8_len - 1;
                        }

                        $is_utf8 = 1;
                    }

                    if (!$loose) {
                        if ($ch =~ /[\x00-\x1f\x22\x5c]/)  { # '/' ok
                            if (!$relaxed or $ch ne "\t") {
                                $at--;
                                decode_error('invalid character encountered while parsing JSON string');
                            }
                        }
                    }

                    $s .= $ch;
                }
            }
        }

        decode_error("unexpected end of string while parsing JSON string");
    }


    sub white {
        while( defined $ch  ){
            if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){
                next_chr();
            }
            elsif($relaxed and $ch eq '/'){
                next_chr();
                if(defined $ch and $ch eq '/'){
                    1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r");
                }
                elsif(defined $ch and $ch eq '*'){
                    next_chr();
                    while(1){
                        if(defined $ch){
                            if($ch eq '*'){
                                if(defined(next_chr()) and $ch eq '/'){
                                    next_chr();
                                    last;
                                }
                            }
                            else{
                                next_chr();
                            }
                        }
                        else{
                            decode_error("Unterminated comment");
                        }
                    }
                    next;
                }
                else{
                    $at--;
                    decode_error("malformed JSON string, neither array, object, number, string or atom");
                }
            }
            else{
                if ($relaxed and $ch eq '#') { # correctly?
                    pos($text) = $at;
                    $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g;
                    $at = pos($text);
                    next_chr;
                    next;
                }

                last;
            }
        }
    }


    sub array {
        my $a  = $_[0] || []; # you can use this code to use another array ref object.

        decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                    if (++$depth > $max_depth);

        next_chr();
        white();

        if(defined $ch and $ch eq ']'){
            --$depth;
            next_chr();
            return $a;
        }
        else {
            while(defined($ch)){
                push @$a, value();

                white();

                if (!defined $ch) {
                    last;
                }

                if($ch eq ']'){
                    --$depth;
                    next_chr();
                    return $a;
                }

                if($ch ne ','){
                    last;
                }

                next_chr();
                white();

                if ($relaxed and $ch eq ']') {
                    --$depth;
                    next_chr();
                    return $a;
                }

            }
        }

        $at-- if defined $ch and $ch ne '';
        decode_error(", or ] expected while parsing array");
    }

    sub tag {
        decode_error('malformed JSON string, neither array, object, number, string or atom') unless $allow_tags;

        next_chr();
        white();

        my $tag = value();
        return unless defined $tag;
        decode_error('malformed JSON string, (tag) must be a string') if ref $tag;

        white();

        if (!defined $ch or $ch ne ')') {
            decode_error(') expected after tag');
        }

        next_chr();
        white();

        my $val = value();
        return unless defined $val;
        decode_error('malformed JSON string, tag value must be an array') unless ref $val eq 'ARRAY';

        if (!eval { $tag->can('THAW') }) {
             decode_error('cannot decode perl-object (package does not exist)') if $@;
             decode_error('cannot decode perl-object (package does not have a THAW method)');
        }
        $tag->THAW('JSON', @$val);
    }

    sub object {
        my $o = $_[0] || {}; # you can use this code to use another hash ref object.
        my $k;

        decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)')
                                                if (++$depth > $max_depth);
        next_chr();
        white();

        if(defined $ch and $ch eq '}'){
            --$depth;
            next_chr();
            if ($F_HOOK) {
                return _json_object_hook($o);
            }
            return $o;
        }
        else {
            while (defined $ch) {
                $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string();
                white();

                if(!defined $ch or $ch ne ':'){
                    $at--;
                    decode_error("':' expected");
                }

                next_chr();
                $o->{$k} = value();
                white();

                last if (!defined $ch);

                if($ch eq '}'){
                    --$depth;
                    next_chr();
                    if ($F_HOOK) {
                        return _json_object_hook($o);
                    }
                    return $o;
                }

                if($ch ne ','){
                    last;
                }

                next_chr();
                white();

                if ($relaxed and $ch eq '}') {
                    --$depth;
                    next_chr();
                    if ($F_HOOK) {
                        return _json_object_hook($o);
                    }
                    return $o;
                }

            }

        }

        $at-- if defined $ch and $ch ne '';
        decode_error(", or } expected while parsing object/hash");
    }


    sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition
        my $key;
        while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){
            $key .= $ch;
            next_chr();
        }
        return $key;
    }


    sub word {
        my $word =  substr($text,$at-1,4);

        if($word eq 'true'){
            $at += 3;
            next_chr;
            return defined $alt_true ? $alt_true : $JSON::PP::true;
        }
        elsif($word eq 'null'){
            $at += 3;
            next_chr;
            return undef;
        }
        elsif($word eq 'fals'){
            $at += 3;
            if(substr($text,$at,1) eq 'e'){
                $at++;
                next_chr;
                return defined $alt_false ? $alt_false : $JSON::PP::false;
            }
        }

        $at--; # for decode_error report

        decode_error("'null' expected")  if ($word =~ /^n/);
        decode_error("'true' expected")  if ($word =~ /^t/);
        decode_error("'false' expected") if ($word =~ /^f/);
        decode_error("malformed JSON string, neither array, object, number, string or atom");
    }


    sub number {
        my $n    = '';
        my $v;
        my $is_dec;
        my $is_exp;

        if($ch eq '-'){
            $n = '-';
            next_chr;
            if (!defined $ch or $ch !~ /\d/) {
                decode_error("malformed number (no digits after initial minus)");
            }
        }

        # According to RFC4627, hex or oct digits are invalid.
        if($ch eq '0'){
            my $peek = substr($text,$at,1);
            if($peek =~ /^[0-9a-dfA-DF]/){ # e may be valid (exponential)
                decode_error("malformed number (leading zero must not be followed by another digit)");
            }
            $n .= $ch;
            next_chr;
        }

        while(defined $ch and $ch =~ /\d/){
            $n .= $ch;
            next_chr;
        }

        if(defined $ch and $ch eq '.'){
            $n .= '.';
            $is_dec = 1;

            next_chr;
            if (!defined $ch or $ch !~ /\d/) {
                decode_error("malformed number (no digits after decimal point)");
            }
            else {
                $n .= $ch;
            }

            while(defined(next_chr) and $ch =~ /\d/){
                $n .= $ch;
            }
        }

        if(defined $ch and ($ch eq 'e' or $ch eq 'E')){
            $n .= $ch;
            $is_exp = 1;
            next_chr;

            if(defined($ch) and ($ch eq '+' or $ch eq '-')){
                $n .= $ch;
                next_chr;
                if (!defined $ch or $ch =~ /\D/) {
                    decode_error("malformed number (no digits after exp sign)");
                }
                $n .= $ch;
            }
            elsif(defined($ch) and $ch =~ /\d/){
                $n .= $ch;
            }
            else {
                decode_error("malformed number (no digits after exp sign)");
            }

            while(defined(next_chr) and $ch =~ /\d/){
                $n .= $ch;
            }

        }

        $v .= $n;

        if ($is_dec or $is_exp) {
            if ($allow_bignum) {
                require Math::BigFloat;
                return Math::BigFloat->new($v);
            }
        } else {
            if (length $v > $max_intsize) {
                if ($allow_bignum) { # from Adam Sussman
                    require Math::BigInt;
                    return Math::BigInt->new($v);
                }
                else {
                    return "$v";
                }
            }
        }

        return $is_dec ? $v/1.0 : 0+$v;
    }


    sub is_valid_utf8 {

        $utf8_len = $_[0] =~ /[\x00-\x7F]/  ? 1
                  : $_[0] =~ /[\xC2-\xDF]/  ? 2
                  : $_[0] =~ /[\xE0-\xEF]/  ? 3
                  : $_[0] =~ /[\xF0-\xF4]/  ? 4
                  : 0
                  ;

        return unless $utf8_len;

        my $is_valid_utf8 = substr($text, $at - 1, $utf8_len);

        return ( $is_valid_utf8 =~ /^(?:
             [\x00-\x7F]
            |[\xC2-\xDF][\x80-\xBF]
            |[\xE0][\xA0-\xBF][\x80-\xBF]
            |[\xE1-\xEC][\x80-\xBF][\x80-\xBF]
            |[\xED][\x80-\x9F][\x80-\xBF]
            |[\xEE-\xEF][\x80-\xBF][\x80-\xBF]
            |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF]
            |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF]
            |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF]
        )$/x )  ? $is_valid_utf8 : '';
    }


    sub decode_error {
        my $error  = shift;
        my $no_rep = shift;
        my $str    = defined $text ? substr($text, $at) : '';
        my $mess   = '';
        my $type   = 'U*';

        if ( OLD_PERL ) {
            my $type   =  $] <  5.006           ? 'C*'
                        : utf8::is_utf8( $str ) ? 'U*' # 5.6
                        : 'C*'
                        ;
        }

        for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ?
            $mess .=  $c == 0x07 ? '\a'
                    : $c == 0x09 ? '\t'
                    : $c == 0x0a ? '\n'
                    : $c == 0x0d ? '\r'
                    : $c == 0x0c ? '\f'
                    : $c <  0x20 ? sprintf('\x{%x}', $c)
                    : $c == 0x5c ? '\\\\'
                    : $c <  0x80 ? chr($c)
                    : sprintf('\x{%x}', $c)
                    ;
            if ( length $mess >= 20 ) {
                $mess .= '...';
                last;
            }
        }

        unless ( length $mess ) {
            $mess = '(end of string)';
        }

        Carp::croak (
            $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")"
        );

    }


    sub _json_object_hook {
        my $o    = $_[0];
        my @ks = keys %{$o};

        if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) {
            my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} );
            if (@val == 0) {
                return $o;
            }
            elsif (@val == 1) {
                return $val[0];
            }
            else {
                Carp::croak("filter_json_single_key_object callbacks must not return more than one scalar");
            }
        }

        my @val = $cb_object->($o) if ($cb_object);
        if (@val == 0) {
            return $o;
        }
        elsif (@val == 1) {
            return $val[0];
        }
        else {
            Carp::croak("filter_json_object callbacks must not return more than one scalar");
        }
    }


    sub PP_decode_box {
        {
            text    => $text,
            at      => $at,
            ch      => $ch,
            len     => $len,
            depth   => $depth,
            encoding      => $encoding,
            is_valid_utf8 => $is_valid_utf8,
        };
    }

} # PARSE


sub _decode_surrogates { # from perlunicode
    my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00);
    my $un  = pack('U*', $uni);
    utf8::encode( $un );
    return $un;
}


sub _decode_unicode {
    my $un = pack('U', hex shift);
    utf8::encode( $un );
    return $un;
}

#
# Setup for various Perl versions (the code from JSON::PP58)
#

BEGIN {

    unless ( defined &utf8::is_utf8 ) {
       require Encode;
       *utf8::is_utf8 = *Encode::is_utf8;
    }

    if ( !OLD_PERL ) {
        *JSON::PP::JSON_PP_encode_ascii      = \&_encode_ascii;
        *JSON::PP::JSON_PP_encode_latin1     = \&_encode_latin1;
        *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates;
        *JSON::PP::JSON_PP_decode_unicode    = \&_decode_unicode;

        if ($] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken.
            package JSON::PP;
            require subs;
            subs->import('join');
            eval q|
                sub join {
                    return '' if (@_ < 2);
                    my $j   = shift;
                    my $str = shift;
                    for (@_) { $str .= $j . $_; }
                    return $str;
                }
            |;
        }
    }


    sub JSON::PP::incr_parse {
        local $Carp::CarpLevel = 1;
        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ );
    }


    sub JSON::PP::incr_skip {
        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip;
    }


    sub JSON::PP::incr_reset {
        ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset;
    }

    eval q{
        sub JSON::PP::incr_text : lvalue {
            $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new;

            if ( $_[0]->{_incr_parser}->{incr_pos} ) {
                Carp::croak("incr_text cannot be called when the incremental parser already started parsing");
            }
            $_[0]->{_incr_parser}->{incr_text};
        }
    } if ( $] >= 5.006 );

} # Setup for various Perl versions (the code from JSON::PP58)


###############################
# Utilities
#

BEGIN {
    eval 'require Scalar::Util';
    unless($@){
        *JSON::PP::blessed = \&Scalar::Util::blessed;
        *JSON::PP::reftype = \&Scalar::Util::reftype;
        *JSON::PP::refaddr = \&Scalar::Util::refaddr;
    }
    else{ # This code is from Scalar::Util.
        # warn $@;
        eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }';
        *JSON::PP::blessed = sub {
            local($@, $SIG{__DIE__}, $SIG{__WARN__});
            ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef;
        };
        require B;
        my %tmap = qw(
            B::NULL   SCALAR
            B::HV     HASH
            B::AV     ARRAY
            B::CV     CODE
            B::IO     IO
            B::GV     GLOB
            B::REGEXP REGEXP
        );
        *JSON::PP::reftype = sub {
            my $r = shift;

            return undef unless length(ref($r));

            my $t = ref(B::svref_2object($r));

            return
                exists $tmap{$t} ? $tmap{$t}
              : length(ref($$r)) ? 'REF'
              :                    'SCALAR';
        };
        *JSON::PP::refaddr = sub {
          return undef unless length(ref($_[0]));

          my $addr;
          if(defined(my $pkg = blessed($_[0]))) {
            $addr .= bless $_[0], 'Scalar::Util::Fake';
            bless $_[0], $pkg;
          }
          else {
            $addr .= $_[0]
          }

          $addr =~ /0x(\w+)/;
          local $^W;
          #no warnings 'portable';
          hex($1);
        }
    }
}


# shamelessly copied and modified from JSON::XS code.

$JSON::PP::true  = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
$JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };

sub is_bool { blessed $_[0] and ( $_[0]->isa("JSON::PP::Boolean") or $_[0]->isa("Types::Serialiser::BooleanBase") or $_[0]->isa("JSON::XS::Boolean") ); }

sub true  { $JSON::PP::true  }
sub false { $JSON::PP::false }
sub null  { undef; }

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

package JSON::PP::IncrParser;

use strict;

use constant INCR_M_WS   => 0; # initial whitespace skipping
use constant INCR_M_STR  => 1; # inside string
use constant INCR_M_BS   => 2; # inside backslash
use constant INCR_M_JSON => 3; # outside anything, count nesting
use constant INCR_M_C0   => 4;
use constant INCR_M_C1   => 5;
use constant INCR_M_TFN  => 6;
use constant INCR_M_NUM  => 7;

$JSON::PP::IncrParser::VERSION = '1.01';

sub new {
    my ( $class ) = @_;

    bless {
        incr_nest    => 0,
        incr_text    => undef,
        incr_pos     => 0,
        incr_mode    => 0,
    }, $class;
}


sub incr_parse {
    my ( $self, $coder, $text ) = @_;

    $self->{incr_text} = '' unless ( defined $self->{incr_text} );

    if ( defined $text ) {
        if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) {
            utf8::upgrade( $self->{incr_text} ) ;
            utf8::decode( $self->{incr_text} ) ;
        }
        $self->{incr_text} .= $text;
    }

    if ( defined wantarray ) {
        my $max_size = $coder->get_max_size;
        my $p = $self->{incr_pos};
        my @ret;
        {
            do {
                unless ( $self->{incr_nest} <= 0 and $self->{incr_mode} == INCR_M_JSON ) {
                    $self->_incr_parse( $coder );

                    if ( $max_size and $self->{incr_pos} > $max_size ) {
                        Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size");
                    }
                    unless ( $self->{incr_nest} <= 0 and $self->{incr_mode} == INCR_M_JSON ) {
                        # as an optimisation, do not accumulate white space in the incr buffer
                        if ( $self->{incr_mode} == INCR_M_WS and $self->{incr_pos} ) {
                            $self->{incr_pos} = 0;
                            $self->{incr_text} = '';
                        }
                        last;
                    }
                }

                unless ( $coder->get_utf8 ) {
                    utf8::upgrade( $self->{incr_text} );
                    utf8::decode( $self->{incr_text} );
                }

                my ($obj, $offset) = $coder->PP_decode_json( $self->{incr_text}, 0x00000001 );
                push @ret, $obj;
                use bytes;
                $self->{incr_text} = substr( $self->{incr_text}, $offset || 0 );
                $self->{incr_pos} = 0;
                $self->{incr_nest} = 0;
                $self->{incr_mode} = 0;
                last unless wantarray;
            } while ( wantarray );
        }

        if ( wantarray ) {
            return @ret;
        }
        else { # in scalar context
            return defined $ret[0] ? $ret[0] : undef;
        }
    }
}


sub _incr_parse {
    my ($self, $coder) = @_;
    my $text = $self->{incr_text};
    my $len = length $text;
    my $p = $self->{incr_pos};

INCR_PARSE:
    while ( $len > $p ) {
        my $s = substr( $text, $p, 1 );
        last INCR_PARSE unless defined $s;
        my $mode = $self->{incr_mode};

        if ( $mode == INCR_M_WS ) {
            while ( $len > $p ) {
                $s = substr( $text, $p, 1 );
                last INCR_PARSE unless defined $s;
                if ( ord($s) > 0x20 ) {
                    if ( $s eq '#' ) {
                        $self->{incr_mode} = INCR_M_C0;
                        redo INCR_PARSE;
                    } else {
                        $self->{incr_mode} = INCR_M_JSON;
                        redo INCR_PARSE;
                    }
                }
                $p++;
            }
        } elsif ( $mode == INCR_M_BS ) {
            $p++;
            $self->{incr_mode} = INCR_M_STR;
            redo INCR_PARSE;
        } elsif ( $mode == INCR_M_C0 or $mode == INCR_M_C1 ) {
            while ( $len > $p ) {
                $s = substr( $text, $p, 1 );
                last INCR_PARSE unless defined $s;
                if ( $s eq "\n" ) {
                    $self->{incr_mode} = $self->{incr_mode} == INCR_M_C0 ? INCR_M_WS : INCR_M_JSON;
                    last;
                }
                $p++;
            }
            next;
        } elsif ( $mode == INCR_M_TFN ) {
            while ( $len > $p ) {
                $s = substr( $text, $p++, 1 );
                next if defined $s and $s =~ /[rueals]/;
                last;
            }
            $p--;
            $self->{incr_mode} = INCR_M_JSON;

            last INCR_PARSE unless $self->{incr_nest};
            redo INCR_PARSE;
        } elsif ( $mode == INCR_M_NUM ) {
            while ( $len > $p ) {
                $s = substr( $text, $p++, 1 );
                next if defined $s and $s =~ /[0-9eE.+\-]/;
                last;
            }
            $p--;
            $self->{incr_mode} = INCR_M_JSON;

            last INCR_PARSE unless $self->{incr_nest};
            redo INCR_PARSE;
        } elsif ( $mode == INCR_M_STR ) {
            while ( $len > $p ) {
                $s = substr( $text, $p, 1 );
                last INCR_PARSE unless defined $s;
                if ( $s eq '"' ) {
                    $p++;
                    $self->{incr_mode} = INCR_M_JSON;

                    last INCR_PARSE unless $self->{incr_nest};
                    redo INCR_PARSE;
                }
                elsif ( $s eq '\\' ) {
                    $p++;
                    if ( !defined substr($text, $p, 1) ) {
                        $self->{incr_mode} = INCR_M_BS;
                        last INCR_PARSE;
                    }
                }
                $p++;
            }
        } elsif ( $mode == INCR_M_JSON ) {
            while ( $len > $p ) {
                $s = substr( $text, $p++, 1 );
                if ( $s eq "\x00" ) {
                    $p--;
                    last INCR_PARSE;
                } elsif ( $s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20" ) {
                    if ( !$self->{incr_nest} ) {
                        $p--; # do not eat the whitespace, let the next round do it
                        last INCR_PARSE;
                    }
                    next;
                } elsif ( $s eq 't' or $s eq 'f' or $s eq 'n' ) {
                    $self->{incr_mode} = INCR_M_TFN;
                    redo INCR_PARSE;
                } elsif ( $s =~ /^[0-9\-]$/ ) {
                    $self->{incr_mode} = INCR_M_NUM;
                    redo INCR_PARSE;
                } elsif ( $s eq '"' ) {
                    $self->{incr_mode} = INCR_M_STR;
                    redo INCR_PARSE;
                } elsif ( $s eq '[' or $s eq '{' ) {
                    if ( ++$self->{incr_nest} > $coder->get_max_depth ) {
                        Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)');
                    }
                    next;
                } elsif ( $s eq ']' or $s eq '}' ) {
                    if ( --$self->{incr_nest} <= 0 ) {
                        last INCR_PARSE;
                    }
                } elsif ( $s eq '#' ) {
                    $self->{incr_mode} = INCR_M_C1;
                    redo INCR_PARSE;
                }
            }
        }
    }

    $self->{incr_pos} = $p;
    $self->{incr_parsing} = $p ? 1 : 0; # for backward compatibility
}


sub incr_text {
    if ( $_[0]->{incr_pos} ) {
        Carp::croak("incr_text cannot be called when the incremental parser already started parsing");
    }
    $_[0]->{incr_text};
}


sub incr_skip {
    my $self  = shift;
    $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_pos} );
    $self->{incr_pos}     = 0;
    $self->{incr_mode}    = 0;
    $self->{incr_nest}    = 0;
}


sub incr_reset {
    my $self = shift;
    $self->{incr_text}    = undef;
    $self->{incr_pos}     = 0;
    $self->{incr_mode}    = 0;
    $self->{incr_nest}    = 0;
}

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


1;
__END__
=pod

=head1 NAME

JSON::PP - JSON::XS compatible pure-Perl module.

=head1 SYNOPSIS

 use JSON::PP;

 # exported functions, they croak on error
 # and expect/generate UTF-8

 $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
 $perl_hash_or_arrayref  = decode_json $utf8_encoded_json_text;

 # OO-interface

 $json = JSON::PP->new->ascii->pretty->allow_nonref;
 
 $pretty_printed_json_text = $json->encode( $perl_scalar );
 $perl_scalar = $json->decode( $json_text );
 
 # Note that JSON version 2.0 and above will automatically use
 # JSON::XS or JSON::PP, so you should be able to just:
 
 use JSON;


=head1 DESCRIPTION

JSON::PP is a pure perl JSON decoder/encoder, and (almost) compatible to much
faster L<JSON::XS> written by Marc Lehmann in C. JSON::PP works as
a fallback module when you use L<JSON> module without having
installed JSON::XS.

Because of this fallback feature of JSON.pm, JSON::PP tries not to
be more JavaScript-friendly than JSON::XS (i.e. not to escape extra
characters such as U+2028 and U+2029, etc),
in order for you not to lose such JavaScript-friendliness silently
when you use JSON.pm and install JSON::XS for speed or by accident.
If you need JavaScript-friendly RFC7159-compliant pure perl module,
try L<JSON::Tiny>, which is derived from L<Mojolicious> web
framework and is also smaller and faster than JSON::PP.

JSON::PP has been in the Perl core since Perl 5.14, mainly for
CPAN toolchain modules to parse META.json.

=head1 FUNCTIONAL INTERFACE

This section is taken from JSON::XS almost verbatim. C<encode_json>
and C<decode_json> are exported by default.

=head2 encode_json

    $json_text = encode_json $perl_scalar

Converts the given Perl data structure to a UTF-8 encoded, binary string
(that is, the string contains octets only). Croaks on error.

This function call is functionally identical to:

    $json_text = JSON::PP->new->utf8->encode($perl_scalar)

Except being faster.

=head2 decode_json

    $perl_scalar = decode_json $json_text

The opposite of C<encode_json>: expects an UTF-8 (binary) string and tries
to parse that as an UTF-8 encoded JSON text, returning the resulting
reference. Croaks on error.

This function call is functionally identical to:

    $perl_scalar = JSON::PP->new->utf8->decode($json_text)

Except being faster.

=head2 JSON::PP::is_bool

    $is_boolean = JSON::PP::is_bool($scalar)

Returns true if the passed scalar represents either JSON::PP::true or
JSON::PP::false, two constants that act like C<1> and C<0> respectively
and are also used to represent JSON C<true> and C<false> in Perl strings.

See L<MAPPING>, below, for more information on how JSON values are mapped to
Perl.

=head1 OBJECT-ORIENTED INTERFACE

This section is also taken from JSON::XS.

The object oriented interface lets you configure your own encoding or
decoding style, within the limits of supported formats.

=head2 new

    $json = JSON::PP->new

Creates a new JSON::PP object that can be used to de/encode JSON
strings. All boolean flags described below are by default I<disabled>
(with the exception of C<allow_nonref>, which defaults to I<enabled> since
version C<4.0>).

The mutators for flags all return the JSON::PP object again and thus calls can
be chained:

   my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]})
   => {"a": [1, 2]}

=head2 ascii

    $json = $json->ascii([$enable])
    
    $enabled = $json->get_ascii

If C<$enable> is true (or missing), then the C<encode> method will not
generate characters outside the code range C<0..127> (which is ASCII). Any
Unicode characters outside that range will be escaped using either a
single \uXXXX (BMP characters) or a double \uHHHH\uLLLLL escape sequence,
as per RFC4627. The resulting encoded JSON text can be treated as a native
Unicode string, an ascii-encoded, latin1-encoded or UTF-8 encoded string,
or any other superset of ASCII.

If C<$enable> is false, then the C<encode> method will not escape Unicode
characters unless required by the JSON syntax or other flags. This results
in a faster and more compact format.

See also the section I<ENCODING/CODESET FLAG NOTES> later in this document.

The main use for this flag is to produce JSON texts that can be
transmitted over a 7-bit channel, as the encoded JSON texts will not
contain any 8 bit characters.

  JSON::PP->new->ascii(1)->encode([chr 0x10401])
  => ["\ud801\udc01"]

=head2 latin1

    $json = $json->latin1([$enable])
    
    $enabled = $json->get_latin1

If C<$enable> is true (or missing), then the C<encode> method will encode
the resulting JSON text as latin1 (or iso-8859-1), escaping any characters
outside the code range C<0..255>. The resulting string can be treated as a
latin1-encoded JSON text or a native Unicode string. The C<decode> method
will not be affected in any way by this flag, as C<decode> by default
expects Unicode, which is a strict superset of latin1.

If C<$enable> is false, then the C<encode> method will not escape Unicode
characters unless required by the JSON syntax or other flags.

See also the section I<ENCODING/CODESET FLAG NOTES> later in this document.

The main use for this flag is efficiently encoding binary data as JSON
text, as most octets will not be escaped, resulting in a smaller encoded
size. The disadvantage is that the resulting JSON text is encoded
in latin1 (and must correctly be treated as such when storing and
transferring), a rare encoding for JSON. It is therefore most useful when
you want to store data structures known to contain binary data efficiently
in files or databases, not when talking to other JSON encoders/decoders.

  JSON::PP->new->latin1->encode (["\x{89}\x{abc}"]
  => ["\x{89}\\u0abc"]    # (perl syntax, U+abc escaped, U+89 not)

=head2 utf8

    $json = $json->utf8([$enable])
    
    $enabled = $json->get_utf8

If C<$enable> is true (or missing), then the C<encode> method will encode
the JSON result into UTF-8, as required by many protocols, while the
C<decode> method expects to be handled an UTF-8-encoded string.  Please
note that UTF-8-encoded strings do not contain any characters outside the
range C<0..255>, they are thus useful for bytewise/binary I/O. In future
versions, enabling this option might enable autodetection of the UTF-16
and UTF-32 encoding families, as described in RFC4627.

If C<$enable> is false, then the C<encode> method will return the JSON
string as a (non-encoded) Unicode string, while C<decode> expects thus a
Unicode string.  Any decoding or encoding (e.g. to UTF-8 or UTF-16) needs
to be done yourself, e.g. using the Encode module.

See also the section I<ENCODING/CODESET FLAG NOTES> later in this document.

Example, output UTF-16BE-encoded JSON:

  use Encode;
  $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object);

Example, decode UTF-32LE-encoded JSON:

  use Encode;
  $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext);

=head2 pretty

    $json = $json->pretty([$enable])

This enables (or disables) all of the C<indent>, C<space_before> and
C<space_after> (and in the future possibly more) flags in one call to
generate the most readable (or most compact) form possible.

=head2 indent

    $json = $json->indent([$enable])
    
    $enabled = $json->get_indent

If C<$enable> is true (or missing), then the C<encode> method will use a multiline
format as output, putting every array member or object/hash key-value pair
into its own line, indenting them properly.

If C<$enable> is false, no newlines or indenting will be produced, and the
resulting JSON text is guaranteed not to contain any C<newlines>.

This setting has no effect when decoding JSON texts.

The default indent space length is three.
You can use C<indent_length> to change the length.

=head2 space_before

    $json = $json->space_before([$enable])
    
    $enabled = $json->get_space_before

If C<$enable> is true (or missing), then the C<encode> method will add an extra
optional space before the C<:> separating keys from values in JSON objects.

If C<$enable> is false, then the C<encode> method will not add any extra
space at those places.

This setting has no effect when decoding JSON texts. You will also
most likely combine this setting with C<space_after>.

Example, space_before enabled, space_after and indent disabled:

   {"key" :"value"}

=head2 space_after

    $json = $json->space_after([$enable])
    
    $enabled = $json->get_space_after

If C<$enable> is true (or missing), then the C<encode> method will add an extra
optional space after the C<:> separating keys from values in JSON objects
and extra whitespace after the C<,> separating key-value pairs and array
members.

If C<$enable> is false, then the C<encode> method will not add any extra
space at those places.

This setting has no effect when decoding JSON texts.

Example, space_before and indent disabled, space_after enabled:

   {"key": "value"}

=head2 relaxed

    $json = $json->relaxed([$enable])
    
    $enabled = $json->get_relaxed

If C<$enable> is true (or missing), then C<decode> will accept some
extensions to normal JSON syntax (see below). C<encode> will not be
affected in anyway. I<Be aware that this option makes you accept invalid
JSON texts as if they were valid!>. I suggest only to use this option to
parse application-specific files written by humans (configuration files,
resource files etc.)

If C<$enable> is false (the default), then C<decode> will only accept
valid JSON texts.

Currently accepted extensions are:

=over 4

=item * list items can have an end-comma

JSON I<separates> array elements and key-value pairs with commas. This
can be annoying if you write JSON texts manually and want to be able to
quickly append elements, so this extension accepts comma at the end of
such items not just between them:

   [
      1,
      2, <- this comma not normally allowed
   ]
   {
      "k1": "v1",
      "k2": "v2", <- this comma not normally allowed
   }

=item * shell-style '#'-comments

Whenever JSON allows whitespace, shell-style comments are additionally
allowed. They are terminated by the first carriage-return or line-feed
character, after which more white-space and comments are allowed.

  [
     1, # this comment not allowed in JSON
        # neither this one...
  ]

=item * C-style multiple-line '/* */'-comments (JSON::PP only)

Whenever JSON allows whitespace, C-style multiple-line comments are additionally
allowed. Everything between C</*> and C<*/> is a comment, after which
more white-space and comments are allowed.

  [
     1, /* this comment not allowed in JSON */
        /* neither this one... */
  ]

=item * C++-style one-line '//'-comments (JSON::PP only)

Whenever JSON allows whitespace, C++-style one-line comments are additionally
allowed. They are terminated by the first carriage-return or line-feed
character, after which more white-space and comments are allowed.

  [
     1, // this comment not allowed in JSON
        // neither this one...
  ]

=item * literal ASCII TAB characters in strings

Literal ASCII TAB characters are now allowed in strings (and treated as
C<\t>).

  [
     "Hello\tWorld",
     "Hello<TAB>World", # literal <TAB> would not normally be allowed
  ]

=back

=head2 canonical

    $json = $json->canonical([$enable])
    
    $enabled = $json->get_canonical

If C<$enable> is true (or missing), then the C<encode> method will output JSON objects
by sorting their keys. This is adding a comparatively high overhead.

If C<$enable> is false, then the C<encode> method will output key-value
pairs in the order Perl stores them (which will likely change between runs
of the same script, and can change even within the same run from 5.18
onwards).

This option is useful if you want the same data structure to be encoded as
the same JSON text (given the same overall settings). If it is disabled,
the same hash might be encoded differently even if contains the same data,
as key-value pairs have no inherent ordering in Perl.

This setting has no effect when decoding JSON texts.

This setting has currently no effect on tied hashes.

=head2 allow_nonref

    $json = $json->allow_nonref([$enable])
    
    $enabled = $json->get_allow_nonref

Unlike other boolean options, this opotion is enabled by default beginning
with version C<4.0>.

If C<$enable> is true (or missing), then the C<encode> method can convert a
non-reference into its corresponding string, number or null JSON value,
which is an extension to RFC4627. Likewise, C<decode> will accept those JSON
values instead of croaking.

If C<$enable> is false, then the C<encode> method will croak if it isn't
passed an arrayref or hashref, as JSON texts must either be an object
or array. Likewise, C<decode> will croak if given something that is not a
JSON object or array.

Example, encode a Perl scalar as JSON value without enabled C<allow_nonref>,
resulting in an error:

   JSON::PP->new->allow_nonref(0)->encode ("Hello, World!")
   => hash- or arrayref expected...

=head2 allow_unknown

    $json = $json->allow_unknown([$enable])
    
    $enabled = $json->get_allow_unknown

If C<$enable> is true (or missing), then C<encode> will I<not> throw an
exception when it encounters values it cannot represent in JSON (for
example, filehandles) but instead will encode a JSON C<null> value. Note
that blessed objects are not included here and are handled separately by
c<allow_blessed>.

If C<$enable> is false (the default), then C<encode> will throw an
exception when it encounters anything it cannot encode as JSON.

This option does not affect C<decode> in any way, and it is recommended to
leave it off unless you know your communications partner.

=head2 allow_blessed

    $json = $json->allow_blessed([$enable])
    
    $enabled = $json->get_allow_blessed

See L<OBJECT SERIALISATION> for details.

If C<$enable> is true (or missing), then the C<encode> method will not
barf when it encounters a blessed reference that it cannot convert
otherwise. Instead, a JSON C<null> value is encoded instead of the object.

If C<$enable> is false (the default), then C<encode> will throw an
exception when it encounters a blessed object that it cannot convert
otherwise.

This setting has no effect on C<decode>.

=head2 convert_blessed

    $json = $json->convert_blessed([$enable])
    
    $enabled = $json->get_convert_blessed

See L<OBJECT SERIALISATION> for details.

If C<$enable> is true (or missing), then C<encode>, upon encountering a
blessed object, will check for the availability of the C<TO_JSON> method
on the object's class. If found, it will be called in scalar context and
the resulting scalar will be encoded instead of the object.

The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
returns other blessed objects, those will be handled in the same
way. C<TO_JSON> must take care of not causing an endless recursion cycle
(== crash) in this case. The name of C<TO_JSON> was chosen because other
methods called by the Perl core (== not by the user of the object) are
usually in upper case letters and to avoid collisions with any C<to_json>
function or method.

If C<$enable> is false (the default), then C<encode> will not consider
this type of conversion.

This setting has no effect on C<decode>.

=head2 allow_tags

    $json = $json->allow_tags([$enable])

    $enabled = $json->get_allow_tags

See L<OBJECT SERIALISATION> for details.

If C<$enable> is true (or missing), then C<encode>, upon encountering a
blessed object, will check for the availability of the C<FREEZE> method on
the object's class. If found, it will be used to serialise the object into
a nonstandard tagged JSON value (that JSON decoders cannot decode).

It also causes C<decode> to parse such tagged JSON values and deserialise
them via a call to the C<THAW> method.

If C<$enable> is false (the default), then C<encode> will not consider
this type of conversion, and tagged JSON values will cause a parse error
in C<decode>, as if tags were not part of the grammar.

=head2 boolean_values

    $json->boolean_values([$false, $true])

    ($false,  $true) = $json->get_boolean_values

By default, JSON booleans will be decoded as overloaded
C<$JSON::PP::false> and C<$JSON::PP::true> objects.

With this method you can specify your own boolean values for decoding -
on decode, JSON C<false> will be decoded as a copy of C<$false>, and JSON
C<true> will be decoded as C<$true> ("copy" here is the same thing as
assigning a value to another variable, i.e. C<$copy = $false>).

This is useful when you want to pass a decoded data structure directly
to other serialisers like YAML, Data::MessagePack and so on.

Note that this works only when you C<decode>. You can set incompatible
boolean objects (like L<boolean>), but when you C<encode> a data structure
with such boolean objects, you still need to enable C<convert_blessed>
(and add a C<TO_JSON> method if necessary).

Calling this method without any arguments will reset the booleans
to their default values.

C<get_boolean_values> will return both C<$false> and C<$true> values, or
the empty list when they are set to the default.

=head2 filter_json_object

    $json = $json->filter_json_object([$coderef])

When C<$coderef> is specified, it will be called from C<decode> each
time it decodes a JSON object. The only argument is a reference to
the newly-created hash. If the code references returns a single scalar
(which need not be a reference), this value (or rather a copy of it) is
inserted into the deserialised data structure. If it returns an empty
list (NOTE: I<not> C<undef>, which is a valid scalar), the original
deserialised hash will be inserted. This setting can slow down decoding
considerably.

When C<$coderef> is omitted or undefined, any existing callback will
be removed and C<decode> will not change the deserialised hash in any
way.

Example, convert all JSON objects into the integer 5:

   my $js = JSON::PP->new->filter_json_object(sub { 5 });
   # returns [5]
   $js->decode('[{}]');
   # returns 5
   $js->decode('{"a":1, "b":2}');

=head2 filter_json_single_key_object

    $json = $json->filter_json_single_key_object($key [=> $coderef])

Works remotely similar to C<filter_json_object>, but is only called for
JSON objects having a single key named C<$key>.

This C<$coderef> is called before the one specified via
C<filter_json_object>, if any. It gets passed the single value in the JSON
object. If it returns a single value, it will be inserted into the data
structure. If it returns nothing (not even C<undef> but the empty list),
the callback from C<filter_json_object> will be called next, as if no
single-key callback were specified.

If C<$coderef> is omitted or undefined, the corresponding callback will be
disabled. There can only ever be one callback for a given key.

As this callback gets called less often then the C<filter_json_object>
one, decoding speed will not usually suffer as much. Therefore, single-key
objects make excellent targets to serialise Perl objects into, especially
as single-key JSON objects are as close to the type-tagged value concept
as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
support this in any way, so you need to make sure your data never looks
like a serialised Perl hash.

Typical names for the single object key are C<__class_whatever__>, or
C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
with real hashes.

Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
into the corresponding C<< $WIDGET{<id>} >> object:

   # return whatever is in $WIDGET{5}:
   JSON::PP
      ->new
      ->filter_json_single_key_object (__widget__ => sub {
            $WIDGET{ $_[0] }
         })
      ->decode ('{"__widget__": 5')

   # this can be used with a TO_JSON method in some "widget" class
   # for serialisation to json:
   sub WidgetBase::TO_JSON {
      my ($self) = @_;

      unless ($self->{id}) {
         $self->{id} = ..get..some..id..;
         $WIDGET{$self->{id}} = $self;
      }

      { __widget__ => $self->{id} }
   }

=head2 shrink

    $json = $json->shrink([$enable])
    
    $enabled = $json->get_shrink

If C<$enable> is true (or missing), the string returned by C<encode> will
be shrunk (i.e. downgraded if possible).

The actual definition of what shrink does might change in future versions,
but it will always try to save space at the expense of time.

If C<$enable> is false, then JSON::PP does nothing.

=head2 max_depth

    $json = $json->max_depth([$maximum_nesting_depth])
    
    $max_depth = $json->get_max_depth

Sets the maximum nesting level (default C<512>) accepted while encoding
or decoding. If a higher nesting level is detected in JSON text or a Perl
data structure, then the encoder and decoder will stop and croak at that
point.

Nesting level is defined by number of hash- or arrayrefs that the encoder
needs to traverse to reach a given point or the number of C<{> or C<[>
characters without their matching closing parenthesis crossed to reach a
given character in a string.

Setting the maximum depth to one disallows any nesting, so that ensures
that the object is only a single hash/object or array.

If no argument is given, the highest possible setting will be used, which
is rarely useful.

See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.

=head2 max_size

    $json = $json->max_size([$maximum_string_size])
    
    $max_size = $json->get_max_size

Set the maximum length a JSON text may have (in bytes) where decoding is
being attempted. The default is C<0>, meaning no limit. When C<decode>
is called on a string that is longer then this many bytes, it will not
attempt to decode the string but throw an exception. This setting has no
effect on C<encode> (yet).

If no argument is given, the limit check will be deactivated (same as when
C<0> is specified).

See L<JSON::XS/SECURITY CONSIDERATIONS> for more info on why this is useful.

=head2 encode

    $json_text = $json->encode($perl_scalar)

Converts the given Perl value or data structure to its JSON
representation. Croaks on error.

=head2 decode

    $perl_scalar = $json->decode($json_text)

The opposite of C<encode>: expects a JSON text and tries to parse it,
returning the resulting simple scalar or reference. Croaks on error.

=head2 decode_prefix

    ($perl_scalar, $characters) = $json->decode_prefix($json_text)

This works like the C<decode> method, but instead of raising an exception
when there is trailing garbage after the first JSON object, it will
silently stop parsing there and return the number of characters consumed
so far.

This is useful if your JSON texts are not delimited by an outer protocol
and you need to know where the JSON text ends.

   JSON::PP->new->decode_prefix ("[1] the tail")
   => ([1], 3)

=head1 FLAGS FOR JSON::PP ONLY

The following flags and properties are for JSON::PP only. If you use
any of these, you can't make your application run faster by replacing
JSON::PP with JSON::XS. If you need these and also speed boost,
you might want to try L<Cpanel::JSON::XS>, a fork of JSON::XS by
Reini Urban, which supports some of these (with a different set of
incompatibilities). Most of these historical flags are only kept
for backward compatibility, and should not be used in a new application.

=head2 allow_singlequote

    $json = $json->allow_singlequote([$enable])
    $enabled = $json->get_allow_singlequote

If C<$enable> is true (or missing), then C<decode> will accept
invalid JSON texts that contain strings that begin and end with
single quotation marks. C<encode> will not be affected in any way.
I<Be aware that this option makes you accept invalid JSON texts
as if they were valid!>. I suggest only to use this option to
parse application-specific files written by humans (configuration
files, resource files etc.)

If C<$enable> is false (the default), then C<decode> will only accept
valid JSON texts.

    $json->allow_singlequote->decode(qq|{"foo":'bar'}|);
    $json->allow_singlequote->decode(qq|{'foo':"bar"}|);
    $json->allow_singlequote->decode(qq|{'foo':'bar'}|);

=head2 allow_barekey

    $json = $json->allow_barekey([$enable])
    $enabled = $json->get_allow_barekey

If C<$enable> is true (or missing), then C<decode> will accept
invalid JSON texts that contain JSON objects whose names don't
begin and end with quotation marks. C<encode> will not be affected
in any way. I<Be aware that this option makes you accept invalid JSON
texts as if they were valid!>. I suggest only to use this option to
parse application-specific files written by humans (configuration
files, resource files etc.)

If C<$enable> is false (the default), then C<decode> will only accept
valid JSON texts.

    $json->allow_barekey->decode(qq|{foo:"bar"}|);

=head2 allow_bignum

    $json = $json->allow_bignum([$enable])
    $enabled = $json->get_allow_bignum

If C<$enable> is true (or missing), then C<decode> will convert
big integers Perl cannot handle as integer into L<Math::BigInt>
objects and convert floating numbers into L<Math::BigFloat>
objects. C<encode> will convert C<Math::BigInt> and C<Math::BigFloat>
objects into JSON numbers.

   $json->allow_nonref->allow_bignum;
   $bigfloat = $json->decode('2.000000000000000000000000001');
   print $json->encode($bigfloat);
   # => 2.000000000000000000000000001

See also L<MAPPING>.

=head2 loose

    $json = $json->loose([$enable])
    $enabled = $json->get_loose

If C<$enable> is true (or missing), then C<decode> will accept
invalid JSON texts that contain unescaped [\x00-\x1f\x22\x5c]
characters. C<encode> will not be affected in any way.
I<Be aware that this option makes you accept invalid JSON texts
as if they were valid!>. I suggest only to use this option to
parse application-specific files written by humans (configuration
files, resource files etc.)

If C<$enable> is false (the default), then C<decode> will only accept
valid JSON texts.

    $json->loose->decode(qq|["abc
                                   def"]|);

=head2 escape_slash

    $json = $json->escape_slash([$enable])
    $enabled = $json->get_escape_slash

If C<$enable> is true (or missing), then C<encode> will explicitly
escape I<slash> (solidus; C<U+002F>) characters to reduce the risk of
XSS (cross site scripting) that may be caused by C<< </script> >>
in a JSON text, with the cost of bloating the size of JSON texts.

This option may be useful when you embed JSON in HTML, but embedding
arbitrary JSON in HTML (by some HTML template toolkit or by string
interpolation) is risky in general. You must escape necessary
characters in correct order, depending on the context.

C<decode> will not be affected in any way.

=head2 indent_length

    $json = $json->indent_length($number_of_spaces)
    $length = $json->get_indent_length

This option is only useful when you also enable C<indent> or C<pretty>.

JSON::XS indents with three spaces when you C<encode> (if requested
by C<indent> or C<pretty>), and the number cannot be changed.
JSON::PP allows you to change/get the number of indent spaces with these
mutator/accessor. The default number of spaces is three (the same as
JSON::XS), and the acceptable range is from C<0> (no indentation;
it'd be better to disable indentation by C<indent(0)>) to C<15>.

=head2 sort_by

    $json = $json->sort_by($code_ref)
    $json = $json->sort_by($subroutine_name)

If you just want to sort keys (names) in JSON objects when you
C<encode>, enable C<canonical> option (see above) that allows you to
sort object keys alphabetically.

If you do need to sort non-alphabetically for whatever reasons,
you can give a code reference (or a subroutine name) to C<sort_by>,
then the argument will be passed to Perl's C<sort> built-in function.

As the sorting is done in the JSON::PP scope, you usually need to
prepend C<JSON::PP::> to the subroutine name, and the special variables
C<$a> and C<$b> used in the subrontine used by C<sort> function.

Example:

   my %ORDER = (id => 1, class => 2, name => 3);
   $json->sort_by(sub {
       ($ORDER{$JSON::PP::a} // 999) <=> ($ORDER{$JSON::PP::b} // 999)
       or $JSON::PP::a cmp $JSON::PP::b
   });
   print $json->encode([
       {name => 'CPAN', id => 1, href => 'http://cpan.org'}
   ]);
   # [{"id":1,"name":"CPAN","href":"http://cpan.org"}]

Note that C<sort_by> affects all the plain hashes in the data structure.
If you need finer control, C<tie> necessary hashes with a module that
implements ordered hash (such as L<Hash::Ordered> and L<Tie::IxHash>).
C<canonical> and C<sort_by> don't affect the key order in C<tie>d
hashes.

   use Hash::Ordered;
   tie my %hash, 'Hash::Ordered',
       (name => 'CPAN', id => 1, href => 'http://cpan.org');
   print $json->encode([\%hash]);
   # [{"name":"CPAN","id":1,"href":"http://cpan.org"}] # order is kept

=head1 INCREMENTAL PARSING

This section is also taken from JSON::XS.

In some cases, there is the need for incremental parsing of JSON
texts. While this module always has to keep both JSON text and resulting
Perl data structure in memory at one time, it does allow you to parse a
JSON stream incrementally. It does so by accumulating text until it has
a full JSON object, which it then can decode. This process is similar to
using C<decode_prefix> to see if a full JSON object is available, but
is much more efficient (and can be implemented with a minimum of method
calls).

JSON::PP will only attempt to parse the JSON text once it is sure it
has enough text to get a decisive result, using a very simple but
truly incremental parser. This means that it sometimes won't stop as
early as the full parser, for example, it doesn't detect mismatched
parentheses. The only thing it guarantees is that it starts decoding as
soon as a syntactically valid JSON text has been seen. This means you need
to set resource limits (e.g. C<max_size>) to ensure the parser will stop
parsing in the presence if syntax errors.

The following methods implement this incremental parser.

=head2 incr_parse

    $json->incr_parse( [$string] ) # void context
    
    $obj_or_undef = $json->incr_parse( [$string] ) # scalar context
    
    @obj_or_empty = $json->incr_parse( [$string] ) # list context

This is the central parsing function. It can both append new text and
extract objects from the stream accumulated so far (both of these
functions are optional).

If C<$string> is given, then this string is appended to the already
existing JSON fragment stored in the C<$json> object.

After that, if the function is called in void context, it will simply
return without doing anything further. This can be used to add more text
in as many chunks as you want.

If the method is called in scalar context, then it will try to extract
exactly I<one> JSON object. If that is successful, it will return this
object, otherwise it will return C<undef>. If there is a parse error,
this method will croak just as C<decode> would do (one can then use
C<incr_skip> to skip the erroneous part). This is the most common way of
using the method.

And finally, in list context, it will try to extract as many objects
from the stream as it can find and return them, or the empty list
otherwise. For this to work, there must be no separators (other than
whitespace) between the JSON objects or arrays, instead they must be
concatenated back-to-back. If an error occurs, an exception will be
raised as in the scalar context case. Note that in this case, any
previously-parsed JSON texts will be lost.

Example: Parse some JSON arrays/objects in a given string and return
them.

    my @objs = JSON::PP->new->incr_parse ("[5][7][1,2]");

=head2 incr_text

    $lvalue_string = $json->incr_text

This method returns the currently stored JSON fragment as an lvalue, that
is, you can manipulate it. This I<only> works when a preceding call to
C<incr_parse> in I<scalar context> successfully returned an object. Under
all other circumstances you must not call this function (I mean it.
although in simple tests it might actually work, it I<will> fail under
real world conditions). As a special exception, you can also call this
method before having parsed anything.

That means you can only use this function to look at or manipulate text
before or after complete JSON objects, not while the parser is in the
middle of parsing a JSON object.

This function is useful in two cases: a) finding the trailing text after a
JSON object or b) parsing multiple JSON objects separated by non-JSON text
(such as commas).

=head2 incr_skip

    $json->incr_skip

This will reset the state of the incremental parser and will remove
the parsed text from the input buffer so far. This is useful after
C<incr_parse> died, in which case the input buffer and incremental parser
state is left unchanged, to skip the text parsed so far and to reset the
parse state.

The difference to C<incr_reset> is that only text until the parse error
occurred is removed.

=head2 incr_reset

    $json->incr_reset

This completely resets the incremental parser, that is, after this call,
it will be as if the parser had never parsed anything.

This is useful if you want to repeatedly parse JSON objects and want to
ignore any trailing data, which means you have to reset the parser after
each successful decode.

=head1 MAPPING

Most of this section is also taken from JSON::XS.

This section describes how JSON::PP maps Perl values to JSON values and
vice versa. These mappings are designed to "do the right thing" in most
circumstances automatically, preserving round-tripping characteristics
(what you put in comes out as something equivalent).

For the more enlightened: note that in the following descriptions,
lowercase I<perl> refers to the Perl interpreter, while uppercase I<Perl>
refers to the abstract Perl language itself.

=head2 JSON -> PERL

=over 4

=item object

A JSON object becomes a reference to a hash in Perl. No ordering of object
keys is preserved (JSON does not preserve object key ordering itself).

=item array

A JSON array becomes a reference to an array in Perl.

=item string

A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
are represented by the same codepoints in the Perl string, so no manual
decoding is necessary.

=item number

A JSON number becomes either an integer, numeric (floating point) or
string scalar in perl, depending on its range and any fractional parts. On
the Perl level, there is no difference between those as Perl handles all
the conversion details, but an integer may take slightly less memory and
might represent more values exactly than floating point numbers.

If the number consists of digits only, JSON::PP will try to represent
it as an integer value. If that fails, it will try to represent it as
a numeric (floating point) value if that is possible without loss of
precision. Otherwise it will preserve the number as a string value (in
which case you lose roundtripping ability, as the JSON number will be
re-encoded to a JSON string).

Numbers containing a fractional or exponential part will always be
represented as numeric (floating point) values, possibly at a loss of
precision (in which case you might lose perfect roundtripping ability, but
the JSON number will still be re-encoded as a JSON number).

Note that precision is not accuracy - binary floating point values cannot
represent most decimal fractions exactly, and when converting from and to
floating point, JSON::PP only guarantees precision up to but not including
the least significant bit.

When C<allow_bignum> is enabled, big integer values and any numeric
values will be converted into L<Math::BigInt> and L<Math::BigFloat>
objects respectively, without becoming string scalars or losing
precision.

=item true, false

These JSON atoms become C<JSON::PP::true> and C<JSON::PP::false>,
respectively. They are overloaded to act almost exactly like the numbers
C<1> and C<0>. You can check whether a scalar is a JSON boolean by using
the C<JSON::PP::is_bool> function.

=item null

A JSON null atom becomes C<undef> in Perl.

=item shell-style comments (C<< # I<text> >>)

As a nonstandard extension to the JSON syntax that is enabled by the
C<relaxed> setting, shell-style comments are allowed. They can start
anywhere outside strings and go till the end of the line.

=item tagged values (C<< (I<tag>)I<value> >>).

Another nonstandard extension to the JSON syntax, enabled with the
C<allow_tags> setting, are tagged values. In this implementation, the
I<tag> must be a perl package/class name encoded as a JSON string, and the
I<value> must be a JSON array encoding optional constructor arguments.

See L<OBJECT SERIALISATION>, below, for details.

=back


=head2 PERL -> JSON

The mapping from Perl to JSON is slightly more difficult, as Perl is a
truly typeless language, so we can only guess which JSON type is meant by
a Perl value.

=over 4

=item hash references

Perl hash references become JSON objects. As there is no inherent
ordering in hash keys (or JSON objects), they will usually be encoded
in a pseudo-random order. JSON::PP can optionally sort the hash keys
(determined by the I<canonical> flag and/or I<sort_by> property), so
the same data structure will serialise to the same JSON text (given
same settings and version of JSON::PP), but this incurs a runtime
overhead and is only rarely useful, e.g. when you want to compare some
JSON text against another for equality.

=item array references

Perl array references become JSON arrays.

=item other references

Other unblessed references are generally not allowed and will cause an
exception to be thrown, except for references to the integers C<0> and
C<1>, which get turned into C<false> and C<true> atoms in JSON. You can
also use C<JSON::PP::false> and C<JSON::PP::true> to improve
readability.

   to_json [\0, JSON::PP::true]      # yields [false,true]

=item JSON::PP::true, JSON::PP::false

These special values become JSON true and JSON false values,
respectively. You can also use C<\1> and C<\0> directly if you want.

=item JSON::PP::null

This special value becomes JSON null.

=item blessed objects

Blessed objects are not directly representable in JSON, but C<JSON::PP>
allows various ways of handling objects. See L<OBJECT SERIALISATION>,
below, for details.

=item simple scalars

Simple Perl scalars (any scalar that is not a reference) are the most
difficult objects to encode: JSON::PP will encode undefined scalars as
JSON C<null> values, scalars that have last been used in a string context
before encoding as JSON strings, and anything else as number value:

   # dump as number
   encode_json [2]                      # yields [2]
   encode_json [-3.0e17]                # yields [-3e+17]
   my $value = 5; encode_json [$value]  # yields [5]

   # used as string, so dump as string
   print $value;
   encode_json [$value]                 # yields ["5"]

   # undef becomes null
   encode_json [undef]                  # yields [null]

You can force the type to be a JSON string by stringifying it:

   my $x = 3.1; # some variable containing a number
   "$x";        # stringified
   $x .= "";    # another, more awkward way to stringify
   print $x;    # perl does it for you, too, quite often
                # (but for older perls)

You can force the type to be a JSON number by numifying it:

   my $x = "3"; # some variable containing a string
   $x += 0;     # numify it, ensuring it will be dumped as a number
   $x *= 1;     # same thing, the choice is yours.

You can not currently force the type in other, less obscure, ways.

Since version 2.91_01, JSON::PP uses a different number detection logic
that converts a scalar that is possible to turn into a number safely.
The new logic is slightly faster, and tends to help people who use older
perl or who want to encode complicated data structure. However, this may
results in a different JSON text from the one JSON::XS encodes (and
thus may break tests that compare entire JSON texts). If you do
need the previous behavior for compatibility or for finer control,
set PERL_JSON_PP_USE_B environmental variable to true before you
C<use> JSON::PP (or JSON.pm).

Note that numerical precision has the same meaning as under Perl (so
binary to decimal conversion follows the same rules as in Perl, which
can differ to other languages). Also, your perl interpreter might expose
extensions to the floating point numbers of your platform, such as
infinities or NaN's - these cannot be represented in JSON, and it is an
error to pass those in.

JSON::PP (and JSON::XS) trusts what you pass to C<encode> method
(or C<encode_json> function) is a clean, validated data structure with
values that can be represented as valid JSON values only, because it's
not from an external data source (as opposed to JSON texts you pass to
C<decode> or C<decode_json>, which JSON::PP considers tainted and
doesn't trust). As JSON::PP doesn't know exactly what you and consumers
of your JSON texts want the unexpected values to be (you may want to
convert them into null, or to stringify them with or without
normalisation (string representation of infinities/NaN may vary
depending on platforms), or to croak without conversion), you're advised
to do what you and your consumers need before you encode, and also not
to numify values that may start with values that look like a number
(including infinities/NaN), without validating.

=back

=head2 OBJECT SERIALISATION

As JSON cannot directly represent Perl objects, you have to choose between
a pure JSON representation (without the ability to deserialise the object
automatically again), and a nonstandard extension to the JSON syntax,
tagged values.

=head3 SERIALISATION

What happens when C<JSON::PP> encounters a Perl object depends on the
C<allow_blessed>, C<convert_blessed>, C<allow_tags> and C<allow_bignum>
settings, which are used in this order:

=over 4

=item 1. C<allow_tags> is enabled and the object has a C<FREEZE> method.

In this case, C<JSON::PP> creates a tagged JSON value, using a nonstandard
extension to the JSON syntax.

This works by invoking the C<FREEZE> method on the object, with the first
argument being the object to serialise, and the second argument being the
constant string C<JSON> to distinguish it from other serialisers.

The C<FREEZE> method can return any number of values (i.e. zero or
more). These values and the paclkage/classname of the object will then be
encoded as a tagged JSON value in the following format:

   ("classname")[FREEZE return values...]

e.g.:

   ("URI")["http://www.google.com/"]
   ("MyDate")[2013,10,29]
   ("ImageData::JPEG")["Z3...VlCg=="]

For example, the hypothetical C<My::Object> C<FREEZE> method might use the
objects C<type> and C<id> members to encode the object:

   sub My::Object::FREEZE {
      my ($self, $serialiser) = @_;

      ($self->{type}, $self->{id})
   }

=item 2. C<convert_blessed> is enabled and the object has a C<TO_JSON> method.

In this case, the C<TO_JSON> method of the object is invoked in scalar
context. It must return a single scalar that can be directly encoded into
JSON. This scalar replaces the object in the JSON text.

For example, the following C<TO_JSON> method will convert all L<URI>
objects to JSON strings when serialised. The fact that these values
originally were L<URI> objects is lost.

   sub URI::TO_JSON {
      my ($uri) = @_;
      $uri->as_string
   }

=item 3. C<allow_bignum> is enabled and the object is a C<Math::BigInt> or C<Math::BigFloat>.

The object will be serialised as a JSON number value.

=item 4. C<allow_blessed> is enabled.

The object will be serialised as a JSON null value.

=item 5. none of the above

If none of the settings are enabled or the respective methods are missing,
C<JSON::PP> throws an exception.

=back

=head3 DESERIALISATION

For deserialisation there are only two cases to consider: either
nonstandard tagging was used, in which case C<allow_tags> decides,
or objects cannot be automatically be deserialised, in which
case you can use postprocessing or the C<filter_json_object> or
C<filter_json_single_key_object> callbacks to get some real objects our of
your JSON.

This section only considers the tagged value case: a tagged JSON object
is encountered during decoding and C<allow_tags> is disabled, a parse
error will result (as if tagged values were not part of the grammar).

If C<allow_tags> is enabled, C<JSON::PP> will look up the C<THAW> method
of the package/classname used during serialisation (it will not attempt
to load the package as a Perl module). If there is no such method, the
decoding will fail with an error.

Otherwise, the C<THAW> method is invoked with the classname as first
argument, the constant string C<JSON> as second argument, and all the
values from the JSON array (the values originally returned by the
C<FREEZE> method) as remaining arguments.

The method must then return the object. While technically you can return
any Perl scalar, you might have to enable the C<allow_nonref> setting to
make that work in all cases, so better return an actual blessed reference.

As an example, let's implement a C<THAW> function that regenerates the
C<My::Object> from the C<FREEZE> example earlier:

   sub My::Object::THAW {
      my ($class, $serialiser, $type, $id) = @_;

      $class->new (type => $type, id => $id)
   }


=head1 ENCODING/CODESET FLAG NOTES

This section is taken from JSON::XS.

The interested reader might have seen a number of flags that signify
encodings or codesets - C<utf8>, C<latin1> and C<ascii>. There seems to be
some confusion on what these do, so here is a short comparison:

C<utf8> controls whether the JSON text created by C<encode> (and expected
by C<decode>) is UTF-8 encoded or not, while C<latin1> and C<ascii> only
control whether C<encode> escapes character values outside their respective
codeset range. Neither of these flags conflict with each other, although
some combinations make less sense than others.

Care has been taken to make all flags symmetrical with respect to
C<encode> and C<decode>, that is, texts encoded with any combination of
these flag values will be correctly decoded when the same flags are used
- in general, if you use different flag settings while encoding vs. when
decoding you likely have a bug somewhere.

Below comes a verbose discussion of these flags. Note that a "codeset" is
simply an abstract set of character-codepoint pairs, while an encoding
takes those codepoint numbers and I<encodes> them, in our case into
octets. Unicode is (among other things) a codeset, UTF-8 is an encoding,
and ISO-8859-1 (= latin 1) and ASCII are both codesets I<and> encodings at
the same time, which can be confusing.

=over 4

=item C<utf8> flag disabled

When C<utf8> is disabled (the default), then C<encode>/C<decode> generate
and expect Unicode strings, that is, characters with high ordinal Unicode
values (> 255) will be encoded as such characters, and likewise such
characters are decoded as-is, no changes to them will be done, except
"(re-)interpreting" them as Unicode codepoints or Unicode characters,
respectively (to Perl, these are the same thing in strings unless you do
funny/weird/dumb stuff).

This is useful when you want to do the encoding yourself (e.g. when you
want to have UTF-16 encoded JSON texts) or when some other layer does
the encoding for you (for example, when printing to a terminal using a
filehandle that transparently encodes to UTF-8 you certainly do NOT want
to UTF-8 encode your data first and have Perl encode it another time).

=item C<utf8> flag enabled

If the C<utf8>-flag is enabled, C<encode>/C<decode> will encode all
characters using the corresponding UTF-8 multi-byte sequence, and will
expect your input strings to be encoded as UTF-8, that is, no "character"
of the input string must have any value > 255, as UTF-8 does not allow
that.

The C<utf8> flag therefore switches between two modes: disabled means you
will get a Unicode string in Perl, enabled means you get an UTF-8 encoded
octet/binary string in Perl.

=item C<latin1> or C<ascii> flags enabled

With C<latin1> (or C<ascii>) enabled, C<encode> will escape characters
with ordinal values > 255 (> 127 with C<ascii>) and encode the remaining
characters as specified by the C<utf8> flag.

If C<utf8> is disabled, then the result is also correctly encoded in those
character sets (as both are proper subsets of Unicode, meaning that a
Unicode string with all character values < 256 is the same thing as a
ISO-8859-1 string, and a Unicode string with all character values < 128 is
the same thing as an ASCII string in Perl).

If C<utf8> is enabled, you still get a correct UTF-8-encoded string,
regardless of these flags, just some more characters will be escaped using
C<\uXXXX> then before.

Note that ISO-8859-1-I<encoded> strings are not compatible with UTF-8
encoding, while ASCII-encoded strings are. That is because the ISO-8859-1
encoding is NOT a subset of UTF-8 (despite the ISO-8859-1 I<codeset> being
a subset of Unicode), while ASCII is.

Surprisingly, C<decode> will ignore these flags and so treat all input
values as governed by the C<utf8> flag. If it is disabled, this allows you
to decode ISO-8859-1- and ASCII-encoded strings, as both strict subsets of
Unicode. If it is enabled, you can correctly decode UTF-8 encoded strings.

So neither C<latin1> nor C<ascii> are incompatible with the C<utf8> flag -
they only govern when the JSON output engine escapes a character or not.

The main use for C<latin1> is to relatively efficiently store binary data
as JSON, at the expense of breaking compatibility with most JSON decoders.

The main use for C<ascii> is to force the output to not contain characters
with values > 127, which means you can interpret the resulting string
as UTF-8, ISO-8859-1, ASCII, KOI8-R or most about any character set and
8-bit-encoding, and still get the same data structure back. This is useful
when your channel for JSON transfer is not 8-bit clean or the encoding
might be mangled in between (e.g. in mail), and works because ASCII is a
proper subset of most 8-bit and multibyte encodings in use in the world.

=back

=head1 BUGS

Please report bugs on a specific behavior of this module to RT or GitHub
issues (preferred):

L<https://github.com/makamaka/JSON-PP/issues>

L<https://rt.cpan.org/Public/Dist/Display.html?Queue=JSON-PP>

As for new features and requests to change common behaviors, please
ask the author of JSON::XS (Marc Lehmann, E<lt>schmorp[at]schmorp.deE<gt>)
first, by email (important!), to keep compatibility among JSON.pm backends.

Generally speaking, if you need something special for you, you are advised
to create a new module, maybe based on L<JSON::Tiny>, which is smaller and
written in a much cleaner way than this module.

=head1 SEE ALSO

The F<json_pp> command line utility for quick experiments.

L<JSON::XS>, L<Cpanel::JSON::XS>, and L<JSON::Tiny> for faster alternatives.
L<JSON> and L<JSON::MaybeXS> for easy migration.

L<JSON::PP::Compat5005> and L<JSON::PP::Compat5006> for older perl users.

RFC4627 (L<http://www.ietf.org/rfc/rfc4627.txt>)

RFC7159 (L<http://www.ietf.org/rfc/rfc7159.txt>)

RFC8259 (L<http://www.ietf.org/rfc/rfc8259.txt>)

=head1 AUTHOR

Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>

=head1 CURRENT MAINTAINER

Kenichi Ishigaki, E<lt>ishigaki[at]cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2007-2016 by Makamaka Hannyaharamitu

Most of the documentation is taken from JSON::XS by Marc Lehmann

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 

=cut
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         package Math::BigFloat;

#
# Mike grinned. 'Two down, infinity to go' - Mike Nostrus in 'Before and After'
#

# The following hash values are used internally:
# sign  : "+", "-", "+inf", "-inf", or "NaN" if not a number
#   _m  : mantissa ($LIB thingy)
#   _es : sign of _e
#   _e  : exponent ($LIB thingy)
#   _a  : accuracy
#   _p  : precision

use 5.006001;
use strict;
use warnings;

use Carp          qw< carp croak >;
use Scalar::Util  qw< blessed >;
use Math::BigInt  qw< >;

our $VERSION = '1.999830';
$VERSION =~ tr/_//d;

require Exporter;
our @ISA        = qw/Math::BigInt/;
our @EXPORT_OK  = qw/bpi/;

# $_trap_inf/$_trap_nan are internal and should never be accessed from outside
our ($AUTOLOAD, $accuracy, $precision, $div_scale, $round_mode, $rnd_mode,
     $upgrade, $downgrade, $_trap_nan, $_trap_inf);

use overload

  # overload key: with_assign

  '+'     =>      sub { $_[0] -> copy() -> badd($_[1]); },

  '-'     =>      sub { my $c = $_[0] -> copy();
                        $_[2] ? $c -> bneg() -> badd($_[1])
                              : $c -> bsub($_[1]); },

  '*'     =>      sub { $_[0] -> copy() -> bmul($_[1]); },

  '/'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bdiv($_[0])
                              : $_[0] -> copy() -> bdiv($_[1]); },

  '%'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bmod($_[0])
                              : $_[0] -> copy() -> bmod($_[1]); },

  '**'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bpow($_[0])
                              : $_[0] -> copy() -> bpow($_[1]); },

  '<<'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blsft($_[0])
                              : $_[0] -> copy() -> blsft($_[1]); },

  '>>'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> brsft($_[0])
                              : $_[0] -> copy() -> brsft($_[1]); },

  # overload key: assign

  '+='    =>      sub { $_[0] -> badd($_[1]); },

  '-='    =>      sub { $_[0] -> bsub($_[1]); },

  '*='    =>      sub { $_[0] -> bmul($_[1]); },

  '/='    =>      sub { scalar $_[0] -> bdiv($_[1]); },

  '%='    =>      sub { $_[0] -> bmod($_[1]); },

  '**='   =>      sub { $_[0] -> bpow($_[1]); },

  '<<='   =>      sub { $_[0] -> blsft($_[1]); },

  '>>='   =>      sub { $_[0] -> brsft($_[1]); },

#  'x='    =>      sub { },

#  '.='    =>      sub { },

  # overload key: num_comparison

  '<'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> blt($_[0])
                              : $_[0] -> blt($_[1]); },

  '<='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> ble($_[0])
                              : $_[0] -> ble($_[1]); },

  '>'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bgt($_[0])
                              : $_[0] -> bgt($_[1]); },

  '>='    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bge($_[0])
                              : $_[0] -> bge($_[1]); },

  '=='    =>      sub { $_[0] -> beq($_[1]); },

  '!='    =>      sub { $_[0] -> bne($_[1]); },

  # overload key: 3way_comparison

  '<=>'   =>      sub { my $cmp = $_[0] -> bcmp($_[1]);
                        defined($cmp) && $_[2] ? -$cmp : $cmp; },

  'cmp'   =>      sub { $_[2] ? "$_[1]" cmp $_[0] -> bstr()
                              : $_[0] -> bstr() cmp "$_[1]"; },

  # overload key: str_comparison

#  'lt'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrlt($_[0])
#                              : $_[0] -> bstrlt($_[1]); },
#
#  'le'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrle($_[0])
#                              : $_[0] -> bstrle($_[1]); },
#
#  'gt'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrgt($_[0])
#                              : $_[0] -> bstrgt($_[1]); },
#
#  'ge'    =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bstrge($_[0])
#                              : $_[0] -> bstrge($_[1]); },
#
#  'eq'    =>      sub { $_[0] -> bstreq($_[1]); },
#
#  'ne'    =>      sub { $_[0] -> bstrne($_[1]); },

  # overload key: binary

  '&'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> band($_[0])
                              : $_[0] -> copy() -> band($_[1]); },

  '&='    =>      sub { $_[0] -> band($_[1]); },

  '|'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bior($_[0])
                              : $_[0] -> copy() -> bior($_[1]); },

  '|='    =>      sub { $_[0] -> bior($_[1]); },

  '^'     =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> bxor($_[0])
                              : $_[0] -> copy() -> bxor($_[1]); },

  '^='    =>      sub { $_[0] -> bxor($_[1]); },

#  '&.'    =>      sub { },

#  '&.='   =>      sub { },

#  '|.'    =>      sub { },

#  '|.='   =>      sub { },

#  '^.'    =>      sub { },

#  '^.='   =>      sub { },

  # overload key: unary

  'neg'   =>      sub { $_[0] -> copy() -> bneg(); },

#  '!'     =>      sub { },

  '~'     =>      sub { $_[0] -> copy() -> bnot(); },

#  '~.'    =>      sub { },

  # overload key: mutators

  '++'    =>      sub { $_[0] -> binc() },

  '--'    =>      sub { $_[0] -> bdec() },

  # overload key: func

  'atan2' =>      sub { $_[2] ? ref($_[0]) -> new($_[1]) -> batan2($_[0])
                              : $_[0] -> copy() -> batan2($_[1]); },

  'cos'   =>      sub { $_[0] -> copy() -> bcos(); },

  'sin'   =>      sub { $_[0] -> copy() -> bsin(); },

  'exp'   =>      sub { $_[0] -> copy() -> bexp($_[1]); },

  'abs'   =>      sub { $_[0] -> copy() -> babs(); },

  'log'   =>      sub { $_[0] -> copy() -> blog(); },

  'sqrt'  =>      sub { $_[0] -> copy() -> bsqrt(); },

  'int'   =>      sub { $_[0] -> copy() -> bint(); },

  # overload key: conversion

  'bool'  =>      sub { $_[0] -> is_zero() ? '' : 1; },

  '""'    =>      sub { $_[0] -> bstr(); },

  '0+'    =>      sub { $_[0] -> numify(); },

  '='     =>      sub { $_[0] -> copy(); },

  ;

##############################################################################
# global constants, flags and assorted stuff

# the following are public, but their usage is not recommended. Use the
# accessor methods instead.

# class constants, use Class->constant_name() to access
# one of 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'
$round_mode = 'even';
$accuracy   = undef;
$precision  = undef;
$div_scale  = 40;

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

# are NaNs ok? (otherwise it dies when encountering an NaN) set w/ config()
$_trap_nan = 0;
# the same for infinity
$_trap_inf = 0;

# constant for easier life
my $nan = 'NaN';

my $IMPORT = 0; # was import() called yet? used to make require work

# some digits of accuracy for blog(undef, 10); which we use in blog() for speed
my $LOG_10 =
 '2.3025850929940456840179914546843642076011014886287729760333279009675726097';
my $LOG_10_A = length($LOG_10)-1;
# ditto for log(2)
my $LOG_2 =
 '0.6931471805599453094172321214581765680755001343602552541206800094933936220';
my $LOG_2_A = length($LOG_2)-1;
my $HALF = '0.5';                       # made into an object if nec.

##############################################################################
# the old code had $rnd_mode, so we need to support it, too

sub TIESCALAR {
    my ($class) = @_;
    bless \$round_mode, $class;
}

sub FETCH {
    return $round_mode;
}

sub STORE {
    $rnd_mode = $_[0]->round_mode($_[1]);
}

BEGIN {
    # when someone sets $rnd_mode, we catch this and check the value to see
    # whether it is valid or not.
    $rnd_mode   = 'even';
    tie $rnd_mode, 'Math::BigFloat';

    # we need both of them in this package:
    *as_int = \&as_number;
}

sub DESTROY {
    # going through AUTOLOAD for every DESTROY is costly, avoid it by empty sub
}

sub AUTOLOAD {
    # make fxxx and bxxx both work by selectively mapping fxxx() to MBF::bxxx()
    my $name = $AUTOLOAD;

    $name =~ s/(.*):://;        # split package
    my $c = $1 || __PACKAGE__;
    no strict 'refs';
    $c->import() if $IMPORT == 0;
    if (!_method_alias($name)) {
        if (!defined $name) {
            # delayed load of Carp and avoid recursion
            croak("$c: Can't call a method without name");
        }
        if (!_method_hand_up($name)) {
            # delayed load of Carp and avoid recursion
            croak("Can't call $c\-\>$name, not a valid method");
        }
        # try one level up, but subst. bxxx() for fxxx() since MBI only got bxxx()
        $name =~ s/^f/b/;
        return &{"Math::BigInt"."::$name"}(@_);
    }
    my $bname = $name;
    $bname =~ s/^f/b/;
    $c .= "::$name";
    *{$c} = \&{$bname};
    &{$c};                      # uses @_
}

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

{
    # valid method aliases for AUTOLOAD
    my %methods = map { $_ => 1 }
      qw / fadd fsub fmul fdiv fround ffround fsqrt fmod fstr fsstr fpow fnorm
           fint facmp fcmp fzero fnan finf finc fdec ffac fneg
           fceil ffloor frsft flsft fone flog froot fexp
         /;
    # valid methods that can be handed up (for AUTOLOAD)
    my %hand_ups = map { $_ => 1 }
      qw / is_nan is_inf is_negative is_positive is_pos is_neg
           accuracy precision div_scale round_mode fabs fnot
           objectify upgrade downgrade
           bone binf bnan bzero
           bsub
         /;

    sub _method_alias { exists $methods{$_[0]||''}; }
    sub _method_hand_up { exists $hand_ups{$_[0]||''}; }
}

sub isa {
    my ($self, $class) = @_;
    return if $class =~ /^Math::BigInt/; # we aren't one of these
    UNIVERSAL::isa($self, $class);
}

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

    # Getter/accessor.

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

    # Setter.

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

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

###############################################################################
# Constructor methods
###############################################################################

sub new {
    # Create a new Math::BigFloat object from a string or another bigfloat object.
    # _e: exponent
    # _m: mantissa
    # sign  => ("+", "-", "+inf", "-inf", or "NaN")

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # Make "require" work.

    $class -> import() if $IMPORT == 0;

    # Although this use has been discouraged for more than 10 years, people
    # apparently still use it, so we still support it.

    return $class -> bzero() unless @_;

    my ($wanted, @r) = @_;

    if (!defined($wanted)) {
        #if (warnings::enabled("uninitialized")) {
        #    warnings::warn("uninitialized",
        #                   "Use of uninitialized value in new()");
        #}
        return $class -> bzero(@r);
    }

    if (!ref($wanted) && $wanted eq "") {
        #if (warnings::enabled("numeric")) {
        #    warnings::warn("numeric",
        #                   q|Argument "" isn't numeric in new()|);
        #}
        #return $class -> bzero(@r);
        return $class -> bnan(@r);
    }

    # Initialize a new object.

    $self = bless {}, $class unless $selfref;

    # The first following ought to work. However, it causes a 'Deep recursion on
    # subroutine "Math::BigFloat::as_number"' in some tests. Fixme!

    if (defined(blessed($wanted)) && $wanted -> isa('Math::BigFloat')) {
    #if (defined(blessed($wanted)) && UNIVERSAL::isa($wanted, 'Math::BigFloat')) {
        $self -> {sign} = $wanted -> {sign};
        $self -> {_m}   = $LIB -> _copy($wanted -> {_m});
        $self -> {_es}  = $wanted -> {_es};
        $self -> {_e}   = $LIB -> _copy($wanted -> {_e});
        $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
        return $self;
    }

    # Shortcut for Math::BigInt and its subclasses. This should be improved.

    if (defined(blessed($wanted))) {
        if ($wanted -> isa('Math::BigInt')) {
            $self->{sign} = $wanted -> {sign};
            $self->{_m}   = $LIB -> _copy($wanted -> {value});
            $self->{_es}  = '+';
            $self->{_e}   = $LIB -> _zero();
            return $self -> bnorm();
        }

        if ($wanted -> can("as_number")) {
            $self->{sign} = $wanted -> sign();
            $self->{_m}   = $wanted -> as_number() -> {value};
            $self->{_es}  = '+';
            $self->{_e}   = $LIB -> _zero();
            return $self -> bnorm();
        }
    }

    # Handle Infs.

    if ($wanted =~ /^\s*([+-]?)inf(inity)?\s*\z/i) {
        return $downgrade->new($wanted) if defined $downgrade;
        my $sgn = $1 || '+';
        $self = $class -> binf($sgn);
        $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
        return $self;
    }

    # Handle explicit NaNs (not the ones returned due to invalid input).

    if ($wanted =~ /^\s*([+-]?)nan\s*\z/i) {
        return $downgrade->new($wanted) if defined $downgrade;
        $self = $class -> bnan();
        $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
        return $self;
    }

    # Shortcut for simple forms like '123' that have no trailing zeros.

    if ($wanted =~ / ^
                     \s*                        # optional leading whitespace
                     ( [+-]? )                  # optional sign
                     0*                         # optional leading zeros
                     ( [1-9] (?: [0-9]* [1-9] )? )  # significand
                     \s*                        # optional trailing whitespace
                     $
                   /x)
    {
        return $downgrade->new($1 . $2) if defined $downgrade;
        $self->{sign} = $1 || '+';
        $self->{_m}   = $LIB -> _new($2);
        $self->{_es}  = '+';
        $self->{_e}   = $LIB -> _zero();
        $self->round(@r) unless @r >= 2 && !defined $r[0] && !defined $r[1];
        return $self;
    }

    my @parts;

    if (
        # Handle hexadecimal numbers. We auto-detect hexadecimal numbers if they
        # have a "0x", "0X", "x", or "X" prefix, cf. CORE::oct().

        $wanted =~ /^\s*[+-]?0?[Xx]/ and
        @parts = $class -> _hex_str_to_lib_parts($wanted)

          or

        # Handle octal numbers. We auto-detect octal numbers if they have a
        # "0o", "0O", "o", "O" prefix, cf. CORE::oct().

        $wanted =~ /^\s*[+-]?0?[Oo]/ and
        @parts = $class -> _oct_str_to_lib_parts($wanted)

          or

        # Handle binary numbers. We auto-detect binary numbers if they have a
        # "0b", "0B", "b", or "B" prefix, cf. CORE::oct().

        $wanted =~ /^\s*[+-]?0?[Bb]/ and
        @parts = $class -> _bin_str_to_lib_parts($wanted)

          or

        # At this point, what is left are decimal numbers that aren't handled
        # above and octal floating point numbers that don't have any of the
        # "0o", "0O", "o", or "O" prefixes. First see if it is a decimal number.

        @parts = $class -> _dec_str_to_lib_parts($wanted)
          or

        # See if it is an octal floating point number. The extra check is
        # included because _oct_str_to_lib_parts() accepts octal numbers that
        # don't have a prefix (this is needed to make it work with, e.g.,
        # from_oct() that don't require a prefix). However, Perl requires a
        # prefix for octal floating point literals. For example, "1p+0" is not
        # valid, but "01p+0" and "0__1p+0" are.

        $wanted =~ /^\s*[+-]?0_*\d/ and
        @parts = $class -> _oct_str_to_lib_parts($wanted))
    {
        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+' && $downgrade) {
            return $downgrade->new($wanted, @r);
        }

        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
        $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
        return $self;
    }

    # If we get here, the value is neither a valid decimal, binary, octal, or
    # hexadecimal number. It is not an explicit Inf or a NaN either.

    return $class -> bnan();
}

sub from_dec {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # Don't modify constant (read-only) objects.

    return if $selfref && $self->modify('from_dec');

    my $str = shift;
    my @r = @_;

    # If called as a class method, initialize a new object.

    $self = $class -> bzero() unless $selfref;

    if (my @parts = $class -> _dec_str_to_lib_parts($str)) {

        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+') {
            return $downgrade->new($str, @r) if defined $downgrade;
        }

        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
        $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
        return $self;
    }

    return $self -> bnan(@r);
}

sub from_hex {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # Don't modify constant (read-only) objects.

    return if $selfref && $self->modify('from_hex');

    my $str = shift;
    my @r = @_;

    # If called as a class method, initialize a new object.

    $self = $class -> bzero() unless $selfref;

    if (my @parts = $class -> _hex_str_to_lib_parts($str)) {

        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+' && defined $downgrade) {
            return $downgrade -> from_hex($str, @r);
        }

        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
        $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
        return $self;
    }

    return $self -> bnan(@r);
}

sub from_oct {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # Don't modify constant (read-only) objects.

    return if $selfref && $self->modify('from_oct');

    my $str = shift;
    my @r = @_;

    # If called as a class method, initialize a new object.

    $self = $class -> bzero() unless $selfref;

    if (my @parts = $class -> _oct_str_to_lib_parts($str)) {

        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+') {
            return $downgrade -> from_oct($str, @r) if defined $downgrade;
        }

        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
        $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
        return $self;
    }

    return $self -> bnan(@r);
}

sub from_bin {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # Don't modify constant (read-only) objects.

    return if $selfref && $self->modify('from_bin');

    my $str = shift;
    my @r = @_;

    # If called as a class method, initialize a new object.

    $self = $class -> bzero() unless $selfref;

    if (my @parts = $class -> _bin_str_to_lib_parts($str)) {

        # The value is an integer iff the exponent is non-negative.

        if ($parts[2] eq '+') {
            return $downgrade -> from_bin($str, @r) if defined $downgrade;
        }

        ($self->{sign}, $self->{_m}, $self->{_es}, $self->{_e}) = @parts;
        $self->round(@r) unless @r >= 2 && !defined($r[0]) && !defined($r[1]);
        return $self;
    }

    return $self -> bnan(@r);
}

sub from_ieee754 {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # Don't modify constant (read-only) objects.

    return if $selfref && $self->modify('from_ieee754');

    my $in     = shift;     # input string (or raw bytes)
    my $format = shift;     # format ("binary32", "decimal64" etc.)
    my $enc;                # significand encoding (applies only to decimal)
    my $k;                  # storage width in bits
    my $b;                  # base
    my @r = @_;

    if ($format =~ /^binary(\d+)\z/) {
        $k = $1;
        $b = 2;
    } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
        $k = $1;
        $b = 10;
        $enc = $2 || 'dpd';     # default is dencely-packed decimals (DPD)
    } elsif ($format eq 'half') {
        $k = 16;
        $b = 2;
    } elsif ($format eq 'single') {
        $k = 32;
        $b = 2;
    } elsif ($format eq 'double') {
        $k = 64;
        $b = 2;
    } elsif ($format eq 'quadruple') {
        $k = 128;
        $b = 2;
    } elsif ($format eq 'octuple') {
        $k = 256;
        $b = 2;
    } elsif ($format eq 'sexdecuple') {
        $k = 512;
        $b = 2;
    }

    if ($b == 2) {

        # Get the parameters for this format.

        my $p;                      # precision (in bits)
        my $t;                      # number of bits in significand
        my $w;                      # number of bits in exponent

        if ($k == 16) {             # binary16 (half-precision)
            $p = 11;
            $t = 10;
            $w =  5;
        } elsif ($k == 32) {        # binary32 (single-precision)
            $p = 24;
            $t = 23;
            $w =  8;
        } elsif ($k == 64) {        # binary64 (double-precision)
            $p = 53;
            $t = 52;
            $w = 11;
        } else {                    # binaryN (quadruple-precision and above)
            if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
                croak "Number of bits must be 16, 32, 64, or >= 128 and",
                  " a multiple of 32";
            }
            $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
            $t = $p - 1;
            $w = $k - $t - 1;
        }

        # The maximum exponent, minimum exponent, and exponent bias.

        my $emax = Math::BigInt -> new(2) -> bpow($w - 1) -> bdec();
        my $emin = 1 - $emax;
        my $bias = $emax;

        # Undefined input.

        unless (defined $in) {
            carp("Input is undefined");
            return $self -> bzero(@r);
        }

        # Make sure input string is a string of zeros and ones.

        my $len = CORE::length $in;
        if (8 * $len == $k) {                   # bytes
            $in = unpack "B*", $in;
        } elsif (4 * $len == $k) {              # hexadecimal
            if ($in =~ /([^\da-f])/i) {
                croak "Illegal hexadecimal digit '$1'";
            }
            $in = unpack "B*", pack "H*", $in;
        } elsif ($len == $k) {                  # bits
            if ($in =~ /([^01])/) {
                croak "Illegal binary digit '$1'";
            }
        } else {
            croak "Unknown input -- $in";
        }

        # Split bit string into sign, exponent, and mantissa/significand.

        my $sign = substr($in, 0, 1) eq '1' ? '-' : '+';
        my $expo = $class -> from_bin(substr($in, 1, $w));
        my $mant = $class -> from_bin(substr($in, $w + 1));

        my $x;

        $expo -> bsub($bias);                   # subtract bias

        if ($expo < $emin) {                    # zero and subnormals
            if ($mant == 0) {                   # zero
                $x = $class -> bzero();
            } else {                            # subnormals
                # compute (1/$b)**(N) rather than ($b)**(-N)
                $x = $class -> new("0.5");      # 1/$b
                $x -> bpow($bias + $t - 1) -> bmul($mant);
                $x -> bneg() if $sign eq '-';
            }
        }

        elsif ($expo > $emax) {                 # inf and nan
            if ($mant == 0) {                   # inf
                $x = $class -> binf($sign);
            } else {                            # nan
                $x = $class -> bnan();
            }
        }

        else {                                  # normals
            $mant = $class -> new(2) -> bpow($t) -> badd($mant);
            if ($expo < $t) {
                # compute (1/$b)**(N) rather than ($b)**(-N)
                $x = $class -> new("0.5");      # 1/$b
                $x -> bpow($t - $expo) -> bmul($mant);
            } else {
                $x = $class -> new(2);
                $x -> bpow($expo - $t) -> bmul($mant);
            }
            $x -> bneg() if $sign eq '-';
        }

        if ($selfref) {
            $self -> {sign} = $x -> {sign};
            $self -> {_m}   = $x -> {_m};
            $self -> {_es}  = $x -> {_es};
            $self -> {_e}   = $x -> {_e};
        } else {
            $self = $x;
        }

        return $downgrade -> new($x, @r)
          if defined($downgrade) && $x -> is_int();
        return $self -> round(@r);
    }

    croak("The format '$format' is not yet supported.");
}

sub bzero {
    # create/assign '+0'

    if (@_ == 0) {
        #carp("Using bone() as a function is deprecated;",
        #           " use bone() as a method instead");
        unshift @_, __PACKAGE__;
    }

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    $self->import() if $IMPORT == 0;            # make require work
    return if $selfref && $self->modify('bzero');

    return $downgrade->bzero() if defined $downgrade;

    $self = bless {}, $class unless $selfref;

    $self -> {sign} = '+';
    $self -> {_m}   = $LIB -> _zero();
    $self -> {_es}  = '+';
    $self -> {_e}   = $LIB -> _zero();

    # If rounding parameters are given as arguments, use them. If no rounding
    # parameters are given, and if called as a class method initialize the new
    # instance with the class variables.

    if (@_) {
        croak "can't specify both accuracy and precision"
          if @_ >= 2 && defined $_[0] && defined $_[1];
        $self->{_a} = $_[0];
        $self->{_p} = $_[1];
    } else {
        unless($selfref) {
            $self->{_a} = $class -> accuracy();
            $self->{_p} = $class -> precision();
        }
    }

    return $self;
}

sub bone {
    # Create or assign '+1' (or -1 if given sign '-').

    if (@_ == 0 || (defined($_[0]) && ($_[0] eq '+' || $_[0] eq '-'))) {
        #carp("Using bone() as a function is deprecated;",
        #           " use bone() as a method instead");
        unshift @_, __PACKAGE__;
    }

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    $self->import() if $IMPORT == 0;            # make require work
    return if $selfref && $self->modify('bone');

    return $downgrade->bone() if defined $downgrade;

    my $sign = shift;
    $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+";

    $self = bless {}, $class unless $selfref;

    $self -> {sign} = $sign;
    $self -> {_m}   = $LIB -> _one();
    $self -> {_es}  = '+';
    $self -> {_e}   = $LIB -> _zero();

    # If rounding parameters are given as arguments, use them. If no rounding
    # parameters are given, and if called as a class method initialize the new
    # instance with the class variables.

    if (@_) {
        croak "can't specify both accuracy and precision"
          if @_ >= 2 && defined $_[0] && defined $_[1];
        $self->{_a} = $_[0];
        $self->{_p} = $_[1];
    } else {
        unless($selfref) {
            $self->{_a} = $class -> accuracy();
            $self->{_p} = $class -> precision();
        }
    }

    return $self;
}

sub binf {
    # create/assign a '+inf' or '-inf'

    if (@_ == 0 || (defined($_[0]) && !ref($_[0]) &&
                    $_[0] =~ /^\s*[+-](inf(inity)?)?\s*$/))
    {
        #carp("Using binf() as a function is deprecated;",
        #           " use binf() as a method instead");
        unshift @_, __PACKAGE__;
    }

    return $downgrade->binf(@_) if defined $downgrade;

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    {
        no strict 'refs';
        if (${"${class}::_trap_inf"}) {
            croak("Tried to create +-inf in $class->binf()");
        }
    }

    $self->import() if $IMPORT == 0;            # make require work
    return if $selfref && $self->modify('binf');

    my $sign = shift;
    $sign = defined $sign && $sign =~ /^\s*-/ ? "-" : "+";

    $self = bless {}, $class unless $selfref;

    $self -> {sign} = $sign . 'inf';
    $self -> {_m}   = $LIB -> _zero();
    $self -> {_es}  = '+';
    $self -> {_e}   = $LIB -> _zero();

    # If rounding parameters are given as arguments, use them. If no rounding
    # parameters are given, and if called as a class method initialize the new
    # instance with the class variables.

    if (@_) {
        croak "can't specify both accuracy and precision"
          if @_ >= 2 && defined $_[0] && defined $_[1];
        $self->{_a} = $_[0];
        $self->{_p} = $_[1];
    } else {
        unless($selfref) {
            $self->{_a} = $class -> accuracy();
            $self->{_p} = $class -> precision();
        }
    }

    return $self;
}

sub bnan {
    # create/assign a 'NaN'

    if (@_ == 0) {
        #carp("Using bnan() as a function is deprecated;",
        #           " use bnan() as a method instead");
        unshift @_, __PACKAGE__;
    }

    return $downgrade->bnan(@_) if defined $downgrade;

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    {
        no strict 'refs';
        if (${"${class}::_trap_nan"}) {
            croak("Tried to create NaN in $class->bnan()");
        }
    }

    $self->import() if $IMPORT == 0;            # make require work
    return if $selfref && $self->modify('bnan');

    $self = bless {}, $class unless $selfref;

    $self -> {sign} = $nan;
    $self -> {_m}   = $LIB -> _zero();
    $self -> {_es}  = '+';
    $self -> {_e}   = $LIB -> _zero();

    # If rounding parameters are given as arguments, use them. If no rounding
    # parameters are given, and if called as a class method initialize the new
    # instance with the class variables.

    if (@_) {
        croak "can't specify both accuracy and precision"
          if @_ >= 2 && defined $_[0] && defined $_[1];
        $self->{_a} = $_[0];
        $self->{_p} = $_[1];
    } else {
        unless($selfref) {
            $self->{_a} = $class -> accuracy();
            $self->{_p} = $class -> precision();
        }
    }

    return $self;
}

sub bpi {

    # Called as                 Argument list
    # ---------                 -------------
    # Math::BigFloat->bpi()     ("Math::BigFloat")
    # Math::BigFloat->bpi(10)   ("Math::BigFloat", 10)
    # $x->bpi()                 ($x)
    # $x->bpi(10)               ($x, 10)
    # Math::BigFloat::bpi()     ()
    # Math::BigFloat::bpi(10)   (10)
    #
    # In ambiguous cases, we favour the OO-style, so the following case
    #
    #   $n = Math::BigFloat->new("10");
    #   $x = Math::BigFloat->bpi($n);
    #
    # which gives an argument list with the single element $n, is resolved as
    #
    #   $n->bpi();

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    my @r;                      # rounding paramters

    # If bpi() is called as a function ...
    #
    # This cludge is necessary because we still support bpi() as a function. If
    # bpi() is called with either no argument or one argument, and that one
    # argument is either undefined or a scalar that looks like a number, then
    # we assume bpi() is called as a function.

    if (@_ == 0 &&
        (defined($self) && !ref($self) && $self =~ /^\s*[+-]?\d/)
          ||
        !defined($self))
    {
        $r[0]  = $self;
        $class = __PACKAGE__;
        $self  = bless {}, $class;              # initialize
    }

    # ... or if bpi() is called as a method ...

    else {
        @r = @_;
        if ($selfref) {                     # bpi() called as instance method
            return $self if $self -> modify('bpi');
        } else {                            # bpi() called as class method
            $self  = bless {}, $class;      # initialize
        }
    }

    ($self, @r) = $self -> _find_round_parameters(@r);

    # The accuracy, i.e., the number of digits. Pi has one digit before the
    # dot, so a precision of 4 digits is equivalent to an accuracy of 5 digits.

    my $n = defined $r[0] ? $r[0]
          : defined $r[1] ? 1 - $r[1]
          : $self -> div_scale();

    my $rmode = defined $r[2] ? $r[2] : $self -> round_mode();

    my $pi;

    if ($n <= 1000) {

        # 75 x 14 = 1050 digits

        my $all_digits = <<EOF;
314159265358979323846264338327950288419716939937510582097494459230781640628
620899862803482534211706798214808651328230664709384460955058223172535940812
848111745028410270193852110555964462294895493038196442881097566593344612847
564823378678316527120190914564856692346034861045432664821339360726024914127
372458700660631558817488152092096282925409171536436789259036001133053054882
046652138414695194151160943305727036575959195309218611738193261179310511854
807446237996274956735188575272489122793818301194912983367336244065664308602
139494639522473719070217986094370277053921717629317675238467481846766940513
200056812714526356082778577134275778960917363717872146844090122495343014654
958537105079227968925892354201995611212902196086403441815981362977477130996
051870721134999999837297804995105973173281609631859502445945534690830264252
230825334468503526193118817101000313783875288658753320838142061717766914730
359825349042875546873115956286388235378759375195778185778053217122680661300
192787661119590921642019893809525720106548586327886593615338182796823030195
EOF

        # Should we round up?

        my $round_up;

        # From the string above, we need to extract the number of digits we
        # want plus extra characters for the newlines.

        my $nchrs = $n + int($n / 75);

        # Extract the digits we want.

        my $digits = substr($all_digits, 0, $nchrs);

        # Find out whether we should round up or down. Rounding is easy, since
        # pi is trancendental. With directed rounding, it doesn't matter what
        # the following digits are. With rounding to nearest, we only have to
        # look at one extra digit.

        if ($rmode eq 'trunc') {
            $round_up = 0;
        } else {
            my $next_digit = substr($all_digits, $nchrs, 1);
            $round_up = $next_digit lt '5' ? 0 : 1;
        }

        # Remove the newlines.

        $digits =~ tr/0-9//cd;

        # Now do the rounding. We could easily make the regex substitution
        # handle all cases, but we avoid using the regex engine when it is
        # simple to avoid it.

        if ($round_up) {
            my $last_digit = substr($digits, -1, 1);
            if ($last_digit lt '9') {
                substr($digits, -1, 1) = ++$last_digit;
            } else {
                $digits =~ s/([0-8])(9+)$/ ($1 + 1) . ("0" x CORE::length($2)) /e;
            }
        }

        # Append the exponent and convert to an object.

        $pi = Math::BigFloat -> new($digits . 'e-' . ($n - 1));

    } else {

        # For large accuracy, the arctan formulas become very inefficient with
        # Math::BigFloat, so use Brent-Salamin (aka AGM or Gauss-Legendre).

        # Use a few more digits in the intermediate computations.
        $n += 8;

        $HALF = $class -> new($HALF) unless ref($HALF);
        my ($an, $bn, $tn, $pn) = ($class -> bone, $HALF -> copy() -> bsqrt($n),
                                   $HALF -> copy() -> bmul($HALF), $class -> bone);
        while ($pn < $n) {
            my $prev_an = $an -> copy();
            $an -> badd($bn) -> bmul($HALF, $n);
            $bn -> bmul($prev_an) -> bsqrt($n);
            $prev_an -> bsub($an);
            $tn -> bsub($pn * $prev_an * $prev_an);
            $pn -> badd($pn);
        }
        $an -> badd($bn);
        $an -> bmul($an, $n) -> bdiv(4 * $tn, $n);

        $an -> round(@r);
        $pi = $an;
    }

    if (defined $r[0]) {
        $pi -> accuracy($r[0]);
    } elsif (defined $r[1]) {
        $pi -> precision($r[1]);
    }

    for my $key (qw/ sign _m _es _e _a _p /) {
        $self -> {$key} = $pi -> {$key};
    }

    return $self;
}

sub copy {
    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    # If called as a class method, the object to copy is the next argument.

    $self = shift() unless $selfref;

    my $copy = bless {}, $class;

    $copy->{sign} = $self->{sign};
    $copy->{_es}  = $self->{_es};
    $copy->{_m}   = $LIB->_copy($self->{_m});
    $copy->{_e}   = $LIB->_copy($self->{_e});
    $copy->{_a}   = $self->{_a} if exists $self->{_a};
    $copy->{_p}   = $self->{_p} if exists $self->{_p};

    return $copy;
}

sub as_number {
    # return copy as a bigint representation of this Math::BigFloat number
    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

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

    if (!$x->isa('Math::BigFloat')) {
        # if the object can as_number(), use it
        return $x->as_number() if $x->can('as_number');
        # otherwise, get us a float and then a number
        $x = $x->can('as_float') ? $x->as_float() : $class->new(0+"$x");
    }

    return Math::BigInt->binf($x->sign()) if $x->is_inf();
    return Math::BigInt->bnan()           if $x->is_nan();

    my $z = $LIB->_copy($x->{_m});
    if ($x->{_es} eq '-') {                     # < 0
        $z = $LIB->_rsft($z, $x->{_e}, 10);
    } elsif (! $LIB->_is_zero($x->{_e})) {      # > 0
        $z = $LIB->_lsft($z, $x->{_e}, 10);
    }
    $z = Math::BigInt->new($x->{sign} . $LIB->_str($z));
    $z;
}

###############################################################################
# Boolean methods
###############################################################################

sub is_zero {
    # return true if arg (BFLOAT or num_str) is zero
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    ($x->{sign} eq '+' && $LIB->_is_zero($x->{_m})) ? 1 : 0;
}

sub is_one {
    # return true if arg (BFLOAT or num_str) is +1 or -1 if signis given
    my ($class, $x, $sign) = ref($_[0]) ? (undef, @_) : objectify(1, @_);

    $sign = '+' if !defined $sign || $sign ne '-';

    ($x->{sign} eq $sign &&
     $LIB->_is_zero($x->{_e}) &&
     $LIB->_is_one($x->{_m})) ? 1 : 0;
}

sub is_odd {
    # return true if arg (BFLOAT or num_str) is odd or false if even
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    (($x->{sign} =~ /^[+-]$/) && # NaN & +-inf aren't
     ($LIB->_is_zero($x->{_e})) &&
     ($LIB->_is_odd($x->{_m}))) ? 1 : 0;
}

sub is_even {
    # return true if arg (BINT or num_str) is even or false if odd
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    (($x->{sign} =~ /^[+-]$/) &&        # NaN & +-inf aren't
     ($x->{_es} eq '+') &&              # 123.45 isn't
     ($LIB->_is_even($x->{_m}))) ? 1 : 0; # but 1200 is
}

sub is_int {
    # return true if arg (BFLOAT or num_str) is an integer
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    (($x->{sign} =~ /^[+-]$/) && # NaN and +-inf aren't
     ($x->{_es} eq '+')) ? 1 : 0; # 1e-1 => no integer
}

###############################################################################
# Comparison methods
###############################################################################

sub bcmp {
    # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)

    # set up parameters
    my ($class, $x, $y) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y) = objectify(2, @_);
    }

    return $upgrade->bcmp($x, $y) if defined $upgrade &&
      ((!$x->isa($class)) || (!$y->isa($class)));

    # Handle all 'nan' cases.

    return    if ($x->{sign} eq $nan) || ($y->{sign} eq $nan);

    # Handle all '+inf' and '-inf' cases.

    return  0 if ($x->{sign} eq '+inf' && $y->{sign} eq '+inf' ||
                  $x->{sign} eq '-inf' && $y->{sign} eq '-inf');
    return +1 if $x->{sign} eq '+inf'; # x = +inf and y < +inf
    return -1 if $x->{sign} eq '-inf'; # x = -inf and y > -inf
    return -1 if $y->{sign} eq '+inf'; # x < +inf and y = +inf
    return +1 if $y->{sign} eq '-inf'; # x > -inf and y = -inf

    # Handle all cases with opposite signs.

    return +1 if $x->{sign} eq '+' && $y->{sign} eq '-'; # also does 0 <=> -y
    return -1 if $x->{sign} eq '-' && $y->{sign} eq '+'; # also does -x <=> 0

    # Handle all remaining zero cases.

    my $xz = $x->is_zero();
    my $yz = $y->is_zero();
    return  0 if $xz && $yz;             # 0 <=> 0
    return -1 if $xz && $y->{sign} eq '+'; # 0 <=> +y
    return +1 if $yz && $x->{sign} eq '+'; # +x <=> 0

    # Both arguments are now finite, non-zero numbers with the same sign.

    my $cmp;

    # The next step is to compare the exponents, but since each mantissa is an
    # integer of arbitrary value, the exponents must be normalized by the length
    # of the mantissas before we can compare them.

    my $mxl = $LIB->_len($x->{_m});
    my $myl = $LIB->_len($y->{_m});

    # If the mantissas have the same length, there is no point in normalizing the
    # exponents by the length of the mantissas, so treat that as a special case.

    if ($mxl == $myl) {

        # First handle the two cases where the exponents have different signs.

        if ($x->{_es} eq '+' && $y->{_es} eq '-') {
            $cmp = +1;
        } elsif ($x->{_es} eq '-' && $y->{_es} eq '+') {
            $cmp = -1;
        }

        # Then handle the case where the exponents have the same sign.

        else {
            $cmp = $LIB->_acmp($x->{_e}, $y->{_e});
            $cmp = -$cmp if $x->{_es} eq '-';
        }

        # Adjust for the sign, which is the same for x and y, and bail out if
        # we're done.

        $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123
        return $cmp if $cmp;

    }

    # We must normalize each exponent by the length of the corresponding
    # mantissa. Life is a lot easier if we first make both exponents
    # non-negative. We do this by adding the same positive value to both
    # exponent. This is safe, because when comparing the exponents, only the
    # relative difference is important.

    my $ex;
    my $ey;

    if ($x->{_es} eq '+') {

        # If the exponent of x is >= 0 and the exponent of y is >= 0, there is no
        # need to do anything special.

        if ($y->{_es} eq '+') {
            $ex = $LIB->_copy($x->{_e});
            $ey = $LIB->_copy($y->{_e});
        }

        # If the exponent of x is >= 0 and the exponent of y is < 0, add the
        # absolute value of the exponent of y to both.

        else {
            $ex = $LIB->_copy($x->{_e});
            $ex = $LIB->_add($ex, $y->{_e}); # ex + |ey|
            $ey = $LIB->_zero();             # -ex + |ey| = 0
        }

    } else {

        # If the exponent of x is < 0 and the exponent of y is >= 0, add the
        # absolute value of the exponent of x to both.

        if ($y->{_es} eq '+') {
            $ex = $LIB->_zero(); # -ex + |ex| = 0
            $ey = $LIB->_copy($y->{_e});
            $ey = $LIB->_add($ey, $x->{_e}); # ey + |ex|
        }

        # If the exponent of x is < 0 and the exponent of y is < 0, add the
        # absolute values of both exponents to both exponents.

        else {
            $ex = $LIB->_copy($y->{_e}); # -ex + |ey| + |ex| = |ey|
            $ey = $LIB->_copy($x->{_e}); # -ey + |ex| + |ey| = |ex|
        }

    }

    # Now we can normalize the exponents by adding lengths of the mantissas.

    $ex = $LIB->_add($ex, $LIB->_new($mxl));
    $ey = $LIB->_add($ey, $LIB->_new($myl));

    # We're done if the exponents are different.

    $cmp = $LIB->_acmp($ex, $ey);
    $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123
    return $cmp if $cmp;

    # Compare the mantissas, but first normalize them by padding the shorter
    # mantissa with zeros (shift left) until it has the same length as the longer
    # mantissa.

    my $mx = $x->{_m};
    my $my = $y->{_m};

    if ($mxl > $myl) {
        $my = $LIB->_lsft($LIB->_copy($my), $LIB->_new($mxl - $myl), 10);
    } elsif ($mxl < $myl) {
        $mx = $LIB->_lsft($LIB->_copy($mx), $LIB->_new($myl - $mxl), 10);
    }

    $cmp = $LIB->_acmp($mx, $my);
    $cmp = -$cmp if $x->{sign} eq '-'; # 124 > 123, but -124 < -123
    return $cmp;

}

sub bacmp {
    # Compares 2 values, ignoring their signs.
    # Returns one of undef, <0, =0, >0. (suitable for sort)

    # set up parameters
    my ($class, $x, $y) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y) = objectify(2, @_);
    }

    return $upgrade->bacmp($x, $y) if defined $upgrade &&
      ((!$x->isa($class)) || (!$y->isa($class)));

    # handle +-inf and NaN's
    if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {
        return    if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));
        return  0 if ($x->is_inf() && $y->is_inf());
        return  1 if ($x->is_inf() && !$y->is_inf());
        return -1;
    }

    # shortcut
    my $xz = $x->is_zero();
    my $yz = $y->is_zero();
    return 0 if $xz && $yz;     # 0 <=> 0
    return -1 if $xz && !$yz;   # 0 <=> +y
    return 1 if $yz && !$xz;    # +x <=> 0

    # adjust so that exponents are equal
    my $lxm = $LIB->_len($x->{_m});
    my $lym = $LIB->_len($y->{_m});
    my ($xes, $yes) = (1, 1);
    $xes = -1 if $x->{_es} ne '+';
    $yes = -1 if $y->{_es} ne '+';
    # the numify somewhat limits our length, but makes it much faster
    my $lx = $lxm + $xes * $LIB->_num($x->{_e});
    my $ly = $lym + $yes * $LIB->_num($y->{_e});
    my $l = $lx - $ly;
    return $l <=> 0 if $l != 0;

    # lengths (corrected by exponent) are equal
    # so make mantissa equal-length by padding with zero (shift left)
    my $diff = $lxm - $lym;
    my $xm = $x->{_m};          # not yet copy it
    my $ym = $y->{_m};
    if ($diff > 0) {
        $ym = $LIB->_copy($y->{_m});
        $ym = $LIB->_lsft($ym, $LIB->_new($diff), 10);
    } elsif ($diff < 0) {
        $xm = $LIB->_copy($x->{_m});
        $xm = $LIB->_lsft($xm, $LIB->_new(-$diff), 10);
    }
    $LIB->_acmp($xm, $ym);
}

###############################################################################
# Arithmetic methods
###############################################################################

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

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

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

    return $downgrade -> new($x)
      if defined($downgrade) && ($x -> is_int() || $x -> is_inf() || $x -> is_nan());
    return $x;
}

sub bnorm {
    # adjust m and e so that m is smallest possible
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    # inf, nan etc
    if ($x->{sign} !~ /^[+-]$/) {
        return $downgrade->new($x) if defined $downgrade;
        return $x;
    }

    my $zeros = $LIB->_zeros($x->{_m}); # correct for trailing zeros
    if ($zeros != 0) {
        my $z = $LIB->_new($zeros);
        $x->{_m} = $LIB->_rsft($x->{_m}, $z, 10);
        if ($x->{_es} eq '-') {
            if ($LIB->_acmp($x->{_e}, $z) >= 0) {
                $x->{_e} = $LIB->_sub($x->{_e}, $z);
                $x->{_es} = '+' if $LIB->_is_zero($x->{_e});
            } else {
                $x->{_e} = $LIB->_sub($LIB->_copy($z), $x->{_e});
                $x->{_es} = '+';
            }
        } else {
            $x->{_e} = $LIB->_add($x->{_e}, $z);
        }
    } else {
        # $x can only be 0Ey if there are no trailing zeros ('0' has 0 trailing
        # zeros). So, for something like 0Ey, set y to 1, and -0 => +0
        $x->{sign} = '+', $x->{_es} = '+', $x->{_e} = $LIB->_one()
          if $LIB->_is_zero($x->{_m});
    }

    return $downgrade->new($x) if defined($downgrade) && $x->is_int();
    $x;
}

sub binc {
    # increment arg by one
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    if ($x->{_es} eq '-') {
        return $x->badd($class->bone(), @r); #  digits after dot
    }

    if (!$LIB->_is_zero($x->{_e})) # _e == 0 for NaN, inf, -inf
    {
        # 1e2 => 100, so after the shift below _m has a '0' as last digit
        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
        $x->{_e} = $LIB->_zero();                      # normalize
        $x->{_es} = '+';
        # we know that the last digit of $x will be '1' or '9', depending on the
        # sign
    }
    # now $x->{_e} == 0
    if ($x->{sign} eq '+') {
        $x->{_m} = $LIB->_inc($x->{_m});
        return $x->bnorm()->bround(@r);
    } elsif ($x->{sign} eq '-') {
        $x->{_m} = $LIB->_dec($x->{_m});
        $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0
        return $x->bnorm()->bround(@r);
    }
    # inf, nan handling etc
    $x->badd($class->bone(), @r); # badd() does round
}

sub bdec {
    # decrement arg by one
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    if ($x->{_es} eq '-') {
        return $x->badd($class->bone('-'), @r); #  digits after dot
    }

    if (!$LIB->_is_zero($x->{_e})) {
        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # 1e2 => 100
        $x->{_e} = $LIB->_zero();                      # normalize
        $x->{_es} = '+';
    }
    # now $x->{_e} == 0
    my $zero = $x->is_zero();
    # <= 0
    if (($x->{sign} eq '-') || $zero) {
        $x->{_m} = $LIB->_inc($x->{_m});
        $x->{sign} = '-' if $zero;                # 0 => 1 => -1
        $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # -1 +1 => -0 => +0
        return $x->bnorm()->round(@r);
    }
    # > 0
    elsif ($x->{sign} eq '+') {
        $x->{_m} = $LIB->_dec($x->{_m});
        return $x->bnorm()->round(@r);
    }
    # inf, nan handling etc
    $x->badd($class->bone('-'), @r); # does round
}

sub badd {
    # add second arg (BFLOAT or string) to first (BFLOAT) (modifies first)
    # return result as BFLOAT

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

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

    # inf and NaN handling
    if ($x->{sign} !~ /^[+-]$/ || $y->{sign} !~ /^[+-]$/) {

        # NaN first
        if ($x->{sign} eq $nan || $y->{sign} eq $nan) {
            $x->bnan();
        }

        # inf handling
        elsif ($x->{sign} =~ /^[+-]inf$/ && $y->{sign} =~ /^[+-]inf$/) {
            # +inf++inf or -inf+-inf => same, rest is NaN
            $x->bnan() if $x->{sign} ne $y->{sign};
        }

        # +-inf + something => +inf; something +-inf => +-inf
        elsif ($y->{sign} =~ /^[+-]inf$/) {
            $x->{sign} = $y->{sign};
        }

        return $downgrade->new($x, @r) if defined $downgrade;
        return $x;
    }

    return $upgrade->badd($x, $y, @r) if defined $upgrade &&
      ((!$x->isa($class)) || (!$y->isa($class)));

    $r[3] = $y;                 # no push!

    # for speed: no add for $x + 0
    if ($y->is_zero()) {
        $x->bround(@r);
    }

    # for speed: no add for 0 + $y
    elsif ($x->is_zero()) {
        # make copy, clobbering up x (modify in place!)
        $x->{_e} = $LIB->_copy($y->{_e});
        $x->{_es} = $y->{_es};
        $x->{_m} = $LIB->_copy($y->{_m});
        $x->{sign} = $y->{sign} || $nan;
        $x->round(@r);
    }

    else {

        # take lower of the two e's and adapt m1 to it to match m2
        my $e = $y->{_e};
        $e = $LIB->_zero() if !defined $e; # if no BFLOAT?
        $e = $LIB->_copy($e);              # make copy (didn't do it yet)

        my $es;

        ($e, $es) = _e_sub($e, $x->{_e}, $y->{_es} || '+', $x->{_es});
        #($e, $es) = $LIB -> _ssub($e, $y->{_es} || '+', $x->{_e}, $x->{_es});

        my $add = $LIB->_copy($y->{_m});

        if ($es eq '-') {                       # < 0
            $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
            ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
            #$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
            #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es);
        } elsif (!$LIB->_is_zero($e)) {         # > 0
            $add = $LIB->_lsft($add, $e, 10);
        }

        # else: both e are the same, so just leave them

        if ($x->{sign} eq $y->{sign}) {
            $x->{_m} = $LIB->_add($x->{_m}, $add);
        } else {
            ($x->{_m}, $x->{sign}) =
              _e_add($x->{_m}, $add, $x->{sign}, $y->{sign});
            #($x->{_m}, $x->{sign}) =
            #  $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $y->{sign});
        }

        # delete trailing zeros, then round
        $x->bnorm()->round(@r);
    }

    return $downgrade->new($x, @r) if defined($downgrade) && $x -> is_int();
    return $x;
}

sub bsub {
    # (BINT or num_str, BINT or num_str) return BINT
    # subtract second arg from first, modify first

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

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

    return $upgrade -> new($x) -> bsub($upgrade -> new($y), @r)
      if defined $upgrade && (!$x -> isa($class) || !$y -> isa($class));

    if ($y -> is_zero()) {
        $x -> round(@r);
    } else {

        # To correctly handle the special case $x -> bsub($x), we note the sign
        # of $x, then flip the sign of $y, and if the sign of $x changed too,
        # then we know that $x and $y are the same object.

        my $xsign = $x -> {sign};
        $y -> {sign} =~ tr/+-/-+/;      # does nothing for NaN
        if ($xsign ne $x -> {sign}) {
            # special case of $x -> bsub($x) results in 0
            if ($xsign =~ /^[+-]$/) {
                $x -> bzero(@r);
            } else {
                $x -> bnan();           # NaN, -inf, +inf
            }
            return $downgrade->new($x, @r) if defined $downgrade;
            return $x;
        }
        $x = $x -> badd($y, @r);        # badd does not leave internal zeros
        $y -> {sign} =~ tr/+-/-+/;      # reset $y (does nothing for NaN)
    }
    return $downgrade->new($x, @r)
      if defined($downgrade) && ($x->is_int() || $x->is_inf() || $x->is_nan());
    $x;                         # already rounded by badd() or no rounding
}

sub bmul {
    # multiply two numbers

    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

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

    return $x->bnan() if (($x->{sign} eq $nan) || ($y->{sign} eq $nan));

    # inf handling
    if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
        return $x->bnan() if $x->is_zero() || $y->is_zero();
        # result will always be +-inf:
        # +inf * +/+inf => +inf, -inf * -/-inf => +inf
        # +inf * -/-inf => -inf, -inf * +/+inf => -inf
        return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
        return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
        return $x->binf('-');
    }

    return $upgrade->bmul($x, $y, @r) if defined $upgrade &&
      ((!$x->isa($class)) || (!$y->isa($class)));

    # aEb * cEd = (a*c)E(b+d)
    $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m});
    ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
    #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});

    $r[3] = $y;                 # no push!

    # adjust sign:
    $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';
    $x->bnorm->round(@r);
}

sub bmuladd {
    # multiply two numbers and add the third to the result

    # set up parameters
    my ($class, $x, $y, $z, @r) = objectify(3, @_);

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

    return $x->bnan() if (($x->{sign} eq $nan) ||
                          ($y->{sign} eq $nan) ||
                          ($z->{sign} eq $nan));

    # inf handling
    if (($x->{sign} =~ /^[+-]inf$/) || ($y->{sign} =~ /^[+-]inf$/)) {
        return $x->bnan() if $x->is_zero() || $y->is_zero();
        # result will always be +-inf:
        # +inf * +/+inf => +inf, -inf * -/-inf => +inf
        # +inf * -/-inf => -inf, -inf * +/+inf => -inf
        return $x->binf() if ($x->{sign} =~ /^\+/ && $y->{sign} =~ /^\+/);
        return $x->binf() if ($x->{sign} =~ /^-/ && $y->{sign} =~ /^-/);
        return $x->binf('-');
    }

    return $upgrade->bmul($x, $y, @r) if defined $upgrade &&
      ((!$x->isa($class)) || (!$y->isa($class)));

    # aEb * cEd = (a*c)E(b+d)
    $x->{_m} = $LIB->_mul($x->{_m}, $y->{_m});
    ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
    #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});

    $r[3] = $y;                 # no push!

    # adjust sign:
    $x->{sign} = $x->{sign} ne $y->{sign} ? '-' : '+';

    # z=inf handling (z=NaN handled above)
    if ($z->{sign} =~ /^[+-]inf$/) {
        $x->{sign} = $z->{sign};
        return $downgrade->new($x) if defined $downgrade;
        return $x;
    }

    # take lower of the two e's and adapt m1 to it to match m2
    my $e = $z->{_e};
    $e = $LIB->_zero() if !defined $e; # if no BFLOAT?
    $e = $LIB->_copy($e);              # make copy (didn't do it yet)

    my $es;

    ($e, $es) = _e_sub($e, $x->{_e}, $z->{_es} || '+', $x->{_es});
    #($e, $es) = $LIB -> _ssub($e, $z->{_es} || '+', $x->{_e}, $x->{_es});

    my $add = $LIB->_copy($z->{_m});

    if ($es eq '-')             # < 0
    {
        $x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
        ($x->{_e}, $x->{_es}) = _e_add($x->{_e}, $e, $x->{_es}, $es);
        #$x->{_m} = $LIB->_lsft($x->{_m}, $e, 10);
        #($x->{_e}, $x->{_es}) = $LIB -> _sadd($x->{_e}, $x->{_es}, $e, $es);
    } elsif (!$LIB->_is_zero($e)) # > 0
    {
        $add = $LIB->_lsft($add, $e, 10);
    }
    # else: both e are the same, so just leave them

    if ($x->{sign} eq $z->{sign}) {
        # add
        $x->{_m} = $LIB->_add($x->{_m}, $add);
    } else {
        ($x->{_m}, $x->{sign}) =
          _e_add($x->{_m}, $add, $x->{sign}, $z->{sign});
        #($x->{_m}, $x->{sign}) =
        #  $LIB -> _sadd($x->{_m}, $x->{sign}, $add, $z->{sign});
    }

    # delete trailing zeros, then round
    $x->bnorm()->round(@r);
}

sub bdiv {
    # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return
    # (BFLOAT, BFLOAT) (quo, rem) or BFLOAT (only quo)

    # set up parameters
    my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $a, $p, $r) = objectify(2, @_);
    }

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

    my $wantarray = wantarray;  # call only once

    # At least one argument is NaN. This is handled the same way as in
    # Math::BigInt -> bdiv().

    if ($x -> is_nan() || $y -> is_nan()) {
        return $wantarray ? ($x -> bnan(), $class -> bnan()) : $x -> bnan();
    }

    # Divide by zero and modulo zero. This is handled the same way as in
    # Math::BigInt -> bdiv(). See the comment in the code for Math::BigInt ->
    # bdiv() for further details.

    if ($y -> is_zero()) {
        my ($quo, $rem);
        if ($wantarray) {
            $rem = $x -> copy();
        }
        if ($x -> is_zero()) {
            $quo = $x -> bnan();
        } else {
            $quo = $x -> binf($x -> {sign});
        }
        return $wantarray ? ($quo, $rem) : $quo;
    }

    # Numerator (dividend) is +/-inf. This is handled the same way as in
    # Math::BigInt -> bdiv(). See the comment in the code for Math::BigInt ->
    # bdiv() for further details.

    if ($x -> is_inf()) {
        my ($quo, $rem);
        $rem = $class -> bnan() if $wantarray;
        if ($y -> is_inf()) {
            $quo = $x -> bnan();
        } else {
            my $sign = $x -> bcmp(0) == $y -> bcmp(0) ? '+' : '-';
            $quo = $x -> binf($sign);
        }
        return $wantarray ? ($quo, $rem) : $quo;
    }

    # Denominator (divisor) is +/-inf. This is handled the same way as in
    # Math::BigInt -> bdiv(), with one exception: In scalar context,
    # Math::BigFloat does true division (although rounded), not floored division
    # (F-division), so a finite number divided by +/-inf is always zero. See the
    # comment in the code for Math::BigInt -> bdiv() for further details.

    if ($y -> is_inf()) {
        my ($quo, $rem);
        if ($wantarray) {
            if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
                $rem = $x -> copy();
                $quo = $x -> bzero();
            } else {
                $rem = $class -> binf($y -> {sign});
                $quo = $x -> bone('-');
            }
            return ($quo, $rem);
        } else {
            if ($y -> is_inf()) {
                if ($x -> is_nan() || $x -> is_inf()) {
                    return $x -> bnan();
                } else {
                    return $x -> bzero();
                }
            }
        }
    }

    # At this point, both the numerator and denominator are finite numbers, and
    # the denominator (divisor) is non-zero.

    # x == 0?
    return wantarray ? ($x, $class->bzero()) : $x if $x->is_zero();

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my (@params, $scale);
    ($x, @params) = $x->_find_round_parameters($a, $p, $r, $y);

    return $x if $x->is_nan();  # error in _find_round_parameters?

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r;                  # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it is not
        # enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    my $rem;
    $rem = $class -> bzero() if wantarray;

    $y = $class->new($y) unless $y->isa('Math::BigFloat');

    my $lx = $LIB -> _len($x->{_m}); my $ly = $LIB -> _len($y->{_m});
    $scale = $lx if $lx > $scale;
    $scale = $ly if $ly > $scale;
    my $diff = $ly - $lx;
    $scale += $diff if $diff > 0; # if lx << ly, but not if ly << lx!

    # check that $y is not 1 nor -1 and cache the result:
    my $y_not_one = !($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m}));

    # flipping the sign of $y will also flip the sign of $x for the special
    # case of $x->bsub($x); so we can catch it below:
    my $xsign = $x->{sign};
    $y->{sign} =~ tr/+-/-+/;

    if ($xsign ne $x->{sign}) {
        # special case of $x /= $x results in 1
        $x->bone();             # "fixes" also sign of $y, since $x is $y
    } else {
        # correct $y's sign again
        $y->{sign} =~ tr/+-/-+/;
        # continue with normal div code:

        # make copy of $x in case of list context for later remainder calculation
        if (wantarray && $y_not_one) {
            $rem = $x->copy();
        }

        $x->{sign} = $x->{sign} ne $y->sign() ? '-' : '+';

        # check for / +-1 (+/- 1E0)
        if ($y_not_one) {
            # promote BigInts and it's subclasses (except when already a Math::BigFloat)
            $y = $class->new($y) unless $y->isa('Math::BigFloat');

            # calculate the result to $scale digits and then round it
            # a * 10 ** b / c * 10 ** d => a/c * 10 ** (b-d)
            $x->{_m} = $LIB->_lsft($x->{_m}, $LIB->_new($scale), 10);
            $x->{_m} = $LIB->_div($x->{_m}, $y->{_m}); # a/c

            # correct exponent of $x
            ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $y->{_e}, $x->{_es}, $y->{_es});
            #($x->{_e}, $x->{_es})
            #  = $LIB -> _ssub($x->{_e}, $x->{_es}, $y->{_e}, $y->{_es});
            # correct for 10**scale
            ($x->{_e}, $x->{_es}) = _e_sub($x->{_e}, $LIB->_new($scale), $x->{_es}, '+');
            #($x->{_e}, $x->{_es})
            #  = $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($scale), '+');
            $x->bnorm();        # remove trailing 0's
        }
    }                           # end else $x != $y

    # shortcut to not run through _find_round_parameters again
    if (defined $params[0]) {
        delete $x->{_a};               # clear before round
        $x->bround($params[0], $params[2]); # then round accordingly
    } else {
        delete $x->{_p};                # clear before round
        $x->bfround($params[1], $params[2]); # then round accordingly
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a}; delete $x->{_p};
    }

    if (wantarray) {
        if ($y_not_one) {
            $x -> bfloor();
            $rem->bmod($y, @params); # copy already done
        }
        if ($fallback) {
            # clear a/p after round, since user did not request it
            delete $rem->{_a}; delete $rem->{_p};
        }
        $x = $downgrade -> new($x)
          if defined($downgrade) && $x -> is_int();
        $rem = $downgrade -> new($rem)
          if defined($downgrade) && $rem -> is_int();
        return ($x, $rem);
    }

    $x = $downgrade -> new($x) if defined($downgrade) && $x -> is_int();
    $x;
}

sub bmod {
    # (dividend: BFLOAT or num_str, divisor: BFLOAT or num_str) return remainder

    # set up parameters
    my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $a, $p, $r) = objectify(2, @_);
    }

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

    # At least one argument is NaN. This is handled the same way as in
    # Math::BigInt -> bmod().

    if ($x -> is_nan() || $y -> is_nan()) {
        return $x -> bnan();
    }

    # Modulo zero. This is handled the same way as in Math::BigInt -> bmod().

    if ($y -> is_zero()) {
        return $x;
    }

    # Numerator (dividend) is +/-inf. This is handled the same way as in
    # Math::BigInt -> bmod().

    if ($x -> is_inf()) {
        return $x -> bnan();
    }

    # Denominator (divisor) is +/-inf. This is handled the same way as in
    # Math::BigInt -> bmod().

    if ($y -> is_inf()) {
        if ($x -> is_zero() || $x -> bcmp(0) == $y -> bcmp(0)) {
            return $x;
        } else {
            return $x -> binf($y -> sign());
        }
    }

    return $x->bzero() if $x->is_zero()
      || ($x->is_int() &&
          # check that $y == +1 or $y == -1:
          ($LIB->_is_zero($y->{_e}) && $LIB->_is_one($y->{_m})));

    my $cmp = $x->bacmp($y);    # equal or $x < $y?
    if ($cmp == 0) {            # $x == $y => result 0
        return $x -> bzero($a, $p);
    }

    # only $y of the operands negative?
    my $neg = $x->{sign} ne $y->{sign} ? 1 : 0;

    $x->{sign} = $y->{sign};     # calc sign first
    if ($cmp < 0 && $neg == 0) { # $x < $y => result $x
        return $x -> round($a, $p, $r);
    }

    my $ym = $LIB->_copy($y->{_m});

    # 2e1 => 20
    $ym = $LIB->_lsft($ym, $y->{_e}, 10)
      if $y->{_es} eq '+' && !$LIB->_is_zero($y->{_e});

    # if $y has digits after dot
    my $shifty = 0;             # correct _e of $x by this
    if ($y->{_es} eq '-')       # has digits after dot
    {
        # 123 % 2.5 => 1230 % 25 => 5 => 0.5
        $shifty = $LIB->_num($y->{_e});  # no more digits after dot
        $x->{_m} = $LIB->_lsft($x->{_m}, $y->{_e}, 10); # 123 => 1230, $y->{_m} is already 25
    }
    # $ym is now mantissa of $y based on exponent 0

    my $shiftx = 0;             # correct _e of $x by this
    if ($x->{_es} eq '-')       # has digits after dot
    {
        # 123.4 % 20 => 1234 % 200
        $shiftx = $LIB->_num($x->{_e}); # no more digits after dot
        $ym = $LIB->_lsft($ym, $x->{_e}, 10); # 123 => 1230
    }
    # 123e1 % 20 => 1230 % 20
    if ($x->{_es} eq '+' && !$LIB->_is_zero($x->{_e})) {
        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # es => '+' here
    }

    $x->{_e} = $LIB->_new($shiftx);
    $x->{_es} = '+';
    $x->{_es} = '-' if $shiftx != 0 || $shifty != 0;
    $x->{_e} = $LIB->_add($x->{_e}, $LIB->_new($shifty)) if $shifty != 0;

    # now mantissas are equalized, exponent of $x is adjusted, so calc result

    $x->{_m} = $LIB->_mod($x->{_m}, $ym);

    $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0
    $x->bnorm();

    if ($neg != 0 && ! $x -> is_zero()) # one of them negative => correct in place
    {
        my $r = $y - $x;
        $x->{_m} = $r->{_m};
        $x->{_e} = $r->{_e};
        $x->{_es} = $r->{_es};
        $x->{sign} = '+' if $LIB->_is_zero($x->{_m}); # fix sign for -0
        $x->bnorm();
    }

    $x->round($a, $p, $r, $y);     # round and return
}

sub bmodpow {
    # takes a very large number to a very large exponent in a given very
    # large modulus, quickly, thanks to binary exponentiation. Supports
    # negative exponents.
    my ($class, $num, $exp, $mod) = objectify(3, @_);

    return $num if $num->modify('bmodpow');

    # check modulus for valid values
    return $num->bnan() if ($mod->{sign} ne '+' # NaN, -, -inf, +inf
                            || $mod->is_zero());

    # check exponent for valid values
    if ($exp->{sign} =~ /\w/) {
        # i.e., if it's NaN, +inf, or -inf...
        return $num->bnan();
    }

    $num->bmodinv ($mod) if ($exp->{sign} eq '-');

    # check num for valid values (also NaN if there was no inverse but $exp < 0)
    return $num->bnan() if $num->{sign} !~ /^[+-]$/;

    # $mod is positive, sign on $exp is ignored, result also positive

    # XXX TODO: speed it up when all three numbers are integers
    $num->bpow($exp)->bmod($mod);
}

sub bpow {
    # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
    # compute power of two numbers, second arg is used as integer
    # modifies first argument

    # set up parameters
    my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $a, $p, $r) = objectify(2, @_);
    }

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

    # $x and/or $y is a NaN
    return $x -> bnan() if $x -> is_nan() || $y -> is_nan();

    # $x and/or $y is a +/-Inf
    if ($x -> is_inf("-")) {
        return $x -> bzero()   if $y -> is_negative();
        return $x -> bnan()    if $y -> is_zero();
        return $x            if $y -> is_odd();
        return $x -> bneg();
    } elsif ($x -> is_inf("+")) {
        return $x -> bzero()   if $y -> is_negative();
        return $x -> bnan()    if $y -> is_zero();
        return $x;
    } elsif ($y -> is_inf("-")) {
        return $x -> bnan()    if $x -> is_one("-");
        return $x -> binf("+") if $x > -1 && $x < 1;
        return $x -> bone()    if $x -> is_one("+");
        return $x -> bzero();
    } elsif ($y -> is_inf("+")) {
        return $x -> bnan()    if $x -> is_one("-");
        return $x -> bzero()   if $x > -1 && $x < 1;
        return $x -> bone()    if $x -> is_one("+");
        return $x -> binf("+");
    }

    if ($x -> is_zero()) {
        return $x -> bone() if $y -> is_zero();
        return $x -> binf() if $y -> is_negative();
        return $x;
    }

    # We don't support complex numbers, so upgrade or return NaN.

    if ($x -> is_negative() && !$y -> is_int()) {
        return $upgrade -> bpow($upgrade -> new($x), $y, $a, $p, $r)
          if defined $upgrade;
        return $x -> bnan();
    }

    if ($x -> is_one("+") || $y -> is_one()) {
        return $x;
    }

    if ($x -> is_one("-")) {
        return $x if $y -> is_odd();
        return $x -> bneg();
    }

    return $x -> _pow($y, $a, $p, $r) if !$y -> is_int();

    my $y1 = $y -> as_int()->{value}; # make MBI part

    my $new_sign = '+';
    $new_sign = $LIB -> _is_odd($y1) ? '-' : '+' if $x->{sign} ne '+';

    # calculate $x->{_m} ** $y and $x->{_e} * $y separately (faster)
    $x->{_m} = $LIB -> _pow($x->{_m}, $y1);
    $x->{_e} = $LIB -> _mul($x->{_e}, $y1);

    $x->{sign} = $new_sign;
    $x -> bnorm();

    # x ** (-y) = 1 / (x ** y)

    if ($y->{sign} eq '-') {
        # modify $x in place!
        my $z = $x -> copy();
        $x -> bone();
        # round in one go (might ignore y's A!)
        return scalar $x -> bdiv($z, $a, $p, $r);
    }

    $x -> round($a, $p, $r, $y);
}

sub blog {
    # Return the logarithm of the operand. If a second operand is defined, that
    # value is used as the base, otherwise the base is assumed to be Euler's
    # constant.

    my ($class, $x, $base, $a, $p, $r);

    # Don't objectify the base, since an undefined base, as in $x->blog() or
    # $x->blog(undef) signals that the base is Euler's number.

    if (!ref($_[0]) && $_[0] =~ /^[A-Za-z]|::/) {
        # E.g., Math::BigFloat->blog(256, 2)
        ($class, $x, $base, $a, $p, $r) =
          defined $_[2] ? objectify(2, @_) : objectify(1, @_);
    } else {
        # E.g., Math::BigFloat::blog(256, 2) or $x->blog(2)
        ($class, $x, $base, $a, $p, $r) =
          defined $_[1] ? objectify(2, @_) : objectify(1, @_);
    }

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

    return $x -> bnan() if $x -> is_nan();

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my ($scale, @params);
    ($x, @params) = $x->_find_round_parameters($a, $p, $r);

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $params[1] = undef;               # P = undef
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r;                  # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it is not
        # enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    my $done = 0;
    if (defined $base) {
        $base = $class -> new($base) unless ref $base;
        if ($base -> is_nan() || $base -> is_one()) {
            $x -> bnan();
            $done = 1;
        } elsif ($base -> is_inf() || $base -> is_zero()) {
            if ($x -> is_inf() || $x -> is_zero()) {
                $x -> bnan();
            } else {
                $x -> bzero(@params);
            }
            $done = 1;
        } elsif ($base -> is_negative()) { # -inf < base < 0
            if ($x -> is_one()) {          #     x = 1
                $x -> bzero(@params);
            } elsif ($x == $base) {
                $x -> bone('+', @params); #     x = base
            } else {
                $x -> bnan();   #     otherwise
            }
            $done = 1;
        } elsif ($x == $base) {
            $x -> bone('+', @params); # 0 < base && 0 < x < inf
            $done = 1;
        }
    }

    # We now know that the base is either undefined or positive and finite.

    unless ($done) {
        if ($x -> is_inf()) {   #   x = +/-inf
            my $sign = defined $base && $base < 1 ? '-' : '+';
            $x -> binf($sign);
            $done = 1;
        } elsif ($x -> is_neg()) { #   -inf < x < 0
            $x -> bnan();
            $done = 1;
        } elsif ($x -> is_one()) { #   x = 1
            $x -> bzero(@params);
            $done = 1;
        } elsif ($x -> is_zero()) { #   x = 0
            my $sign = defined $base && $base < 1 ? '+' : '-';
            $x -> binf($sign);
            $done = 1;
        }
    }

    if ($done) {
        if ($fallback) {
            # clear a/p after round, since user did not request it
            delete $x->{_a};
            delete $x->{_p};
        }
        return $x;
    }

    # when user set globals, they would interfere with our calculation, so
    # disable them and later re-enable them
    no strict 'refs';
    my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
    # we also need to disable any set A or P on $x (_find_round_parameters took
    # them already into account), since these would interfere, too
    delete $x->{_a}; delete $x->{_p};
    # need to disable $upgrade in BigInt, to avoid deep recursion
    local $Math::BigInt::upgrade = undef;
    local $Math::BigFloat::downgrade = undef;

    # upgrade $x if $x is not a Math::BigFloat (handle BigInt input)
    # XXX TODO: rebless!
    if (!$x->isa('Math::BigFloat')) {
        $x = Math::BigFloat->new($x);
        $class = ref($x);
    }

    $done = 0;

    # If the base is defined and an integer, try to calculate integer result
    # first. This is very fast, and in case the real result was found, we can
    # stop right here.
    if (defined $base && $base->is_int() && $x->is_int()) {
        my $xint = Math::BigInt -> new($x    -> bdstr());
        my $bint = Math::BigInt -> new($base -> bdstr());
        $xint->blog($bint);

        # if we found the exact result, we're done
        if ($bint -> bpow($xint) == $x) {
            my $xflt = Math::BigFloat -> new($xint -> bdstr());
            $x->{sign} = $xflt->{sign};
            $x->{_m}   = $xflt->{_m};
            $x->{_es}  = $xflt->{_es};
            $x->{_e}   = $xflt->{_e};
            $done = 1;
        }
    }

    if ($done == 0) {
        # First calculate the log to base e (using reduction by 10 and possibly
        # also by 2):
        $x->_log_10($scale);

        # and if a different base was requested, convert it
        if (defined $base) {
            $base = Math::BigFloat->new($base)
              unless $base->isa('Math::BigFloat');
            # log_b(x) = ln(x) / ln(b), so compute ln(b)
            my $base_log_e = $base->copy()->_log_10($scale);
            $x->bdiv($base_log_e, $scale);
        }
    }

    # shortcut to not run through _find_round_parameters again
    if (defined $params[0]) {
        $x->bround($params[0], $params[2]); # then round accordingly
    } else {
        $x->bfround($params[1], $params[2]); # then round accordingly
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a};
        delete $x->{_p};
    }
    # restore globals
    $$abr = $ab;
    $$pbr = $pb;

    $x;
}

sub bexp {
    # Calculate e ** X (Euler's number to the power of X)
    my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    return $x->binf() if $x->{sign} eq '+inf';
    return $x->bzero() if $x->{sign} eq '-inf';

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my ($scale, @params);
    ($x, @params) = $x->_find_round_parameters($a, $p, $r);

    # also takes care of the "error in _find_round_parameters?" case
    return $x if $x->{sign} eq 'NaN';

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $params[1] = undef;               # P = undef
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r;                  # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it's not
        # enough ...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    return $x->bone(@params) if $x->is_zero();

    if (!$x->isa('Math::BigFloat')) {
        $x = Math::BigFloat->new($x);
        $class = ref($x);
    }

    # when user set globals, they would interfere with our calculation, so
    # disable them and later re-enable them
    no strict 'refs';
    my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
    # we also need to disable any set A or P on $x (_find_round_parameters took
    # them already into account), since these would interfere, too
    delete $x->{_a};
    delete $x->{_p};
    # need to disable $upgrade in BigInt, to avoid deep recursion
    local $Math::BigInt::upgrade = undef;
    local $Math::BigFloat::downgrade = undef;

    my $x_org = $x->copy();

    # We use the following Taylor series:

    #           x    x^2   x^3   x^4
    #  e = 1 + --- + --- + --- + --- ...
    #           1!    2!    3!    4!

    # The difference for each term is X and N, which would result in:
    # 2 copy, 2 mul, 2 add, 1 inc, 1 div operations per term

    # But it is faster to compute exp(1) and then raising it to the
    # given power, esp. if $x is really big and an integer because:

    #  * The numerator is always 1, making the computation faster
    #  * the series converges faster in the case of x == 1
    #  * We can also easily check when we have reached our limit: when the
    #    term to be added is smaller than "1E$scale", we can stop - f.i.
    #    scale == 5, and we have 1/40320, then we stop since 1/40320 < 1E-5.
    #  * we can compute the *exact* result by simulating bigrat math:

    #  1   1    gcd(3, 4) = 1    1*24 + 1*6    5
    #  - + -                  = ---------- =  --
    #  6   24                      6*24       24

    # We do not compute the gcd() here, but simple do:
    #  1   1    1*24 + 1*6   30
    #  - + -  = --------- =  --
    #  6   24       6*24     144

    # In general:
    #  a   c    a*d + c*b         and note that c is always 1 and d = (b*f)
    #  - + -  = ---------
    #  b   d       b*d

    # This leads to:         which can be reduced by b to:
    #  a   1     a*b*f + b    a*f + 1
    #  - + -   = --------- =  -------
    #  b   b*f     b*b*f        b*f

    # The first terms in the series are:

    # 1     1    1    1    1    1     1     1     13700
    # -- + -- + -- + -- + -- + --- + --- + ---- = -----
    # 1     1    2    6   24   120   720   5040   5040

    # Note that we cannot simply reduce 13700/5040 to 685/252, but must keep
    # the numerator and the denominator!

    if ($scale <= 75) {
        # set $x directly from a cached string form
        $x->{_m} = $LIB->_new("2718281828459045235360287471352662497757" .
                              "2470936999595749669676277240766303535476");
        $x->{sign} = '+';
        $x->{_es} = '-';
        $x->{_e} = $LIB->_new(79);
    } else {
        # compute A and B so that e = A / B.

        # After some terms we end up with this, so we use it as a starting point:
        my $A = $LIB->_new("9093339520860578540197197" .
                           "0164779391644753259799242");
        my $F = $LIB->_new(42);
        my $step = 42;

        # Compute how many steps we need to take to get $A and $B sufficiently big
        my $steps = _len_to_steps($scale - 4);
        #    print STDERR "# Doing $steps steps for ", $scale-4, " digits\n";
        while ($step++ <= $steps) {
            # calculate $a * $f + 1
            $A = $LIB->_mul($A, $F);
            $A = $LIB->_inc($A);
            # increment f
            $F = $LIB->_inc($F);
        }
        # compute $B as factorial of $steps (this is faster than doing it manually)
        my $B = $LIB->_fac($LIB->_new($steps));

        #  print "A ", $LIB->_str($A), "\nB ", $LIB->_str($B), "\n";

        # compute A/B with $scale digits in the result (truncate, not round)
        $A = $LIB->_lsft($A, $LIB->_new($scale), 10);
        $A = $LIB->_div($A, $B);

        $x->{_m} = $A;
        $x->{sign} = '+';
        $x->{_es} = '-';
        $x->{_e} = $LIB->_new($scale);
    }

    # $x contains now an estimate of e, with some surplus digits, so we can round
    if (!$x_org->is_one()) {
        # Reduce size of fractional part, followup with integer power of two.
        my $lshift = 0;
        while ($lshift < 30 && $x_org->bacmp(2 << $lshift) > 0) {
            $lshift++;
        }
        # Raise $x to the wanted power and round it.
        if ($lshift == 0) {
            $x->bpow($x_org, @params);
        } else {
            my($mul, $rescale) = (1 << $lshift, $scale+1+$lshift);
            $x->bpow(scalar $x_org->bdiv($mul, $rescale), $rescale)->bpow($mul, @params);
        }
    } else {
        # else just round the already computed result
        delete $x->{_a};
        delete $x->{_p};
        # shortcut to not run through _find_round_parameters again
        if (defined $params[0]) {
            $x->bround($params[0], $params[2]); # then round accordingly
        } else {
            $x->bfround($params[1], $params[2]); # then round accordingly
        }
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a};
        delete $x->{_p};
    }
    # restore globals
    $$abr = $ab;
    $$pbr = $pb;

    $x;                         # return modified $x
}

sub bnok {
    # Calculate n over k (binomial coefficient or "choose" function) as integer.
    # set up parameters
    my ($class, $x, $y, @r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, @r) = objectify(2, @_);
    }

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

    return $x->bnan() if $x->is_nan() || $y->is_nan();
    return $x->bnan() if (($x->is_finite() && !$x->is_int()) ||
                          ($y->is_finite() && !$y->is_int()));

    my $xint = Math::BigInt -> new($x -> bsstr());
    my $yint = Math::BigInt -> new($y -> bsstr());
    $xint -> bnok($yint);
    my $xflt = Math::BigFloat -> new($xint);

    $x->{_m}   = $xflt->{_m};
    $x->{_e}   = $xflt->{_e};
    $x->{_es}  = $xflt->{_es};
    $x->{sign} = $xflt->{sign};

    return $x;
}

sub bsin {
    # Calculate a sinus of x.
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    # taylor:      x^3   x^5   x^7   x^9
    #    sin = x - --- + --- - --- + --- ...
    #               3!    5!    7!    9!

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my ($scale, @params);
    ($x, @params) = $x->_find_round_parameters(@r);

    #         constant object       or error in _find_round_parameters?
    return $x if $x->modify('bsin') || $x->is_nan();
    return $x->bnan()    if $x->is_inf();
    return $x->bzero(@r) if $x->is_zero();

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $params[1] = undef;               # disable P
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r[2];               # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it is not
        # enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    # when user set globals, they would interfere with our calculation, so
    # disable them and later re-enable them
    no strict 'refs';
    my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
    # we also need to disable any set A or P on $x (_find_round_parameters took
    # them already into account), since these would interfere, too
    delete $x->{_a};
    delete $x->{_p};
    # need to disable $upgrade in BigInt, to avoid deep recursion
    local $Math::BigInt::upgrade = undef;

    my $over = $x * $x;         # X ^ 2
    my $x2 = $over->copy();     # X ^ 2; difference between terms
    $over->bmul($x);            # X ^ 3 as starting value
    my $sign = 1;               # start with -=
    my $below = $class->new(6); my $factorial = $class->new(4);
    delete $x->{_a};
    delete $x->{_p};

    my $limit = $class->new("1E-". ($scale-1));
    #my $steps = 0;
    while (3 < 5) {
        # we calculate the next term, and add it to the last
        # when the next term is below our limit, it won't affect the outcome
        # anymore, so we stop:
        my $next = $over->copy()->bdiv($below, $scale);
        last if $next->bacmp($limit) <= 0;

        if ($sign == 0) {
            $x->badd($next);
        } else {
            $x->bsub($next);
        }
        $sign = 1-$sign;        # alternate
        # calculate things for the next term
        $over->bmul($x2);                         # $x*$x
        $below->bmul($factorial); $factorial->binc(); # n*(n+1)
        $below->bmul($factorial); $factorial->binc(); # n*(n+1)
    }

    # shortcut to not run through _find_round_parameters again
    if (defined $params[0]) {
        $x->bround($params[0], $params[2]); # then round accordingly
    } else {
        $x->bfround($params[1], $params[2]); # then round accordingly
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a};
        delete $x->{_p};
    }
    # restore globals
    $$abr = $ab;
    $$pbr = $pb;
    $x;
}

sub bcos {
    # Calculate a cosinus of x.
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

    # Taylor:      x^2   x^4   x^6   x^8
    #    cos = 1 - --- + --- - --- + --- ...
    #               2!    4!    6!    8!

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my ($scale, @params);
    ($x, @params) = $x->_find_round_parameters(@r);

    #         constant object       or error in _find_round_parameters?
    return $x if $x->modify('bcos') || $x->is_nan();
    return $x->bnan()   if $x->is_inf();
    return $x->bone(@r) if $x->is_zero();

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $params[1] = undef;               # disable P
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r[2];               # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it is not
        # enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    # when user set globals, they would interfere with our calculation, so
    # disable them and later re-enable them
    no strict 'refs';
    my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
    # we also need to disable any set A or P on $x (_find_round_parameters took
    # them already into account), since these would interfere, too
    delete $x->{_a}; delete $x->{_p};
    # need to disable $upgrade in BigInt, to avoid deep recursion
    local $Math::BigInt::upgrade = undef;

    my $over = $x * $x;         # X ^ 2
    my $x2 = $over->copy();     # X ^ 2; difference between terms
    my $sign = 1;               # start with -=
    my $below = $class->new(2);
    my $factorial = $class->new(3);
    $x->bone();
    delete $x->{_a};
    delete $x->{_p};

    my $limit = $class->new("1E-". ($scale-1));
    #my $steps = 0;
    while (3 < 5) {
        # we calculate the next term, and add it to the last
        # when the next term is below our limit, it won't affect the outcome
        # anymore, so we stop:
        my $next = $over->copy()->bdiv($below, $scale);
        last if $next->bacmp($limit) <= 0;

        if ($sign == 0) {
            $x->badd($next);
        } else {
            $x->bsub($next);
        }
        $sign = 1-$sign;        # alternate
        # calculate things for the next term
        $over->bmul($x2);                         # $x*$x
        $below->bmul($factorial); $factorial->binc(); # n*(n+1)
        $below->bmul($factorial); $factorial->binc(); # n*(n+1)
    }

    # shortcut to not run through _find_round_parameters again
    if (defined $params[0]) {
        $x->bround($params[0], $params[2]); # then round accordingly
    } else {
        $x->bfround($params[1], $params[2]); # then round accordingly
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a};
        delete $x->{_p};
    }
    # restore globals
    $$abr = $ab;
    $$pbr = $pb;
    $x;
}

sub batan {
    # Calculate a arcus tangens of x.

    my $self    = shift;
    my $selfref = ref $self;
    my $class   = $selfref || $self;

    my (@r) = @_;

    # taylor:       x^3   x^5   x^7   x^9
    #    atan = x - --- + --- - --- + --- ...
    #                3     5     7     9

    # We need to limit the accuracy to protect against overflow.

    my $fallback = 0;
    my ($scale, @params);
    ($self, @params) = $self->_find_round_parameters(@r);

    # Constant object or error in _find_round_parameters?

    return $self if $self->modify('batan') || $self->is_nan();

    if ($self->{sign} =~ /^[+-]inf\z/) {
        # +inf result is PI/2
        # -inf result is -PI/2
        # calculate PI/2
        my $pi = $class->bpi(@r);
        # modify $self in place
        $self->{_m} = $pi->{_m};
        $self->{_e} = $pi->{_e};
        $self->{_es} = $pi->{_es};
        # -y => -PI/2, +y => PI/2
        $self->{sign} = substr($self->{sign}, 0, 1); # "+inf" => "+"
        $self -> {_m} = $LIB->_div($self->{_m}, $LIB->_new(2));
        return $self;
    }

    return $self->bzero(@r) if $self->is_zero();

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $params[1] = undef;               # disable P
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r[2];               # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it is not
        # enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    # 1 or -1 => PI/4
    # inlined is_one() && is_one('-')
    if ($LIB->_is_one($self->{_m}) && $LIB->_is_zero($self->{_e})) {
        my $pi = $class->bpi($scale - 3);
        # modify $self in place
        $self->{_m} = $pi->{_m};
        $self->{_e} = $pi->{_e};
        $self->{_es} = $pi->{_es};
        # leave the sign of $self alone (+1 => +PI/4, -1 => -PI/4)
        $self->{_m} = $LIB->_div($self->{_m}, $LIB->_new(4));
        return $self;
    }

    # This series is only valid if -1 < x < 1, so for other x we need to
    # calculate PI/2 - atan(1/x):
    my $pi = undef;
    if ($self->bacmp($self->copy()->bone) >= 0) {
        # calculate PI/2
        $pi = $class->bpi($scale - 3);
        $pi->{_m} = $LIB->_div($pi->{_m}, $LIB->_new(2));
        # calculate 1/$self:
        my $self_copy = $self->copy();
        # modify $self in place
        $self->bone();
        $self->bdiv($self_copy, $scale);
    }

    my $fmul = 1;
    foreach (0 .. int($scale / 20)) {
        $fmul *= 2;
        $self->bdiv($self->copy()->bmul($self)->binc->bsqrt($scale + 4)->binc, $scale + 4);
    }

    # When user set globals, they would interfere with our calculation, so
    # disable them and later re-enable them.
    no strict 'refs';
    my $abr = "$class\::accuracy";  my $ab = $$abr; $$abr = undef;
    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
    # We also need to disable any set A or P on $self (_find_round_parameters
    # took them already into account), since these would interfere, too
    delete $self->{_a};
    delete $self->{_p};
    # Need to disable $upgrade in BigInt, to avoid deep recursion.
    local $Math::BigInt::upgrade = undef;

    my $over = $self * $self;   # X ^ 2
    my $self2 = $over->copy();  # X ^ 2; difference between terms
    $over->bmul($self);         # X ^ 3 as starting value
    my $sign = 1;               # start with -=
    my $below = $class->new(3);
    my $two = $class->new(2);
    delete $self->{_a};
    delete $self->{_p};

    my $limit = $class->new("1E-". ($scale-1));
    #my $steps = 0;
    while (1) {
        # We calculate the next term, and add it to the last. When the next
        # term is below our limit, it won't affect the outcome anymore, so we
        # stop:
        my $next = $over->copy()->bdiv($below, $scale);
        last if $next->bacmp($limit) <= 0;

        if ($sign == 0) {
            $self->badd($next);
        } else {
            $self->bsub($next);
        }
        $sign = 1-$sign;        # alternatex
        # calculate things for the next term
        $over->bmul($self2);    # $self*$self
        $below->badd($two);     # n += 2
    }
    $self->bmul($fmul);

    if (defined $pi) {
        my $self_copy = $self->copy();
        # modify $self in place
        $self->{_m} = $pi->{_m};
        $self->{_e} = $pi->{_e};
        $self->{_es} = $pi->{_es};
        # PI/2 - $self
        $self->bsub($self_copy);
    }

    # Shortcut to not run through _find_round_parameters again.
    if (defined $params[0]) {
        $self->bround($params[0], $params[2]); # then round accordingly
    } else {
        $self->bfround($params[1], $params[2]); # then round accordingly
    }
    if ($fallback) {
        # Clear a/p after round, since user did not request it.
        delete $self->{_a};
        delete $self->{_p};
    }

    # restore globals
    $$abr = $ab;
    $$pbr = $pb;
    $self;
}

sub batan2 {
    # $y -> batan2($x) returns the arcus tangens of $y / $x.

    # Set up parameters.
    my ($class, $y, $x, @r) = (ref($_[0]), @_);

    # Objectify is costly, so avoid it if we can.
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $y, $x, @r) = objectify(2, @_);
    }

    # Quick exit if $y is read-only.
    return $y if $y -> modify('batan2');

    # Handle all NaN cases.
    return $y -> bnan() if $x->{sign} eq $nan || $y->{sign} eq $nan;

    # We need to limit the accuracy to protect against overflow.
    my $fallback = 0;
    my ($scale, @params);
    ($y, @params) = $y -> _find_round_parameters(@r);

    # Error in _find_round_parameters?
    return $y if $y->is_nan();

    # No rounding at all, so must use fallback.
    if (scalar @params == 0) {
        # Simulate old behaviour
        $params[0] = $class -> div_scale(); # and round to it as accuracy
        $params[1] = undef;                 # disable P
        $scale = $params[0] + 4; # at least four more for proper round
        $params[2] = $r[2];      # round mode by caller or undef
        $fallback = 1;           # to clear a/p afterwards
    } else {
        # The 4 below is empirical, and there might be cases where it is not
        # enough ...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    if ($x -> is_inf("+")) {                    # x = inf
        if ($y -> is_inf("+")) {                #    y = inf
            $y -> bpi($scale) -> bmul("0.25");  #       pi/4
        } elsif ($y -> is_inf("-")) {           #    y = -inf
            $y -> bpi($scale) -> bmul("-0.25"); #       -pi/4
        } else {                                #    -inf < y < inf
            return $y -> bzero(@r);             #       0
        }
    } elsif ($x -> is_inf("-")) {               # x = -inf
        if ($y -> is_inf("+")) {                #    y = inf
            $y -> bpi($scale) -> bmul("0.75");  #       3/4 pi
        } elsif ($y -> is_inf("-")) {           #    y = -inf
            $y -> bpi($scale) -> bmul("-0.75"); #       -3/4 pi
        } elsif ($y >= 0) {                     #    y >= 0
            $y -> bpi($scale);                  #       pi
        } else {                                #    y < 0
            $y -> bpi($scale) -> bneg();        #       -pi
        }
    } elsif ($x > 0) {                               # 0 < x < inf
        if ($y -> is_inf("+")) {                     #    y = inf
            $y -> bpi($scale) -> bmul("0.5");        #       pi/2
        } elsif ($y -> is_inf("-")) {                #    y = -inf
            $y -> bpi($scale) -> bmul("-0.5");       #       -pi/2
        } else {                                     #   -inf < y < inf
            $y -> bdiv($x, $scale) -> batan($scale); #       atan(y/x)
        }
    } elsif ($x < 0) {                        # -inf < x < 0
        my $pi = $class -> bpi($scale);
        if ($y >= 0) {                        #    y >= 0
            $y -> bdiv($x, $scale) -> batan() #       atan(y/x) + pi
               -> badd($pi);
        } else {                              #    y < 0
            $y -> bdiv($x, $scale) -> batan() #       atan(y/x) - pi
               -> bsub($pi);
        }
    } else {                                   # x = 0
        if ($y > 0) {                          #    y > 0
            $y -> bpi($scale) -> bmul("0.5");  #       pi/2
        } elsif ($y < 0) {                     #    y < 0
            $y -> bpi($scale) -> bmul("-0.5"); #       -pi/2
        } else {                               #    y = 0
            return $y -> bzero(@r);            #       0
        }
    }

    $y -> round(@r);

    if ($fallback) {
        delete $y->{_a};
        delete $y->{_p};
    }

    return $y;
}
##############################################################################

sub bsqrt {
    # calculate square root
    my ($class, $x, $a, $p, $r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    return $x->bnan() if $x->{sign} !~ /^\+/;  # NaN, -inf or < 0
    return $x if $x->{sign} eq '+inf';         # sqrt(inf) == inf
    return $x->round($a, $p, $r) if $x->is_zero() || $x->is_one();

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my (@params, $scale);
    ($x, @params) = $x->_find_round_parameters($a, $p, $r);

    return $x if $x->is_nan();  # error in _find_round_parameters?

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r;                  # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it is not
        # enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    # when user set globals, they would interfere with our calculation, so
    # disable them and later re-enable them
    no strict 'refs';
    my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
    # we also need to disable any set A or P on $x (_find_round_parameters took
    # them already into account), since these would interfere, too
    delete $x->{_a};
    delete $x->{_p};
    # need to disable $upgrade in BigInt, to avoid deep recursion
    local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI

    my $i = $LIB->_copy($x->{_m});
    $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e});
    my $xas = Math::BigInt->bzero();
    $xas->{value} = $i;

    my $gs = $xas->copy()->bsqrt(); # some guess

    if (($x->{_es} ne '-')           # guess can't be accurate if there are
        # digits after the dot
        && ($xas->bacmp($gs * $gs) == 0)) # guess hit the nail on the head?
    {
        # exact result, copy result over to keep $x
        $x->{_m} = $gs->{value};
        $x->{_e} = $LIB->_zero();
        $x->{_es} = '+';
        $x->bnorm();
        # shortcut to not run through _find_round_parameters again
        if (defined $params[0]) {
            $x->bround($params[0], $params[2]); # then round accordingly
        } else {
            $x->bfround($params[1], $params[2]); # then round accordingly
        }
        if ($fallback) {
            # clear a/p after round, since user did not request it
            delete $x->{_a};
            delete $x->{_p};
        }
        # re-enable A and P, upgrade is taken care of by "local"
        ${"$class\::accuracy"} = $ab;
        ${"$class\::precision"} = $pb;
        return $x;
    }

    # sqrt(2) = 1.4 because sqrt(2*100) = 1.4*10; so we can increase the accuracy
    # of the result by multiplying the input by 100 and then divide the integer
    # result of sqrt(input) by 10. Rounding afterwards returns the real result.

    # The following steps will transform 123.456 (in $x) into 123456 (in $y1)
    my $y1 = $LIB->_copy($x->{_m});

    my $length = $LIB->_len($y1);

    # Now calculate how many digits the result of sqrt(y1) would have
    my $digits = int($length / 2);

    # But we need at least $scale digits, so calculate how many are missing
    my $shift = $scale - $digits;

    # This happens if the input had enough digits
    # (we take care of integer guesses above)
    $shift = 0 if $shift < 0;

    # Multiply in steps of 100, by shifting left two times the "missing" digits
    my $s2 = $shift * 2;

    # We now make sure that $y1 has the same odd or even number of digits than
    # $x had. So when _e of $x is odd, we must shift $y1 by one digit left,
    # because we always must multiply by steps of 100 (sqrt(100) is 10) and not
    # steps of 10. The length of $x does not count, since an even or odd number
    # of digits before the dot is not changed by adding an even number of digits
    # after the dot (the result is still odd or even digits long).
    $s2++ if $LIB->_is_odd($x->{_e});

    $y1 = $LIB->_lsft($y1, $LIB->_new($s2), 10);

    # now take the square root and truncate to integer
    $y1 = $LIB->_sqrt($y1);

    # By "shifting" $y1 right (by creating a negative _e) we calculate the final
    # result, which is than later rounded to the desired scale.

    # calculate how many zeros $x had after the '.' (or before it, depending
    # on sign of $dat, the result should have half as many:
    my $dat = $LIB->_num($x->{_e});
    $dat = -$dat if $x->{_es} eq '-';
    $dat += $length;

    if ($dat > 0) {
        # no zeros after the dot (e.g. 1.23, 0.49 etc)
        # preserve half as many digits before the dot than the input had
        # (but round this "up")
        $dat = int(($dat+1)/2);
    } else {
        $dat = int(($dat)/2);
    }
    $dat -= $LIB->_len($y1);
    if ($dat < 0) {
        $dat = abs($dat);
        $x->{_e} = $LIB->_new($dat);
        $x->{_es} = '-';
    } else {
        $x->{_e} = $LIB->_new($dat);
        $x->{_es} = '+';
    }
    $x->{_m} = $y1;
    $x->bnorm();

    # shortcut to not run through _find_round_parameters again
    if (defined $params[0]) {
        $x->bround($params[0], $params[2]); # then round accordingly
    } else {
        $x->bfround($params[1], $params[2]); # then round accordingly
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a};
        delete $x->{_p};
    }
    # restore globals
    $$abr = $ab;
    $$pbr = $pb;
    $x;
}

sub broot {
    # calculate $y'th root of $x

    # set up parameters
    my ($class, $x, $y, $a, $p, $r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $a, $p, $r) = objectify(2, @_);
    }

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

    # NaN handling: $x ** 1/0, x or y NaN, or y inf/-inf or y == 0
    return $x->bnan() if $x->{sign} !~ /^\+/ || $y->is_zero() ||
      $y->{sign} !~ /^\+$/;

    return $x if $x->is_zero() || $x->is_one() || $x->is_inf() || $y->is_one();

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my (@params, $scale);
    ($x, @params) = $x->_find_round_parameters($a, $p, $r);

    return $x if $x->is_nan();  # error in _find_round_parameters?

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r;                  # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it is not
        # enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    # when user set globals, they would interfere with our calculation, so
    # disable them and later re-enable them
    no strict 'refs';
    my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
    # we also need to disable any set A or P on $x (_find_round_parameters took
    # them already into account), since these would interfere, too
    delete $x->{_a};
    delete $x->{_p};
    # need to disable $upgrade in BigInt, to avoid deep recursion
    local $Math::BigInt::upgrade = undef; # should be really parent class vs MBI

    # remember sign and make $x positive, since -4 ** (1/2) => -2
    my $sign = 0;
    $sign = 1 if $x->{sign} eq '-';
    $x->{sign} = '+';

    my $is_two = 0;
    if ($y->isa('Math::BigFloat')) {
        $is_two = ($y->{sign} eq '+' && $LIB->_is_two($y->{_m}) && $LIB->_is_zero($y->{_e}));
    } else {
        $is_two = ($y == 2);
    }

    # normal square root if $y == 2:
    if ($is_two) {
        $x->bsqrt($scale+4);
    } elsif ($y->is_one('-')) {
        # $x ** -1 => 1/$x
        my $u = $class->bone()->bdiv($x, $scale);
        # copy private parts over
        $x->{_m} = $u->{_m};
        $x->{_e} = $u->{_e};
        $x->{_es} = $u->{_es};
    } else {
        # calculate the broot() as integer result first, and if it fits, return
        # it rightaway (but only if $x and $y are integer):

        my $done = 0;           # not yet
        if ($y->is_int() && $x->is_int()) {
            my $i = $LIB->_copy($x->{_m});
            $i = $LIB->_lsft($i, $x->{_e}, 10) unless $LIB->_is_zero($x->{_e});
            my $int = Math::BigInt->bzero();
            $int->{value} = $i;
            $int->broot($y->as_number());
            # if ($exact)
            if ($int->copy()->bpow($y) == $x) {
                # found result, return it
                $x->{_m} = $int->{value};
                $x->{_e} = $LIB->_zero();
                $x->{_es} = '+';
                $x->bnorm();
                $done = 1;
            }
        }
        if ($done == 0) {
            my $u = $class->bone()->bdiv($y, $scale+4);
            delete $u->{_a}; delete $u->{_p}; # otherwise it conflicts
            $x->bpow($u, $scale+4);            # el cheapo
        }
    }
    $x->bneg() if $sign == 1;

    # shortcut to not run through _find_round_parameters again
    if (defined $params[0]) {
        $x->bround($params[0], $params[2]); # then round accordingly
    } else {
        $x->bfround($params[1], $params[2]); # then round accordingly
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a};
        delete $x->{_p};
    }
    # restore globals
    $$abr = $ab;
    $$pbr = $pb;
    $x;
}

sub bfac {
    # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
    # compute factorial number, modifies first argument

    # set up parameters
    my ($class, $x, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    ($class, $x, @r) = objectify(1, @_) if !ref($x);

    # inf => inf
    return $x if $x->modify('bfac') || $x->{sign} eq '+inf';

    return $x->bnan()
      if (($x->{sign} ne '+') || # inf, NaN, <0 etc => NaN
          ($x->{_es} ne '+'));   # digits after dot?

    if (! $LIB->_is_zero($x->{_e})) {
        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
        $x->{_e} = $LIB->_zero();           # normalize
        $x->{_es} = '+';
    }
    $x->{_m} = $LIB->_fac($x->{_m});       # calculate factorial
    $x->bnorm()->round(@r);     # norm again and round result
}

sub bdfac {
    # compute double factorial

    # set up parameters
    my ($class, $x, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    ($class, $x, @r) = objectify(1, @_) if !ref($x);

    # inf => inf
    return $x if $x->modify('bdfac') || $x->{sign} eq '+inf';

    return $x->bnan() if ($x->is_nan() ||
                          $x->{_es} ne '+');    # digits after dot?
    return $x->bnan() if $x <= -2;
    return $x->bone() if $x <= 1;

    croak("bdfac() requires a newer version of the $LIB library.")
        unless $LIB->can('_dfac');

    if (! $LIB->_is_zero($x->{_e})) {
        $x->{_m} = $LIB->_lsft($x->{_m}, $x->{_e}, 10); # change 12e1 to 120e0
        $x->{_e} = $LIB->_zero();           # normalize
        $x->{_es} = '+';
    }
    $x->{_m} = $LIB->_dfac($x->{_m});       # calculate factorial
    $x->bnorm()->round(@r);     # norm again and round result
}

sub btfac {
    # compute triple factorial

    # set up parameters
    my ($class, $x, @r) = (ref($_[0]), @_);
    # objectify is costly, so avoid it
    ($class, $x, @r) = objectify(1, @_) if !ref($x);

    # inf => inf
    return $x if $x->modify('btfac') || $x->{sign} eq '+inf';

    return $x->bnan() if ($x->is_nan() ||
                          $x->{_es} ne '+');    # digits after dot?

    my $k = $class -> new("3");
    return $x->bnan() if $x <= -$k;

    my $one = $class -> bone();
    return $x->bone() if $x <= $one;

    my $f = $x -> copy();
    while ($f -> bsub($k) > $one) {
        $x -> bmul($f);
    }
    $x->round(@r);
}

sub bmfac {
    my ($class, $x, $k, @r) = objectify(2, @_);

    # inf => inf
    return $x if $x->modify('bmfac') || $x->{sign} eq '+inf';

    return $x->bnan() if ($x->is_nan() || $k->is_nan() ||
                          $k < 1 || $x <= -$k ||
                          $x->{_es} ne '+' || $k->{_es} ne '+');

    return $x->bnan() if $x <= -$k;

    my $one = $class -> bone();
    return $x->bone() if $x <= $one;

    my $f = $x -> copy();
    while ($f -> bsub($k) > $one) {
        $x -> bmul($f);
    }
    $x->round(@r);
}

sub blsft {
    # shift left by $y (multiply by $b ** $y)

    # set up parameters
    my ($class, $x, $y, $b, $a, $p, $r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $b, $a, $p, $r) = objectify(2, @_);
    }

    return $x if $x -> modify('blsft');
    return $x if $x -> {sign} !~ /^[+-]$/; # nan, +inf, -inf

    $b = 2 if !defined $b;
    $b = $class -> new($b) unless ref($b) && $b -> isa($class);

    return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();

    # shift by a negative amount?
    return $x -> brsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;

    $x -> bmul($b -> bpow($y), $a, $p, $r, $y);
}

sub brsft {
    # shift right by $y (divide $b ** $y)

    # set up parameters
    my ($class, $x, $y, $b, $a, $p, $r) = (ref($_[0]), @_);

    # objectify is costly, so avoid it
    if ((!ref($_[0])) || (ref($_[0]) ne ref($_[1]))) {
        ($class, $x, $y, $b, $a, $p, $r) = objectify(2, @_);
    }

    return $x if $x -> modify('brsft');
    return $x if $x -> {sign} !~ /^[+-]$/; # nan, +inf, -inf

    $b = 2 if !defined $b;
    $b = $class -> new($b) unless ref($b) && $b -> isa($class);

    return $x -> bnan() if $x -> is_nan() || $y -> is_nan() || $b -> is_nan();

    # shift by a negative amount?
    return $x -> blsft($y -> copy() -> babs(), $b) if $y -> {sign} =~ /^-/;

    # the following call to bdiv() will return either quotient (scalar context)
    # or quotient and remainder (list context).
    $x -> bdiv($b -> bpow($y), $a, $p, $r, $y);
}

###############################################################################
# Bitwise methods
###############################################################################

sub band {
    my $x     = shift;
    my $xref  = ref($x);
    my $class = $xref || $x;

    croak 'band() is an instance method, not a class method' unless $xref;
    croak 'Not enough arguments for band()' if @_ < 1;

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

    my $y = shift;
    $y = $class -> new($y) unless ref($y);

    my @r = @_;

    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
    $xtmp -> band($y);
    $xtmp = $class -> new($xtmp);                   # back to Math::BigFloat

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_m}   = $xtmp -> {_m};
    $x -> {_es}  = $xtmp -> {_es};
    $x -> {_e}   = $xtmp -> {_e};

    return $x -> round(@r);
}

sub bior {
    my $x     = shift;
    my $xref  = ref($x);
    my $class = $xref || $x;

    croak 'bior() is an instance method, not a class method' unless $xref;
    croak 'Not enough arguments for bior()' if @_ < 1;

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

    my $y = shift;
    $y = $class -> new($y) unless ref($y);

    my @r = @_;

    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
    $xtmp -> bior($y);
    $xtmp = $class -> new($xtmp);                   # back to Math::BigFloat

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_m}   = $xtmp -> {_m};
    $x -> {_es}  = $xtmp -> {_es};
    $x -> {_e}   = $xtmp -> {_e};

    return $x -> round(@r);
}

sub bxor {
    my $x     = shift;
    my $xref  = ref($x);
    my $class = $xref || $x;

    croak 'bxor() is an instance method, not a class method' unless $xref;
    croak 'Not enough arguments for bxor()' if @_ < 1;

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

    my $y = shift;
    $y = $class -> new($y) unless ref($y);

    my @r = @_;

    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
    $xtmp -> bxor($y);
    $xtmp = $class -> new($xtmp);                   # back to Math::BigFloat

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_m}   = $xtmp -> {_m};
    $x -> {_es}  = $xtmp -> {_es};
    $x -> {_e}   = $xtmp -> {_e};

    return $x -> round(@r);
}

sub bnot {
    my $x     = shift;
    my $xref  = ref($x);
    my $class = $xref || $x;

    croak 'bnot() is an instance method, not a class method' unless $xref;

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

    my @r = @_;

    my $xtmp = Math::BigInt -> new($x -> bint());   # to Math::BigInt
    $xtmp -> bnot();
    $xtmp = $class -> new($xtmp);                   # back to Math::BigFloat

    $x -> {sign} = $xtmp -> {sign};
    $x -> {_m}   = $xtmp -> {_m};
    $x -> {_es}  = $xtmp -> {_es};
    $x -> {_e}   = $xtmp -> {_e};

    return $x -> round(@r);
}

###############################################################################
# Rounding methods
###############################################################################

sub bround {
    # accuracy: preserve $N digits, and overwrite the rest with 0's
    my $x = shift;
    my $class = ref($x) || $x;
    $x = $class->new(shift) if !ref($x);

    if (($_[0] || 0) < 0) {
        croak('bround() needs positive accuracy');
    }

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

    my ($scale, $mode) = $x->_scale_a(@_);
    if (!defined $scale) {         # no-op
        return $downgrade->new($x) if defined($downgrade)
          && ($x->is_int() || $x->is_inf() || $x->is_nan());
        return $x;
    }

    # Scale is now either $x->{_a}, $accuracy, or the input argument. Test
    # whether $x already has lower accuracy, do nothing in this case but do
    # round if the accuracy is the same, since a math operation might want to
    # round a number with A=5 to 5 digits afterwards again

    if (defined $x->{_a} && $x->{_a} < $scale) {
        return $downgrade->new($x) if defined($downgrade)
          && ($x->is_int() || $x->is_inf() || $x->is_nan());
        return $x;
    }

    # scale < 0 makes no sense
    # scale == 0 => keep all digits
    # never round a +-inf, NaN

    if ($scale <= 0 || $x->{sign} !~ /^[+-]$/) {
        return $downgrade->new($x) if defined($downgrade)
          && ($x->is_int() || $x->is_inf() || $x->is_nan());
        return $x;
    }

    # 1: never round a 0
    # 2: if we should keep more digits than the mantissa has, do nothing
    if ($x->is_zero() || $LIB->_len($x->{_m}) <= $scale) {
        $x->{_a} = $scale if !defined $x->{_a} || $x->{_a} > $scale;
        return $downgrade->new($x) if defined($downgrade)
          && ($x->is_int() || $x->is_inf() || $x->is_nan());
        return $x;
    }

    # pass sign to bround for '+inf' and '-inf' rounding modes
    my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';

    $m->bround($scale, $mode);   # round mantissa
    $x->{_m} = $m->{value};     # get our mantissa back
    $x->{_a} = $scale;          # remember rounding
    delete $x->{_p};            # and clear P

    # bnorm() downgrades if necessary, so no need to check whether to downgrade.
    $x->bnorm();                # del trailing zeros gen. by bround()
}

sub bfround {
    # precision: round to the $Nth digit left (+$n) or right (-$n) from the '.'
    # $n == 0 means round to integer
    # expects and returns normalized numbers!
    my $x = shift;
    my $class = ref($x) || $x;
    $x = $class->new(shift) if !ref($x);

    return $x if $x->modify('bfround'); # no-op

    my ($scale, $mode) = $x->_scale_p(@_);
    if (!defined $scale) {
        return $downgrade->new($x) if defined($downgrade)
          && ($x->is_int() || $x->is_inf() || $x->is_nan());
        return $x;
    }

    # never round a 0, +-inf, NaN

    if ($x->is_zero()) {
        $x->{_p} = $scale if !defined $x->{_p} || $x->{_p} < $scale; # -3 < -2
        return $downgrade->new($x) if defined($downgrade)
          && ($x->is_int() || $x->is_inf() || $x->is_nan());
        return $x;
    }

    if ($x->{sign} !~ /^[+-]$/) {
        return $downgrade->new($x) if defined($downgrade)
          && ($x->is_int() || $x->is_inf() || $x->is_nan());
        return $x;
    }

    # don't round if x already has lower precision
    if (defined $x->{_p} && $x->{_p} < 0 && $scale < $x->{_p}) {
        return $downgrade->new($x) if defined($downgrade)
          && ($x->is_int() || $x->is_inf() || $x->is_nan());
        return $x;
    }

    $x->{_p} = $scale;          # remember round in any case
    delete $x->{_a};            # and clear A
    if ($scale < 0) {
        # round right from the '.'

        if ($x->{_es} eq '+') { # e >= 0 => nothing to round
            return $downgrade->new($x) if defined($downgrade)
              && ($x->is_int() || $x->is_inf() || $x->is_nan());
            return $x;
        }

        $scale = -$scale;           # positive for simplicity
        my $len = $LIB->_len($x->{_m}); # length of mantissa

        # the following poses a restriction on _e, but if _e is bigger than a
        # scalar, you got other problems (memory etc) anyway
        my $dad = -(0+ ($x->{_es}.$LIB->_num($x->{_e}))); # digits after dot
        my $zad = 0;                                      # zeros after dot
        $zad = $dad - $len if (-$dad < -$len); # for 0.00..00xxx style

        # print "scale $scale dad $dad zad $zad len $len\n";
        # number  bsstr   len zad dad
        # 0.123   123e-3    3   0 3
        # 0.0123  123e-4    3   1 4
        # 0.001   1e-3      1   2 3
        # 1.23    123e-2    3   0 2
        # 1.2345  12345e-4  5   0 4

        # do not round after/right of the $dad

        if ($scale > $dad) { # 0.123, scale >= 3 => exit
            return $downgrade->new($x) if defined($downgrade)
              && ($x->is_int() || $x->is_inf() || $x->is_nan());
            return $x;
        }

        # round to zero if rounding inside the $zad, but not for last zero like:
        # 0.0065, scale -2, round last '0' with following '65' (scale == zad case)
        if ($scale < $zad) {
            return $downgrade->new($x) if defined($downgrade)
              && ($x->is_int() || $x->is_inf() || $x->is_nan());
            return $x->bzero();
        }

        if ($scale == $zad) {    # for 0.006, scale -3 and trunc
            $scale = -$len;
        } else {
            # adjust round-point to be inside mantissa
            if ($zad != 0) {
                $scale = $scale-$zad;
            } else {
                my $dbd = $len - $dad;
                $dbd = 0 if $dbd < 0; # digits before dot
                $scale = $dbd+$scale;
            }
        }
    } else {
        # round left from the '.'

        # 123 => 100 means length(123) = 3 - $scale (2) => 1

        my $dbt = $LIB->_len($x->{_m});
        # digits before dot
        my $dbd = $dbt + ($x->{_es} . $LIB->_num($x->{_e}));
        # should be the same, so treat it as this
        $scale = 1 if $scale == 0;
        # shortcut if already integer
        if ($scale == 1 && $dbt <= $dbd) {
            return $downgrade->new($x) if defined($downgrade)
              && ($x->is_int() || $x->is_inf() || $x->is_nan());
            return $x;
        }
        # maximum digits before dot
        ++$dbd;

        if ($scale > $dbd) {
            # not enough digits before dot, so round to zero
            return $downgrade->new($x) if defined($downgrade);
            return $x->bzero;
        } elsif ($scale == $dbd) {
            # maximum
            $scale = -$dbt;
        } else {
            $scale = $dbd - $scale;
        }
    }

    # pass sign to bround for rounding modes '+inf' and '-inf'
    my $m = bless { sign => $x->{sign}, value => $x->{_m} }, 'Math::BigInt';
    $m->bround($scale, $mode);
    $x->{_m} = $m->{value};     # get our mantissa back

    # bnorm() downgrades if necessary, so no need to check whether to downgrade.
    $x->bnorm();
}

sub bfloor {
    # round towards minus infinity
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    if ($x->{sign} =~ /^[+-]$/) {
        # if $x has digits after dot, remove them
        if ($x->{_es} eq '-') {
            $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10);
            $x->{_e} = $LIB->_zero();
            $x->{_es} = '+';
            # increment if negative
            $x->{_m} = $LIB->_inc($x->{_m}) if $x->{sign} eq '-';
        }
        $x->round(@r);
    }
    return $downgrade->new($x, @r) if defined($downgrade);
    return $x;
}

sub bceil {
    # round towards plus infinity
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    # if $x has digits after dot, remove them
    if ($x->{sign} =~ /^[+-]$/) {
        if ($x->{_es} eq '-') {
            $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10);
            $x->{_e} = $LIB->_zero();
            $x->{_es} = '+';
            if ($x->{sign} eq '+') {
                $x->{_m} = $LIB->_inc($x->{_m});        # increment if positive
            } else {
                $x->{sign} = '+' if $LIB->_is_zero($x->{_m});   # avoid -0
            }
        }
        $x->round(@r);
    }

    return $downgrade->new($x, @r) if defined($downgrade);
    return $x;
}

sub bint {
    # round towards zero
    my ($class, $x, @r) = ref($_[0]) ? (ref($_[0]), @_) : objectify(1, @_);

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

    if ($x->{sign} =~ /^[+-]$/) {
        # if $x has digits after the decimal point
        if ($x->{_es} eq '-') {
            $x->{_m} = $LIB->_rsft($x->{_m}, $x->{_e}, 10); # remove fraction part
            $x->{_e} = $LIB->_zero();                       # truncate/normalize
            $x->{_es} = '+';                                # abs e
            $x->{sign} = '+' if $LIB->_is_zero($x->{_m});   # avoid -0
        }
        $x->round(@r);
    }

    return $downgrade->new($x, @r) if defined($downgrade);
    return $x;
}

###############################################################################
# Other mathematical methods
###############################################################################

sub bgcd {
    # (BINT or num_str, BINT or num_str) return BINT
    # does not modify arguments, but returns new object

    unshift @_, __PACKAGE__
      unless ref($_[0]) || $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i;

    my ($class, @args) = objectify(0, @_);

    my $x = shift @args;
    $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x);
    return $class->bnan() unless $x -> is_int();

    while (@args) {
        my $y = shift @args;
        $y = $class->new($y) unless ref($y) && $y -> isa($class);
        return $class->bnan() unless $y -> is_int();

        # greatest common divisor
        while (! $y->is_zero()) {
            ($x, $y) = ($y->copy(), $x->copy()->bmod($y));
        }

        last if $x -> is_one();
    }
    return $x -> babs();
}

sub blcm {
    # (BFLOAT or num_str, BFLOAT or num_str) return BFLOAT
    # does not modify arguments, but returns new object
    # Least Common Multiple

    unshift @_, __PACKAGE__
      unless ref($_[0]) || $_[0] =~ /^[a-z]\w*(?:::[a-z]\w*)*$/i;

    my ($class, @args) = objectify(0, @_);

    my $x = shift @args;
    $x = ref($x) && $x -> isa($class) ? $x -> copy() : $class -> new($x);
    return $class->bnan() if $x->{sign} !~ /^[+-]$/;    # x NaN?

    while (@args) {
        my $y = shift @args;
        $y = $class -> new($y) unless ref($y) && $y -> isa($class);
        return $x->bnan() unless $y -> is_int();
        my $gcd = $x -> bgcd($y);
        $x -> bdiv($gcd) -> bmul($y);
    }

    return $x -> babs();
}

###############################################################################
# Object property methods
###############################################################################

sub length {
    my $x = shift;
    my $class = ref($x) || $x;
    $x = $class->new(shift) unless ref($x);

    return 1 if $LIB->_is_zero($x->{_m});

    my $len = $LIB->_len($x->{_m});
    $len += $LIB->_num($x->{_e}) if $x->{_es} eq '+';
    if (wantarray()) {
        my $t = 0;
        $t = $LIB->_num($x->{_e}) if $x->{_es} eq '-';
        return ($len, $t);
    }
    $len;
}

sub mantissa {
    # return a copy of the mantissa
    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    if ($x->{sign} !~ /^[+-]$/) {
        my $s = $x->{sign};
        $s =~ s/^\+//;
        return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
    }
    my $m = Math::BigInt->new($LIB->_str($x->{_m}), undef, undef);
    $m->bneg() if $x->{sign} eq '-';

    $m;
}

sub exponent {
    # return a copy of the exponent
    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    if ($x->{sign} !~ /^[+-]$/) {
        my $s = $x->{sign};
        $s =~ s/^[+-]//;
        return Math::BigInt->new($s, undef, undef); # -inf, +inf => +inf
    }
    Math::BigInt->new($x->{_es} . $LIB->_str($x->{_e}), undef, undef);
}

sub parts {
    # return a copy of both the exponent and the mantissa
    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    if ($x->{sign} !~ /^[+-]$/) {
        my $s = $x->{sign};
        $s =~ s/^\+//;
        my $se = $s;
        $se =~ s/^-//;
        return ($class->new($s), $class->new($se)); # +inf => inf and -inf, +inf => inf
    }
    my $m = Math::BigInt->bzero();
    $m->{value} = $LIB->_copy($x->{_m});
    $m->bneg() if $x->{sign} eq '-';
    ($m, Math::BigInt->new($x->{_es} . $LIB->_num($x->{_e})));
}

sub sparts {
    my $self  = shift;
    my $class = ref $self;

    croak("sparts() is an instance method, not a class method")
        unless $class;

    # Not-a-number.

    if ($self -> is_nan()) {
        my $mant = $self -> copy();             # mantissa
        return $mant unless wantarray;          # scalar context
        my $expo = $class -> bnan();            # exponent
        return ($mant, $expo);                  # list context
    }

    # Infinity.

    if ($self -> is_inf()) {
        my $mant = $self -> copy();             # mantissa
        return $mant unless wantarray;          # scalar context
        my $expo = $class -> binf('+');         # exponent
        return ($mant, $expo);                  # list context
    }

    # Finite number.

    my $mant = $self -> copy() -> bzero();
    $mant -> {sign} = $self -> {sign};
    $mant -> {_m}   = $LIB->_copy($self -> {_m});
    return $mant unless wantarray;

    my $expo = $class -> bzero();
    $expo -> {sign} = $self -> {_es};
    $expo -> {_m}   = $LIB->_copy($self -> {_e});

    return ($mant, $expo);
}

sub nparts {
    my $self  = shift;
    my $class = ref $self;

    croak("nparts() is an instance method, not a class method")
        unless $class;

    # Not-a-number.

    if ($self -> is_nan()) {
        my $mant = $self -> copy();             # mantissa
        return $mant unless wantarray;          # scalar context
        my $expo = $class -> bnan();            # exponent
        return ($mant, $expo);                  # list context
    }

    # Infinity.

    if ($self -> is_inf()) {
        my $mant = $self -> copy();             # mantissa
        return $mant unless wantarray;          # scalar context
        my $expo = $class -> binf('+');         # exponent
        return ($mant, $expo);                  # list context
    }

    # Finite number.

    my ($mant, $expo) = $self -> sparts();

    if ($mant -> bcmp(0)) {
        my ($ndigtot, $ndigfrac) = $mant -> length();
        my $expo10adj = $ndigtot - $ndigfrac - 1;

        if ($expo10adj != 0) {
            my $factor  = "1e" . -$expo10adj;
            $mant -> bmul($factor);
            return $mant unless wantarray;
            $expo -> badd($expo10adj);
            return ($mant, $expo);
        }
    }

    return $mant unless wantarray;
    return ($mant, $expo);
}

sub eparts {
    my $self  = shift;
    my $class = ref $self;

    croak("eparts() is an instance method, not a class method")
        unless $class;

    # Not-a-number and Infinity.

    return $self -> sparts() if $self -> is_nan() || $self -> is_inf();

    # Finite number.

    my ($mant, $expo) = $self -> nparts();

    my $c = $expo -> copy() -> bmod(3);
    $mant -> blsft($c, 10);
    return $mant unless wantarray;

    $expo -> bsub($c);
    return ($mant, $expo);
}

sub dparts {
    my $self  = shift;
    my $class = ref $self;

    croak("dparts() is an instance method, not a class method")
        unless $class;

    # Not-a-number and Infinity.

    if ($self -> is_nan() || $self -> is_inf()) {
        my $int = $self -> copy();
        return $int unless wantarray;
        my $frc = $class -> bzero();
        return ($int, $frc);
    }

    my $int = $self  -> copy();
    my $frc = $class -> bzero();

    # If the input has a fraction part.

    if ($int->{_es} eq '-') {
        $int->{_m} = $LIB -> _rsft($int->{_m}, $int->{_e}, 10);
        $int->{_e} = $LIB -> _zero();
        $int->{_es} = '+';
        $int->{sign} = '+' if $LIB->_is_zero($int->{_m});   # avoid -0

        return $int unless wantarray;
        $frc = $self -> copy() -> bsub($int);
        return ($int, $frc);
    }

    return $int unless wantarray;
    return ($int, $frc);
}

sub fparts {
    my $x = shift;
    my $class = ref $x;

    croak("fparts() is an instance method") unless $class;

    return ($class -> bnan(),
            $class -> bnan()) if $x -> is_nan();

    return ($class -> binf($x -> sign()),
            $class -> bone()) if $x -> is_inf();

    return ($class -> bzero(),
            $class -> bone()) if $x -> is_zero();

    if ($x -> {_es} eq '-') {                   # exponent < 0
        my $numer_lib = $LIB -> _copy($x -> {_m});
        my $denom_lib = $LIB -> _1ex($x -> {_e});
        my $gcd_lib = $LIB -> _gcd($LIB -> _copy($numer_lib), $denom_lib);
        $numer_lib = $LIB -> _div($numer_lib, $gcd_lib);
        $denom_lib = $LIB -> _div($denom_lib, $gcd_lib);
        return ($class -> new($x -> {sign} . $LIB -> _str($numer_lib)),
                $class -> new($LIB -> _str($denom_lib)));
    }

    elsif (! $LIB -> _is_zero($x -> {_e})) {    # exponent > 0
        my $numer_lib = $LIB -> _copy($x -> {_m});
        $numer_lib = $LIB -> _lsft($numer_lib, $x -> {_e}, 10);
        return ($class -> new($x -> {sign} . $LIB -> _str($numer_lib)),
                $class -> bone());
    }

    else {                                      # exponent = 0
        return ($class -> new($x -> {sign} . $LIB -> _str($x -> {_m})),
                $class -> bone());
    }
}

sub numerator {
    my $x = shift;
    my $class = ref $x;

    croak("numerator() is an instance method") unless $class;

    return $class -> bnan()             if $x -> is_nan();
    return $class -> binf($x -> sign()) if $x -> is_inf();
    return $class -> bzero()            if $x -> is_zero();

    if ($x -> {_es} eq '-') {                   # exponent < 0
        my $numer_lib = $LIB -> _copy($x -> {_m});
        my $denom_lib = $LIB -> _1ex($x -> {_e});
        my $gcd_lib = $LIB -> _gcd($LIB -> _copy($numer_lib), $denom_lib);
        $numer_lib = $LIB -> _div($numer_lib, $gcd_lib);
        return $class -> new($x -> {sign} . $LIB -> _str($numer_lib));
    }

    elsif (! $LIB -> _is_zero($x -> {_e})) {    # exponent > 0
        my $numer_lib = $LIB -> _copy($x -> {_m});
        $numer_lib = $LIB -> _lsft($numer_lib, $x -> {_e}, 10);
        return $class -> new($x -> {sign} . $LIB -> _str($numer_lib));
    }

    else {                                      # exponent = 0
        return $class -> new($x -> {sign} . $LIB -> _str($x -> {_m}));
    }
}

sub denominator {
    my $x = shift;
    my $class = ref $x;

    croak("denominator() is an instance method") unless $class;

    return $class -> bnan() if $x -> is_nan();

    if ($x -> {_es} eq '-') {                   # exponent < 0
        my $numer_lib = $LIB -> _copy($x -> {_m});
        my $denom_lib = $LIB -> _1ex($x -> {_e});
        my $gcd_lib = $LIB -> _gcd($LIB -> _copy($numer_lib), $denom_lib);
        $denom_lib = $LIB -> _div($denom_lib, $gcd_lib);
        return $class -> new($LIB -> _str($denom_lib));
    }

    else {                                      # exponent >= 0
        return $class -> bone();
    }
}

###############################################################################
# String conversion methods
###############################################################################

sub bstr {
    # (ref to BFLOAT or num_str) return num_str
    # Convert number from internal format to (non-scientific) string format.
    # internal format is always normalized (no leading zeros, "-0" => "+0")
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    if ($x->{sign} !~ /^[+-]$/) {
        return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
        return 'inf';                                  # +inf
    }

    my $es = '0';
    my $len = 1;
    my $cad = 0;
    my $dot = '.';

    # $x is zero?
    my $not_zero = !($x->{sign} eq '+' && $LIB->_is_zero($x->{_m}));
    if ($not_zero) {
        $es = $LIB->_str($x->{_m});
        $len = CORE::length($es);
        my $e = $LIB->_num($x->{_e});
        $e = -$e if $x->{_es} eq '-';
        if ($e < 0) {
            $dot = '';
            # if _e is bigger than a scalar, the following will blow your memory
            if ($e <= -$len) {
                my $r = abs($e) - $len;
                $es = '0.'. ('0' x $r) . $es;
                $cad = -($len+$r);
            } else {
                substr($es, $e, 0) = '.';
                $cad = $LIB->_num($x->{_e});
                $cad = -$cad if $x->{_es} eq '-';
            }
        } elsif ($e > 0) {
            # expand with zeros
            $es .= '0' x $e;
            $len += $e;
            $cad = 0;
        }
    }                           # if not zero

    $es = '-'.$es if $x->{sign} eq '-';
    # if set accuracy or precision, pad with zeros on the right side
    if ((defined $x->{_a}) && ($not_zero)) {
        # 123400 => 6, 0.1234 => 4, 0.001234 => 4
        my $zeros = $x->{_a} - $cad; # cad == 0 => 12340
        $zeros = $x->{_a} - $len if $cad != $len;
        $es .= $dot.'0' x $zeros if $zeros > 0;
    } elsif ((($x->{_p} || 0) < 0)) {
        # 123400 => 6, 0.1234 => 4, 0.001234 => 6
        my $zeros = -$x->{_p} + $cad;
        $es .= $dot.'0' x $zeros if $zeros > 0;
    }
    $es;
}

# Decimal notation, e.g., "12345.6789".

sub bdstr {
    my $x = shift;

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
        return 'inf';                                  # +inf
    }

    my $mant = $LIB->_str($x->{_m});
    my $expo = $x -> exponent();

    my $str = $mant;
    if ($expo >= 0) {
        $str .= "0" x $expo;
    } else {
        my $mantlen = CORE::length($mant);
        my $c = $mantlen + $expo;
        $str = "0" x (1 - $c) . $str if $c <= 0;
        substr($str, $expo, 0) = '.';
    }

    return $x->{sign} eq '-' ? "-$str" : $str;
}

# Scientific notation with significand/mantissa as an integer, e.g., "12345.6789"
# is written as "123456789e-4".

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

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
        return 'inf';                                  # +inf
    }

    my $str = $LIB->_str($x->{_m}) . 'e' . $x->{_es}. $LIB->_str($x->{_e});
    return $x->{sign} eq '-' ? "-$str" : $str;
}

# Normalized notation, e.g., "12345.6789" is written as "1.23456789e+4".

sub bnstr {
    my $x = shift;

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
        return 'inf';                                  # +inf
    }

    my ($mant, $expo) = $x -> nparts();

    my $esgn = $expo < 0 ? '-' : '+';
    my $eabs = $expo -> babs() -> bfround(0) -> bstr();
    #$eabs = '0' . $eabs if length($eabs) < 2;

    return $mant . 'e' . $esgn . $eabs;
}

# Engineering notation, e.g., "12345.6789" is written as "12.3456789e+3".

sub bestr {
    my $x = shift;

    if ($x->{sign} ne '+' && $x->{sign} ne '-') {
        return $x->{sign} unless $x->{sign} eq '+inf'; # -inf, NaN
        return 'inf';                                  # +inf
    }

    my ($mant, $expo) = $x -> eparts();

    my $esgn = $expo < 0 ? '-' : '+';
    my $eabs = $expo -> babs() -> bfround(0) -> bstr();
    #$eabs = '0' . $eabs if length($eabs) < 2;

    return $mant . 'e' . $esgn . $eabs;
}

sub to_hex {
    # return number as hexadecimal string (only for integers defined)

    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
    return '0' if $x->is_zero();

    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in hex?

    my $z = $LIB->_copy($x->{_m});
    if (! $LIB->_is_zero($x->{_e})) {   # > 0
        $z = $LIB->_lsft($z, $x->{_e}, 10);
    }
    my $str = $LIB->_to_hex($z);
    return $x->{sign} eq '-' ? "-$str" : $str;
}

sub to_oct {
    # return number as octal digit string (only for integers defined)

    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
    return '0' if $x->is_zero();

    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in octal?

    my $z = $LIB->_copy($x->{_m});
    if (! $LIB->_is_zero($x->{_e})) {   # > 0
        $z = $LIB->_lsft($z, $x->{_e}, 10);
    }
    my $str = $LIB->_to_oct($z);
    return $x->{sign} eq '-' ? "-$str" : $str;
}

sub to_bin {
    # return number as binary digit string (only for integers defined)

    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
    return '0' if $x->is_zero();

    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in binary?

    my $z = $LIB->_copy($x->{_m});
    if (! $LIB->_is_zero($x->{_e})) {   # > 0
        $z = $LIB->_lsft($z, $x->{_e}, 10);
    }
    my $str = $LIB->_to_bin($z);
    return $x->{sign} eq '-' ? "-$str" : $str;
}

sub to_ieee754 {
    my $x = shift;
    my $format = shift;
    my $class = ref $x;

    my $enc;            # significand encoding (applies only to decimal)
    my $k;              # storage width in bits
    my $b;              # base

    if ($format =~ /^binary(\d+)\z/) {
        $k = $1;
        $b = 2;
    } elsif ($format =~ /^decimal(\d+)(dpd|bcd)?\z/) {
        $k = $1;
        $b = 10;
        $enc = $2 || 'dpd';     # default is dencely-packed decimals (DPD)
    } elsif ($format eq 'half') {
        $k = 16;
        $b = 2;
    } elsif ($format eq 'single') {
        $k = 32;
        $b = 2;
    } elsif ($format eq 'double') {
        $k = 64;
        $b = 2;
    } elsif ($format eq 'quadruple') {
        $k = 128;
        $b = 2;
    } elsif ($format eq 'octuple') {
        $k = 256;
        $b = 2;
    } elsif ($format eq 'sexdecuple') {
        $k = 512;
        $b = 2;
    }

    if ($b == 2) {

        # Get the parameters for this format.

        my $p;                      # precision (in bits)
        my $t;                      # number of bits in significand
        my $w;                      # number of bits in exponent

        if ($k == 16) {             # binary16 (half-precision)
            $p = 11;
            $t = 10;
            $w =  5;
        } elsif ($k == 32) {        # binary32 (single-precision)
            $p = 24;
            $t = 23;
            $w =  8;
        } elsif ($k == 64) {        # binary64 (double-precision)
            $p = 53;
            $t = 52;
            $w = 11;
        } else {                    # binaryN (quadruple-precition and above)
            if ($k < 128 || $k != 32 * sprintf('%.0f', $k / 32)) {
                croak "Number of bits must be 16, 32, 64, or >= 128 and",
                  " a multiple of 32";
            }
            $p = $k - sprintf('%.0f', 4 * log($k) / log(2)) + 13;
            $t = $p - 1;
            $w = $k - $t - 1;
        }

        # The maximum exponent, minimum exponent, and exponent bias.

        my $emax = $class -> new(2) -> bpow($w - 1) -> bdec();
        my $emin = 1 - $emax;
        my $bias = $emax;

        # Get numerical sign, exponent, and mantissa/significand for bit
        # string.

        my $sign = 0;
        my $expo;
        my $mant;

        if ($x -> is_nan()) {                   # nan
            $sign = 1;
            $expo = $emax -> copy() -> binc();
            $mant = $class -> new(2) -> bpow($t - 1);
        } elsif ($x -> is_inf()) {              # inf
            $sign = 1 if $x -> is_neg();
            $expo = $emax -> copy() -> binc();
            $mant = $class -> bzero();
        } elsif ($x -> is_zero()) {             # zero
            $expo = $emin -> copy() -> bdec();
            $mant = $class -> bzero();
        } else {                                # normal and subnormal

            $sign = 1 if $x -> is_neg();

            # Now we need to compute the mantissa and exponent in base $b.

            my $binv = $class -> new("0.5");
            my $b    = $class -> new(2);
            my $one  = $class -> bone();

            # We start off by initializing the exponent to zero and the
            # mantissa to the input value. Then we increase the mantissa and
            # decrease the exponent, or vice versa, until the mantissa is in
            # the desired range or we hit one of the limits for the exponent.

            $mant = $x -> copy() -> babs();

            # We need to find the base 2 exponent. First make an estimate of
            # the base 2 exponent, before adjusting it below. We could skip
            # this estimation and go straight to the while-loops below, but the
            # loops are slow, especially when the final exponent is far from
            # zero and even more so if the number of digits is large. This
            # initial estimation speeds up the computation dramatically.
            #
            #   log2($m * 10**$e) = log10($m + 10**$e) * log(10)/log(2)
            #                     = (log10($m) + $e) * log(10)/log(2)
            #                     = (log($m)/log(10) + $e) * log(10)/log(2)

            my ($m, $e) = $x -> nparts();
            my $ms = $m -> numify();
            my $es = $e -> numify();

            my $expo_est = (log(abs($ms))/log(10) + $es) * log(10)/log(2);
            $expo_est = int($expo_est);

            # Limit the exponent.

            if ($expo_est > $emax) {
                $expo_est = $emax;
            } elsif ($expo_est < $emin) {
                $expo_est = $emin;
            }

            # Don't multiply by a number raised to a negative exponent. This
            # will cause a division, whose result is truncated to some fixed
            # number of digits. Instead, multiply by the inverse number raised
            # to a positive exponent.

            $expo = $class -> new($expo_est);
            if ($expo_est > 0) {
                $mant -> bmul($binv -> copy() -> bpow($expo));
            } elsif ($expo_est < 0) {
                my $expo_abs = $expo -> copy() -> bneg();
                $mant -> bmul($b -> copy() -> bpow($expo_abs));
            }

            # Final adjustment of the estimate above.

            while ($mant >= $b && $expo <= $emax) {
                $mant -> bmul($binv);
                $expo -> binc();
            }

            while ($mant < $one && $expo >= $emin) {
                $mant -> bmul($b);
                $expo -> bdec();
            }

            # This is when the magnitude is larger than what can be represented
            # in this format. Encode as infinity.

            if ($expo > $emax) {
                $mant = $class -> bzero();
                $expo = $emax -> copy() -> binc();
            }

            # This is when the magnitude is so small that the number is encoded
            # as a subnormal number.
            #
            # If the magnitude is smaller than that of the smallest subnormal
            # number, and rounded downwards, it is encoded as zero. This works
            # transparently and does not need to be treated as a special case.
            #
            # If the number is between the largest subnormal number and the
            # smallest normal number, and the value is rounded upwards, the
            # value must be encoded as a normal number. This must be treated as
            # a special case.

            elsif ($expo < $emin) {

                # Scale up the mantissa (significand), and round to integer.

                my $const = $class -> new($b) -> bpow($t - 1);
                $mant -> bmul($const);
                $mant -> bfround(0);

                # If the mantissa overflowed, encode as the smallest normal
                # number.

                if ($mant == $const -> bmul($b)) {
                    $mant -> bzero();
                    $expo -> binc();
                }
            }

            # This is when the magnitude is within the range of what can be
            # encoded as a normal number.

            else {

                # Remove implicit leading bit, scale up the mantissa
                # (significand) to an integer, and round.

                $mant -> bdec();
                my $const = $class -> new($b) -> bpow($t);
                $mant -> bmul($const) -> bfround(0);

                # If the mantissa overflowed, encode as the next larger value.
                # This works correctly also when the next larger value is
                # infinity.

                if ($mant == $const) {
                    $mant -> bzero();
                    $expo -> binc();
                }
            }
        }

        $expo -> badd($bias);                   # add bias

        my $signbit = "$sign";

        my $mantbits = $mant -> to_bin();
        $mantbits = ("0" x ($t - CORE::length($mantbits))) . $mantbits;

        my $expobits = $expo -> to_bin();
        $expobits = ("0" x ($w - CORE::length($expobits))) . $expobits;

        my $bin = $signbit . $expobits . $mantbits;
        return pack "B*", $bin;
    }

    croak("The format '$format' is not yet supported.");
}

sub as_hex {
    # return number as hexadecimal string (only for integers defined)

    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
    return '0x0' if $x->is_zero();

    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in hex?

    my $z = $LIB->_copy($x->{_m});
    if (! $LIB->_is_zero($x->{_e})) {   # > 0
        $z = $LIB->_lsft($z, $x->{_e}, 10);
    }
    my $str = $LIB->_as_hex($z);
    return $x->{sign} eq '-' ? "-$str" : $str;
}

sub as_oct {
    # return number as octal digit string (only for integers defined)

    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
    return '00' if $x->is_zero();

    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in octal?

    my $z = $LIB->_copy($x->{_m});
    if (! $LIB->_is_zero($x->{_e})) {   # > 0
        $z = $LIB->_lsft($z, $x->{_e}, 10);
    }
    my $str = $LIB->_as_oct($z);
    return $x->{sign} eq '-' ? "-$str" : $str;
}

sub as_bin {
    # return number as binary digit string (only for integers defined)

    my ($class, $x) = ref($_[0]) ? (ref($_[0]), $_[0]) : objectify(1, @_);

    return $x->bstr() if $x->{sign} !~ /^[+-]$/; # inf, nan etc
    return '0b0' if $x->is_zero();

    return $nan if $x->{_es} ne '+';    # how to do 1e-1 in binary?

    my $z = $LIB->_copy($x->{_m});
    if (! $LIB->_is_zero($x->{_e})) {   # > 0
        $z = $LIB->_lsft($z, $x->{_e}, 10);
    }
    my $str = $LIB->_as_bin($z);
    return $x->{sign} eq '-' ? "-$str" : $str;
}

sub numify {
    # Make a Perl scalar number from a Math::BigFloat object.
    my ($class, $x) = ref($_[0]) ? (undef, $_[0]) : objectify(1, @_);

    if ($x -> is_nan()) {
        require Math::Complex;
        my $inf = $Math::Complex::Inf;
        return $inf - $inf;
    }

    if ($x -> is_inf()) {
        require Math::Complex;
        my $inf = $Math::Complex::Inf;
        return $x -> is_negative() ? -$inf : $inf;
    }

    # Create a string and let Perl's atoi()/atof() handle the rest.
    return 0 + $x -> bnstr();
}

###############################################################################
# Private methods and functions.
###############################################################################

sub import {
    my $class = shift;
    $IMPORT++;                  # remember we did import()

    my @import = ('objectify');
    my @a;                      # unrecognized arguments

    while (@_) {
        my $param = shift;

        # Enable overloading of constants.

        if ($param eq ':constant') {
            overload::constant

                integer => sub {
                    $class -> new(shift);
                },

                float   => sub {
                    $class -> new(shift);
                },

                binary  => sub {
                    # E.g., a literal 0377 shall result in an object whose value
                    # is decimal 255, but new("0377") returns decimal 377.
                    return $class -> from_oct($_[0]) if $_[0] =~ /^0_*[0-7]/;
                    $class -> new(shift);
                };
            next;
        }

        # Upgrading.

        if ($param eq 'upgrade') {
            $class -> upgrade(shift);
            next;
        }

        # Downgrading.

        if ($param eq 'downgrade') {
            $class -> downgrade(shift);
            next;
        }

        # Accuracy.

        if ($param eq 'accuracy') {
            $class -> accuracy(shift);
            next;
        }

        # Precision.

        if ($param eq 'precision') {
            $class -> precision(shift);
            next;
        }

        # Rounding mode.

        if ($param eq 'round_mode') {
            $class -> round_mode(shift);
            next;
        }

        # Backend library.

        if ($param =~ /^(lib|try|only)\z/) {
            push @import, $param;
            push @import, shift() if @_;
            next;
        }

        if ($param eq 'with') {
            # alternative class for our private parts()
            # XXX: no longer supported
            # $LIB = shift() || 'Calc';
            # carp "'with' is no longer supported, use 'lib', 'try', or 'only'";
            shift;
            next;
        }

        # Unrecognized parameter.

        push @a, $param;
    }

    Math::BigInt -> import(@import);

    # find out which one was actually loaded
    $LIB = Math::BigInt -> config('lib');

    $class->export_to_level(1, $class, @a); # export wanted functions
}

sub _len_to_steps {
    # Given D (digits in decimal), compute N so that N! (N factorial) is
    # at least D digits long. D should be at least 50.
    my $d = shift;

    # two constants for the Ramanujan estimate of ln(N!)
    my $lg2 = log(2 * 3.14159265) / 2;
    my $lg10 = log(10);

    # D = 50 => N => 42, so L = 40 and R = 50
    my $l = 40;
    my $r = $d;

    # Otherwise this does not work under -Mbignum and we do not yet have "no bignum;" :(
    $l = $l->numify if ref($l);
    $r = $r->numify if ref($r);
    $lg2 = $lg2->numify if ref($lg2);
    $lg10 = $lg10->numify if ref($lg10);

    # binary search for the right value (could this be written as the reverse of lg(n!)?)
    while ($r - $l > 1) {
        my $n = int(($r - $l) / 2) + $l;
        my $ramanujan =
          int(($n * log($n) - $n + log($n * (1 + 4*$n*(1+2*$n))) / 6 + $lg2) / $lg10);
        $ramanujan > $d ? $r = $n : $l = $n;
    }
    $l;
}

sub _log {
    # internal log function to calculate ln() based on Taylor series.
    # Modifies $x in place.
    my ($x, $scale) = @_;
    my $class = ref $x;

    # in case of $x == 1, result is 0
    return $x->bzero() if $x->is_one();

    # XXX TODO: rewrite this in a similar manner to bexp()

    # http://www.efunda.com/math/taylor_series/logarithmic.cfm?search_string=log

    # u = x-1, v = x+1
    #              _                               _
    # Taylor:     |    u    1   u^3   1   u^5       |
    # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 0
    #             |_   v    3   v^3   5   v^5      _|

    # This takes much more steps to calculate the result and is thus not used
    # u = x-1
    #              _                               _
    # Taylor:     |    u    1   u^2   1   u^3       |
    # ln (x)  = 2 |   --- + - * --- + - * --- + ... |  x > 1/2
    #             |_   x    2   x^2   3   x^3      _|

    my ($limit, $v, $u, $below, $factor, $next, $over, $f);

    $v = $x->copy(); $v->binc(); # v = x+1
    $x->bdec(); $u = $x->copy(); # u = x-1; x = x-1
    $x->bdiv($v, $scale);        # first term: u/v
    $below = $v->copy();
    $over = $u->copy();
    $u *= $u; $v *= $v;         # u^2, v^2
    $below->bmul($v);           # u^3, v^3
    $over->bmul($u);
    $factor = $class->new(3); $f = $class->new(2);

    $limit = $class->new("1E-". ($scale-1));

    while (3 < 5) {
        # we calculate the next term, and add it to the last
        # when the next term is below our limit, it won't affect the outcome
        # anymore, so we stop

        # calculating the next term simple from over/below will result in quite
        # a time hog if the input has many digits, since over and below will
        # accumulate more and more digits, and the result will also have many
        # digits, but in the end it is rounded to $scale digits anyway. So if we
        # round $over and $below first, we save a lot of time for the division
        # (not with log(1.2345), but try log (123**123) to see what I mean. This
        # can introduce a rounding error if the division result would be f.i.
        # 0.1234500000001 and we round it to 5 digits it would become 0.12346, but
        # if we truncated $over and $below we might get 0.12345. Does this matter
        # for the end result? So we give $over and $below 4 more digits to be
        # on the safe side (unscientific error handling as usual... :+D

        $next = $over->copy()->bround($scale+4)
          ->bdiv($below->copy()->bmul($factor)->bround($scale+4),
                 $scale);

        ## old version:
        ##    $next = $over->copy()->bdiv($below->copy()->bmul($factor), $scale);

        last if $next->bacmp($limit) <= 0;

        delete $next->{_a};
        delete $next->{_p};
        $x->badd($next);
        # calculate things for the next term
        $over *= $u;
        $below *= $v;
        $factor->badd($f);
    }
    $x->bmul($f);               # $x *= 2
}

sub _log_10 {
    # Internal log function based on reducing input to the range of 0.1 .. 9.99
    # and then "correcting" the result to the proper one. Modifies $x in place.
    my ($x, $scale) = @_;
    my $class = ref $x;

    # Taking blog() from numbers greater than 10 takes a *very long* time, so we
    # break the computation down into parts based on the observation that:
    #  blog(X*Y) = blog(X) + blog(Y)
    # We set Y here to multiples of 10 so that $x becomes below 1 - the smaller
    # $x is the faster it gets. Since 2*$x takes about 10 times as
    # long, we make it faster by about a factor of 100 by dividing $x by 10.

    # The same observation is valid for numbers smaller than 0.1, e.g. computing
    # log(1) is fastest, and the further away we get from 1, the longer it takes.
    # So we also 'break' this down by multiplying $x with 10 and subtract the
    # log(10) afterwards to get the correct result.

    # To get $x even closer to 1, we also divide by 2 and then use log(2) to
    # correct for this. For instance if $x is 2.4, we use the formula:
    #  blog(2.4 * 2) == blog(1.2) + blog(2)
    # and thus calculate only blog(1.2) and blog(2), which is faster in total
    # than calculating blog(2.4).

    # In addition, the values for blog(2) and blog(10) are cached.

    # Calculate nr of digits before dot. x = 123, dbd = 3; x = 1.23, dbd = 1;
    # x = 0.0123, dbd = -1; x = 0.000123, dbd = -3, etc.

    my $dbd = $LIB->_num($x->{_e});
    $dbd = -$dbd if $x->{_es} eq '-';
    $dbd += $LIB->_len($x->{_m});

    # more than one digit (e.g. at least 10), but *not* exactly 10 to avoid
    # infinite recursion

    my $calc = 1;               # do some calculation?

    # disable the shortcut for 10, since we need log(10) and this would recurse
    # infinitely deep
    if ($x->{_es} eq '+' &&                     # $x == 10
        ($LIB->_is_one($x->{_e}) &&
         $LIB->_is_one($x->{_m})))
    {
        $dbd = 0;               # disable shortcut
        # we can use the cached value in these cases
        if ($scale <= $LOG_10_A) {
            $x->bzero();
            $x->badd($LOG_10); # modify $x in place
            $calc = 0;                      # no need to calc, but round
        }
        # if we can't use the shortcut, we continue normally
    } else {
        # disable the shortcut for 2, since we maybe have it cached
        if (($LIB->_is_zero($x->{_e}) &&        # $x == 2
             $LIB->_is_two($x->{_m})))
        {
            $dbd = 0;           # disable shortcut
            # we can use the cached value in these cases
            if ($scale <= $LOG_2_A) {
                $x->bzero();
                $x->badd($LOG_2); # modify $x in place
                $calc = 0;                     # no need to calc, but round
            }
            # if we can't use the shortcut, we continue normally
        }
    }

    # if $x = 0.1, we know the result must be 0-log(10)
    if ($calc != 0 &&
        ($x->{_es} eq '-' &&                    # $x == 0.1
         ($LIB->_is_one($x->{_e}) &&
          $LIB->_is_one($x->{_m}))))
    {
        $dbd = 0;               # disable shortcut
        # we can use the cached value in these cases
        if ($scale <= $LOG_10_A) {
            $x->bzero();
            $x->bsub($LOG_10);
            $calc = 0;          # no need to calc, but round
        }
    }

    return $x if $calc == 0;    # already have the result

    # default: these correction factors are undef and thus not used
    my $l_10;                   # value of ln(10) to A of $scale
    my $l_2;                    # value of ln(2) to A of $scale

    my $two = $class->new(2);

    # $x == 2 => 1, $x == 13 => 2, $x == 0.1 => 0, $x == 0.01 => -1
    # so don't do this shortcut for 1 or 0
    if (($dbd > 1) || ($dbd < 0)) {
        # convert our cached value to an object if not already (avoid doing this
        # at import() time, since not everybody needs this)
        $LOG_10 = $class->new($LOG_10, undef, undef) unless ref $LOG_10;

        #print "x = $x, dbd = $dbd, calc = $calc\n";
        # got more than one digit before the dot, or more than one zero after the
        # dot, so do:
        #  log(123)    == log(1.23) + log(10) * 2
        #  log(0.0123) == log(1.23) - log(10) * 2

        if ($scale <= $LOG_10_A) {
            # use cached value
            $l_10 = $LOG_10->copy(); # copy for mul
        } else {
            # else: slower, compute and cache result
            # also disable downgrade for this code path
            local $Math::BigFloat::downgrade = undef;

            # shorten the time to calculate log(10) based on the following:
            # log(1.25 * 8) = log(1.25) + log(8)
            #               = log(1.25) + log(2) + log(2) + log(2)

            # first get $l_2 (and possible compute and cache log(2))
            $LOG_2 = $class->new($LOG_2, undef, undef) unless ref $LOG_2;
            if ($scale <= $LOG_2_A) {
                # use cached value
                $l_2 = $LOG_2->copy(); # copy() for the mul below
            } else {
                # else: slower, compute and cache result
                $l_2 = $two->copy();
                $l_2->_log($scale); # scale+4, actually
                $LOG_2 = $l_2->copy(); # cache the result for later
                # the copy() is for mul below
                $LOG_2_A = $scale;
            }

            # now calculate log(1.25):
            $l_10 = $class->new('1.25');
            $l_10->_log($scale); # scale+4, actually

            # log(1.25) + log(2) + log(2) + log(2):
            $l_10->badd($l_2);
            $l_10->badd($l_2);
            $l_10->badd($l_2);
            $LOG_10 = $l_10->copy(); # cache the result for later
            # the copy() is for mul below
            $LOG_10_A = $scale;
        }
        $dbd-- if ($dbd > 1);       # 20 => dbd=2, so make it dbd=1
        $l_10->bmul($class->new($dbd)); # log(10) * (digits_before_dot-1)
        my $dbd_sign = '+';
        if ($dbd < 0) {
            $dbd = -$dbd;
            $dbd_sign = '-';
        }
        ($x->{_e}, $x->{_es}) =
          _e_sub($x->{_e}, $LIB->_new($dbd), $x->{_es}, $dbd_sign); # 123 => 1.23
        #($x->{_e}, $x->{_es}) =
        #  $LIB -> _ssub($x->{_e}, $x->{_es}, $LIB->_new($dbd), $dbd_sign);
    }

    # Now: 0.1 <= $x < 10 (and possible correction in l_10)

    ### Since $x in the range 0.5 .. 1.5 is MUCH faster, we do a repeated div
    ### or mul by 2 (maximum times 3, since x < 10 and x > 0.1)

    $HALF = $class->new($HALF) unless ref($HALF);

    my $twos = 0;               # default: none (0 times)
    while ($x->bacmp($HALF) <= 0) { # X <= 0.5
        $twos--;
        $x->bmul($two);
    }
    while ($x->bacmp($two) >= 0) { # X >= 2
        $twos++;
        $x->bdiv($two, $scale+4); # keep all digits
    }
    $x->bround($scale+4);
    # $twos > 0 => did mul 2, < 0 => did div 2 (but we never did both)
    # So calculate correction factor based on ln(2):
    if ($twos != 0) {
        $LOG_2 = $class->new($LOG_2, undef, undef) unless ref $LOG_2;
        if ($scale <= $LOG_2_A) {
            # use cached value
            $l_2 = $LOG_2->copy(); # copy() for the mul below
        } else {
            # else: slower, compute and cache result
            # also disable downgrade for this code path
            local $Math::BigFloat::downgrade = undef;
            $l_2 = $two->copy();
            $l_2->_log($scale); # scale+4, actually
            $LOG_2 = $l_2->copy(); # cache the result for later
            # the copy() is for mul below
            $LOG_2_A = $scale;
        }
        $l_2->bmul($twos);      # * -2 => subtract, * 2 => add
    } else {
        undef $l_2;
    }

    $x->_log($scale);       # need to do the "normal" way
    $x->badd($l_10) if defined $l_10; # correct it by ln(10)
    $x->badd($l_2) if defined $l_2;   # and maybe by ln(2)

    # all done, $x contains now the result
    $x;
}

sub _e_add {
    # Internal helper sub to take two positive integers and their signs and
    # then add them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')), output
    # ($LIB, ('+'|'-')).

    my ($x, $y, $xs, $ys) = @_;

    # if the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)
    if ($xs eq $ys) {
        $x = $LIB->_add($x, $y); # +a + +b or -a + -b
    } else {
        my $a = $LIB->_acmp($x, $y);
        if ($a == 0) {
            # This does NOT modify $x in-place. TODO: Fix this?
            $x = $LIB->_zero(); # result is 0
            $xs = '+';
            return ($x, $xs);
        }
        if ($a > 0) {
            $x = $LIB->_sub($x, $y);     # abs sub
        } else {                         # a < 0
            $x = $LIB->_sub ($y, $x, 1); # abs sub
            $xs = $ys;
        }
    }

    $xs = '+' if $xs eq '-' && $LIB->_is_zero($x); # no "-0"

    return ($x, $xs);
}

sub _e_sub {
    # Internal helper sub to take two positive integers and their signs and
    # then subtract them. Input ($LIB, $LIB, ('+'|'-'), ('+'|'-')),
    # output ($LIB, ('+'|'-'))
    my ($x, $y, $xs, $ys) = @_;

    # flip sign
    $ys = $ys eq '+' ? '-' : '+'; # swap sign of second operand ...
    _e_add($x, $y, $xs, $ys);     # ... and let _e_add() do the job
    #$LIB -> _sadd($x, $xs, $y, $ys);     # ... and let $LIB -> _sadd() do the job
}

sub _pow {
    # Calculate a power where $y is a non-integer, like 2 ** 0.3
    my ($x, $y, @r) = @_;
    my $class = ref($x);

    # if $y == 0.5, it is sqrt($x)
    $HALF = $class->new($HALF) unless ref($HALF);
    return $x->bsqrt(@r, $y) if $y->bcmp($HALF) == 0;

    # Using:
    # a ** x == e ** (x * ln a)

    # u = y * ln x
    #                _                         _
    # Taylor:       |   u    u^2    u^3         |
    # x ** y  = 1 + |  --- + --- + ----- + ...  |
    #               |_  1    1*2   1*2*3       _|

    # we need to limit the accuracy to protect against overflow
    my $fallback = 0;
    my ($scale, @params);
    ($x, @params) = $x->_find_round_parameters(@r);

    return $x if $x->is_nan();  # error in _find_round_parameters?

    # no rounding at all, so must use fallback
    if (scalar @params == 0) {
        # simulate old behaviour
        $params[0] = $class->div_scale(); # and round to it as accuracy
        $params[1] = undef;               # disable P
        $scale = $params[0]+4;            # at least four more for proper round
        $params[2] = $r[2];               # round mode by caller or undef
        $fallback = 1;                    # to clear a/p afterwards
    } else {
        # the 4 below is empirical, and there might be cases where it is not
        # enough...
        $scale = abs($params[0] || $params[1]) + 4; # take whatever is defined
    }

    # when user set globals, they would interfere with our calculation, so
    # disable them and later re-enable them
    no strict 'refs';
    my $abr = "$class\::accuracy"; my $ab = $$abr; $$abr = undef;
    my $pbr = "$class\::precision"; my $pb = $$pbr; $$pbr = undef;
    # we also need to disable any set A or P on $x (_find_round_parameters took
    # them already into account), since these would interfere, too
    delete $x->{_a};
    delete $x->{_p};
    # need to disable $upgrade in BigInt, to avoid deep recursion
    local $Math::BigInt::upgrade = undef;

    my ($limit, $v, $u, $below, $factor, $next, $over);

    $u = $x->copy()->blog(undef, $scale)->bmul($y);
    my $do_invert = ($u->{sign} eq '-');
    $u->bneg()  if $do_invert;
    $v = $class->bone();        # 1
    $factor = $class->new(2);   # 2
    $x->bone();                 # first term: 1

    $below = $v->copy();
    $over = $u->copy();

    $limit = $class->new("1E-". ($scale-1));
    while (3 < 5) {
        # we calculate the next term, and add it to the last
        # when the next term is below our limit, it won't affect the outcome
        # anymore, so we stop:
        $next = $over->copy()->bdiv($below, $scale);
        last if $next->bacmp($limit) <= 0;
        $x->badd($next);
        # calculate things for the next term
        $over *= $u;
        $below *= $factor;
        $factor->binc();

        last if $x->{sign} !~ /^[-+]$/;
    }

    if ($do_invert) {
        my $x_copy = $x->copy();
        $x->bone->bdiv($x_copy, $scale);
    }

    # shortcut to not run through _find_round_parameters again
    if (defined $params[0]) {
        $x->bround($params[0], $params[2]); # then round accordingly
    } else {
        $x->bfround($params[1], $params[2]); # then round accordingly
    }
    if ($fallback) {
        # clear a/p after round, since user did not request it
        delete $x->{_a};
        delete $x->{_p};
    }
    # restore globals
    $$abr = $ab;
    $$pbr = $pb;
    $x;
}

1;

__END__

=pod

=head1 NAME

Math::BigFloat - arbitrary size floating point math package

=head1 SYNOPSIS

  use Math::BigFloat;

  # Configuration methods (may be used as class methods and instance methods)

  Math::BigFloat->accuracy();     # get class accuracy
  Math::BigFloat->accuracy($n);   # set class accuracy
  Math::BigFloat->precision();    # get class precision
  Math::BigFloat->precision($n);  # set class precision
  Math::BigFloat->round_mode();   # get class rounding mode
  Math::BigFloat->round_mode($m); # set global round mode, must be one of
                                  # 'even', 'odd', '+inf', '-inf', 'zero',
                                  # 'trunc', or 'common'
  Math::BigFloat->config("lib");  # name of backend math library

  # Constructor methods (when the class methods below are used as instance
  # methods, the value is assigned the invocand)

  $x = Math::BigFloat->new($str);               # defaults to 0
  $x = Math::BigFloat->new('0x123');            # from hexadecimal
  $x = Math::BigFloat->new('0o377');            # from octal
  $x = Math::BigFloat->new('0b101');            # from binary
  $x = Math::BigFloat->from_hex('0xc.afep+3');  # from hex
  $x = Math::BigFloat->from_hex('cafe');        # ditto
  $x = Math::BigFloat->from_oct('1.3267p-4');   # from octal
  $x = Math::BigFloat->from_oct('01.3267p-4');  # ditto
  $x = Math::BigFloat->from_oct('0o1.3267p-4'); # ditto
  $x = Math::BigFloat->from_oct('0377');        # ditto
  $x = Math::BigFloat->from_bin('0b1.1001p-4'); # from binary
  $x = Math::BigFloat->from_bin('0101');        # ditto
  $x = Math::BigFloat->from_ieee754($b, "binary64");  # from IEEE-754 bytes
  $x = Math::BigFloat->bzero();                 # create a +0
  $x = Math::BigFloat->bone();                  # create a +1
  $x = Math::BigFloat->bone('-');               # create a -1
  $x = Math::BigFloat->binf();                  # create a +inf
  $x = Math::BigFloat->binf('-');               # create a -inf
  $x = Math::BigFloat->bnan();                  # create a Not-A-Number
  $x = Math::BigFloat->bpi();                   # returns pi

  $y = $x->copy();        # make a copy (unlike $y = $x)
  $y = $x->as_int();      # return as BigInt

  # Boolean methods (these don't modify the invocand)

  $x->is_zero();          # if $x is 0
  $x->is_one();           # if $x is +1
  $x->is_one("+");        # ditto
  $x->is_one("-");        # if $x is -1
  $x->is_inf();           # if $x is +inf or -inf
  $x->is_inf("+");        # if $x is +inf
  $x->is_inf("-");        # if $x is -inf
  $x->is_nan();           # if $x is NaN

  $x->is_positive();      # if $x > 0
  $x->is_pos();           # ditto
  $x->is_negative();      # if $x < 0
  $x->is_neg();           # ditto

  $x->is_odd();           # if $x is odd
  $x->is_even();          # if $x is even
  $x->is_int();           # if $x is an integer

  # Comparison methods

  $x->bcmp($y);           # compare numbers (undef, < 0, == 0, > 0)
  $x->bacmp($y);          # compare absolutely (undef, < 0, == 0, > 0)
  $x->beq($y);            # true if and only if $x == $y
  $x->bne($y);            # true if and only if $x != $y
  $x->blt($y);            # true if and only if $x < $y
  $x->ble($y);            # true if and only if $x <= $y
  $x->bgt($y);            # true if and only if $x > $y
  $x->bge($y);            # true if and only if $x >= $y

  # Arithmetic methods

  $x->bneg();             # negation
  $x->babs();             # absolute value
  $x->bsgn();             # sign function (-1, 0, 1, or NaN)
  $x->bnorm();            # normalize (no-op)
  $x->binc();             # increment $x by 1
  $x->bdec();             # decrement $x by 1
  $x->badd($y);           # addition (add $y to $x)
  $x->bsub($y);           # subtraction (subtract $y from $x)
  $x->bmul($y);           # multiplication (multiply $x by $y)
  $x->bmuladd($y,$z);     # $x = $x * $y + $z
  $x->bdiv($y);           # division (floored), set $x to quotient
                          # return (quo,rem) or quo if scalar
  $x->btdiv($y);          # division (truncated), set $x to quotient
                          # return (quo,rem) or quo if scalar
  $x->bmod($y);           # modulus (x % y)
  $x->btmod($y);          # modulus (truncated)
  $x->bmodinv($mod);      # modular multiplicative inverse
  $x->bmodpow($y,$mod);   # modular exponentiation (($x ** $y) % $mod)
  $x->bpow($y);           # power of arguments (x ** y)
  $x->blog();             # logarithm of $x to base e (Euler's number)
  $x->blog($base);        # logarithm of $x to base $base (e.g., base 2)
  $x->bexp();             # calculate e ** $x where e is Euler's number
  $x->bnok($y);           # x over y (binomial coefficient n over k)
  $x->bsin();             # sine
  $x->bcos();             # cosine
  $x->batan();            # inverse tangent
  $x->batan2($y);         # two-argument inverse tangent
  $x->bsqrt();            # calculate square root
  $x->broot($y);          # $y'th root of $x (e.g. $y == 3 => cubic root)
  $x->bfac();             # factorial of $x (1*2*3*4*..$x)

  $x->blsft($n);          # left shift $n places in base 2
  $x->blsft($n,$b);       # left shift $n places in base $b
                          # returns (quo,rem) or quo (scalar context)
  $x->brsft($n);          # right shift $n places in base 2
  $x->brsft($n,$b);       # right shift $n places in base $b
                          # returns (quo,rem) or quo (scalar context)

  # Bitwise methods

  $x->band($y);           # bitwise and
  $x->bior($y);           # bitwise inclusive or
  $x->bxor($y);           # bitwise exclusive or
  $x->bnot();             # bitwise not (two's complement)

  # Rounding methods
  $x->round($A,$P,$mode); # round to accuracy or precision using
                          # rounding mode $mode
  $x->bround($n);         # accuracy: preserve $n digits
  $x->bfround($n);        # $n > 0: round to $nth digit left of dec. point
                          # $n < 0: round to $nth digit right of dec. point
  $x->bfloor();           # round towards minus infinity
  $x->bceil();            # round towards plus infinity
  $x->bint();             # round towards zero

  # Other mathematical methods

  $x->bgcd($y);            # greatest common divisor
  $x->blcm($y);            # least common multiple

  # Object property methods (do not modify the invocand)

  $x->sign();              # the sign, either +, - or NaN
  $x->digit($n);           # the nth digit, counting from the right
  $x->digit(-$n);          # the nth digit, counting from the left
  $x->length();            # return number of digits in number
  ($xl,$f) = $x->length(); # length of number and length of fraction
                           # part, latter is always 0 digits long
                           # for Math::BigInt objects
  $x->mantissa();          # return (signed) mantissa as BigInt
  $x->exponent();          # return exponent as BigInt
  $x->parts();             # return (mantissa,exponent) as BigInt
  $x->sparts();            # mantissa and exponent (as integers)
  $x->nparts();            # mantissa and exponent (normalised)
  $x->eparts();            # mantissa and exponent (engineering notation)
  $x->dparts();            # integer and fraction part
  $x->fparts();            # numerator and denominator
  $x->numerator();         # numerator
  $x->denominator();       # denominator

  # Conversion methods (do not modify the invocand)

  $x->bstr();         # decimal notation, possibly zero padded
  $x->bsstr();        # string in scientific notation with integers
  $x->bnstr();        # string in normalized notation
  $x->bestr();        # string in engineering notation
  $x->bdstr();        # string in decimal notation
  $x->as_hex();       # as signed hexadecimal string with prefixed 0x
  $x->as_bin();       # as signed binary string with prefixed 0b
  $x->as_oct();       # as signed octal string with prefixed 0
  $x->to_ieee754($format); # to bytes encoded according to IEEE 754-2008

  # Other conversion methods

  $x->numify();           # return as scalar (might overflow or underflow)

=head1 DESCRIPTION

Math::BigFloat provides support for arbitrary precision floating point.
Overloading is also provided for Perl operators.

All operators (including basic math operations) are overloaded if you
declare your big floating point numbers as

  $x = Math::BigFloat -> new('12_3.456_789_123_456_789E-2');

Operations with overloaded operators preserve the arguments, which is
exactly what you expect.

=head2 Input

Input values to these routines may be any scalar number or string that looks
like a number. Anything that is accepted by Perl as a literal numeric constant
should be accepted by this module.

=over

=item *

Leading and trailing whitespace is ignored.

=item *

Leading zeros are ignored, except for floating point numbers with a binary
exponent, in which case the number is interpreted as an octal floating point
number. For example, "01.4p+0" gives 1.5, "00.4p+0" gives 0.5, but "0.4p+0"
gives a NaN. And while "0377" gives 255, "0377p0" gives 255.

=item *

If the string has a "0x" or "0X" prefix, it is interpreted as a hexadecimal
number.

=item *

If the string has a "0o" or "0O" prefix, it is interpreted as an octal number. A
floating point literal with a "0" prefix is also interpreted as an octal number.

=item *

If the string has a "0b" or "0B" prefix, it is interpreted as a binary number.

=item *

Underline characters are allowed in the same way as they are allowed in literal
numerical constants.

=item *

If the string can not be interpreted, NaN is returned.

=item *

For hexadecimal, octal, and binary floating point numbers, the exponent must be
separated from the significand (mantissa) by the letter "p" or "P", not "e" or
"E" as with decimal numbers.

=back

Some examples of valid string input

    Input string                Resulting value

    123                         123
    1.23e2                      123
    12300e-2                    123

    67_538_754                  67538754
    -4_5_6.7_8_9e+0_1_0         -4567890000000

    0x13a                       314
    0x13ap0                     314
    0x1.3ap+8                   314
    0x0.00013ap+24              314
    0x13a000p-12                314

    0o472                       314
    0o1.164p+8                  314
    0o0.0001164p+20             314
    0o1164000p-10               314

    0472                        472     Note!
    01.164p+8                   314
    00.0001164p+20              314
    01164000p-10                314

    0b100111010                 314
    0b1.0011101p+8              314
    0b0.00010011101p+12         314
    0b100111010000p-3           314

    0x1.921fb5p+1               3.14159262180328369140625e+0
    0o1.2677025p1               2.71828174591064453125
    01.2677025p1                2.71828174591064453125
    0b1.1001p-4                 9.765625e-2

=head2 Output

Output values are usually Math::BigFloat objects.

Boolean operators C<is_zero()>, C<is_one()>, C<is_inf()>, etc. return true or
false.

Comparison operators C<bcmp()> and C<bacmp()>) return -1, 0, 1, or
undef.

=head1 METHODS

Math::BigFloat supports all methods that Math::BigInt supports, except it
calculates non-integer results when possible. Please see L<Math::BigInt> for a
full description of each method. Below are just the most important differences:

=head2 Configuration methods

=over

=item accuracy()

    $x->accuracy(5);           # local for $x
    CLASS->accuracy(5);        # global for all members of CLASS
                               # Note: This also applies to new()!

    $A = $x->accuracy();       # read out accuracy that affects $x
    $A = CLASS->accuracy();    # read out global accuracy

Set or get the global or local accuracy, aka how many significant digits the
results have. If you set a global accuracy, then this also applies to new()!

Warning! The accuracy I<sticks>, e.g. once you created a number under the
influence of C<< CLASS->accuracy($A) >>, all results from math operations with
that number will also be rounded.

In most cases, you should probably round the results explicitly using one of
L<Math::BigInt/round()>, L<Math::BigInt/bround()> or L<Math::BigInt/bfround()>
or by passing the desired accuracy to the math operation as additional
parameter:

    my $x = Math::BigInt->new(30000);
    my $y = Math::BigInt->new(7);
    print scalar $x->copy()->bdiv($y, 2);           # print 4300
    print scalar $x->copy()->bdiv($y)->bround(2);   # print 4300

=item precision()

    $x->precision(-2);        # local for $x, round at the second
                              # digit right of the dot
    $x->precision(2);         # ditto, round at the second digit
                              # left of the dot

    CLASS->precision(5);      # Global for all members of CLASS
                              # This also applies to new()!
    CLASS->precision(-5);     # ditto

    $P = CLASS->precision();  # read out global precision
    $P = $x->precision();     # read out precision that affects $x

Note: You probably want to use L</accuracy()> instead. With L</accuracy()> you
set the number of digits each result should have, with L</precision()> you
set the place where to round!

=back

=head2 Constructor methods

=over

=item from_hex()

    $x -> from_hex("0x1.921fb54442d18p+1");
    $x = Math::BigFloat -> from_hex("0x1.921fb54442d18p+1");

Interpret input as a hexadecimal string.A prefix ("0x", "x", ignoring case) is
optional. A single underscore character ("_") may be placed between any two
digits. If the input is invalid, a NaN is returned. The exponent is in base 2
using decimal digits.

If called as an instance method, the value is assigned to the invocand.

=item from_oct()

    $x -> from_oct("1.3267p-4");
    $x = Math::BigFloat -> from_oct("1.3267p-4");

Interpret input as an octal string. A single underscore character ("_") may be
placed between any two digits. If the input is invalid, a NaN is returned. The
exponent is in base 2 using decimal digits.

If called as an instance method, the value is assigned to the invocand.

=item from_bin()

    $x -> from_bin("0b1.1001p-4");
    $x = Math::BigFloat -> from_bin("0b1.1001p-4");

Interpret input as a hexadecimal string. A prefix ("0b" or "b", ignoring case)
is optional. A single underscore character ("_") may be placed between any two
digits. If the input is invalid, a NaN is returned. The exponent is in base 2
using decimal digits.

If called as an instance method, the value is assigned to the invocand.

=item from_ieee754()

Interpret the input as a value encoded as described in IEEE754-2008.  The input
can be given as a byte string, hex string or binary string. The input is
assumed to be in big-endian byte-order.

        # both $dbl and $mbf are 3.141592...
        $bytes = "\x40\x09\x21\xfb\x54\x44\x2d\x18";
        $dbl = unpack "d>", $bytes;
        $mbf = Math::BigFloat -> from_ieee754($bytes, "binary64");

=item bpi()

    print Math::BigFloat->bpi(100), "\n";

Calculate PI to N digits (including the 3 before the dot). The result is
rounded according to the current rounding mode, which defaults to "even".

This method was added in v1.87 of Math::BigInt (June 2007).

=back

=head2 Arithmetic methods

=over

=item bmuladd()

    $x->bmuladd($y,$z);

Multiply $x by $y, and then add $z to the result.

This method was added in v1.87 of Math::BigInt (June 2007).

=item bdiv()

    $q = $x->bdiv($y);
    ($q, $r) = $x->bdiv($y);

In scalar context, divides $x by $y and returns the result to the given or
default accuracy/precision. In list context, does floored division
(F-division), returning an integer $q and a remainder $r so that $x = $q * $y +
$r. The remainer (modulo) is equal to what is returned by C<< $x->bmod($y) >>.

=item bmod()

    $x->bmod($y);

Returns $x modulo $y. When $x is finite, and $y is finite and non-zero, the
result is identical to the remainder after floored division (F-division). If,
in addition, both $x and $y are integers, the result is identical to the result
from Perl's % operator.

=item bexp()

    $x->bexp($accuracy);            # calculate e ** X

Calculates the expression C<e ** $x> where C<e> is Euler's number.

This method was added in v1.82 of Math::BigInt (April 2007).

=item bnok()

    $x->bnok($y);   # x over y (binomial coefficient n over k)

Calculates the binomial coefficient n over k, also called the "choose"
function. The result is equivalent to:

    ( n )      n!
    | - |  = -------
    ( k )    k!(n-k)!

This method was added in v1.84 of Math::BigInt (April 2007).

=item bsin()

    my $x = Math::BigFloat->new(1);
    print $x->bsin(100), "\n";

Calculate the sinus of $x, modifying $x in place.

This method was added in v1.87 of Math::BigInt (June 2007).

=item bcos()

    my $x = Math::BigFloat->new(1);
    print $x->bcos(100), "\n";

Calculate the cosinus of $x, modifying $x in place.

This method was added in v1.87 of Math::BigInt (June 2007).

=item batan()

    my $x = Math::BigFloat->new(1);
    print $x->batan(100), "\n";

Calculate the arcus tanges of $x, modifying $x in place. See also L</batan2()>.

This method was added in v1.87 of Math::BigInt (June 2007).

=item batan2()

    my $y = Math::BigFloat->new(2);
    my $x = Math::BigFloat->new(3);
    print $y->batan2($x), "\n";

Calculate the arcus tanges of C<$y> divided by C<$x>, modifying $y in place.
See also L</batan()>.

This method was added in v1.87 of Math::BigInt (June 2007).

=item as_float()

This method is called when Math::BigFloat encounters an object it doesn't know
how to handle. For instance, assume $x is a Math::BigFloat, or subclass
thereof, and $y is defined, but not a Math::BigFloat, or subclass thereof. If
you do

    $x -> badd($y);

$y needs to be converted into an object that $x can deal with. This is done by
first checking if $y is something that $x might be upgraded to. If that is the
case, no further attempts are made. The next is to see if $y supports the
method C<as_float()>. The method C<as_float()> is expected to return either an
object that has the same class as $x, a subclass thereof, or a string that
C<ref($x)-E<gt>new()> can parse to create an object.

In Math::BigFloat, C<as_float()> has the same effect as C<copy()>.

=item to_ieee754()

Encodes the invocand as a byte string in the given format as specified in IEEE
754-2008. Note that the encoded value is the nearest possible representation of
the value. This value might not be exactly the same as the value in the
invocand.

    # $x = 3.1415926535897932385
    $x = Math::BigFloat -> bpi(30);

    $b = $x -> to_ieee754("binary64");  # encode as 8 bytes
    $h = unpack "H*", $b;               # "400921fb54442d18"

    # 3.141592653589793115997963...
    $y = Math::BigFloat -> from_ieee754($h, "binary64");

All binary formats in IEEE 754-2008 are accepted. For convenience, som aliases
are recognized: "half" for "binary16", "single" for "binary32", "double" for
"binary64", "quadruple" for "binary128", "octuple" for "binary256", and
"sexdecuple" for "binary512".

See also L<https://en.wikipedia.org/wiki/IEEE_754>.

=back

=head2 ACCURACY AND PRECISION

See also: L<Rounding|/Rounding>.

Math::BigFloat supports both precision (rounding to a certain place before or
after the dot) and accuracy (rounding to a certain number of digits). For a
full documentation, examples and tips on these topics please see the large
section about rounding in L<Math::BigInt>.

Since things like C<sqrt(2)> or C<1 / 3> must presented with a limited
accuracy lest a operation consumes all resources, each operation produces
no more than the requested number of digits.

If there is no global precision or accuracy set, B<and> the operation in
question was not called with a requested precision or accuracy, B<and> the
input $x has no accuracy or precision set, then a fallback parameter will
be used. For historical reasons, it is called C<div_scale> and can be accessed
via:

    $d = Math::BigFloat->div_scale();       # query
    Math::BigFloat->div_scale($n);          # set to $n digits

The default value for C<div_scale> is 40.

In case the result of one operation has more digits than specified,
it is rounded. The rounding mode taken is either the default mode, or the one
supplied to the operation after the I<scale>:

    $x = Math::BigFloat->new(2);
    Math::BigFloat->accuracy(5);              # 5 digits max
    $y = $x->copy()->bdiv(3);                 # gives 0.66667
    $y = $x->copy()->bdiv(3,6);               # gives 0.666667
    $y = $x->copy()->bdiv(3,6,undef,'odd');   # gives 0.666667
    Math::BigFloat->round_mode('zero');
    $y = $x->copy()->bdiv(3,6);               # will also give 0.666667

Note that C<< Math::BigFloat->accuracy() >> and C<< Math::BigFloat->precision() >>
set the global variables, and thus B<any> newly created number will be subject
to the global rounding B<immediately>. This means that in the examples above, the
C<3> as argument to C<bdiv()> will also get an accuracy of B<5>.

It is less confusing to either calculate the result fully, and afterwards
round it explicitly, or use the additional parameters to the math
functions like so:

    use Math::BigFloat;
    $x = Math::BigFloat->new(2);
    $y = $x->copy()->bdiv(3);
    print $y->bround(5),"\n";               # gives 0.66667

    or

    use Math::BigFloat;
    $x = Math::BigFloat->new(2);
    $y = $x->copy()->bdiv(3,5);             # gives 0.66667
    print "$y\n";

=head2 Rounding

=over

=item bfround ( +$scale )

Rounds to the $scale'th place left from the '.', counting from the dot.
The first digit is numbered 1.

=item bfround ( -$scale )

Rounds to the $scale'th place right from the '.', counting from the dot.

=item bfround ( 0 )

Rounds to an integer.

=item bround  ( +$scale )

Preserves accuracy to $scale digits from the left (aka significant digits) and
pads the rest with zeros. If the number is between 1 and -1, the significant
digits count from the first non-zero after the '.'

=item bround  ( -$scale ) and bround ( 0 )

These are effectively no-ops.

=back

All rounding functions take as a second parameter a rounding mode from one of
the following: 'even', 'odd', '+inf', '-inf', 'zero', 'trunc' or 'common'.

The default rounding mode is 'even'. By using
C<< Math::BigFloat->round_mode($round_mode); >> you can get and set the default
mode for subsequent rounding. The usage of C<$Math::BigFloat::$round_mode> is
no longer supported.
The second parameter to the round functions then overrides the default
temporarily.

The C<as_number()> function returns a BigInt from a Math::BigFloat. It uses
'trunc' as rounding mode to make it equivalent to:

    $x = 2.5;
    $y = int($x) + 2;

You can override this by passing the desired rounding mode as parameter to
C<as_number()>:

    $x = Math::BigFloat->new(2.5);
    $y = $x->as_number('odd');      # $y = 3

=head1 NUMERIC LITERALS

After C<use Math::BigFloat ':constant'> all numeric literals in the given scope
are converted to C<Math::BigFloat> objects. This conversion happens at compile
time.

For example,

    perl -MMath::BigFloat=:constant -le 'print 2e-150'

prints the exact value of C<2e-150>. Note that without conversion of constants
the expression C<2e-150> is calculated using Perl scalars, which leads to an
inaccuracte result.

Note that strings are not affected, so that

    use Math::BigFloat qw/:constant/;

    $y = "1234567890123456789012345678901234567890"
            + "123456789123456789";

does not give you what you expect. You need an explicit Math::BigFloat->new()
around at least one of the operands. You should also quote large constants to
prevent loss of precision:

    use Math::BigFloat;

    $x = Math::BigFloat->new("1234567889123456789123456789123456789");

Without the quotes Perl converts the large number to a floating point constant
at compile time, and then converts the result to a Math::BigFloat object at
runtime, which results in an inaccurate result.

=head2 Hexadecimal, octal, and binary floating point literals

Perl (and this module) accepts hexadecimal, octal, and binary floating point
literals, but use them with care with Perl versions before v5.32.0, because some
versions of Perl silently give the wrong result. Below are some examples of
different ways to write the number decimal 314.

Hexadecimal floating point literals:

    0x1.3ap+8         0X1.3AP+8
    0x1.3ap8          0X1.3AP8
    0x13a0p-4         0X13A0P-4

Octal floating point literals (with "0" prefix):

    01.164p+8         01.164P+8
    01.164p8          01.164P8
    011640p-4         011640P-4

Octal floating point literals (with "0o" prefix) (requires v5.34.0):

    0o1.164p+8        0O1.164P+8
    0o1.164p8         0O1.164P8
    0o11640p-4        0O11640P-4

Binary floating point literals:

    0b1.0011101p+8    0B1.0011101P+8
    0b1.0011101p8     0B1.0011101P8
    0b10011101000p-2  0B10011101000P-2

=head2 Math library

Math with the numbers is done (by default) by a module called
Math::BigInt::Calc. This is equivalent to saying:

    use Math::BigFloat lib => "Calc";

You can change this by using:

    use Math::BigFloat lib => "GMP";

B<Note>: General purpose packages should not be explicit about the library to
use; let the script author decide which is best.

Note: The keyword 'lib' will warn when the requested library could not be
loaded. To suppress the warning use 'try' instead:

    use Math::BigFloat try => "GMP";

If your script works with huge numbers and Calc is too slow for them, you can
also for the loading of one of these libraries and if none of them can be used,
the code will die:

    use Math::BigFloat only => "GMP,Pari";

The following would first try to find Math::BigInt::Foo, then Math::BigInt::Bar,
and when this also fails, revert to Math::BigInt::Calc:

    use Math::BigFloat lib => "Foo,Math::BigInt::Bar";

See the respective low-level library documentation for further details.

See L<Math::BigInt> for more details about using a different low-level library.

=head2 Using Math::BigInt::Lite

For backwards compatibility reasons it is still possible to
request a different storage class for use with Math::BigFloat:

    use Math::BigFloat with => 'Math::BigInt::Lite';

However, this request is ignored, as the current code now uses the low-level
math library for directly storing the number parts.

=head1 EXPORTS

C<Math::BigFloat> exports nothing by default, but can export the C<bpi()> method:

    use Math::BigFloat qw/bpi/;

    print bpi(10), "\n";

=head1 CAVEATS

Do not try to be clever to insert some operations in between switching
libraries:

    require Math::BigFloat;
    my $matter = Math::BigFloat->bone() + 4;    # load BigInt and Calc
    Math::BigFloat->import( lib => 'Pari' );    # load Pari, too
    my $anti_matter = Math::BigFloat->bone()+4; # now use Pari

This will create objects with numbers stored in two different backend libraries,
and B<VERY BAD THINGS> will happen when you use these together:

    my $flash_and_bang = $matter + $anti_matter;    # Don't do this!

=over

=item stringify, bstr()

Both stringify and bstr() now drop the leading '+'. The old code would return
'+1.23', the new returns '1.23'. See the documentation in L<Math::BigInt> for
reasoning and details.

=item brsft()

The following will probably not print what you expect:

    my $c = Math::BigFloat->new('3.14159');
    print $c->brsft(3,10),"\n";     # prints 0.00314153.1415

It prints both quotient and remainder, since print calls C<brsft()> in list
context. Also, C<< $c->brsft() >> will modify $c, so be careful.
You probably want to use

    print scalar $c->copy()->brsft(3,10),"\n";
    # or if you really want to modify $c
    print scalar $c->brsft(3,10),"\n";

instead.

=item Modifying and =

Beware of:

    $x = Math::BigFloat->new(5);
    $y = $x;

It will not do what you think, e.g. making a copy of $x. Instead it just makes
a second reference to the B<same> object and stores it in $y. Thus anything
that modifies $x will modify $y (except overloaded math operators), and vice
versa. See L<Math::BigInt> for details and how to avoid that.

=item precision() vs. accuracy()

A common pitfall is to use L</precision()> when you want to round a result to
a certain number of digits:

    use Math::BigFloat;

    Math::BigFloat->precision(4);           # does not do what you
                                            # think it does
    my $x = Math::BigFloat->new(12345);     # rounds $x to "12000"!
    print "$x\n";                           # print "12000"
    my $y = Math::BigFloat->new(3);         # rounds $y to "0"!
    print "$y\n";                           # print "0"
    $z = $x / $y;                           # 12000 / 0 => NaN!
    print "$z\n";
    print $z->precision(),"\n";             # 4

Replacing L</precision()> with L</accuracy()> is probably not what you want, either:

    use Math::BigFloat;

    Math::BigFloat->accuracy(4);          # enables global rounding:
    my $x = Math::BigFloat->new(123456);  # rounded immediately
                                          #   to "12350"
    print "$x\n";                         # print "123500"
    my $y = Math::BigFloat->new(3);       # rounded to "3
    print "$y\n";                         # print "3"
    print $z = $x->copy()->bdiv($y),"\n"; # 41170
    print $z->accuracy(),"\n";            # 4

What you want to use instead is:

    use Math::BigFloat;

    my $x = Math::BigFloat->new(123456);    # no rounding
    print "$x\n";                           # print "123456"
    my $y = Math::BigFloat->new(3);         # no rounding
    print "$y\n";                           # print "3"
    print $z = $x->copy()->bdiv($y,4),"\n"; # 41150
    print $z->accuracy(),"\n";              # undef

In addition to computing what you expected, the last example also does B<not>
"taint" the result with an accuracy or precision setting, which would
influence any further operation.

=back

=head1 BUGS

Please report any bugs or feature requests to
C<bug-math-bigint at rt.cpan.org>, or through the web interface at
L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt> (requires login).
We will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Math::BigFloat

You can also look for information at:

=over 4

=item * GitHub

L<https://github.com/pjacklam/p5-Math-BigInt>

=item * RT: CPAN's request tracker

L<https://rt.cpan.org/Dist/Display.html?Name=Math-BigInt>

=item * MetaCPAN

L<https://metacpan.org/release/Math-BigInt>

=item * CPAN Testers Matrix

L<http://matrix.cpantesters.org/?dist=Math-BigInt>

=item * CPAN Ratings

L<https://cpanratings.perl.org/dist/Math-BigInt>

=item * The Bignum mailing list

=over 4

=item * Post to mailing list

C<bignum at lists.scsys.co.uk>

=item * View mailing list

L<http://lists.scsys.co.uk/pipermail/bignum/>

=item * Subscribe/Unsubscribe

L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>

=back

=back

=head1 LICENSE

This program is free software; you may redistribute it and/or modify it under
the same terms as Perl itself.

=head1 SEE ALSO

L<Math::BigInt> and L<Math::BigInt> as well as the backends
L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>, and L<Math::BigInt::Pari>.

The pragmas L<bignum>, L<bigint> and L<bigrat>.

=head1 AUTHORS

=over 4

=item *

Mark Biggar, overloaded interface by Ilya Zakharevich, 1996-2001.

=item *

Completely rewritten by Tels L<http://bloodgate.com> in 2001-2008.

=item *

Florian Ragwitz E<lt>flora@cpan.orgE<gt>, 2010.

=item *

Peter John Acklam E<lt>pjacklam@gmail.comE<gt>, 2011-.

=back

=cut
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   package Math::BigInt::Calc;

use 5.006001;
use strict;
use warnings;

use Carp qw< carp croak >;
use Math::BigInt::Lib;

our $VERSION = '1.999830';
$VERSION =~ tr/_//d;

our @ISA = ('Math::BigInt::Lib');

# Package to store unsigned big integers in decimal and do math with them
#
# Internally the numbers are stored in an array with at least 1 element, no
# leading zero parts (except the first) and in base 1eX where X is determined
# automatically at loading time to be the maximum possible value
#
# todo:
# - fully remove funky $# stuff in div() (maybe - that code scares me...)

##############################################################################
# global constants, flags and accessory

# constants for easier life

my $MAX_EXP_F;      # the maximum possible base 10 exponent with "no integer"
my $MAX_EXP_I;      # the maximum possible base 10 exponent with "use integer"

my $MAX_BITS;       # the maximum possible number of bits for $AND_BITS etc.

my $BASE_LEN;       # the current base exponent in use
my $USE_INT;        # whether "use integer" is used in the computations

my $BASE;           # the current base, e.g., 10000 if $BASE_LEN is 5
my $MAX_VAL;        # maximum value for an element, i.e., $BASE - 1

my $AND_BITS;       # maximum value used in binary and, e.g., 0xffff
my $OR_BITS;        # ditto for binary or
my $XOR_BITS;       # ditto for binary xor

my $AND_MASK;       # $AND_BITS + 1, e.g., 0x10000 if $AND_BITS is 0xffff
my $OR_MASK;        # ditto for binary or
my $XOR_MASK;       # ditto for binary xor

sub config {
    my $self = shift;

    croak "Missing input argument" unless @_;

    # Called as a getter.

    if (@_ == 1) {
        my $param = shift;
        croak "Parameter name must be a non-empty string"
          unless defined $param && length $param;
        return $BASE_LEN if $param eq 'base_len';
        return $USE_INT  if $param eq 'use_int';
        croak "Unknown parameter '$param'";
    }

    # Called as a setter.

    my $opts;
    while (@_) {
        my $param = shift;
        croak "Parameter name must be a non-empty string"
          unless defined $param && length $param;
        croak "Missing value for parameter '$param'"
          unless @_;
        my $value = shift;

        if ($param eq 'base_len' || $param eq 'use_int') {
            $opts -> {$param} = $value;
            next;
        }

        croak "Unknown parameter '$param'";
    }

    $BASE_LEN = $opts -> {base_len} if exists $opts -> {base_len};
    $USE_INT  = $opts -> {use_int}  if exists $opts -> {use_int};
    __PACKAGE__ -> _base_len($BASE_LEN, $USE_INT);

    return $self;
}

sub _base_len {
    #my $class = shift;                  # $class is not used
    shift;

    if (@_) {                           # if called as setter ...
        my ($base_len, $use_int) = @_;

        croak "The base length must be a positive integer"
          unless defined($base_len) && $base_len == int($base_len)
                 && $base_len > 0;

        if ( $use_int && ($base_len > $MAX_EXP_I) ||
            !$use_int && ($base_len > $MAX_EXP_F))
        {
            croak "The maximum base length (exponent) is $MAX_EXP_I with",
              " 'use integer' and $MAX_EXP_F without 'use integer'. The",
              " requested settings, a base length of $base_len ",
              $use_int ? "with" : "without", " 'use integer', is invalid.";
        }

        $BASE_LEN = $base_len;
        $BASE = 0 + ("1" . ("0" x $BASE_LEN));
        $MAX_VAL = $BASE - 1;
        $USE_INT = $use_int ? 1 : 0;

        {
            no warnings "redefine";
            if ($use_int) {
                *_mul = \&_mul_use_int;
                *_div = \&_div_use_int;
            } else {
                *_mul = \&_mul_no_int;
                *_div = \&_div_no_int;
            }
        }
    }

    # Find max bits. This is the largest power of two that is both no larger
    # than $BASE and no larger than the maximum integer (i.e., ~0). We need
    # this limitation because _and(), _or(), and _xor() only work on one
    # element at a time.

    my $umax = ~0;                      # largest unsigned integer
    my $tmp  = $umax < $BASE ? $umax : $BASE;

    $MAX_BITS = 0;
    while ($tmp >>= 1) {
        $MAX_BITS++;
    }

    # Limit to 32 bits for portability. Is this really necessary? XXX

    $MAX_BITS = 32 if $MAX_BITS > 32;

    # Find out how many bits _and, _or and _xor can take (old default = 16).
    # Are these tests really necessary? Can't we just use $MAX_BITS? XXX

    for ($AND_BITS = $MAX_BITS ; $AND_BITS > 0 ; $AND_BITS--) {
        my $x = CORE::oct('0b' . '1' x $AND_BITS);
        my $y = $x & $x;
        my $z = 2 * (2 ** ($AND_BITS - 1)) + 1;
        last unless $AND_BITS < $MAX_BITS && $x == $z && $y == $x;
    }

    for ($XOR_BITS = $MAX_BITS ; $XOR_BITS > 0 ; $XOR_BITS--) {
        my $x = CORE::oct('0b' . '1' x $XOR_BITS);
        my $y = $x ^ $x;
        my $z = 2 * (2 ** ($XOR_BITS - 1)) + 1;
        last unless $XOR_BITS < $MAX_BITS && $x == $z && $y == $x;
    }

    for ($OR_BITS = $MAX_BITS ; $OR_BITS > 0 ; $OR_BITS--) {
        my $x = CORE::oct('0b' . '1' x $OR_BITS);
        my $y = $x | $x;
        my $z = 2 * (2 ** ($OR_BITS - 1)) + 1;
        last unless $OR_BITS < $MAX_BITS && $x == $z && $y == $x;
    }

    $AND_MASK = __PACKAGE__->_new(( 2 ** $AND_BITS ));
    $XOR_MASK = __PACKAGE__->_new(( 2 ** $XOR_BITS ));
    $OR_MASK  = __PACKAGE__->_new(( 2 ** $OR_BITS  ));

    return $BASE_LEN unless wantarray;
    return ($BASE_LEN, $BASE, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN, $MAX_VAL,
            $MAX_BITS, $MAX_EXP_F, $MAX_EXP_I, $USE_INT);
}

sub _new {
    # Given a string representing an integer, returns a reference to an array
    # of integers, where each integer represents a chunk of the original input
    # integer.

    my ($class, $str) = @_;
    #unless ($str =~ /^([1-9]\d*|0)\z/) {
    #    croak("Invalid input string '$str'");
    #}

    my $input_len = length($str) - 1;

    # Shortcut for small numbers.
    return bless [ $str ], $class if $input_len < $BASE_LEN;

    my $format = "a" . (($input_len % $BASE_LEN) + 1);
    $format .= $] < 5.008 ? "a$BASE_LEN" x int($input_len / $BASE_LEN)
                          : "(a$BASE_LEN)*";

    my $self = [ reverse(map { 0 + $_ } unpack($format, $str)) ];
    return bless $self, $class;
}

BEGIN {

    # Compute $MAX_EXP_F, the maximum usable base 10 exponent.

    # The largest element in base 10**$BASE_LEN is 10**$BASE_LEN-1. For instance,
    # with $BASE_LEN = 5, the largest element is 99_999, and the largest carry is
    #
    #     int( 99_999 * 99_999 / 100_000 ) = 99_998
    #
    # so make sure that 99_999 * 99_999 + 99_998 is within the range of integers
    # that can be represented accuratly.
    #
    # Note that on some systems with quadmath support, the following is within
    # the range of numbers that can be represented exactly, but it still gives
    # the incorrect value $r = 2 (even though POSIX::fmod($x, $y) gives the
    # correct value of 1:
    #
    #     $x =  99999999999999999;
    #     $y = 100000000000000000;
    #     $r = $x * $x % $y;            # should be 1
    #
    # so also check for this.

    for ($MAX_EXP_F = 1 ; ; $MAX_EXP_F++) {         # when $MAX_EXP_F = 5
        my $MAX_EXP_FM1 = $MAX_EXP_F - 1;           #   = 4
        my $bs = "1" . ("0" x $MAX_EXP_F);          #   = "100000"
        my $xs = "9" x $MAX_EXP_F;                  #   =  "99999"
        my $cs = ("9" x $MAX_EXP_FM1) . "8";        #   =  "99998"
        my $ys = $cs . ("0" x $MAX_EXP_FM1) . "1";  #   = "9999800001"

        # Compute and check the product.
        my $yn = $xs * $xs;                         #   = 9999800001
        last if $yn != $ys;

        # Compute and check the remainder.
        my $rn = $yn % $bs;                         #   = 1
        last if $rn != 1;

        # Compute and check the carry. The division here is exact.
        my $cn = ($yn - $rn) / $bs;                 #   = 99998
        last if $cn != $cs;

        # Compute and check product plus carry.
        my $zs = $cs . ("9" x $MAX_EXP_F);          #   = "9999899999"
        my $zn = $yn + $cn;                         #   = 99998999999
        last if $zn != $zs;
        last if $zn - ($zn - 1) != 1;
    }
    $MAX_EXP_F--;                       # last test failed, so retract one step

    # Compute $MAX_EXP_I, the maximum usable base 10 exponent within the range
    # of what is available with "use integer". On older versions of Perl,
    # integers are converted to floating point numbers, even though they are
    # within the range of what can be represented as integers. For example, on
    # some 64 bit Perls, 999999999 * 999999999 becomes 999999998000000000, not
    # 999999998000000001, even though the latter is less than the maximum value
    # for a 64 bit integer, 18446744073709551615.

    my $umax = ~0;                      # largest unsigned integer
    for ($MAX_EXP_I = int(0.5 * log($umax) / log(10));
         $MAX_EXP_I > 0;
         $MAX_EXP_I--)
    {                                               # when $MAX_EXP_I = 5
        my $MAX_EXP_IM1 = $MAX_EXP_I - 1;           #   = 4
        my $bs = "1" . ("0" x $MAX_EXP_I);          #   = "100000"
        my $xs = "9" x $MAX_EXP_I;                  #   =  "99999"
        my $cs = ("9" x $MAX_EXP_IM1) . "8";        #   =  "99998"
        my $ys = $cs . ("0" x $MAX_EXP_IM1) . "1";  #   = "9999800001"

        # Compute and check the product.
        my $yn = $xs * $xs;                         #   = 9999800001
        next if $yn != $ys;

        # Compute and check the remainder.
        my $rn = $yn % $bs;                         #   = 1
        next if $rn != 1;

        # Compute and check the carry. The division here is exact.
        my $cn = ($yn - $rn) / $bs;                 #   = 99998
        next if $cn != $cs;

        # Compute and check product plus carry.
        my $zs = $cs . ("9" x $MAX_EXP_I);          #   = "9999899999"
        my $zn = $yn + $cn;                         #   = 99998999999
        next if $zn != $zs;
        next if $zn - ($zn - 1) != 1;
        last;
    }

    ($BASE_LEN, $USE_INT) = $MAX_EXP_F > $MAX_EXP_I
                          ? ($MAX_EXP_F, 0) : ($MAX_EXP_I, 1);

    __PACKAGE__ -> _base_len($BASE_LEN, $USE_INT);
}

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

sub _zero {
    # create a zero
    my $class = shift;
    return bless [ 0 ], $class;
}

sub _one {
    # create a one
    my $class = shift;
    return bless [ 1 ], $class;
}

sub _two {
    # create a two
    my $class = shift;
    return bless [ 2 ], $class;
}

sub _ten {
    # create a 10
    my $class = shift;
    my $self = $BASE_LEN == 1 ? [ 0, 1 ] : [ 10 ];
    bless $self, $class;
}

sub _1ex {
    # create a 1Ex
    my $class = shift;

    my $rem = $_[0] % $BASE_LEN;                # remainder
    my $div = ($_[0] - $rem) / $BASE_LEN;       # parts

    # With a $BASE_LEN of 6, 1e14 becomes
    # [ 000000, 000000, 100 ] -> [ 0, 0, 100 ]
    bless [ (0) x $div,  0 + ("1" . ("0" x $rem)) ], $class;
}

sub _copy {
    # make a true copy
    my $class = shift;
    return bless [ @{ $_[0] } ], $class;
}

sub import {
    my $self = shift;

    my $opts;
    my ($base_len, $use_int);
    while (@_) {
        my $param = shift;
        croak "Parameter name must be a non-empty string"
          unless defined $param && length $param;
        croak "Missing value for parameter '$param'"
          unless @_;
        my $value = shift;

        if ($param eq 'base_len' || $param eq 'use_int') {
            $opts -> {$param} = $value;
            next;
        }

        croak "Unknown parameter '$param'";
    }

    $base_len = exists $opts -> {base_len} ? $opts -> {base_len} : $BASE_LEN;
    $use_int  = exists $opts -> {use_int}  ? $opts -> {use_int}  : $USE_INT;
    __PACKAGE__ -> _base_len($base_len, $use_int);

    return $self;
}

##############################################################################
# convert back to string and number

sub _str {
    # Convert number from internal base 1eN format to string format. Internal
    # format is always normalized, i.e., no leading zeros.

    my $ary = $_[1];
    my $idx = $#$ary;           # index of last element

    if ($idx < 0) {             # should not happen
        croak("$_[1] has no elements");
    }

    # Handle first one differently, since it should not have any leading zeros.
    my $ret = int($ary->[$idx]);
    if ($idx > 0) {
        # Interestingly, the pre-padd method uses more time.
        # The old grep variant takes longer (14 vs. 10 sec).
        my $z = '0' x ($BASE_LEN - 1);
        while (--$idx >= 0) {
            $ret .= substr($z . $ary->[$idx], -$BASE_LEN);
        }
    }
    $ret;
}

sub _num {
    # Make a Perl scalar number (int/float) from a BigInt object.
    my $x = $_[1];

    return $x->[0] if @$x == 1;         # below $BASE

    # Start with the most significant element and work towards the least
    # significant element. Avoid multiplying "inf" (which happens if the number
    # overflows) with "0" (if there are zero elements in $x) since this gives
    # "nan" which propagates to the output.

    my $num = 0;
    for (my $i = $#$x ; $i >= 0 ; --$i) {
        $num *= $BASE;
        $num += $x -> [$i];
    }
    return $num;
}

##############################################################################
# actual math code

sub _add {
    # (ref to int_num_array, ref to int_num_array)
    #
    # Routine to add two base 1eX numbers stolen from Knuth Vol 2 Algorithm A
    # pg 231. There are separate routines to add and sub as per Knuth pg 233.
    # This routine modifies array x, but not y.

    my ($c, $x, $y) = @_;

    # $x + 0 => $x

    return $x if @$y == 1 && $y->[0] == 0;

    # 0 + $y => $y->copy

    if (@$x == 1 && $x->[0] == 0) {
        @$x = @$y;
        return $x;
    }

    # For each in Y, add Y to X and carry. If after that, something is left in
    # X, foreach in X add carry to X and then return X, carry. Trades one
    # "$j++" for having to shift arrays.

    my $car = 0;
    my $j = 0;
    for my $i (@$y) {
        $x->[$j] -= $BASE if $car = (($x->[$j] += $i + $car) >= $BASE) ? 1 : 0;
        $j++;
    }
    while ($car != 0) {
        $x->[$j] -= $BASE if $car = (($x->[$j] += $car) >= $BASE) ? 1 : 0;
        $j++;
    }
    $x;
}

sub _inc {
    # (ref to int_num_array, ref to int_num_array)
    # Add 1 to $x, modify $x in place
    my ($c, $x) = @_;

    for my $i (@$x) {
        return $x if ($i += 1) < $BASE; # early out
        $i = 0;                         # overflow, next
    }
    push @$x, 1 if $x->[-1] == 0;       # last overflowed, so extend
    $x;
}

sub _dec {
    # (ref to int_num_array, ref to int_num_array)
    # Sub 1 from $x, modify $x in place
    my ($c, $x) = @_;

    my $MAX = $BASE - 1;                # since MAX_VAL based on BASE
    for my $i (@$x) {
        last if ($i -= 1) >= 0;         # early out
        $i = $MAX;                      # underflow, next
    }
    pop @$x if $x->[-1] == 0 && @$x > 1; # last underflowed (but leave 0)
    $x;
}

sub _sub {
    # (ref to int_num_array, ref to int_num_array, swap)
    #
    # Subtract base 1eX numbers -- stolen from Knuth Vol 2 pg 232, $x > $y
    # subtract Y from X by modifying x in place
    my ($c, $sx, $sy, $s) = @_;

    my $car = 0;
    my $j = 0;
    if (!$s) {
        for my $i (@$sx) {
            last unless defined $sy->[$j] || $car;
            $i += $BASE if $car = (($i -= ($sy->[$j] || 0) + $car) < 0);
            $j++;
        }
        # might leave leading zeros, so fix that
        return __strip_zeros($sx);
    }
    for my $i (@$sx) {
        # We can't do an early out if $x < $y, since we need to copy the high
        # chunks from $y. Found by Bob Mathews.
        #last unless defined $sy->[$j] || $car;
        $sy->[$j] += $BASE
          if $car = ($sy->[$j] = $i - ($sy->[$j] || 0) - $car) < 0;
        $j++;
    }
    # might leave leading zeros, so fix that
    __strip_zeros($sy);
}

sub _mul_use_int {
    # (ref to int_num_array, ref to int_num_array)
    # multiply two numbers in internal representation
    # modifies first arg, second need not be different from first
    # works for 64 bit integer with "use integer"
    my ($c, $xv, $yv) = @_;
    use integer;

    if (@$yv == 1) {
        # shortcut for two very short numbers (improved by Nathan Zook) works
        # also if xv and yv are the same reference, and handles also $x == 0
        if (@$xv == 1) {
            if (($xv->[0] *= $yv->[0]) >= $BASE) {
                $xv->[0] =
                  $xv->[0] - ($xv->[1] = $xv->[0] / $BASE) * $BASE;
            }
            return $xv;
        }
        # $x * 0 => 0
        if ($yv->[0] == 0) {
            @$xv = (0);
            return $xv;
        }

        # multiply a large number a by a single element one, so speed up
        my $y = $yv->[0];
        my $car = 0;
        foreach my $i (@$xv) {
            #$i = $i * $y + $car; $car = $i / $BASE; $i -= $car * $BASE;
            $i = $i * $y + $car;
            $i -= ($car = $i / $BASE) * $BASE;
        }
        push @$xv, $car if $car != 0;
        return $xv;
    }

    # shortcut for result $x == 0 => result = 0
    return $xv if @$xv == 1 && $xv->[0] == 0;

    # since multiplying $x with $x fails, make copy in this case
    $yv = $c->_copy($xv) if $xv == $yv;         # same references?

    my @prod = ();
    my ($prod, $car, $cty);
    for my $xi (@$xv) {
        $car = 0;
        $cty = 0;
        # looping through this if $xi == 0 is silly - so optimize it away!
        $xi = (shift(@prod) || 0), next if $xi == 0;
        for my $yi (@$yv) {
            $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
            $prod[$cty++] = $prod - ($car = $prod / $BASE) * $BASE;
        }
        $prod[$cty] += $car if $car;    # need really to check for 0?
        $xi = shift(@prod) || 0;        # || 0 makes v5.005_3 happy
    }
    push @$xv, @prod;
    $xv;
}

sub _mul_no_int {
    # (ref to int_num_array, ref to int_num_array)
    # multiply two numbers in internal representation
    # modifies first arg, second need not be different from first
    my ($c, $xv, $yv) = @_;

    if (@$yv == 1) {
        # shortcut for two very short numbers (improved by Nathan Zook) works
        # also if xv and yv are the same reference, and handles also $x == 0
        if (@$xv == 1) {
            if (($xv->[0] *= $yv->[0]) >= $BASE) {
                my $rem = $xv->[0] % $BASE;
                $xv->[1] = ($xv->[0] - $rem) / $BASE;
                $xv->[0] = $rem;
            }
            return $xv;
        }
        # $x * 0 => 0
        if ($yv->[0] == 0) {
            @$xv = (0);
            return $xv;
        }

        # multiply a large number a by a single element one, so speed up
        my $y = $yv->[0];
        my $car = 0;
        my $rem;
        foreach my $i (@$xv) {
            $i = $i * $y + $car;
            $rem = $i % $BASE;
            $car = ($i - $rem) / $BASE;
            $i = $rem;
        }
        push @$xv, $car if $car != 0;
        return $xv;
    }

    # shortcut for result $x == 0 => result = 0
    return $xv if @$xv == 1 && $xv->[0] == 0;

    # since multiplying $x with $x fails, make copy in this case
    $yv = $c->_copy($xv) if $xv == $yv;         # same references?

    my @prod = ();
    my ($prod, $rem, $car, $cty);
    for my $xi (@$xv) {
        $car = 0;
        $cty = 0;
        # looping through this if $xi == 0 is silly - so optimize it away!
        $xi = (shift(@prod) || 0), next if $xi == 0;
        for my $yi (@$yv) {
            $prod = $xi * $yi + ($prod[$cty] || 0) + $car;
            $rem = $prod % $BASE;
            $car = ($prod - $rem) / $BASE;
            $prod[$cty++] = $rem;
        }
        $prod[$cty] += $car if $car;    # need really to check for 0?
        $xi = shift(@prod) || 0;        # || 0 makes v5.005_3 happy
    }
    push @$xv, @prod;
    $xv;
}

sub _div_use_int {
    # ref to array, ref to array, modify first array and return remainder if
    # in list context

    # This version works on integers
    use integer;

    my ($c, $x, $yorg) = @_;

    # the general div algorithm here is about O(N*N) and thus quite slow, so
    # we first check for some special cases and use shortcuts to handle them.

    # if both numbers have only one element:
    if (@$x == 1 && @$yorg == 1) {
        # shortcut, $yorg and $x are two small numbers
        if (wantarray) {
            my $rem = [ $x->[0] % $yorg->[0] ];
            bless $rem, $c;
            $x->[0] = $x->[0] / $yorg->[0];
            return ($x, $rem);
        } else {
            $x->[0] = $x->[0] / $yorg->[0];
            return $x;
        }
    }

    # if x has more than one, but y has only one element:
    if (@$yorg == 1) {
        my $rem;
        $rem = $c->_mod($c->_copy($x), $yorg) if wantarray;

        # shortcut, $y is < $BASE
        my $j = @$x;
        my $r = 0;
        my $y = $yorg->[0];
        my $b;
        while ($j-- > 0) {
            $b = $r * $BASE + $x->[$j];
            $r = $b % $y;
            $x->[$j] = $b / $y;
        }
        pop(@$x) if @$x > 1 && $x->[-1] == 0;   # remove any trailing zero
        return ($x, $rem) if wantarray;
        return $x;
    }

    # now x and y have more than one element

    # check whether y has more elements than x, if so, the result is 0
    if (@$yorg > @$x) {
        my $rem;
        $rem = $c->_copy($x) if wantarray;      # make copy
        @$x = 0;                                # set to 0
        return ($x, $rem) if wantarray;         # including remainder?
        return $x;                              # only x, which is [0] now
    }

    # check whether the numbers have the same number of elements, in that case
    # the result will fit into one element and can be computed efficiently
    if (@$yorg == @$x) {
        my $cmp = 0;
        for (my $j = $#$x ; $j >= 0 ; --$j) {
            last if $cmp = $x->[$j] - $yorg->[$j];
        }

        if ($cmp == 0) {        # x = y
            @$x = 1;
            return $x, $c->_zero() if wantarray;
            return $x;
        }

        if ($cmp < 0) {         # x < y
            if (wantarray) {
                my $rem = $c->_copy($x);
                @$x = 0;
                return $x, $rem;
            }
            @$x = 0;
            return $x;
        }
    }

    # all other cases:

    my $y = $c->_copy($yorg);           # always make copy to preserve

    my $tmp;
    my $dd = $BASE / ($y->[-1] + 1);
    if ($dd != 1) {
        my $car = 0;
        for my $xi (@$x) {
            $xi = $xi * $dd + $car;
            $xi -= ($car = $xi / $BASE) * $BASE;
        }
        push(@$x, $car);
        $car = 0;
        for my $yi (@$y) {
            $yi = $yi * $dd + $car;
            $yi -= ($car = $yi / $BASE) * $BASE;
        }
    } else {
        push(@$x, 0);
    }

    # @q will accumulate the final result, $q contains the current computed
    # part of the final result

    my @q = ();
    my ($v2, $v1) = @$y[-2, -1];
    $v2 = 0 unless $v2;
    while ($#$x > $#$y) {
        my ($u2, $u1, $u0) = @$x[-3 .. -1];
        $u2 = 0 unless $u2;
        #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
        # if $v1 == 0;
        my $tmp = $u0 * $BASE + $u1;
        my $rem = $tmp % $v1;
        my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1);
        --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2;
        if ($q) {
            my $prd;
            my ($car, $bar) = (0, 0);
            for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                $prd = $q * $y->[$yi] + $car;
                $prd -= ($car = int($prd / $BASE)) * $BASE;
                $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0);
            }
            if ($x->[-1] < $car + $bar) {
                $car = 0;
                --$q;
                for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                    $x->[$xi] -= $BASE
                      if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
                }
            }
        }
        pop(@$x);
        unshift(@q, $q);
    }

    if (wantarray) {
        my $d = bless [], $c;
        if ($dd != 1) {
            my $car = 0;
            my $prd;
            for my $xi (reverse @$x) {
                $prd = $car * $BASE + $xi;
                $car = $prd - ($tmp = $prd / $dd) * $dd;
                unshift @$d, $tmp;
            }
        } else {
            @$d = @$x;
        }
        @$x = @q;
        __strip_zeros($x);
        __strip_zeros($d);
        return ($x, $d);
    }
    @$x = @q;
    __strip_zeros($x);
    $x;
}

sub _div_no_int {
    # ref to array, ref to array, modify first array and return remainder if
    # in list context

    my ($c, $x, $yorg) = @_;

    # the general div algorithm here is about O(N*N) and thus quite slow, so
    # we first check for some special cases and use shortcuts to handle them.

    # if both numbers have only one element:
    if (@$x == 1 && @$yorg == 1) {
        # shortcut, $yorg and $x are two small numbers
        my $rem = [ $x->[0] % $yorg->[0] ];
        bless $rem, $c;
        $x->[0] = ($x->[0] - $rem->[0]) / $yorg->[0];
        return ($x, $rem) if wantarray;
        return $x;
    }

    # if x has more than one, but y has only one element:
    if (@$yorg == 1) {
        my $rem;
        $rem = $c->_mod($c->_copy($x), $yorg) if wantarray;

        # shortcut, $y is < $BASE
        my $j = @$x;
        my $r = 0;
        my $y = $yorg->[0];
        my $b;
        while ($j-- > 0) {
            $b = $r * $BASE + $x->[$j];
            $r = $b % $y;
            $x->[$j] = ($b - $r) / $y;
        }
        pop(@$x) if @$x > 1 && $x->[-1] == 0;   # remove any trailing zero
        return ($x, $rem) if wantarray;
        return $x;
    }

    # now x and y have more than one element

    # check whether y has more elements than x, if so, the result is 0
    if (@$yorg > @$x) {
        my $rem;
        $rem = $c->_copy($x) if wantarray;      # make copy
        @$x = 0;                                # set to 0
        return ($x, $rem) if wantarray;         # including remainder?
        return $x;                              # only x, which is [0] now
    }

    # check whether the numbers have the same number of elements, in that case
    # the result will fit into one element and can be computed efficiently
    if (@$yorg == @$x) {
        my $cmp = 0;
        for (my $j = $#$x ; $j >= 0 ; --$j) {
            last if $cmp = $x->[$j] - $yorg->[$j];
        }

        if ($cmp == 0) {        # x = y
            @$x = 1;
            return $x, $c->_zero() if wantarray;
            return $x;
        }

        if ($cmp < 0) {         # x < y
            if (wantarray) {
                my $rem = $c->_copy($x);
                @$x = 0;
                return $x, $rem;
            }
            @$x = 0;
            return $x;
        }
    }

    # all other cases:

    my $y = $c->_copy($yorg);           # always make copy to preserve

    my $tmp = $y->[-1] + 1;
    my $rem = $BASE % $tmp;
    my $dd  = ($BASE - $rem) / $tmp;
    if ($dd != 1) {
        my $car = 0;
        for my $xi (@$x) {
            $xi = $xi * $dd + $car;
            $rem = $xi % $BASE;
            $car = ($xi - $rem) / $BASE;
            $xi = $rem;
        }
        push(@$x, $car);
        $car = 0;
        for my $yi (@$y) {
            $yi = $yi * $dd + $car;
            $rem = $yi % $BASE;
            $car = ($yi - $rem) / $BASE;
            $yi = $rem;
        }
    } else {
        push(@$x, 0);
    }

    # @q will accumulate the final result, $q contains the current computed
    # part of the final result

    my @q = ();
    my ($v2, $v1) = @$y[-2, -1];
    $v2 = 0 unless $v2;
    while ($#$x > $#$y) {
        my ($u2, $u1, $u0) = @$x[-3 .. -1];
        $u2 = 0 unless $u2;
        #warn "oups v1 is 0, u0: $u0 $y->[-2] $y->[-1] l ",scalar @$y,"\n"
        # if $v1 == 0;
        my $tmp = $u0 * $BASE + $u1;
        my $rem = $tmp % $v1;
        my $q = $u0 == $v1 ? $MAX_VAL : (($tmp - $rem) / $v1);
        --$q while $v2 * $q > ($u0 * $BASE + $u1 - $q * $v1) * $BASE + $u2;
        if ($q) {
            my $prd;
            my ($car, $bar) = (0, 0);
            for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                $prd = $q * $y->[$yi] + $car;
                $rem = $prd % $BASE;
                $car = ($prd - $rem) / $BASE;
                $prd -= $car * $BASE;
                $x->[$xi] += $BASE if $bar = (($x->[$xi] -= $prd + $bar) < 0);
            }
            if ($x->[-1] < $car + $bar) {
                $car = 0;
                --$q;
                for (my $yi = 0, my $xi = $#$x - $#$y - 1; $yi <= $#$y; ++$yi, ++$xi) {
                    $x->[$xi] -= $BASE
                      if $car = (($x->[$xi] += $y->[$yi] + $car) >= $BASE);
                }
            }
        }
        pop(@$x);
        unshift(@q, $q);
    }

    if (wantarray) {
        my $d = bless [], $c;
        if ($dd != 1) {
            my $car = 0;
            my ($prd, $rem);
            for my $xi (reverse @$x) {
                $prd = $car * $BASE + $xi;
                $rem = $prd % $dd;
                $tmp = ($prd - $rem) / $dd;
                $car = $rem;
                unshift @$d, $tmp;
            }
        } else {
            @$d = @$x;
        }
        @$x = @q;
        __strip_zeros($x);
        __strip_zeros($d);
        return ($x, $d);
    }
    @$x = @q;
    __strip_zeros($x);
    $x;
}

##############################################################################
# testing

sub _acmp {
    # Internal absolute post-normalized compare (ignore signs)
    # ref to array, ref to array, return <0, 0, >0
    # Arrays must have at least one entry; this is not checked for.
    my ($c, $cx, $cy) = @_;

    # shortcut for short numbers
    return (($cx->[0] <=> $cy->[0]) <=> 0)
      if @$cx == 1 && @$cy == 1;

    # fast comp based on number of array elements (aka pseudo-length)
    my $lxy = (@$cx - @$cy)
      # or length of first element if same number of elements (aka difference 0)
      ||
        # need int() here because sometimes the last element is '00018' vs '18'
        (length(int($cx->[-1])) - length(int($cy->[-1])));

    return -1 if $lxy < 0;      # already differs, ret
    return  1 if $lxy > 0;      # ditto

    # manual way (abort if unequal, good for early ne)
    my $a;
    my $j = @$cx;
    while (--$j >= 0) {
        last if $a = $cx->[$j] - $cy->[$j];
    }
    $a <=> 0;
}

sub _len {
    # compute number of digits in base 10

    # int() because add/sub sometimes leaves strings (like '00005') instead of
    # '5' in this place, thus causing length() to report wrong length
    my $cx = $_[1];

    (@$cx - 1) * $BASE_LEN + length(int($cx->[-1]));
}

sub _digit {
    # Return the nth digit. Zero is rightmost, so _digit(123, 0) gives 3.
    # Negative values count from the left, so _digit(123, -1) gives 1.
    my ($c, $x, $n) = @_;

    my $len = _len('', $x);

    $n += $len if $n < 0;               # -1 last, -2 second-to-last

    # Math::BigInt::Calc returns 0 if N is out of range, but this is not done
    # by the other backend libraries.

    return "0" if $n < 0 || $n >= $len; # return 0 for digits out of range

    my $elem = int($n / $BASE_LEN);     # index of array element
    my $digit = $n % $BASE_LEN;         # index of digit within the element
    substr("0" x $BASE_LEN . "$x->[$elem]", -1 - $digit, 1);
}

sub _zeros {
    # Return number of trailing zeros in decimal.
    # Check each array element for having 0 at end as long as elem == 0
    # Upon finding a elem != 0, stop.

    my $x = $_[1];

    return 0 if @$x == 1 && $x->[0] == 0;

    my $zeros = 0;
    foreach my $elem (@$x) {
        if ($elem != 0) {
            $elem =~ /[^0](0*)\z/;
            $zeros += length($1);       # count trailing zeros
            last;                       # early out
        }
        $zeros += $BASE_LEN;
    }
    $zeros;
}

##############################################################################
# _is_* routines

sub _is_zero {
    # return true if arg is zero
    @{$_[1]} == 1 && $_[1]->[0] == 0 ? 1 : 0;
}

sub _is_even {
    # return true if arg is even
    $_[1]->[0] % 2 ? 0 : 1;
}

sub _is_odd {
    # return true if arg is odd
    $_[1]->[0] % 2 ? 1 : 0;
}

sub _is_one {
    # return true if arg is one
    @{$_[1]} == 1 && $_[1]->[0] == 1 ? 1 : 0;
}

sub _is_two {
    # return true if arg is two
    @{$_[1]} == 1 && $_[1]->[0] == 2 ? 1 : 0;
}

sub _is_ten {
    # return true if arg is ten
    if ($BASE_LEN == 1) {
        @{$_[1]} == 2 && $_[1]->[0] == 0 && $_[1]->[1] == 1 ? 1 : 0;
    } else {
        @{$_[1]} == 1 && $_[1]->[0] == 10 ? 1 : 0;
    }
}

sub __strip_zeros {
    # Internal normalization function that strips leading zeros from the array.
    # Args: ref to array
    my $x = shift;

    push @$x, 0 if @$x == 0;    # div might return empty results, so fix it
    return $x if @$x == 1;      # early out

    #print "strip: cnt $cnt i $i\n";
    # '0', '3', '4', '0', '0',
    #  0    1    2    3    4
    # cnt = 5, i = 4
    # i = 4
    # i = 3
    # => fcnt = cnt - i (5-2 => 3, cnt => 5-1 = 4, throw away from 4th pos)
    # >= 1: skip first part (this can be zero)

    my $i = $#$x;
    while ($i > 0) {
        last if $x->[$i] != 0;
        $i--;
    }
    $i++;
    splice(@$x, $i) if $i < @$x;
    $x;
}

###############################################################################
# check routine to test internal state for corruptions

sub _check {
    # used by the test suite
    my ($class, $x) = @_;

    my $msg = $class -> SUPER::_check($x);
    return $msg if $msg;

    my $n;
    eval { $n = @$x };
    return "Not an array reference" unless $@ eq '';

    return "Reference to an empty array" unless $n > 0;

    # The following fails with Math::BigInt::FastCalc because a
    # Math::BigInt::FastCalc "object" is an unblessed array ref.
    #
    #return 0 unless ref($x) eq $class;

    for (my $i = 0 ; $i <= $#$x ; ++ $i) {
        my $e = $x -> [$i];

        return "Element at index $i is undefined"
          unless defined $e;

        return "Element at index $i is a '" . ref($e) .
          "', which is not a scalar"
          unless ref($e) eq "";

        # It would be better to use the regex /^([1-9]\d*|0)\z/, but that fails
        # in Math::BigInt::FastCalc, because it sometimes creates array
        # elements like "000000".
        return "Element at index $i is '$e', which does not look like an" .
          " normal integer" unless $e =~ /^\d+\z/;

        return "Element at index $i is '$e', which is not smaller than" .
          " the base '$BASE'" if $e >= $BASE;

        return "Element at index $i (last element) is zero"
          if $#$x > 0 && $i == $#$x && $e == 0;
    }

    return 0;
}

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

sub _mod {
    # if possible, use mod shortcut
    my ($c, $x, $yo) = @_;

    # slow way since $y too big
    if (@$yo > 1) {
        my ($xo, $rem) = $c->_div($x, $yo);
        @$x = @$rem;
        return $x;
    }

    my $y = $yo->[0];

    # if both are single element arrays
    if (@$x == 1) {
        $x->[0] %= $y;
        return $x;
    }

    # if @$x has more than one element, but @$y is a single element
    my $b = $BASE % $y;
    if ($b == 0) {
        # when BASE % Y == 0 then (B * BASE) % Y == 0
        # (B * BASE) % $y + A % Y => A % Y
        # so need to consider only last element: O(1)
        $x->[0] %= $y;
    } elsif ($b == 1) {
        # else need to go through all elements in @$x: O(N), but loop is a bit
        # simplified
        my $r = 0;
        foreach (@$x) {
            $r = ($r + $_) % $y; # not much faster, but heh...
            #$r += $_ % $y; $r %= $y;
        }
        $r = 0 if $r == $y;
        $x->[0] = $r;
    } else {
        # else need to go through all elements in @$x: O(N)
        my $r = 0;
        my $bm = 1;
        foreach (@$x) {
            $r = ($_ * $bm + $r) % $y;
            $bm = ($bm * $b) % $y;

            #$r += ($_ % $y) * $bm;
            #$bm *= $b;
            #$bm %= $y;
            #$r %= $y;
        }
        $r = 0 if $r == $y;
        $x->[0] = $r;
    }
    @$x = $x->[0];              # keep one element of @$x
    return $x;
}

##############################################################################
# shifts

sub _rsft {
    my ($c, $x, $n, $b) = @_;
    return $x if $c->_is_zero($x) || $c->_is_zero($n);

    # For backwards compatibility, allow the base $b to be a scalar.

    $b = $c->_new($b) unless ref $b;

    if ($c -> _acmp($b, $c -> _ten())) {
        return scalar $c->_div($x, $c->_pow($c->_copy($b), $n));
    }

    # shortcut (faster) for shifting by 10)
    # multiples of $BASE_LEN
    my $dst = 0;                # destination
    my $src = $c->_num($n);     # as normal int
    my $xlen = (@$x - 1) * $BASE_LEN + length(int($x->[-1]));
    if ($src >= $xlen or ($src == $xlen and !defined $x->[1])) {
        # 12345 67890 shifted right by more than 10 digits => 0
        splice(@$x, 1);         # leave only one element
        $x->[0] = 0;            # set to zero
        return $x;
    }
    my $rem = $src % $BASE_LEN;   # remainder to shift
    $src = int($src / $BASE_LEN); # source
    if ($rem == 0) {
        splice(@$x, 0, $src);   # even faster, 38.4 => 39.3
    } else {
        my $len = @$x - $src;   # elems to go
        my $vd;
        my $z = '0' x $BASE_LEN;
        $x->[ @$x ] = 0;          # avoid || 0 test inside loop
        while ($dst < $len) {
            $vd = $z . $x->[$src];
            $vd = substr($vd, -$BASE_LEN, $BASE_LEN - $rem);
            $src++;
            $vd = substr($z . $x->[$src], -$rem, $rem) . $vd;
            $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
            $x->[$dst] = int($vd);
            $dst++;
        }
        splice(@$x, $dst) if $dst > 0;       # kill left-over array elems
        pop(@$x) if $x->[-1] == 0 && @$x > 1; # kill last element if 0
    }                                        # else rem == 0
    $x;
}

sub _lsft {
    my ($c, $x, $n, $b) = @_;

    return $x if $c->_is_zero($x) || $c->_is_zero($n);

    # For backwards compatibility, allow the base $b to be a scalar.

    $b = $c->_new($b) unless ref $b;

    # If the base is a power of 10, use shifting, since the internal
    # representation is in base 10eX.

    my $bstr = $c->_str($b);
    if ($bstr =~ /^1(0+)\z/) {

        # Adjust $n so that we're shifting in base 10. Do this by multiplying
        # $n by the base 10 logarithm of $b: $b ** $n = 10 ** (log10($b) * $n).

        my $log10b = length($1);
        $n = $c->_mul($c->_new($log10b), $n);
        $n = $c->_num($n);              # shift-len as normal int

        # $q is the number of places to shift the elements within the array,
        # and $r is the number of places to shift the values within the
        # elements.

        my $r = $n % $BASE_LEN;
        my $q = ($n - $r) / $BASE_LEN;

        # If we must shift the values within the elements ...

        if ($r) {
            my $i = @$x;                # index
            $x->[$i] = 0;               # initialize most significant element
            my $z = '0' x $BASE_LEN;
            my $vd;
            while ($i >= 0) {
                $vd = $x->[$i];
                $vd = $z . $vd;
                $vd = substr($vd, $r - $BASE_LEN, $BASE_LEN - $r);
                $vd .= $i > 0 ? substr($z . $x->[$i - 1], -$BASE_LEN, $r)
                              : '0' x $r;
                $vd = substr($vd, -$BASE_LEN, $BASE_LEN) if length($vd) > $BASE_LEN;
                $x->[$i] = int($vd);    # e.g., "0...048" -> 48 etc.
                $i--;
            }

            pop(@$x) if $x->[-1] == 0;  # if most significant element is zero
        }

        # If we must shift the elements within the array ...

        if ($q) {
            unshift @$x, (0) x $q;
        }

    } else {
        $x = $c->_mul($x, $c->_pow($b, $n));
    }

    return $x;
}

sub _pow {
    # power of $x to $y
    # ref to array, ref to array, return ref to array
    my ($c, $cx, $cy) = @_;

    if (@$cy == 1 && $cy->[0] == 0) {
        splice(@$cx, 1);
        $cx->[0] = 1;           # y == 0 => x => 1
        return $cx;
    }

    if ((@$cx == 1 && $cx->[0] == 1) || #    x == 1
        (@$cy == 1 && $cy->[0] == 1))   # or y == 1
    {
        return $cx;
    }

    if (@$cx == 1 && $cx->[0] == 0) {
        splice (@$cx, 1);
        $cx->[0] = 0;           # 0 ** y => 0 (if not y <= 0)
        return $cx;
    }

    my $pow2 = $c->_one();

    my $y_bin = $c->_as_bin($cy);
    $y_bin =~ s/^0b//;
    my $len = length($y_bin);
    while (--$len > 0) {
        $c->_mul($pow2, $cx) if substr($y_bin, $len, 1) eq '1'; # is odd?
        $c->_mul($cx, $cx);
    }

    $c->_mul($cx, $pow2);
    $cx;
}

sub _nok {
    # Return binomial coefficient (n over k).
    # Given refs to arrays, return ref to array.
    # First input argument is modified.

    my ($c, $n, $k) = @_;

    # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
    # nok(n, n-k), to minimize the number if iterations in the loop.

    {
        my $twok = $c->_mul($c->_two(), $c->_copy($k)); # 2 * k
        if ($c->_acmp($twok, $n) > 0) {               # if 2*k > n
            $k = $c->_sub($c->_copy($n), $k);         # k = n - k
        }
    }

    # Example:
    #
    # / 7 \       7!       1*2*3*4 * 5*6*7   5 * 6 * 7       6   7
    # |   | = --------- =  --------------- = --------- = 5 * - * -
    # \ 3 /   (7-3)! 3!    1*2*3*4 * 1*2*3   1 * 2 * 3       2   3

    if ($c->_is_zero($k)) {
        @$n = 1;
    } else {

        # Make a copy of the original n, since we'll be modifying n in-place.

        my $n_orig = $c->_copy($n);

        # n = 5, f = 6, d = 2 (cf. example above)

        $c->_sub($n, $k);
        $c->_inc($n);

        my $f = $c->_copy($n);
        $c->_inc($f);

        my $d = $c->_two();

        # while f <= n (the original n, that is) ...

        while ($c->_acmp($f, $n_orig) <= 0) {

            # n = (n * f / d) == 5 * 6 / 2 (cf. example above)

            $c->_mul($n, $f);
            $c->_div($n, $d);

            # f = 7, d = 3 (cf. example above)

            $c->_inc($f);
            $c->_inc($d);
        }

    }

    return $n;
}

sub _fac {
    # factorial of $x
    # ref to array, return ref to array
    my ($c, $cx) = @_;

    # We cache the smallest values. Don't assume that a single element has a
    # value larger than 9 or else it won't work with a $BASE_LEN of 1.

    if (@$cx == 1) {
        my @factorials =
          (
           '1',
           '1',
           '2',
           '6',
           '24',
           '120',
           '720',
           '5040',
           '40320',
           '362880',
          );
        if ($cx->[0] <= $#factorials) {
            my $tmp = $c -> _new($factorials[ $cx->[0] ]);
            @$cx = @$tmp;
            return $cx;
        }
    }

    # The old code further below doesn't work for small values of $BASE_LEN.
    # Alas, I have not been able to (or taken the time to) decipher it, so for
    # the case when $BASE_LEN is small, we call the parent class. This code
    # works in for every value of $x and $BASE_LEN. We could use this code for
    # all cases, but it is a little slower than the code further below, so at
    # least for now we keep the code below.

    if ($BASE_LEN <= 2) {
        my $tmp = $c -> SUPER::_fac($cx);
        @$cx = @$tmp;
        return $cx;
    }

    # This code does not work for small values of $BASE_LEN.

    if ((@$cx == 1) &&          # we do this only if $x >= 12 and $x <= 7000
        ($cx->[0] >= 12 && $cx->[0] < 7000)) {

        # Calculate (k-j) * (k-j+1) ... k .. (k+j-1) * (k + j)
        # See http://blogten.blogspot.com/2007/01/calculating-n.html
        # The above series can be expressed as factors:
        #   k * k - (j - i) * 2
        # We cache k*k, and calculate (j * j) as the sum of the first j odd integers

        # This will not work when N exceeds the storage of a Perl scalar, however,
        # in this case the algorithm would be way too slow to terminate, anyway.

        # As soon as the last element of $cx is 0, we split it up and remember
        # how many zeors we got so far. The reason is that n! will accumulate
        # zeros at the end rather fast.
        my $zero_elements = 0;

        # If n is even, set n = n -1
        my $k = $c->_num($cx);
        my $even = 1;
        if (($k & 1) == 0) {
            $even = $k;
            $k --;
        }
        # set k to the center point
        $k = ($k + 1) / 2;
        #  print "k $k even: $even\n";
        # now calculate k * k
        my $k2 = $k * $k;
        my $odd = 1;
        my $sum = 1;
        my $i = $k - 1;
        # keep reference to x
        my $new_x = $c->_new($k * $even);
        @$cx = @$new_x;
        if ($cx->[0] == 0) {
            $zero_elements ++;
            shift @$cx;
        }
        #  print STDERR "x = ", $c->_str($cx), "\n";
        my $BASE2 = int(sqrt($BASE))-1;
        my $j = 1;
        while ($j <= $i) {
            my $m = ($k2 - $sum);
            $odd += 2;
            $sum += $odd;
            $j++;
            while ($j <= $i && ($m < $BASE2) && (($k2 - $sum) < $BASE2)) {
                $m *= ($k2 - $sum);
                $odd += 2;
                $sum += $odd;
                $j++;
                #      print STDERR "\n k2 $k2 m $m sum $sum odd $odd\n"; sleep(1);
            }
            if ($m < $BASE) {
                $c->_mul($cx, [$m]);
            } else {
                $c->_mul($cx, $c->_new($m));
            }
            if ($cx->[0] == 0) {
                $zero_elements ++;
                shift @$cx;
            }
            #    print STDERR "Calculate $k2 - $sum = $m (x = ", $c->_str($cx), ")\n";
        }
        # multiply in the zeros again
        unshift @$cx, (0) x $zero_elements;
        return $cx;
    }

    # go forward until $base is exceeded limit is either $x steps (steps == 100
    # means a result always too high) or $base.
    my $steps = 100;
    $steps = $cx->[0] if @$cx == 1;
    my $r = 2;
    my $cf = 3;
    my $step = 2;
    my $last = $r;
    while ($r * $cf < $BASE && $step < $steps) {
        $last = $r;
        $r *= $cf++;
        $step++;
    }
    if ((@$cx == 1) && $step == $cx->[0]) {
        # completely done, so keep reference to $x and return
        $cx->[0] = $r;
        return $cx;
    }

    # now we must do the left over steps
    my $n;                      # steps still to do
    if (@$cx == 1) {
        $n = $cx->[0];
    } else {
        $n = $c->_copy($cx);
    }

    # Set $cx to the last result below $BASE (but keep ref to $x)
    $cx->[0] = $last;
    splice (@$cx, 1);
    # As soon as the last element of $cx is 0, we split it up and remember
    # how many zeors we got so far. The reason is that n! will accumulate
    # zeros at the end rather fast.
    my $zero_elements = 0;

    # do left-over steps fit into a scalar?
    if (ref $n eq 'ARRAY') {
        # No, so use slower inc() & cmp()
        # ($n is at least $BASE here)
        my $base_2 = int(sqrt($BASE)) - 1;
        #print STDERR "base_2: $base_2\n";
        while ($step < $base_2) {
            if ($cx->[0] == 0) {
                $zero_elements ++;
                shift @$cx;
            }
            my $b = $step * ($step + 1);
            $step += 2;
            $c->_mul($cx, [$b]);
        }
        $step = [$step];
        while ($c->_acmp($step, $n) <= 0) {
            if ($cx->[0] == 0) {
                $zero_elements ++;
                shift @$cx;
            }
            $c->_mul($cx, $step);
            $c->_inc($step);
        }
    } else {
        # Yes, so we can speed it up slightly

        #    print "# left over steps $n\n";

        my $base_4 = int(sqrt(sqrt($BASE))) - 2;
        #print STDERR "base_4: $base_4\n";
        my $n4 = $n - 4;
        while ($step < $n4 && $step < $base_4) {
            if ($cx->[0] == 0) {
                $zero_elements ++;
                shift @$cx;
            }
            my $b = $step * ($step + 1);
            $step += 2;
            $b *= $step * ($step + 1);
            $step += 2;
            $c->_mul($cx, [$b]);
        }
        my $base_2 = int(sqrt($BASE)) - 1;
        my $n2 = $n - 2;
        #print STDERR "base_2: $base_2\n";
        while ($step < $n2 && $step < $base_2) {
            if ($cx->[0] == 0) {
                $zero_elements ++;
                shift @$cx;
            }
            my $b = $step * ($step + 1);
            $step += 2;
            $c->_mul($cx, [$b]);
        }
        # do what's left over
        while ($step <= $n) {
            $c->_mul($cx, [$step]);
            $step++;
            if ($cx->[0] == 0) {
                $zero_elements ++;
                shift @$cx;
            }
        }
    }
    # multiply in the zeros again
    unshift @$cx, (0) x $zero_elements;
    $cx;                        # return result
}

sub _log_int {
    # calculate integer log of $x to base $base
    # ref to array, ref to array - return ref to array
    my ($c, $x, $base) = @_;

    # X == 0 => NaN
    return if @$x == 1 && $x->[0] == 0;

    # BASE 0 or 1 => NaN
    return if @$base == 1 && $base->[0] < 2;

    # X == 1 => 0 (is exact)
    if (@$x == 1 && $x->[0] == 1) {
        @$x = 0;
        return $x, 1;
    }

    my $cmp = $c->_acmp($x, $base);

    # X == BASE => 1 (is exact)
    if ($cmp == 0) {
        @$x = 1;
        return $x, 1;
    }

    # 1 < X < BASE => 0 (is truncated)
    if ($cmp < 0) {
        @$x = 0;
        return $x, 0;
    }

    my $x_org = $c->_copy($x);  # preserve x

    # Compute a guess for the result based on:
    # $guess = int ( length_in_base_10(X) / ( log(base) / log(10) ) )
    my $len = $c->_len($x_org);
    my $log = log($base->[-1]) / log(10);

    # for each additional element in $base, we add $BASE_LEN to the result,
    # based on the observation that log($BASE, 10) is BASE_LEN and
    # log(x*y) == log(x) + log(y):
    $log += (@$base - 1) * $BASE_LEN;

    # calculate now a guess based on the values obtained above:
    my $res = $c->_new(int($len / $log));

    @$x = @$res;
    my $trial = $c->_pow($c->_copy($base), $x);
    my $acmp = $c->_acmp($trial, $x_org);

    # Did we get the exact result?

    return $x, 1 if $acmp == 0;

    # Too small?

    while ($acmp < 0) {
        $c->_mul($trial, $base);
        $c->_inc($x);
        $acmp = $c->_acmp($trial, $x_org);
    }

    # Too big?

    while ($acmp > 0) {
        $c->_div($trial, $base);
        $c->_dec($x);
        $acmp = $c->_acmp($trial, $x_org);
    }

    return $x, 1 if $acmp == 0;         # result is exact
    return $x, 0;                       # result is too small
}

# for debugging:
use constant DEBUG => 0;
my $steps = 0;
sub steps { $steps };

sub _sqrt {
    # square-root of $x in-place

    my ($c, $x) = @_;

    if (@$x == 1) {
        # fits into one Perl scalar, so result can be computed directly
        $x->[0] = int(sqrt($x->[0]));
        return $x;
    }

    # Create an initial guess for the square root.

    my $s;
    if (@$x % 2) {
        $s = [ (0) x ((@$x - 1) / 2), int(sqrt($x->[-1])) ];
    } else {
        $s = [ (0) x ((@$x - 2) / 2), int(sqrt($x->[-2] + $x->[-1] * $BASE)) ];
    }

    # Newton's method for the square root of y:
    #
    #                      x(n) * x(n) - y
    #     x(n+1) = x(n) - -----------------
    #                          2 * x(n)

    my $cmp;
    while (1) {
        my $sq = $c -> _mul($c -> _copy($s), $s);
        $cmp = $c -> _acmp($sq, $x);

        # If x(n)*x(n) > y, compute
        #
        #                      x(n) * x(n) - y
        #     x(n+1) = x(n) - -----------------
        #                          2 * x(n)

        if ($cmp > 0) {
            my $num = $c -> _sub($c -> _copy($sq), $x);
            my $den = $c -> _mul($c -> _two(), $s);
            my $delta = $c -> _div($num, $den);
            last if $c -> _is_zero($delta);
            $s = $c -> _sub($s, $delta);
        }

        # If x(n)*x(n) < y, compute
        #
        #                      y - x(n) * x(n)
        #     x(n+1) = x(n) + -----------------
        #                          2 * x(n)

        elsif ($cmp < 0) {
            my $num = $c -> _sub($c -> _copy($x), $sq);
            my $den = $c -> _mul($c -> _two(), $s);
            my $delta = $c -> _div($num, $den);
            last if $c -> _is_zero($delta);
            $s = $c -> _add($s, $delta);
        }

        # If x(n)*x(n) = y, we have the exact result.

        else {
            last;
        }
    }

    $s = $c -> _dec($s) if $cmp > 0;    # never overshoot
    @$x = @$s;
    return $x;
}

sub _root {
    # Take n'th root of $x in place.

    my ($c, $x, $n) = @_;

    # Small numbers.

    if (@$x == 1) {
        return $x if $x -> [0] == 0 || $x -> [0] == 1;

        if (@$n == 1) {
            # Result can be computed directly. Adjust initial result for
            # numerical errors, e.g., int(1000**(1/3)) is 2, not 3.
            my $y = int($x->[0] ** (1 / $n->[0]));
            my $yp1 = $y + 1;
            $y = $yp1 if $yp1 ** $n->[0] == $x->[0];
            $x->[0] = $y;
            return $x;
        }
    }

    # If x <= n, the result is always (truncated to) 1.

    if ((@$x > 1 || $x -> [0] > 0) &&           # if x is non-zero ...
        $c -> _acmp($x, $n) <= 0)               # ... and x <= n
    {
        my $one = $c -> _one();
        @$x = @$one;
        return $x;
    }

    # If $n is a power of two, take sqrt($x) repeatedly, e.g., root($x, 4) =
    # sqrt(sqrt($x)), root($x, 8) = sqrt(sqrt(sqrt($x))).

    my $b = $c -> _as_bin($n);
    if ($b =~ /0b1(0+)$/) {
        my $count = length($1);       # 0b100 => len('00') => 2
        my $cnt = $count;             # counter for loop
        unshift @$x, 0;               # add one element, together with one
                                      #   more below in the loop this makes 2
        while ($cnt-- > 0) {
            # 'Inflate' $x by adding one element, basically computing
            # $x * $BASE * $BASE. This gives us more $BASE_LEN digits for
            # result since len(sqrt($X)) approx == len($x) / 2.
            unshift @$x, 0;
            # Calculate sqrt($x), $x is now one element to big, again. In the
            # next round we make that two, again.
            $c -> _sqrt($x);
        }

        # $x is now one element too big, so truncate result by removing it.
        shift @$x;

        return $x;
    }

    my $DEBUG = 0;

    # Now the general case. This works by finding an initial guess. If this
    # guess is incorrect, a relatively small delta is chosen. This delta is
    # used to find a lower and upper limit for the correct value. The delta is
    # doubled in each iteration. When a lower and upper limit is found,
    # bisection is applied to narrow down the region until we have the correct
    # value.

    # Split x into mantissa and exponent in base 10, so that
    #
    #   x = xm * 10^xe, where 0 < xm < 1 and xe is an integer

    my $x_str = $c -> _str($x);
    my $xm    = "." . $x_str;
    my $xe    = length($x_str);

    # From this we compute the base 10 logarithm of x
    #
    #   log_10(x) = log_10(xm) + log_10(xe^10)
    #             = log(xm)/log(10) + xe
    #
    # and then the base 10 logarithm of y, where y = x^(1/n)
    #
    #   log_10(y) = log_10(x)/n

    my $log10x = log($xm) / log(10) + $xe;
    my $log10y = $log10x / $c -> _num($n);

    # And from this we compute ym and ye, the mantissa and exponent (in
    # base 10) of y, where 1 < ym <= 10 and ye is an integer.

    my $ye = int $log10y;
    my $ym = 10 ** ($log10y - $ye);

    # Finally, we scale the mantissa and exponent to incraese the integer
    # part of ym, before building the string representing our guess of y.

    if ($DEBUG) {
        print "\n";
        print "xm     = $xm\n";
        print "xe     = $xe\n";
        print "log10x = $log10x\n";
        print "log10y = $log10y\n";
        print "ym     = $ym\n";
        print "ye     = $ye\n";
        print "\n";
    }

    my $d = $ye < 15 ? $ye : 15;
    $ym *= 10 ** $d;
    $ye -= $d;

    my $y_str = sprintf('%.0f', $ym) . "0" x $ye;
    my $y = $c -> _new($y_str);

    if ($DEBUG) {
        print "ym     = $ym\n";
        print "ye     = $ye\n";
        print "\n";
        print "y_str  = $y_str (initial guess)\n";
        print "\n";
    }

    # See if our guess y is correct.

    my $trial = $c -> _pow($c -> _copy($y), $n);
    my $acmp  = $c -> _acmp($trial, $x);

    if ($acmp == 0) {
        @$x = @$y;
        return $x;
    }

    # Find a lower and upper limit for the correct value of y. Start off with a
    # delta value that is approximately the size of the accuracy of the guess.

    my $lower;
    my $upper;

    my $delta = $c -> _new("1" . ("0" x $ye));
    my $two   = $c -> _two();

    if ($acmp < 0) {
        $lower = $y;
        while ($acmp < 0) {
            $upper = $c -> _add($c -> _copy($lower), $delta);

            if ($DEBUG) {
                print "lower  = $lower\n";
                print "upper  = $upper\n";
                print "delta  = $delta\n";
                print "\n";
            }
            $acmp  = $c -> _acmp($c -> _pow($c -> _copy($upper), $n), $x);
            if ($acmp == 0) {
                @$x = @$upper;
                return $x;
            }
            $delta = $c -> _mul($delta, $two);
        }
    }

    elsif ($acmp > 0) {
        $upper = $y;
        while ($acmp > 0) {
            if ($c -> _acmp($upper, $delta) <= 0) {
                $lower = $c -> _zero();
                last;
            }
            $lower = $c -> _sub($c -> _copy($upper), $delta);

            if ($DEBUG) {
                print "lower  = $lower\n";
                print "upper  = $upper\n";
                print "delta  = $delta\n";
                print "\n";
            }
            $acmp  = $c -> _acmp($c -> _pow($c -> _copy($lower), $n), $x);
            if ($acmp == 0) {
                @$x = @$lower;
                return $x;
            }
            $delta = $c -> _mul($delta, $two);
        }
    }

    # Use bisection to narrow down the interval.

    my $one = $c -> _one();
    {

        $delta = $c -> _sub($c -> _copy($upper), $lower);
        if ($c -> _acmp($delta, $one) <= 0) {
            @$x = @$lower;
            return $x;
        }

        if ($DEBUG) {
            print "lower  = $lower\n";
            print "upper  = $upper\n";
            print "delta   = $delta\n";
            print "\n";
        }

        $delta = $c -> _div($delta, $two);
        my $middle = $c -> _add($c -> _copy($lower), $delta);

        $acmp  = $c -> _acmp($c -> _pow($c -> _copy($middle), $n), $x);
        if ($acmp < 0) {
            $lower = $middle;
        } elsif ($acmp > 0) {
            $upper = $middle;
        } else {
            @$x = @$middle;
            return $x;
        }

        redo;
    }

    $x;
}

##############################################################################
# binary stuff

sub _and {
    my ($c, $x, $y) = @_;

    # the shortcut makes equal, large numbers _really_ fast, and makes only a
    # very small performance drop for small numbers (e.g. something with less
    # than 32 bit) Since we optimize for large numbers, this is enabled.
    return $x if $c->_acmp($x, $y) == 0; # shortcut

    my $m = $c->_one();
    my ($xr, $yr);
    my $mask = $AND_MASK;

    my $x1 = $c->_copy($x);
    my $y1 = $c->_copy($y);
    my $z  = $c->_zero();

    use integer;
    until ($c->_is_zero($x1) || $c->_is_zero($y1)) {
        ($x1, $xr) = $c->_div($x1, $mask);
        ($y1, $yr) = $c->_div($y1, $mask);

        $c->_add($z, $c->_mul([ 0 + $xr->[0] & 0 + $yr->[0] ], $m));
        $c->_mul($m, $mask);
    }

    @$x = @$z;
    return $x;
}

sub _xor {
    my ($c, $x, $y) = @_;

    return $c->_zero() if $c->_acmp($x, $y) == 0; # shortcut (see -and)

    my $m = $c->_one();
    my ($xr, $yr);
    my $mask = $XOR_MASK;

    my $x1 = $c->_copy($x);
    my $y1 = $c->_copy($y);      # make copy
    my $z  = $c->_zero();

    use integer;
    until ($c->_is_zero($x1) || $c->_is_zero($y1)) {
        ($x1, $xr) = $c->_div($x1, $mask);
        ($y1, $yr) = $c->_div($y1, $mask);
        # make ints() from $xr, $yr (see _and())
        #$b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
        #$b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
        #$c->_add($x, $c->_mul($c->_new($xrr ^ $yrr)), $m) );

        $c->_add($z, $c->_mul([ 0 + $xr->[0] ^ 0 + $yr->[0] ], $m));
        $c->_mul($m, $mask);
    }
    # the loop stops when the shorter of the two numbers is exhausted
    # the remainder of the longer one will survive bit-by-bit, so we simple
    # multiply-add it in
    $c->_add($z, $c->_mul($x1, $m) ) if !$c->_is_zero($x1);
    $c->_add($z, $c->_mul($y1, $m) ) if !$c->_is_zero($y1);

    @$x = @$z;
    return $x;
}

sub _or {
    my ($c, $x, $y) = @_;

    return $x if $c->_acmp($x, $y) == 0; # shortcut (see _and)

    my $m = $c->_one();
    my ($xr, $yr);
    my $mask = $OR_MASK;

    my $x1 = $c->_copy($x);
    my $y1 = $c->_copy($y);      # make copy
    my $z  = $c->_zero();

    use integer;
    until ($c->_is_zero($x1) || $c->_is_zero($y1)) {
        ($x1, $xr) = $c->_div($x1, $mask);
        ($y1, $yr) = $c->_div($y1, $mask);
        # make ints() from $xr, $yr (see _and())
        #    $b = 1; $xrr = 0; foreach (@$xr) { $xrr += $_ * $b; $b *= $BASE; }
        #    $b = 1; $yrr = 0; foreach (@$yr) { $yrr += $_ * $b; $b *= $BASE; }
        #    $c->_add($x, $c->_mul(_new( $c, ($xrr | $yrr) ), $m) );
        $c->_add($z, $c->_mul([ 0 + $xr->[0] | 0 + $yr->[0] ], $m));
        $c->_mul($m, $mask);
    }
    # the loop stops when the shorter of the two numbers is exhausted
    # the remainder of the longer one will survive bit-by-bit, so we simple
    # multiply-add it in
    $c->_add($z, $c->_mul($x1, $m) ) if !$c->_is_zero($x1);
    $c->_add($z, $c->_mul($y1, $m) ) if !$c->_is_zero($y1);

    @$x = @$z;
    return $x;
}

sub _as_hex {
    # convert a decimal number to hex (ref to array, return ref to string)
    my ($c, $x) = @_;

    return "0x0" if @$x == 1 && $x->[0] == 0;

    my $x1 = $c->_copy($x);

    my $x10000 = [ 0x10000 ];

    my $es = '';
    my $xr;
    until (@$x1 == 1 && $x1->[0] == 0) {        # _is_zero()
        ($x1, $xr) = $c->_div($x1, $x10000);
        $es = sprintf('%04x', $xr->[0]) . $es;
    }
    #$es = reverse $es;
    $es =~ s/^0*/0x/;
    return $es;
}

sub _as_bin {
    # convert a decimal number to bin (ref to array, return ref to string)
    my ($c, $x) = @_;

    return "0b0" if @$x == 1 && $x->[0] == 0;

    my $x1 = $c->_copy($x);

    my $x10000 = [ 0x10000 ];

    my $es = '';
    my $xr;

    until (@$x1 == 1 && $x1->[0] == 0) {        # _is_zero()
        ($x1, $xr) = $c->_div($x1, $x10000);
        $es = sprintf('%016b', $xr->[0]) . $es;
    }
    $es =~ s/^0*/0b/;
    return $es;
}

sub _as_oct {
    # convert a decimal number to octal (ref to array, return ref to string)
    my ($c, $x) = @_;

    return "00" if @$x == 1 && $x->[0] == 0;

    my $x1 = $c->_copy($x);

    my $x1000 = [ 1 << 15 ];    # 15 bits = 32768 = 0100000

    my $es = '';
    my $xr;
    until (@$x1 == 1 && $x1->[0] == 0) {        # _is_zero()
        ($x1, $xr) = $c->_div($x1, $x1000);
        $es = sprintf("%05o", $xr->[0]) . $es;
    }
    $es =~ s/^0*/0/;            # excactly one leading zero
    return $es;
}

sub _from_oct {
    # convert a octal number to decimal (string, return ref to array)
    my ($c, $os) = @_;

    my $m = $c->_new(1 << 30);          # 30 bits at a time (<32 bits!)
    my $d = 10;                         # 10 octal digits at a time

    my $mul = $c->_one();
    my $x = $c->_zero();

    my $len = int((length($os) - 1) / $d);      # $d digit parts, w/o the '0'
    my $val;
    my $i = -$d;
    while ($len >= 0) {
        $val = substr($os, $i, $d);             # get oct digits
        $val = CORE::oct($val);
        $i -= $d;
        $len --;
        my $adder = $c -> _new($val);
        $c->_add($x, $c->_mul($adder, $mul)) if $val != 0;
        $c->_mul($mul, $m) if $len >= 0;        # skip last mul
    }
    $x;
}

sub _from_hex {
    # convert a hex number to decimal (string, return ref to array)
    my ($c, $hs) = @_;

    my $m = $c->_new(0x10000000);       # 28 bit at a time (<32 bit!)
    my $d = 7;                          # 7 hexadecimal digits at a time
    my $mul = $c->_one();
    my $x = $c->_zero();

    my $len = int((length($hs) - 2) / $d); # $d digit parts, w/o the '0x'
    my $val;
    my $i = -$d;
    while ($len >= 0) {
        $val = substr($hs, $i, $d);     # get hex digits
        $val =~ s/^0x// if $len == 0; # for last part only because
        $val = CORE::hex($val);       # hex does not like wrong chars
        $i -= $d;
        $len --;
        my $adder = $c->_new($val);
        # if the resulting number was to big to fit into one element, create a
        # two-element version (bug found by Mark Lakata - Thanx!)
        if (CORE::length($val) > $BASE_LEN) {
            $adder = $c->_new($val);
        }
        $c->_add($x, $c->_mul($adder, $mul)) if $val != 0;
        $c->_mul($mul, $m) if $len >= 0; # skip last mul
    }
    $x;
}

sub _from_bin {
    # convert a hex number to decimal (string, return ref to array)
    my ($c, $bs) = @_;

    # instead of converting X (8) bit at a time, it is faster to "convert" the
    # number to hex, and then call _from_hex.

    my $hs = $bs;
    $hs =~ s/^[+-]?0b//;                                # remove sign and 0b
    my $l = length($hs);                                # bits
    $hs = '0' x (8 - ($l % 8)) . $hs if ($l % 8) != 0;  # padd left side w/ 0
    my $h = '0x' . unpack('H*', pack ('B*', $hs));      # repack as hex

    $c->_from_hex($h);
}

##############################################################################
# special modulus functions

sub _modinv {
    # modular multiplicative inverse
    my ($c, $x, $y) = @_;

    # modulo zero
    if ($c->_is_zero($y)) {
        return;
    }

    # modulo one
    if ($c->_is_one($y)) {
        return $c->_zero(), '+';
    }

    my $u = $c->_zero();
    my $v = $c->_one();
    my $a = $c->_copy($y);
    my $b = $c->_copy($x);

    # Euclid's Algorithm for bgcd(), only that we calc bgcd() ($a) and the result
    # ($u) at the same time. See comments in BigInt for why this works.
    my $q;
    my $sign = 1;
    {
        ($a, $q, $b) = ($b, $c->_div($a, $b));          # step 1
        last if $c->_is_zero($b);

        my $t = $c->_add(                               # step 2:
                         $c->_mul($c->_copy($v), $q),   #  t =   v * q
                         $u);                           #      + u
        $u = $v;                                        #  u = v
        $v = $t;                                        #  v = t
        $sign = -$sign;
        redo;
    }

    # if the gcd is not 1, then return NaN
    return unless $c->_is_one($a);

    ($v, $sign == 1 ? '+' : '-');
}

sub _modpow {
    # modulus of power ($x ** $y) % $z
    my ($c, $num, $exp, $mod) = @_;

    # a^b (mod 1) = 0 for all a and b
    if ($c->_is_one($mod)) {
        @$num = 0;
        return $num;
    }

    # 0^a (mod m) = 0 if m != 0, a != 0
    # 0^0 (mod m) = 1 if m != 0
    if ($c->_is_zero($num)) {
        if ($c->_is_zero($exp)) {
            @$num = 1;
        } else {
            @$num = 0;
        }
        return $num;
    }

    #  $num = $c->_mod($num, $mod);   # this does not make it faster

    my $acc = $c->_copy($num);
    my $t = $c->_one();

    my $expbin = $c->_as_bin($exp);
    $expbin =~ s/^0b//;
    my $len = length($expbin);
    while (--$len >= 0) {
        if (substr($expbin, $len, 1) eq '1') { # is_odd
            $t = $c->_mul($t, $acc);
            $t = $c->_mod($t, $mod);
        }
        $acc = $c->_mul($acc, $acc);
        $acc = $c->_mod($acc, $mod);
    }
    @$num = @$t;
    $num;
}

sub _gcd {
    # Greatest common divisor.

    my ($c, $x, $y) = @_;

    # gcd(0, 0) = 0
    # gcd(0, a) = a, if a != 0

    if (@$x == 1 && $x->[0] == 0) {
        if (@$y == 1 && $y->[0] == 0) {
            @$x = 0;
        } else {
            @$x = @$y;
        }
        return $x;
    }

    # Until $y is zero ...

    until (@$y == 1 && $y->[0] == 0) {

        # Compute remainder.

        $c->_mod($x, $y);

        # Swap $x and $y.

        my $tmp = $c->_copy($x);
        @$x = @$y;
        $y = $tmp;              # no deref here; that would modify input $y
    }

    return $x;
}

1;

=pod

=head1 NAME

Math::BigInt::Calc - pure Perl module to support Math::BigInt

=head1 SYNOPSIS

    # to use it with Math::BigInt
    use Math::BigInt lib => 'Calc';

    # to use it with Math::BigFloat
    use Math::BigFloat lib => 'Calc';

    # to use it with Math::BigRat
    use Math::BigRat lib => 'Calc';

    # explicitly set base length and whether to "use integer"
    use Math::BigInt::Calc base_len => 4, use_int => 1;
    use Math::BigInt lib => 'Calc';

=head1 DESCRIPTION

Math::BigInt::Calc inherits from Math::BigInt::Lib.

In this library, the numbers are represented interenally in base B = 10**N,
where N is the largest possible integer that does not cause overflow in the
intermediate computations. The base B elements are stored in an array, with the
least significant element stored in array element zero. There are no leading
zero elements, except a single zero element when the number is zero. For
instance, if B = 10000, the number 1234567890 is represented internally as
[7890, 3456, 12].

=head1 OPTIONS

When the module is loaded, it computes the maximum exponent, i.e., power of 10,
that can be used with and without "use integer" in the computations. The default
is to use this maximum exponent. If the combination of the 'base_len' value and
the 'use_int' value exceeds the maximum value, an error is thrown.

=over 4

=item base_len

The base length can be specified explicitly with the 'base_len' option. The
value must be a positive integer.

    use Math::BigInt::Calc base_len => 4;  # use 10000 as internal base

=item use_int

This option is used to specify whether "use integer" should be used in the
internal computations. The value is interpreted as a boolean value, so use 0 or
"" for false and anything else for true. If the 'base_len' is not specified
together with 'use_int', the current value for the base length is used.

    use Math::BigInt::Calc use_int => 1;   # use "use integer" internally

=back

=head1 METHODS

This overview constains only the methods that are specific to
C<Math::BigInt::Calc>. For the other methods, see L<Math::BigInt::Lib>.

=over 4

=item _base_len()

Specify the desired base length and whether to enable "use integer" in the
computations.

    Math::BigInt::Calc -> _base_len($base_len, $use_int);

Note that it is better to specify the base length and whether to use integers as
options when the module is loaded, for example like this

    use Math::BigInt::Calc base_len => 6, use_int => 1;

=back

=head1 SEE ALSO

L<Math::BigInt::Lib> for a description of the API.

Alternative libraries L<Math::BigInt::FastCalc>, L<Math::BigInt::GMP>,
L<Math::BigInt::Pari>, L<Math::BigInt::GMPz>, and L<Math::BigInt::BitVect>.

Some of the modules that use these libraries L<Math::BigInt>,
L<Math::BigFloat>, and L<Math::BigRat>.

=cut
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   package Math::BigInt::Lib;

use 5.006001;
use strict;
use warnings;

our $VERSION = '1.999830';
$VERSION =~ tr/_//d;

use Carp;

use overload

  # overload key: with_assign

  '+'    => sub {
                my $class = ref $_[0];
                my $x = $class -> _copy($_[0]);
                my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                return $class -> _add($x, $y);
            },

  '-'    => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _sub($x, $y);
            },

  '*'    => sub {
                my $class = ref $_[0];
                my $x = $class -> _copy($_[0]);
                my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                return $class -> _mul($x, $y);
            },

  '/'    => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _div($x, $y);
            },

  '%'    => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _mod($x, $y);
            },

  '**'   => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _pow($x, $y);
            },

  '<<'   => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $class -> _num($_[0]);
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $_[0];
                    $y = ref($_[1]) ? $class -> _num($_[1]) : $_[1];
                }
                return $class -> _lsft($x, $y);
            },

  '>>'   => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _rsft($x, $y);
            },

  # overload key: num_comparison

  '<'    => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _acmp($x, $y) < 0;
            },

  '<='   => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _acmp($x, $y) <= 0;
            },

  '>'    => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _acmp($x, $y) > 0;
            },

  '>='   => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _acmp($x, $y) >= 0;
          },

  '=='   => sub {
                my $class = ref $_[0];
                my $x = $class -> _copy($_[0]);
                my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                return $class -> _acmp($x, $y) == 0;
            },

  '!='   => sub {
                my $class = ref $_[0];
                my $x = $class -> _copy($_[0]);
                my $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                return $class -> _acmp($x, $y) != 0;
            },

  # overload key: 3way_comparison

  '<=>'  => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _acmp($x, $y);
            },

  # overload key: binary

  '&'    => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _and($x, $y);
            },

  '|'    => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _or($x, $y);
            },

  '^'    => sub {
                my $class = ref $_[0];
                my ($x, $y);
                if ($_[2]) {            # if swapped
                    $y = $_[0];
                    $x = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                } else {
                    $x = $class -> _copy($_[0]);
                    $y = ref($_[1]) ? $_[1] : $class -> _new($_[1]);
                }
                return $class -> _xor($x, $y);
            },

  # overload key: func

  'abs'  => sub { $_[0] },

  'sqrt' => sub {
                my $class = ref $_[0];
                return $class -> _sqrt($class -> _copy($_[0]));
            },

  'int'  => sub { $_[0] },

  # overload key: conversion

  'bool' => sub { ref($_[0]) -> _is_zero($_[0]) ? '' : 1; },

  '""'   => sub { ref($_[0]) -> _str($_[0]); },

  '0+'   => sub { ref($_[0]) -> _num($_[0]); },

  '='    => sub { ref($_[0]) -> _copy($_[0]); },

  ;

sub _new {
    croak "@{[(caller 0)[3]]} method not implemented";
}

sub _zero {
    my $class = shift;
    return $class -> _new("0");
}

sub _one {
    my $class = shift;
    return $class -> _new("1");
}

sub _two {
    my $class = shift;
    return $class -> _new("2");

}
sub _ten {
    my $class = shift;
    return $class -> _new("10");
}

sub _1ex {
    my ($class, $exp) = @_;
    $exp = $class -> _num($exp) if ref($exp);
    return $class -> _new("1" . ("0" x $exp));
}

sub _copy {
    my ($class, $x) = @_;
    return $class -> _new($class -> _str($x));
}

# catch and throw away
sub import { }

##############################################################################
# convert back to string and number

sub _str {
    # Convert number from internal base 1eN format to string format. Internal
    # format is always normalized, i.e., no leading zeros.
    croak "@{[(caller 0)[3]]} method not implemented";
}

sub _num {
    my ($class, $x) = @_;
    0 + $class -> _str($x);
}

##############################################################################
# actual math code

sub _add {
    croak "@{[(caller 0)[3]]} method not implemented";
}

sub _sub {
    croak "@{[(caller 0)[3]]} method not implemented";
}

sub _mul {
    my ($class, $x, $y) = @_;
    my $sum = $class -> _zero();
    my $i   = $class -> _zero();
    while ($class -> _acmp($i, $y) < 0) {
        $sum = $class -> _add($sum, $x);
        $i   = $class -> _inc($i);
    }
    return $sum;
}

sub _div {
    my ($class, $x, $y) = @_;

    croak "@{[(caller 0)[3]]} requires non-zero divisor"
      if $class -> _is_zero($y);

    my $r = $class -> _copy($x);
    my $q = $class -> _zero();
    while ($class -> _acmp($r, $y) >= 0) {
        $q = $class -> _inc($q);
        $r = $class -> _sub($r, $y);
    }

    return $q, $r if wantarray;
    return $q;
}

sub _inc {
    my ($class, $x) = @_;
    $class -> _add($x, $class -> _one());
}

sub _dec {
    my ($class, $x) = @_;
    $class -> _sub($x, $class -> _one());
}

# Signed addition. If the flag is false, $xa might be modified, but not $ya. If
# the false is true, $ya might be modified, but not $xa.

sub _sadd {
    my $class = shift;
    my ($xa, $xs, $ya, $ys, $flag) = @_;
    my ($za, $zs);

    # If the signs are equal we can add them (-5 + -3 => -(5 + 3) => -8)

    if ($xs eq $ys) {
        if ($flag) {
            $za = $class -> _add($ya, $xa);
        } else {
            $za = $class -> _add($xa, $ya);
        }
        $zs = $class -> _is_zero($za) ? '+' : $xs;
        return $za, $zs;
    }

    my $acmp = $class -> _acmp($xa, $ya);       # abs(x) = abs(y)

    if ($acmp == 0) {                           # x = -y or -x = y
        $za = $class -> _zero();
        $zs = '+';
        return $za, $zs;
    }

    if ($acmp > 0) {                            # abs(x) > abs(y)
        $za = $class -> _sub($xa, $ya, $flag);
        $zs = $xs;
    } else {                                    # abs(x) < abs(y)
        $za = $class -> _sub($ya, $xa, !$flag);
        $zs = $ys;
    }
    return $za, $zs;
}

# Signed subtraction. If the flag is false, $xa might be modified, but not $ya.
# If the false is true, $ya might be modified, but not $xa.

sub _ssub {
    my $class = shift;
    my ($xa, $xs, $ya, $ys, $flag) = @_;

    # Swap sign of second operand and let _sadd() do the job.
    $ys = $ys eq '+' ? '-' : '+';
    $class -> _sadd($xa, $xs, $ya, $ys, $flag);
}

##############################################################################
# testing

sub _acmp {
    # Compare two (absolute) values. Return -1, 0, or 1.
    my ($class, $x, $y) = @_;
    my $xstr = $class -> _str($x);
    my $ystr = $class -> _str($y);

    length($xstr) <=> length($ystr) || $xstr cmp $ystr;
}

sub _len {
    my ($class, $x) = @_;
    CORE::length($class -> _str($x));
}

sub _alen {
    my ($class, $x) = @_;
    $class -> _len($x);
}

sub _digit {
    my ($class, $x, $n) = @_;
    substr($class ->_str($x), -($n+1), 1);
}

sub _digitsum {
    my ($class, $x) = @_;

    my $len = $class -> _len($x);
    my $sum = $class -> _zero();
    for (my $i = 0 ; $i < $len ; ++$i) {
        my $digit = $class -> _digit($x, $i);
        $digit = $class -> _new($digit);
        $sum = $class -> _add($sum, $digit);
    }

    return $sum;
}

sub _zeros {
    my ($class, $x) = @_;
    my $str = $class -> _str($x);
    $str =~ /[^0](0*)\z/ ? CORE::length($1) : 0;
}

##############################################################################
# _is_* routines

sub _is_zero {
    # return true if arg is zero
    my ($class, $x) = @_;
    $class -> _str($x) == 0;
}

sub _is_even {
    # return true if arg is even
    my ($class, $x) = @_;
    substr($class -> _str($x), -1, 1) % 2 == 0;
}

sub _is_odd {
    # return true if arg is odd
    my ($class, $x) = @_;
    substr($class -> _str($x), -1, 1) % 2 != 0;
}

sub _is_one {
    # return true if arg is one
    my ($class, $x) = @_;
    $class -> _str($x) == 1;
}

sub _is_two {
    # return true if arg is two
    my ($class, $x) = @_;
    $class -> _str($x) == 2;
}

sub _is_ten {
    # return true if arg is ten
    my ($class, $x) = @_;
    $class -> _str($x) == 10;
}

###############################################################################
# check routine to test internal state for corruptions

sub _check {
    # used by the test suite
    my ($class, $x) = @_;
    return "Input is undefined" unless defined $x;
    return "$x is not a reference" unless ref($x);
    return 0;
}

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

sub _mod {
    # modulus
    my ($class, $x, $y) = @_;

    croak "@{[(caller 0)[3]]} requires non-zero second operand"
      if $class -> _is_zero($y);

    if ($class -> can('_div')) {
        $x = $class -> _copy($x);
        my ($q, $r) = $class -> _div($x, $y);
        return $r;
    } else {
        my $r = $class -> _copy($x);
        while ($class -> _acmp($r, $y) >= 0) {
            $r = $class -> _sub($r, $y);
        }
        return $r;
    }
}

##############################################################################
# shifts

sub _rsft {
    my ($class, $x, $n, $b) = @_;
    $b = $class -> _new($b) unless ref $b;
    return scalar $class -> _div($x, $class -> _pow($class -> _copy($b), $n));
}

sub _lsft {
    my ($class, $x, $n, $b) = @_;
    $b = $class -> _new($b) unless ref $b;
    return $class -> _mul($x, $class -> _pow($class -> _copy($b), $n));
}

sub _pow {
    # power of $x to $y
    my ($class, $x, $y) = @_;

    if ($class -> _is_zero($y)) {
        return $class -> _one();        # y == 0 => x => 1
    }

    if (($class -> _is_one($x)) ||      #    x == 1
        ($class -> _is_one($y)))        # or y == 1
    {
        return $x;
    }

    if ($class -> _is_zero($x)) {
        return $class -> _zero();       # 0 ** y => 0 (if not y <= 0)
    }

    my $pow2 = $class -> _one();

    my $y_bin = $class -> _as_bin($y);
    $y_bin =~ s/^0b//;
    my $len = length($y_bin);

    while (--$len > 0) {
        $pow2 = $class -> _mul($pow2, $x) if substr($y_bin, $len, 1) eq '1';
        $x = $class -> _mul($x, $x);
    }

    $x = $class -> _mul($x, $pow2);
    return $x;
}

sub _nok {
    # Return binomial coefficient (n over k).
    my ($class, $n, $k) = @_;

    # If k > n/2, or, equivalently, 2*k > n, compute nok(n, k) as
    # nok(n, n-k), to minimize the number if iterations in the loop.

    {
        my $twok = $class -> _mul($class -> _two(), $class -> _copy($k));
        if ($class -> _acmp($twok, $n) > 0) {
            $k = $class -> _sub($class -> _copy($n), $k);
        }
    }

    # Example:
    #
    # / 7 \       7!       1*2*3*4 * 5*6*7   5 * 6 * 7
    # |   | = --------- =  --------------- = --------- = ((5 * 6) / 2 * 7) / 3
    # \ 3 /   (7-3)! 3!    1*2*3*4 * 1*2*3   1 * 2 * 3
    #
    # Equivalently, _nok(11, 5) is computed as
    #
    # (((((((7 * 8) / 2) * 9) / 3) * 10) / 4) * 11) / 5

    if ($class -> _is_zero($k)) {
        return $class -> _one();
    }

    # Make a copy of the original n, in case the subclass modifies n in-place.

    my $n_orig = $class -> _copy($n);

    # n = 5, f = 6, d = 2 (cf. example above)

    $n = $class -> _sub($n, $k);
    $n = $class -> _inc($n);

    my $f = $class -> _copy($n);
    $f = $class -> _inc($f);

    my $d = $class -> _two();

    # while f <= n (the original n, that is) ...

    while ($class -> _acmp($f, $n_orig) <= 0) {
        $n = $class -> _mul($n, $f);
        $n = $class -> _div($n, $d);
        $f = $class -> _inc($f);
        $d = $class -> _inc($d);
    }

    return $n;
}

#sub _fac {
#    # factorial
#    my ($class, $x) = @_;
#
#    my $two = $class -> _two();
#
#    if ($class -> _acmp($x, $two) < 0) {
#        return $class -> _one();
#    }
#
#    my $i = $class -> _copy($x);
#    while ($class -> _acmp($i, $two) > 0) {
#        $i = $class -> _dec($i);
#        $x = $class -> _mul($x, $i);
#    }
#
#    return $x;
#}

sub _fac {
    # factorial
    my ($class, $x) = @_;

    # This is an implementation of the split recursive algorithm. See
    # http://www.luschny.de/math/factorial/csharp/FactorialSplit.cs.html

    my $p   = $class -> _one();
    my $r   = $class -> _one();
    my $two = $class -> _two();

    my ($log2n) = $class -> _log_int($class -> _copy($x), $two);
    my $h     = $class -> _zero();
    my $shift = $class -> _zero();
    my $k     = $class -> _one();

    while ($class -> _acmp($h, $x)) {
        $shift = $class -> _add($shift, $h);
        $h = $class -> _rsft($class -> _copy($x), $log2n, $two);
        $log2n = $class -> _dec($log2n) if !$class -> _is_zero($log2n);
        my $high = $class -> _copy($h);
        $high = $class -> _dec($high) if $class -> _is_even($h);
        while ($class -> _acmp($k, $high)) {
            $k = $class -> _add($k, $two);
            $p = $class -> _mul($p, $k);
        }
        $r = $class -> _mul($r, $p);
    }
    return $class -> _lsft($r, $shift, $two);
}

sub _dfac {
    # double factorial
    my ($class, $x) = @_;

    my $two = $class -> _two();

    if ($class -> _acmp($x, $two) < 0) {
        return $class -> _one();
    }

    my $i = $class -> _copy($x);
    while ($class -> _acmp($i, $two) > 0) {
        $i = $class -> _sub($i, $two);
        $x = $class -> _mul($x, $i);
    }

    return $x;
}

sub _log_int {
    # calculate integer log of $x to base $base
    # calculate integer log of $x to base $base
    # ref to array, ref to array - return ref to array
    my ($class, $x, $base) = @_;

    # X == 0 => NaN
    return if $class -> _is_zero($x);

    $base = $class -> _new(2)     unless defined($base);
    $base = $class -> _new($base) unless ref($base);

    # BASE 0 or 1 => NaN
    return if $class -> _is_zero($base) || $class -> _is_one($base);

    # X == 1 => 0 (is exact)
    if ($class -> _is_one($x)) {
        return $class -> _zero(), 1;
    }

    my $cmp = $class -> _acmp($x, $base);

    # X == BASE => 1 (is exact)
    if ($cmp == 0) {
        return $class -> _one(), 1;
    }

    # 1 < X < BASE => 0 (is truncated)
    if ($cmp < 0) {
        return $class -> _zero(), 0;
    }

    my $y;

    # log(x) / log(b) = log(xm * 10^xe) / log(bm * 10^be)
    #                 = (log(xm) + xe*(log(10))) / (log(bm) + be*log(10))

    {
        my $x_str = $class -> _str($x);
        my $b_str = $class -> _str($base);
        my $xm    = "." . $x_str;
        my $bm    = "." . $b_str;
        my $xe    = length($x_str);
        my $be    = length($b_str);
        my $log10 = log(10);
        my $guess = int((log($xm) + $xe * $log10) / (log($bm) + $be * $log10));
        $y = $class -> _new($guess);
    }

    my $trial = $class -> _pow($class -> _copy($base), $y);
    my $acmp  = $class -> _acmp($trial, $x);

    # Did we get the exact result?

    return $y, 1 if $acmp == 0;

    # Too small?

    while ($acmp < 0) {
        $trial = $class -> _mul($trial, $base);
        $y     = $class -> _inc($y);
        $acmp  = $class -> _acmp($trial, $x);
    }

    # Too big?

    while ($acmp > 0) {
        $trial = $class -> _div($trial, $base);
        $y     = $class -> _dec($y);
        $acmp  = $class -> _acmp($trial, $x);
    }

    return $y, 1 if $acmp == 0;         # result is exact
    return $y, 0;                       # result is too small
}

sub _sqrt {
    # square-root of $y in place
    my ($class, $y) = @_;

    return $y if $class -> _is_zero($y);

    my $y_str = $class -> _str($y);
    my $y_len = length($y_str);

    # Compute the guess $x.

    my $xm;
    my $xe;
    if ($y_len % 2 == 0) {
        $xm = sqrt("." . $y_str);
        $xe = $y_len / 2;
        $xm = sprintf "%.0f", int($xm * 1e15);
        $xe -= 15;
    } else {
        $xm = sqrt(".0" . $y_str);
        $xe = ($y_len + 1) / 2;
        $xm = sprintf "%.0f", int($xm * 1e16);
        $xe -= 16;
    }

    my $x;
    if ($xe < 0) {
        $x = substr $xm, 0, length($xm) + $xe;
    } else {
        $x = $xm . ("0" x $xe);
    }

    $x = $class -> _new($x);

    # Newton's method for computing square root of y
    #
    # x(i+1) = x(i) - f(x(i)) / f'(x(i))
    #        = x(i) - (x(i)^2 - y) / (2 * x(i))     # use if x(i)^2 > y
    #        = x(i) + (y - x(i)^2) / (2 * x(i))     # use if x(i)^2 < y

    # Determine if x, our guess, is too small, correct, or too large.

    my $xsq = $class -> _mul($class -> _copy($x), $x);          # x(i)^2
    my $acmp = $class -> _acmp($xsq, $y);                       # x(i)^2 <=> y

    # Only assign a value to this variable if we will be using it.

    my $two;
    $two = $class -> _two() if $acmp != 0;

    # If x is too small, do one iteration of Newton's method. Since the
    # function f(x) = x^2 - y is concave and monotonically increasing, the next
    # guess for x will either be correct or too large.

    if ($acmp < 0) {

        # x(i+1) = x(i) + (y - x(i)^2) / (2 * x(i))

        my $numer = $class -> _sub($class -> _copy($y), $xsq);  # y - x(i)^2
        my $denom = $class -> _mul($class -> _copy($two), $x);  # 2 * x(i)
        my $delta = $class -> _div($numer, $denom);

        unless ($class -> _is_zero($delta)) {
            $x    = $class -> _add($x, $delta);
            $xsq  = $class -> _mul($class -> _copy($x), $x);    # x(i)^2
            $acmp = $class -> _acmp($xsq, $y);                  # x(i)^2 <=> y
        }
    }

    # If our guess for x is too large, apply Newton's method repeatedly until
    # we either have got the correct value, or the delta is zero.

    while ($acmp > 0) {

        # x(i+1) = x(i) - (x(i)^2 - y) / (2 * x(i))

        my $numer = $class -> _sub($xsq, $y);                   # x(i)^2 - y
        my $denom = $class -> _mul($class -> _copy($two), $x);  # 2 * x(i)
        my $delta = $class -> _div($numer, $denom);
        last if $class -> _is_zero($delta);

        $x    = $class -> _sub($x, $delta);
        $xsq  = $class -> _mul($class -> _copy($x), $x);        # x(i)^2
        $acmp = $class -> _acmp($xsq, $y);                      # x(i)^2 <=> y
    }

    # When the delta is zero, our value for x might still be too large. We
    # require that the outout is either exact or too small (i.e., rounded down
    # to the nearest integer), so do a final check.

    while ($acmp > 0) {
        $x    = $class -> _dec($x);
        $xsq  = $class -> _mul($class -> _copy($x), $x);        # x(i)^2
        $acmp = $class -> _acmp($xsq, $y);                      # x(i)^2 <=> y
    }

    return $x;
}

sub _root {
    my ($class, $y, $n) = @_;

    return $y if $class -> _is_zero($y) || $class -> _is_one($y) ||
                 $class -> _is_one($n);

    # If y <= n, the result is always (truncated to) 1.

    return $class -> _one() if $class -> _acmp($y, $n) <= 0;

    # Compute the initial guess x of y^(1/n). When n is large, Newton's method
    # converges slowly if the "guess" (initial value) is poor, so we need a
    # good guess. It the guess is too small, the next guess will be too large,
    # and from then on all guesses are too large.

    my $DEBUG = 0;

    # Split y into mantissa and exponent in base 10, so that
    #
    #   y = xm * 10^xe, where 0 < xm < 1 and xe is an integer

    my $y_str  = $class -> _str($y);
    my $ym = "." . $y_str;
    my $ye = length($y_str);

    # From this compute the approximate base 10 logarithm of y
    #
    #   log_10(y) = log_10(ym) + log_10(ye^10)
    #             = log(ym)/log(10) + ye

    my $log10y = log($ym) / log(10) + $ye;

    # And from this compute the approximate base 10 logarithm of x, where
    # x = y^(1/n)
    #
    #   log_10(x) = log_10(y)/n

    my $log10x = $log10y / $class -> _num($n);

    # From this compute xm and xe, the mantissa and exponent (in base 10) of x,
    # where 1 < xm <= 10 and xe is an integer.

    my $xe = int $log10x;
    my $xm = 10 ** ($log10x - $xe);

    # Scale the mantissa and exponent to increase the integer part of ym, which
    # gives us better accuracy.

    if ($DEBUG) {
        print "\n";
        print "y_str  = $y_str\n";
        print "ym     = $ym\n";
        print "ye     = $ye\n";
        print "log10y = $log10y\n";
        print "log10x = $log10x\n";
        print "xm     = $xm\n";
        print "xe     = $xe\n";
    }

    my $d = $xe < 15 ? $xe : 15;
    $xm *= 10 ** $d;
    $xe -= $d;

    if ($DEBUG) {
        print "\n";
        print "xm     = $xm\n";
        print "xe     = $xe\n";
    }

    # If the mantissa is not an integer, round up to nearest integer, and then
    # convert the number to a string. It is important to always round up due to
    # how Newton's method behaves in this case. If the initial guess is too
    # small, the next guess will be too large, after which every succeeding
    # guess converges the correct value from above. Now, if the initial guess
    # is too small and n is large, the next guess will be much too large and
    # require a large number of iterations to get close to the solution.
    # Because of this, we are likely to find the solution faster if we make
    # sure the initial guess is not too small.

    my $xm_int = int($xm);
    my $x_str = sprintf '%.0f', $xm > $xm_int ? $xm_int + 1 : $xm_int;
    $x_str .= "0" x $xe;

    my $x = $class -> _new($x_str);

    if ($DEBUG) {
        print "xm     = $xm\n";
        print "xe     = $xe\n";
        print "\n";
        print "x_str  = $x_str (initial guess)\n";
        print "\n";
    }

    # Use Newton's method for computing n'th root of y.
    #
    # x(i+1) = x(i) - f(x(i)) / f'(x(i))
    #        = x(i) - (x(i)^n - y) / (n * x(i)^(n-1))   # use if x(i)^n > y
    #        = x(i) + (y - x(i)^n) / (n * x(i)^(n-1))   # use if x(i)^n < y

    # Determine if x, our guess, is too small, correct, or too large. Rather
    # than computing x(i)^n and x(i)^(n-1) directly, compute x(i)^(n-1) and
    # then the same value multiplied by x.

    my $nm1     = $class -> _dec($class -> _copy($n));           # n-1
    my $xpownm1 = $class -> _pow($class -> _copy($x), $nm1);     # x(i)^(n-1)
    my $xpown   = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
    my $acmp    = $class -> _acmp($xpown, $y);                   # x(i)^n <=> y

    if ($DEBUG) {
        print "\n";
        print "x      = ", $class -> _str($x), "\n";
        print "x^n    = ", $class -> _str($xpown), "\n";
        print "y      = ", $class -> _str($y), "\n";
        print "acmp   = $acmp\n";
    }

    # If x is too small, do one iteration of Newton's method. Since the
    # function f(x) = x^n - y is concave and monotonically increasing, the next
    # guess for x will either be correct or too large.

    if ($acmp < 0) {

        # x(i+1) = x(i) + (y - x(i)^n) / (n * x(i)^(n-1))

        my $numer = $class -> _sub($class -> _copy($y), $xpown);    # y - x(i)^n
        my $denom = $class -> _mul($class -> _copy($n), $xpownm1);  # n * x(i)^(n-1)
        my $delta = $class -> _div($numer, $denom);

        if ($DEBUG) {
            print "\n";
            print "numer  = ", $class -> _str($numer), "\n";
            print "denom  = ", $class -> _str($denom), "\n";
            print "delta  = ", $class -> _str($delta), "\n";
        }

        unless ($class -> _is_zero($delta)) {
            $x       = $class -> _add($x, $delta);
            $xpownm1 = $class -> _pow($class -> _copy($x), $nm1);     # x(i)^(n-1)
            $xpown   = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
            $acmp    = $class -> _acmp($xpown, $y);                   # x(i)^n <=> y

            if ($DEBUG) {
                print "\n";
                print "x      = ", $class -> _str($x), "\n";
                print "x^n    = ", $class -> _str($xpown), "\n";
                print "y      = ", $class -> _str($y), "\n";
                print "acmp   = $acmp\n";
            }
        }
    }

    # If our guess for x is too large, apply Newton's method repeatedly until
    # we either have got the correct value, or the delta is zero.

    while ($acmp > 0) {

        # x(i+1) = x(i) - (x(i)^n - y) / (n * x(i)^(n-1))

        my $numer = $class -> _sub($class -> _copy($xpown), $y);    # x(i)^n - y
        my $denom = $class -> _mul($class -> _copy($n), $xpownm1);  # n * x(i)^(n-1)

        if ($DEBUG) {
            print "numer  = ", $class -> _str($numer), "\n";
            print "denom  = ", $class -> _str($denom), "\n";
        }

        my $delta = $class -> _div($numer, $denom);

        if ($DEBUG) {
            print "delta  = ", $class -> _str($delta), "\n";
        }

        last if $class -> _is_zero($delta);

        $x       = $class -> _sub($x, $delta);
        $xpownm1 = $class -> _pow($class -> _copy($x), $nm1);     # x(i)^(n-1)
        $xpown   = $class -> _mul($class -> _copy($xpownm1), $x); # x(i)^n
        $acmp    = $class -> _acmp($xpown, $y);                   # x(i)^n <=> y

        if ($DEBUG) {
            print "\n";
            print "x      = ", $class -> _str($x), "\n";
            print "x^n    = ", $class -> _str($xpown), "\n";
            print "y      = ", $class -> _str($y), "\n";
            print "acmp   = $acmp\n";
        }
    }

    # When the delta is zero, our value for x might still be too large. We
    # require that the outout is either exact or too small (i.e., rounded down
    # to the nearest integer), so do a final check.

    while ($acmp > 0) {
        $x     = $class -> _dec($x);
        $xpown = $class -> _pow($class -> _copy($x), $n);     # x(i)^n
        $acmp  = $class -> _acmp($xpown, $y);                 # x(i)^n <=> y
    }

    return $x;
}

##############################################################################
# binary stuff

sub _and {
    my ($class, $x, $y) = @_;

    return $x if $class -> _acmp($x, $y) == 0;

    my $m    = $class -> _one();
    my $mask = $class -> _new("32768");

    my ($xr, $yr);                # remainders after division

    my $xc = $class -> _copy($x);
    my $yc = $class -> _copy($y);
    my $z  = $class -> _zero();

    until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) {
        ($xc, $xr) = $class -> _div($xc, $mask);
        ($yc, $yr) = $class -> _div($yc, $mask);
        my $bits = $class -> _new($class -> _num($xr) & $class -> _num($yr));
        $z = $class -> _add($z, $class -> _mul($bits, $m));
        $m = $class -> _mul($m, $mask);
    }

    return $z;
}

sub _xor {
    my ($class, $x, $y) = @_;

    return $class -> _zero() if $class -> _acmp($x, $y) == 0;

    my $m    = $class -> _one();
    my $mask = $class -> _new("32768");

    my ($xr, $yr);                # remainders after division

    my $xc = $class -> _copy($x);
    my $yc = $class -> _copy($y);
    my $z  = $class -> _zero();

    until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) {
        ($xc, $xr) = $class -> _div($xc, $mask);
        ($yc, $yr) = $class -> _div($yc, $mask);
        my $bits = $class -> _new($class -> _num($xr) ^ $class -> _num($yr));
        $z = $class -> _add($z, $class -> _mul($bits, $m));
        $m = $class -> _mul($m, $mask);
    }

    # The loop above stops when the smallest of the two numbers is exhausted.
    # The remainder of the longer one will survive bit-by-bit, so we simple
    # multiply-add it in.

    $z = $class -> _add($z, $class -> _mul($xc, $m))
      unless $class -> _is_zero($xc);
    $z = $class -> _add($z, $class -> _mul($yc, $m))
      unless $class -> _is_zero($yc);

    return $z;
}

sub _or {
    my ($class, $x, $y) = @_;

    return $x if $class -> _acmp($x, $y) == 0; # shortcut (see _and)

    my $m    = $class -> _one();
    my $mask = $class -> _new("32768");

    my ($xr, $yr);                # remainders after division

    my $xc = $class -> _copy($x);
    my $yc = $class -> _copy($y);
    my $z  = $class -> _zero();

    until ($class -> _is_zero($xc) || $class -> _is_zero($yc)) {
        ($xc, $xr) = $class -> _div($xc, $mask);
        ($yc, $yr) = $class -> _div($yc, $mask);
        my $bits = $class -> _new($class -> _num($xr) | $class -> _num($yr));
        $z = $class -> _add($z, $class -> _mul($bits, $m));
        $m = $class -> _mul($m, $mask);
    }

    # The loop above stops when the smallest of the two numbers is exhausted.
    # The remainder of the longer one will survive bit-by-bit, so we simple
    # multiply-add it in.

    $z = $class -> _add($z, $class -> _mul($xc, $m))
      unless $class -> _is_zero($xc);
    $z = $class -> _add($z, $class -> _mul($yc, $m))
      unless $class -> _is_zero($yc);

    return $z;
}

sub _sand {
    my ($class, $x, $sx, $y, $sy) = @_;

    return ($class -> _zero(), '+')
      if $class -> _is_zero($x) || $class -> _is_zero($y);

    my $sign = $sx eq '-' && $sy eq '-' ? '-' : '+';

    my ($bx, $by);

    if ($sx eq '-') {                   # if x is negative
        # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
        $bx = $class -> _copy($x);
        $bx = $class -> _dec($bx);
        $bx = $class -> _as_hex($bx);
        $bx =~ s/^-?0x//;
        $bx =~ tr<0123456789abcdef>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    } else {                            # if x is positive
        $bx = $class -> _as_hex($x);    # get binary representation
        $bx =~ s/^-?0x//;
        $bx =~ tr<fedcba9876543210>
                 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    }

    if ($sy eq '-') {                   # if y is negative
        # two's complement: inc (dec unsigned value) and flip all "bits" in $by
        $by = $class -> _copy($y);
        $by = $class -> _dec($by);
        $by = $class -> _as_hex($by);
        $by =~ s/^-?0x//;
        $by =~ tr<0123456789abcdef>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    } else {
        $by = $class -> _as_hex($y);    # get binary representation
        $by =~ s/^-?0x//;
        $by =~ tr<fedcba9876543210>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    }

    # now we have bit-strings from X and Y, reverse them for padding
    $bx = reverse $bx;
    $by = reverse $by;

    # padd the shorter string
    my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
    my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
    my $diff = CORE::length($bx) - CORE::length($by);
    if ($diff > 0) {
        # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
        $by .= $yy x $diff;
    } elsif ($diff < 0) {
        # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
        $bx .= $xx x abs($diff);
    }

    # and the strings together
    my $r = $bx & $by;

    # and reverse the result again
    $bx = reverse $r;

    # One of $bx or $by was negative, so need to flip bits in the result. In both
    # cases (one or two of them negative, or both positive) we need to get the
    # characters back.
    if ($sign eq '-') {
        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
                 <0123456789abcdef>;
    } else {
        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
                 <fedcba9876543210>;
    }

    # leading zeros will be stripped by _from_hex()
    $bx = '0x' . $bx;
    $bx = $class -> _from_hex($bx);

    $bx = $class -> _inc($bx) if $sign eq '-';

    # avoid negative zero
    $sign = '+' if $class -> _is_zero($bx);

    return $bx, $sign;
}

sub _sxor {
    my ($class, $x, $sx, $y, $sy) = @_;

    return ($class -> _zero(), '+')
      if $class -> _is_zero($x) && $class -> _is_zero($y);

    my $sign = $sx ne $sy ? '-' : '+';

    my ($bx, $by);

    if ($sx eq '-') {                   # if x is negative
        # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
        $bx = $class -> _copy($x);
        $bx = $class -> _dec($bx);
        $bx = $class -> _as_hex($bx);
        $bx =~ s/^-?0x//;
        $bx =~ tr<0123456789abcdef>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    } else {                            # if x is positive
        $bx = $class -> _as_hex($x);    # get binary representation
        $bx =~ s/^-?0x//;
        $bx =~ tr<fedcba9876543210>
                 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    }

    if ($sy eq '-') {                   # if y is negative
        # two's complement: inc (dec unsigned value) and flip all "bits" in $by
        $by = $class -> _copy($y);
        $by = $class -> _dec($by);
        $by = $class -> _as_hex($by);
        $by =~ s/^-?0x//;
        $by =~ tr<0123456789abcdef>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    } else {
        $by = $class -> _as_hex($y);    # get binary representation
        $by =~ s/^-?0x//;
        $by =~ tr<fedcba9876543210>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    }

    # now we have bit-strings from X and Y, reverse them for padding
    $bx = reverse $bx;
    $by = reverse $by;

    # padd the shorter string
    my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
    my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
    my $diff = CORE::length($bx) - CORE::length($by);
    if ($diff > 0) {
        # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
        $by .= $yy x $diff;
    } elsif ($diff < 0) {
        # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
        $bx .= $xx x abs($diff);
    }

    # xor the strings together
    my $r = $bx ^ $by;

    # and reverse the result again
    $bx = reverse $r;

    # One of $bx or $by was negative, so need to flip bits in the result. In both
    # cases (one or two of them negative, or both positive) we need to get the
    # characters back.
    if ($sign eq '-') {
        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
                 <0123456789abcdef>;
    } else {
        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
                 <fedcba9876543210>;
    }

    # leading zeros will be stripped by _from_hex()
    $bx = '0x' . $bx;
    $bx = $class -> _from_hex($bx);

    $bx = $class -> _inc($bx) if $sign eq '-';

    # avoid negative zero
    $sign = '+' if $class -> _is_zero($bx);

    return $bx, $sign;
}

sub _sor {
    my ($class, $x, $sx, $y, $sy) = @_;

    return ($class -> _zero(), '+')
      if $class -> _is_zero($x) && $class -> _is_zero($y);

    my $sign = $sx eq '-' || $sy eq '-' ? '-' : '+';

    my ($bx, $by);

    if ($sx eq '-') {                   # if x is negative
        # two's complement: inc (dec unsigned value) and flip all "bits" in $bx
        $bx = $class -> _copy($x);
        $bx = $class -> _dec($bx);
        $bx = $class -> _as_hex($bx);
        $bx =~ s/^-?0x//;
        $bx =~ tr<0123456789abcdef>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    } else {                            # if x is positive
        $bx = $class -> _as_hex($x);     # get binary representation
        $bx =~ s/^-?0x//;
        $bx =~ tr<fedcba9876543210>
                 <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    }

    if ($sy eq '-') {                   # if y is negative
        # two's complement: inc (dec unsigned value) and flip all "bits" in $by
        $by = $class -> _copy($y);
        $by = $class -> _dec($by);
        $by = $class -> _as_hex($by);
        $by =~ s/^-?0x//;
        $by =~ tr<0123456789abcdef>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    } else {
        $by = $class -> _as_hex($y);     # get binary representation
        $by =~ s/^-?0x//;
        $by =~ tr<fedcba9876543210>
                <\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>;
    }

    # now we have bit-strings from X and Y, reverse them for padding
    $bx = reverse $bx;
    $by = reverse $by;

    # padd the shorter string
    my $xx = "\x00"; $xx = "\x0f" if $sx eq '-';
    my $yy = "\x00"; $yy = "\x0f" if $sy eq '-';
    my $diff = CORE::length($bx) - CORE::length($by);
    if ($diff > 0) {
        # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
        $by .= $yy x $diff;
    } elsif ($diff < 0) {
        # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
        $bx .= $xx x abs($diff);
    }

    # or the strings together
    my $r = $bx | $by;

    # and reverse the result again
    $bx = reverse $r;

    # One of $bx or $by was negative, so need to flip bits in the result. In both
    # cases (one or two of them negative, or both positive) we need to get the
    # characters back.
    if ($sign eq '-') {
        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
                 <0123456789abcdef>;
    } else {
        $bx =~ tr<\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00>
                 <fedcba9876543210>;
    }

    # leading zeros will be stripped by _from_hex()
    $bx = '0x' . $bx;
    $bx = $class -> _from_hex($bx);

    $bx = $class -> _inc($bx) if $sign eq '-';

    # avoid negative zero
    $sign = '+' if $class -> _is_zero($bx);

    return $bx, $sign;
}

sub _to_bin {
    # convert the number to a string of binary digits without prefix
    my ($class, $x) = @_;
    my $str    = '';
    my $tmp    = $class -> _copy($x);
    my $chunk = $class -> _new("16777216");     # 2^24 = 24 binary digits
    my $rem;
    until ($class -> _acmp($tmp, $chunk) < 0) {
        ($tmp, $rem) = $class -> _div($tmp, $chunk);
        $str = sprintf("%024b", $class -> _num($rem)) . $str;
    }
    unless ($class -> _is_zero($tmp)) {
        $str = sprintf("%b", $class -> _num($tmp)) . $str;
    }
    return length($str) ? $str : '0';
}

sub _to_oct {
    # convert the number to a string of octal digits without prefix
    my ($class, $x) = @_;
    my $str    = '';
    my $tmp    = $class -> _copy($x);
    my $chunk = $class -> _new("16777216");     # 2^24 = 8 octal digits
    my $rem;
    until ($class -> _acmp($tmp, $chunk) < 0) {
        ($tmp, $rem) = $class -> _div($tmp, $chunk);
        $str = sprintf("%08o", $class -> _num($rem)) . $str;
    }
    unless ($class -> _is_zero($tmp)) {
        $str = sprintf("%o", $class -> _num($tmp)) . $str;
    }
    return length($str) ? $str : '0';
}

sub _to_hex {
    # convert the number to a string of hexadecimal digits without prefix
    my ($class, $x) = @_;
    my $str    = '';
    my $tmp    = $class -> _copy($x);
    my $chunk = $class -> _new("16777216");     # 2^24 = 6 hexadecimal digits
    my $rem;
    until ($class -> _acmp($tmp, $chunk) < 0) {
        ($tmp, $rem) = $class -> _div($tmp, $chunk);
        $str = sprintf("%06x", $class -> _num($rem)) . $str;
    }
    unless ($class -> _is_zero($tmp)) {
        $str = sprintf("%x", $class -> _num($tmp)) . $str;
    }
    return length($str) ? $str : '0';
}

sub _as_bin {
    # convert the number to a string of binary digits with prefix
    my ($class, $x) = @_;
    return '0b' . $class -> _to_bin($x);
}

sub _as_oct {
    # convert the number to a string of octal digits with prefix
    my ($class, $x) = @_;
    return '0' . $class -> _to_oct($x);         # yes, 0 becomes "00"
}

sub _as_hex {
    # convert the number to a string of hexadecimal digits with prefix
    my ($class, $x) = @_;
    return '0x' . $class -> _to_hex($x);
}

sub _to_bytes {
    # convert the number to a string of bytes
    my ($class, $x) = @_;
    my $str    = '';
    my $tmp    = $class -> _copy($x);
    my $chunk = $class -> _new("65536");
    my $rem;
    until ($class -> _is_zero($tmp)) {
        ($tmp, $rem) = $class -> _div($tmp, $chunk);
        $str = pack('n', $class -> _num($rem)) . $str;
    }
    $str =~ s/^\0+//;
    return length($str) ? $str : "\x00";
}

*_as_bytes = \&_to_bytes;

sub _to_base {
    # convert the number to a string of digits in various bases
    my $class = shift;
    my $x     = shift;
    my $base  = shift;
    $base = $class -> _new($base) unless ref($base);

    my $collseq;
    if (@_) {
        $collseq = shift;
        croak "The collation sequence must be a non-empty string"
          unless defined($collseq) && length($collseq);
    } else {
        if ($class -> _acmp($base, $class -> _new("94")) <= 0) {
            $collseq = '0123456789'                     #  48 ..  57
                     . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'     #  65 ..  90
                     . 'abcdefghijklmnopqrstuvwxyz'     #  97 .. 122
                     . '!"#$%&\'()*+,-./'               #  33 ..  47
                     . ':;<=>?@'                        #  58 ..  64
                     . '[\\]^_`'                        #  91 ..  96
                     . '{|}~';                          # 123 .. 126
        } else {
            croak "When base > 94, a collation sequence must be given";
        }
    }

    my @collseq = split '', $collseq;

    my $str   = '';
    my $tmp   = $class -> _copy($x);
    my $rem;
    until ($class -> _is_zero($tmp)) {
        ($tmp, $rem) = $class -> _div($tmp, $base);
        my $num = $class -> _num($rem);
        croak "no character to represent '$num' in collation sequence",
          " (collation sequence is too short)" if $num > $#collseq;
        my $chr = $collseq[$num];
        $str = $chr . $str;
    }
    return $collseq[0] unless length $str;
    return $str;
}

sub _to_base_num {
    # Convert the number to an array of integers in any base.
    my ($class, $x, $base) = @_;

    # Make sure the base is an object and >= 2.
    $base = $class -> _new($base) unless ref($base);
    my $two = $class -> _two();
    croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;

    my $out   = [];
    my $xcopy = $class -> _copy($x);
    my $rem;

    # Do all except the last (most significant) element.
    until ($class -> _acmp($xcopy, $base) < 0) {
        ($xcopy, $rem) = $class -> _div($xcopy, $base);
        unshift @$out, $rem;
    }

    # Do the last (most significant element).
    unless ($class -> _is_zero($xcopy)) {
        unshift @$out, $xcopy;
    }

    # $out is empty if $x is zero.
    unshift @$out, $class -> _zero() unless @$out;

    return $out;
}

sub _from_hex {
    # Convert a string of hexadecimal digits to a number.

    my ($class, $hex) = @_;
    $hex =~ s/^0[xX]//;

    # Find the largest number of hexadecimal digits that we can safely use with
    # 32 bit integers. There are 4 bits pr hexadecimal digit, and we use only
    # 31 bits to play safe. This gives us int(31 / 4) = 7.

    my $len = length $hex;
    my $rem = 1 + ($len - 1) % 7;

    # Do the first chunk.

    my $ret = $class -> _new(int hex substr $hex, 0, $rem);
    return $ret if $rem == $len;

    # Do the remaining chunks, if any.

    my $shift = $class -> _new(1 << (4 * 7));
    for (my $offset = $rem ; $offset < $len ; $offset += 7) {
        my $part = int hex substr $hex, $offset, 7;
        $ret = $class -> _mul($ret, $shift);
        $ret = $class -> _add($ret, $class -> _new($part));
    }

    return $ret;
}

sub _from_oct {
    # Convert a string of octal digits to a number.

    my ($class, $oct) = @_;

    # Find the largest number of octal digits that we can safely use with 32
    # bit integers. There are 3 bits pr octal digit, and we use only 31 bits to
    # play safe. This gives us int(31 / 3) = 10.

    my $len = length $oct;
    my $rem = 1 + ($len - 1) % 10;

    # Do the first chunk.

    my $ret = $class -> _new(int oct substr $oct, 0, $rem);
    return $ret if $rem == $len;

    # Do the remaining chunks, if any.

    my $shift = $class -> _new(1 << (3 * 10));
    for (my $offset = $rem ; $offset < $len ; $offset += 10) {
        my $part = int oct substr $oct, $offset, 10;
        $ret = $class -> _mul($ret, $shift);
        $ret = $class -> _add($ret, $class -> _new($part));
    }

    return $ret;
}

sub _from_bin {
    # Convert a string of binary digits to a number.

    my ($class, $bin) = @_;
    $bin =~ s/^0[bB]//;

    # The largest number of binary digits that we can safely use with 32 bit
    # integers is 31. We use only 31 bits to play safe.

    my $len = length $bin;
    my $rem = 1 + ($len - 1) % 31;

    # Do the first chunk.

    my $ret = $class -> _new(int oct '0b' . substr $bin, 0, $rem);
    return $ret if $rem == $len;

    # Do the remaining chunks, if any.

    my $shift = $class -> _new(1 << 31);
    for (my $offset = $rem ; $offset < $len ; $offset += 31) {
        my $part = int oct '0b' . substr $bin, $offset, 31;
        $ret = $class -> _mul($ret, $shift);
        $ret = $class -> _add($ret, $class -> _new($part));
    }

    return $ret;
}

sub _from_bytes {
    # convert string of bytes to a number
    my ($class, $str) = @_;
    my $x    = $class -> _zero();
    my $base = $class -> _new("256");
    my $n    = length($str);
    for (my $i = 0 ; $i < $n ; ++$i) {
        $x = $class -> _mul($x, $base);
        my $byteval = $class -> _new(unpack 'C', substr($str, $i, 1));
        $x = $class -> _add($x, $byteval);
    }
    return $x;
}

sub _from_base {
    # convert a string to a decimal number
    my $class = shift;
    my $str   = shift;
    my $base  = shift;
    $base = $class -> _new($base) unless ref($base);

    my $n = length($str);
    my $x = $class -> _zero();

    my $collseq;
    if (@_) {
        $collseq = shift();
    } else {
        if ($class -> _acmp($base, $class -> _new("36")) <= 0) {
            $str = uc $str;
            $collseq = '0123456789' . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
        } elsif ($class -> _acmp($base, $class -> _new("94")) <= 0) {
            $collseq = '0123456789'                     #  48 ..  57
                     . 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'     #  65 ..  90
                     . 'abcdefghijklmnopqrstuvwxyz'     #  97 .. 122
                     . '!"#$%&\'()*+,-./'               #  33 ..  47
                     . ':;<=>?@'                        #  58 ..  64
                     . '[\\]^_`'                        #  91 ..  96
                     . '{|}~';                          # 123 .. 126
        } else {
            croak "When base > 94, a collation sequence must be given";
        }
        $collseq = substr $collseq, 0, $class -> _num($base);
    }

    # Create a mapping from each character in the collation sequence to the
    # corresponding integer. Check for duplicates in the collation sequence.

    my @collseq = split '', $collseq;
    my %collseq;
    for my $num (0 .. $#collseq) {
        my $chr = $collseq[$num];
        die "duplicate character '$chr' in collation sequence"
          if exists $collseq{$chr};
        $collseq{$chr} = $num;
    }

    for (my $i = 0 ; $i < $n ; ++$i) {
        my $chr = substr($str, $i, 1);
        die "input character '$chr' does not exist in collation sequence"
          unless exists $collseq{$chr};
        $x = $class -> _mul($x, $base);
        my $num = $class -> _new($collseq{$chr});
        $x = $class -> _add($x, $num);
    }

    return $x;
}

sub _from_base_num {
    # Convert an array in the given base to a number.
    my ($class, $in, $base) = @_;

    # Make sure the base is an object and >= 2.
    $base = $class -> _new($base) unless ref($base);
    my $two = $class -> _two();
    croak "base must be >= 2" unless $class -> _acmp($base, $two) >= 0;

    # @$in = map { ref($_) ? $_ : $class -> _new($_) } @$in;

    my $ele = $in -> [0];

    $ele = $class -> _new($ele) unless ref($ele);
    my $x = $class -> _copy($ele);

    for my $i (1 .. $#$in) {
        $x = $class -> _mul($x, $base);
        $ele = $in -> [$i];
        $ele = $class -> _new($ele) unless ref($ele);
        $x = $class -> _add($x, $ele);
    }

    return $x;
}

##############################################################################
# special modulus functions

sub _modinv {
    # modular multiplicative inverse
    my ($class, $x, $y) = @_;

    # modulo zero
    if ($class -> _is_zero($y)) {
        return (undef, undef);
    }

    # modulo one
    if ($class -> _is_one($y)) {
        return ($class -> _zero(), '+');
    }

    my $u = $class -> _zero();
    my $v = $class -> _one();
    my $a = $class -> _copy($y);
    my $b = $class -> _copy($x);

    # Euclid's Algorithm for bgcd().

    my $q;
    my $sign = 1;
    {
        ($a, $q, $b) = ($b, $class -> _div($a, $b));
        last if $class -> _is_zero($b);

        my $vq = $class -> _mul($class -> _copy($v), $q);
        my $t = $class -> _add($vq, $u);
        $u = $v;
        $v = $t;
        $sign = -$sign;
        redo;
    }

    # if the gcd is not 1, there exists no modular multiplicative inverse
    return (undef, undef) unless $class -> _is_one($a);

    ($v, $sign == 1 ? '+' : '-');
}

sub _modpow {
    # modulus of power ($x ** $y) % $z
    my ($class, $num, $exp, $mod) = @_;

    # a^b (mod 1) = 0 for all a and b
    if ($class -> _is_one($mod)) {
        return $class -> _zero();
    }

    # 0^a (mod m) = 0 if m != 0, a != 0
    # 0^0 (mod m) = 1 if m != 0
    if ($class -> _is_zero($num)) {
        return $class -> _is_zero($exp) ? $class -> _one()
                                        : $class -> _zero();
    }

    #  $num = $class -> _mod($num, $mod);   # this does not make it faster

    my $acc = $class -> _copy($num);
    my $t   = $class -> _one();

    my $expbin = $class -> _as_bin($exp);
    $expbin =~ s/^0b//;
    my $len = length($expbin);

    while (--$len >= 0) {
        if (substr($expbin, $len, 1) eq '1') {
            $t = $class -> _mul($t, $acc);
            $t = $class -> _mod($t, $mod);
        }
        $acc = $class -> _mul($acc, $acc);
        $acc = $class -> _mod($acc, $mod);
    }
    return $t;
}

sub _gcd {
    # Greatest common divisor.

    my ($class, $x, $y) = @_;

    # gcd(0, 0) = 0
    # gcd(0, a) = a, if a != 0

    if ($class -> _acmp($x, $y) == 0) {
        return $class -> _copy($x);
    }

    if ($class -> _is_zero($x)) {
        if ($class -> _is_zero($y)) {
            return $class -> _zero();
        } else {
            return $class -> _copy($y);
        }
    } else {
        if ($class -> _is_zero($y)) {
            return $class -> _copy($x);
        } else {

            # Until $y is zero ...

            $x = $class -> _copy($x);
            until ($class -> _is_zero($y)) {

                # Compute remainder.

                $x = $class -> _mod($x, $y);

                # Swap $x and $y.

                my $tmp = $x;
                $x = $class -> _copy($y);
                $y = $tmp;
            }

            return $x;
        }
    }
}

sub _lcm {
    # Least common multiple.

    my ($class, $x, $y) = @_;

    # lcm(0, x) = 0 for all x

    return $class -> _zero()
      if ($class -> _is_zero($x) ||
          $class -> _is_zero($y));

    my $gcd = $class -> _gcd($class -> _copy($x), $y);
    $x = $class -> _div($x, $gcd);
    $x = $class -> _mul($x, $y);
    return $x;
}

sub _lucas {
    my ($class, $n) = @_;

    $n = $class -> _num($n) if ref $n;

    # In list context, use lucas(n) = lucas(n-1) + lucas(n-2)

    if (wantarray) {
        my @y;

        push @y, $class -> _two();
        return @y if $n == 0;

        push @y, $class -> _one();
        return @y if $n == 1;

        for (my $i = 2 ; $i <= $n ; ++ $i) {
            $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]);
        }

        return @y;
    }

    # In scalar context use that lucas(n) = fib(n-1) + fib(n+1).
    #
    # Remember that _fib() behaves differently in scalar context and list
    # context, so we must add scalar() to get the desired behaviour.

    return $class -> _two() if $n == 0;

    return $class -> _add(scalar($class -> _fib($n - 1)),
                          scalar($class -> _fib($n + 1)));
}

sub _fib {
    my ($class, $n) = @_;

    $n = $class -> _num($n) if ref $n;

    # In list context, use fib(n) = fib(n-1) + fib(n-2)

    if (wantarray) {
        my @y;

        push @y, $class -> _zero();
        return @y if $n == 0;

        push @y, $class -> _one();
        return @y if $n == 1;

        for (my $i = 2 ; $i <= $n ; ++ $i) {
            $y[$i] = $class -> _add($class -> _copy($y[$i - 1]), $y[$i - 2]);
        }

        return @y;
    }

    # In scalar context use a fast algorithm that is much faster than the
    # recursive algorith used in list context.

    my $cache = {};
    my $two = $class -> _two();
    my $fib;

    $fib = sub {
        my $n = shift;
        return $class -> _zero() if $n <= 0;
        return $class -> _one()  if $n <= 2;
        return $cache -> {$n}    if exists $cache -> {$n};

        my $k = int($n / 2);
        my $a = $fib -> ($k + 1);
        my $b = $fib -> ($k);
        my $y;

        if ($n % 2 == 1) {
            # a*a + b*b
            $y = $class -> _add($class -> _mul($class -> _copy($a), $a),
                                $class -> _mul($class -> _copy($b), $b));
        } else {
            # (2*a - b)*b
            $y = $class -> _mul($class -> _sub($class -> _mul(
                   $class -> _copy($two), $a), $b), $b);
        }

        $cache -> {$n} = $y;
        return $y;
    };

    return $fib -> ($n);
}

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

1;

__END__

=pod

=head1 NAME

Math::BigInt::Lib - virtual parent class for Math::BigInt libraries

=head1 SYNOPSIS

    # In the backend library for Math::BigInt et al.

    package Math::BigInt::MyBackend;

    use Math::BigInt::Lib;
    our @ISA = qw< Math::BigInt::Lib >;

    sub _new { ... }
    sub _str { ... }
    sub _add { ... }
    str _sub { ... }
    ...

    # In your main program.

    use Math::BigInt lib => 'MyBackend';

=head1 DESCRIPTION

This module provides support for big integer calculations. It is not intended
to be used directly, but rather as a parent class for backend libraries used by
Math::BigInt, Math::BigFloat, Math::BigRat, and related modules.

Other backend libraries include Math::BigInt::Calc, Math::BigInt::FastCalc,
Math::BigInt::GMP, and Math::BigInt::Pari.

In order to allow for multiple big integer libraries, Math::BigInt was
rewritten to use a plug-in library for core math routines. Any module which
conforms to the API can be used by Math::BigInt by using this in your program:

        use Math::BigInt lib => 'libname';

'libname' is either the long name, like 'Math::BigInt::Pari', or only the short
version, like 'Pari'.

=head2 General Notes

A library only needs to deal with unsigned big integers. Testing of input
parameter validity is done by the caller, so there is no need to worry about
underflow (e.g., in C<_sub()> and C<_dec()>) or about division by zero (e.g.,
in C<_div()> and C<_mod()>)) or similar cases.

Some libraries use methods that don't modify their argument, and some libraries
don't even use objects, but rather unblessed references. Because of this,
liberary methods are always called as class methods, not instance methods:

    $x = Class -> method($x, $y);     # like this
    $x = $x -> method($y);            # not like this ...
    $x -> method($y);                 # ... or like this

And with boolean methods

    $bool = Class -> method($x, $y);  # like this
    $bool = $x -> method($y);         # not like this

Return values are always objects, strings, Perl scalars, or true/false for
comparison routines.

=head3 API version

=over 4

=item CLASS-E<gt>api_version()

This method is no longer used and can be omitted. Methods that are not
implemented by a subclass will be inherited from this class.

=back

=head3 Constructors

The following methods are mandatory: _new(), _str(), _add(), and _sub().
However, computations will be very slow without _mul() and _div().

=over 4

=item CLASS-E<gt>_new(STR)

Convert a string representing an unsigned decimal number to an object
representing the same number. The input is normalized, i.e., it matches
C<^(0|[1-9]\d*)$>.

=item CLASS-E<gt>_zero()

Return an object representing the number zero.

=item CLASS-E<gt>_one()

Return an object representing the number one.

=item CLASS-E<gt>_two()

Return an object representing the number two.

=item CLASS-E<gt>_ten()

Return an object representing the number ten.

=item CLASS-E<gt>_from_bin(STR)

Return an object given a string representing a binary number. The input has a
'0b' prefix and matches the regular expression C<^0[bB](0|1[01]*)$>.

=item CLASS-E<gt>_from_oct(STR)

Return an object given a string representing an octal number. The input has a
'0' prefix and matches the regular expression C<^0[1-7]*$>.

=item CLASS-E<gt>_from_hex(STR)

Return an object given a string representing a hexadecimal number. The input
has a '0x' prefix and matches the regular expression
C<^0x(0|[1-9a-fA-F][\da-fA-F]*)$>.

=item CLASS-E<gt>_from_bytes(STR)

Returns an object given a byte string representing the number. The byte string
is in big endian byte order, so the two-byte input string "\x01\x00" should
give an output value representing the number 256.

=item CLASS-E<gt>_from_base(STR, BASE, COLLSEQ)

Returns an object given a string STR, a base BASE, and a collation sequence
COLLSEQ. Each character in STR represents a numerical value identical to the
character's position in COLLSEQ. All characters in STR must be present in
COLLSEQ.

If BASE is less than or equal to 94, and a collation sequence is not specified,
the following default collation sequence is used. It contains of all the 94
printable ASCII characters except space/blank:

    0123456789                  # ASCII  48 to  57
    ABCDEFGHIJKLMNOPQRSTUVWXYZ  # ASCII  65 to  90
    abcdefghijklmnopqrstuvwxyz  # ASCII  97 to 122
    !"#$%&'()*+,-./             # ASCII  33 to  47
    :;<=>?@                     # ASCII  58 to  64
    [\]^_`                      # ASCII  91 to  96
    {|}~                        # ASCII 123 to 126

If the default collation sequence is used, and the BASE is less than or equal
to 36, the letter case in STR is ignored.

For instance, with base 3 and collation sequence "-/|", the character "-"
represents 0, "/" represents 1, and "|" represents 2. So if STR is "/|-", the
output is 1 * 3**2 + 2 * 3**1 + 0 * 3**0 = 15.

The following examples show standard binary, octal, decimal, and hexadecimal
conversion. All examples return 250.

    $x = $class -> _from_base("11111010", 2)
    $x = $class -> _from_base("372", 8)
    $x = $class -> _from_base("250", 10)
    $x = $class -> _from_base("FA", 16)

Some more examples, all returning 250:

    $x = $class -> _from_base("100021", 3)
    $x = $class -> _from_base("3322", 4)
    $x = $class -> _from_base("2000", 5)
    $x = $class -> _from_base("caaa", 5, "abcde")
    $x = $class -> _from_base("42", 62)
    $x = $class -> _from_base("2!", 94)

=item CLASS-E<gt>_from_base_num(ARRAY, BASE)

Returns an object given an array of values and a base. This method is
equivalent to C<_from_base()>, but works on numbers in an array rather than
characters in a string. Unlike C<_from_base()>, all input values may be
arbitrarily large.

    $x = $class -> _from_base_num([1, 1, 0, 1], 2)    # $x is 13
    $x = $class -> _from_base_num([3, 125, 39], 128)  # $x is 65191

=back

=head3 Mathematical functions

=over 4

=item CLASS-E<gt>_add(OBJ1, OBJ2)

Addition. Returns the result of adding OBJ2 to OBJ1.

=item CLASS-E<gt>_mul(OBJ1, OBJ2)

Multiplication. Returns the result of multiplying OBJ2 and OBJ1.

=item CLASS-E<gt>_div(OBJ1, OBJ2)

Division. In scalar context, returns the quotient after dividing OBJ1 by OBJ2
and truncating the result to an integer. In list context, return the quotient
and the remainder.

=item CLASS-E<gt>_sub(OBJ1, OBJ2, FLAG)

=item CLASS-E<gt>_sub(OBJ1, OBJ2)

Subtraction. Returns the result of subtracting OBJ2 by OBJ1. If C<flag> is false
or omitted, OBJ1 might be modified. If C<flag> is true, OBJ2 might be modified.

=item CLASS-E<gt>_sadd(OBJ1, SIGN1, OBJ2, SIGN2)

Signed addition. Returns the result of adding OBJ2 with sign SIGN2 to OBJ1 with
sign SIGN1.

    ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2);

=item CLASS-E<gt>_ssub(OBJ1, SIGN1, OBJ2, SIGN2)

Signed subtraction. Returns the result of subtracting OBJ2 with sign SIGN2 to
OBJ1 with sign SIGN1.

    ($obj3, $sign3) = $class -> _sadd($obj1, $sign1, $obj2, $sign2);

=item CLASS-E<gt>_dec(OBJ)

Returns the result after decrementing OBJ by one.

=item CLASS-E<gt>_inc(OBJ)

Returns the result after incrementing OBJ by one.

=item CLASS-E<gt>_mod(OBJ1, OBJ2)

Returns OBJ1 modulo OBJ2, i.e., the remainder after dividing OBJ1 by OBJ2.

=item CLASS-E<gt>_sqrt(OBJ)

Returns the square root of OBJ, truncated to an integer.

=item CLASS-E<gt>_root(OBJ, N)

Returns the Nth root of OBJ, truncated to an integer.

=item CLASS-E<gt>_fac(OBJ)

Returns the factorial of OBJ, i.e., the product of all positive integers up to
and including OBJ.

=item CLASS-E<gt>_dfac(OBJ)

Returns the double factorial of OBJ. If OBJ is an even integer, returns the
product of all positive, even integers up to and including OBJ, i.e.,
2*4*6*...*OBJ. If OBJ is an odd integer, returns the product of all positive,
odd integers, i.e., 1*3*5*...*OBJ.

=item CLASS-E<gt>_pow(OBJ1, OBJ2)

Returns OBJ1 raised to the power of OBJ2. By convention, 0**0 = 1.

=item CLASS-E<gt>_modinv(OBJ1, OBJ2)

Returns the modular multiplicative inverse, i.e., return OBJ3 so that

    (OBJ3 * OBJ1) % OBJ2 = 1 % OBJ2

The result is returned as two arguments. If the modular multiplicative inverse
does not exist, both arguments are undefined. Otherwise, the arguments are a
number (object) and its sign ("+" or "-").

The output value, with its sign, must either be a positive value in the range
1,2,...,OBJ2-1 or the same value subtracted OBJ2. For instance, if the input
arguments are objects representing the numbers 7 and 5, the method must either
return an object representing the number 3 and a "+" sign, since (3*7) % 5 = 1
% 5, or an object representing the number 2 and a "-" sign, since (-2*7) % 5 = 1
% 5.

=item CLASS-E<gt>_modpow(OBJ1, OBJ2, OBJ3)

Returns the modular exponentiation, i.e., (OBJ1 ** OBJ2) % OBJ3.

=item CLASS-E<gt>_rsft(OBJ, N, B)

Returns the result after shifting OBJ N digits to thee right in base B. This is
equivalent to performing integer division by B**N and discarding the remainder,
except that it might be much faster.

For instance, if the object $obj represents the hexadecimal number 0xabcde,
then C<_rsft($obj, 2, 16)> returns an object representing the number 0xabc. The
"remainer", 0xde, is discarded and not returned.

=item CLASS-E<gt>_lsft(OBJ, N, B)

Returns the result after shifting OBJ N digits to the left in base B. This is
equivalent to multiplying by B**N, except that it might be much faster.

=item CLASS-E<gt>_log_int(OBJ, B)

Returns the logarithm of OBJ to base BASE truncted to an integer. This method
has two output arguments, the OBJECT and a STATUS. The STATUS is Perl scalar;
it is 1 if OBJ is the exact result, 0 if the result was truncted to give OBJ,
and undef if it is unknown whether OBJ is the exact result.

=item CLASS-E<gt>_gcd(OBJ1, OBJ2)

Returns the greatest common divisor of OBJ1 and OBJ2.

=item CLASS-E<gt>_lcm(OBJ1, OBJ2)

Return the least common multiple of OBJ1 and OBJ2.

=item CLASS-E<gt>_fib(OBJ)

In scalar context, returns the nth Fibonacci number: _fib(0) returns 0, _fib(1)
returns 1, _fib(2) returns 1, _fib(3) returns 2 etc. In list context, returns
the Fibonacci numbers from F(0) to F(n): 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, ...

=item CLASS-E<gt>_lucas(OBJ)

In scalar context, returns the nth Lucas number: _lucas(0) returns 2, _lucas(1)
returns 1, _lucas(2) returns 3, etc. In list context, returns the Lucas numbers
from L(0) to L(n): 2, 1, 3, 4, 7, 11, 18, 29,47, 76, ...

=back

=head3 Bitwise operators

=over 4

=item CLASS-E<gt>_and(OBJ1, OBJ2)

Returns bitwise and.

=item CLASS-E<gt>_or(OBJ1, OBJ2)

Returns bitwise or.

=item CLASS-E<gt>_xor(OBJ1, OBJ2)

Returns bitwise exclusive or.

=item CLASS-E<gt>_sand(OBJ1, OBJ2, SIGN1, SIGN2)

Returns bitwise signed and.

=item CLASS-E<gt>_sor(OBJ1, OBJ2, SIGN1, SIGN2)

Returns bitwise signed or.

=item CLASS-E<gt>_sxor(OBJ1, OBJ2, SIGN1, SIGN2)

Returns bitwise signed exclusive or.

=back

=head3 Boolean operators

=over 4

=item CLASS-E<gt>_is_zero(OBJ)

Returns a true value if OBJ is zero, and false value otherwise.

=item CLASS-E<gt>_is_one(OBJ)

Returns a true value if OBJ is one, and false value otherwise.

=item CLASS-E<gt>_is_two(OBJ)

Returns a true value if OBJ is two, and false value otherwise.

=item CLASS-E<gt>_is_ten(OBJ)

Returns a true value if OBJ is ten, and false value otherwise.

=item CLASS-E<gt>_is_even(OBJ)

Return a true value if OBJ is an even integer, and a false value otherwise.

=item CLASS-E<gt>_is_odd(OBJ)

Return a true value if OBJ is an even integer, and a false value otherwise.

=item CLASS-E<gt>_acmp(OBJ1, OBJ2)

Compare OBJ1 and OBJ2 and return -1, 0, or 1, if OBJ1 is numerically less than,
equal to, or larger than OBJ2, respectively.

=back

=head3 String conversion

=over 4

=item CLASS-E<gt>_str(OBJ)

Returns a string representing OBJ in decimal notation. The returned string
should have no leading zeros, i.e., it should match C<^(0|[1-9]\d*)$>.

=item CLASS-E<gt>_to_bin(OBJ)

Returns the binary string representation of OBJ.

=item CLASS-E<gt>_to_oct(OBJ)

Returns the octal string representation of the number.

=item CLASS-E<gt>_to_hex(OBJ)

Returns the hexadecimal string representation of the number.

=item CLASS-E<gt>_to_bytes(OBJ)

Returns a byte string representation of OBJ. The byte string is in big endian
byte order, so if OBJ represents the number 256, the output should be the
two-byte string "\x01\x00".

=item CLASS-E<gt>_to_base(OBJ, BASE, COLLSEQ)

Returns a string representation of OBJ in base BASE with collation sequence
COLLSEQ.

    $val = $class -> _new("210");
    $str = $class -> _to_base($val, 10, "xyz")  # $str is "zyx"

    $val = $class -> _new("32");
    $str = $class -> _to_base($val, 2, "-|")  # $str is "|-----"

See _from_base() for more information.

=item CLASS-E<gt>_to_base_num(OBJ, BASE)

Converts the given number to the given base. This method is equivalent to
C<_to_base()>, but returns numbers in an array rather than characters in a
string. In the output, the first element is the most significant. Unlike
C<_to_base()>, all input values may be arbitrarily large.

    $x = $class -> _to_base_num(13, 2)        # $x is [1, 1, 0, 1]
    $x = $class -> _to_base_num(65191, 128)   # $x is [3, 125, 39]

=item CLASS-E<gt>_as_bin(OBJ)

Like C<_to_bin()> but with a '0b' prefix.

=item CLASS-E<gt>_as_oct(OBJ)

Like C<_to_oct()> but with a '0' prefix.

=item CLASS-E<gt>_as_hex(OBJ)

Like C<_to_hex()> but with a '0x' prefix.

=item CLASS-E<gt>_as_bytes(OBJ)

This is an alias to C<_to_bytes()>.

=back

=head3 Numeric conversion

=over 4

=item CLASS-E<gt>_num(OBJ)

Returns a Perl scalar number representing the number OBJ as close as
possible. Since Perl scalars have limited precision, the returned value might
not be exactly the same as OBJ.

=back

=head3 Miscellaneous

=over 4

=item CLASS-E<gt>_copy(OBJ)

Returns a true copy OBJ.

=item CLASS-E<gt>_len(OBJ)

Returns the number of the decimal digits in OBJ. The output is a Perl scalar.

=item CLASS-E<gt>_zeros(OBJ)

Returns the number of trailing decimal zeros. The output is a Perl scalar. The
number zero has no trailing decimal zeros.

=item CLASS-E<gt>_digit(OBJ, N)

Returns the Nth digit in OBJ as a Perl scalar. N is a Perl scalar, where zero
refers to the rightmost (least significant) digit, and negative values count
from the left (most significant digit). If $obj represents the number 123, then

    CLASS->_digit($obj,  0)     # returns 3
    CLASS->_digit($obj,  1)     # returns 2
    CLASS->_digit($obj,  2)     # returns 1
    CLASS->_digit($obj, -1)     # returns 1

=item CLASS-E<gt>_digitsum(OBJ)

Returns the sum of the base 10 digits.

=item CLASS-E<gt>_check(OBJ)

Returns true if the object is invalid and false otherwise. Preferably, the true
value is a string describing the problem with the object. This is a check
routine to test the internal state of the object for corruption.

=item CLASS-E<gt>_set(OBJ)

xxx

=back

=head2 API version 2

The following methods are required for an API version of 2 or greater.

=head3 Constructors

=over 4

=item CLASS-E<gt>_1ex(N)

Return an object representing the number 10**N where N E<gt>= 0 is a Perl
scalar.

=back

=head3 Mathematical functions

=over 4

=item CLASS-E<gt>_nok(OBJ1, OBJ2)

Return the binomial coefficient OBJ1 over OBJ1.

=back

=head3 Miscellaneous

=over 4

=item CLASS-E<gt>_alen(OBJ)

Return the approximate number of decimal digits of the object. The output is a
Perl scalar.

=back

=head1 WRAP YOUR OWN

If you want to port your own favourite C library for big numbers to the
Math::BigInt interface, you can take any of the already existing modules as a
rough guideline. You should really wrap up the latest Math::BigInt and
Math::BigFloat testsuites with your module, and replace in them any of the
following:

        use Math::BigInt;

by this:

        use Math::BigInt lib => 'yourlib';

This way you ensure that your library really works 100% within Math::BigInt.

=head1 BUGS

Please report any bugs or feature requests to
C<bug-math-bigint at rt.cpan.org>, or through the web interface at
L<https://rt.cpan.org/Ticket/Create.html?Queue=Math-BigInt>
(requires login).
We will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Math::BigInt::Calc

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<https://rt.cpan.org/Public/Dist/Display.html?Name=Math-BigInt>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Math-BigInt>

=item * CPAN Ratings

L<https://cpanratings.perl.org/dist/Math-BigInt>

=item * MetaCPAN

L<https://metacpan.org/release/Math-BigInt>

=item * CPAN Testers Matrix

L<http://matrix.cpantesters.org/?dist=Math-BigInt>

=item * The Bignum mailing list

=over 4

=item * Post to mailing list

C<bignum at lists.scsys.co.uk>

=item * View mailing list

L<http://lists.scsys.co.uk/pipermail/bignum/>

=item * Subscribe/Unsubscribe

L<http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/bignum>

=back

=back

=head1 LICENSE

This program is free software; you may redistribute it and/or modify it under
the same terms as Perl itself.

=head1 AUTHOR

Peter John Acklam, E<lt>pjacklam@gmail.comE<gt>

Code and documentation based on the Math::BigInt::Calc module by Tels
E<lt>nospam-abuse@bloodgate.comE<gt>

=head1 SEE ALSO

L<Math::BigInt>, L<Math::BigInt::Calc>, L<Math::BigInt::GMP>,
L<Math::BigInt::FastCalc> and L<Math::BigInt::Pari>.

=cut
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            