File Coverage

blib/lib/Math/Units/PhysicalValue.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Math::Units::PhysicalValue;

use strict;
use Math::Units::PhysicalValue::AutoUnit;

use Carp;
use base qw(Exporter);
use Math::Units qw(convert);
use Number::Format;
use Math::BigFloat;
use overload
    '+'    => \&pv_add,
    '*'    => \&pv_mul,
    '**'   => \&pv_mulmul,
    'sqrt' => \&pv_sqrt,
    '-'    => \&pv_sub,
    '/'    => \&pv_div,
    '++'   => \&pv_inc,
    '--'   => \&pv_dec,
    '=='   => \&pv_num_eq,
    '<'    => \&pv_num_lt,
    '>'    => \&pv_num_gt,
    '<='   => \&pv_num_lte,
    '>='   => \&pv_num_gte,
    'eq'   => \&pv_str_eq,
    'ne'   => \&pv_str_ne,
    '""'   => \&pv_print,
    '<=>'  => \&pv_ncmp,
    'cmp'  => \&pv_scmp,
    'bool' => \&pv_bool;

our $VERSION = 1.0007;

our $StrictTypes    = 0; # throws errors on unknown units
our $PrintPrecision = 2;
our $fmt;
    $fmt = new Number::Format if not defined $fmt;

our @EXPORT_OK = qw(pv PV G);
our @AUTO_PLURALS = ();

# NOTE:  AUTO_PLURALS and G are not documented because they are still experimental

1;

sub G { Math::Units::PhysicalValue->new( "6.672e-11 N m^2 / kg^2" ) }

# PV {{{
sub PV {
    my $v = shift;

    return Math::Units::PhysicalValue->new( $v );
}
*pv = *PV;
# }}}

# new {{{
sub new {
    my $class = shift;
    my $value = shift;
    my $this  = bless [], $class;

    $value = 0 unless defined $value;

    if( $value =~ m/^\s*([\-\,\.\de]+)\s*([\s\w\^\d\.\/\*]*)$/ ) {
        my ($v, $u) = ($1, $2);

        $v =~ s/\,//g;
        $u =~ s/\^/**/g;
        $u =~ s/(\w+(?:\*\*\d+)?)\s+(\w+(?:\*\*\d+)?)/$1*$2/g;
        $u =~ s/\s//g;

        if ( $StrictTypes ) {
            eval { convert(3.1415926, $u, '') };
            if( $@ =~ /unknown unit/ ) {
                my $e = $@;
                $e =~ s/ at .*PhysicalValue.*//s;
                croak $e;
            }
        }

        $u =~ s/\b$_->[1]\b/$_->[0]/sg for @AUTO_PLURALS;

        $this->[0] = Math::BigFloat->new($v);
        $this->[1] = new Math::Units::PhysicalValue::AutoUnit $u;

    } else {
        croak "value passed to PhysicalValue->new(\"$value\") was not understood";
    }

    return $this;
}
# }}}
# deunit {{{
sub deunit {
    my $this = shift;

    return $this->[0];
}
# }}}

# pv_add {{{
sub pv_add {
    my ($lhs, $rhs) = @_;

    $rhs = ref($lhs)->new($rhs eq "0" ? "0 $lhs->[1]" : $rhs) unless ref $rhs eq ref $lhs;

    my $v;
    eval {
        $v = convert(@$lhs, $rhs->[1]);
    };

    if( $@ ) {
        my $e = $@;
        $e =~ s/'1'/''/;
        $e =~ s/ at .*PhysicalValue.*//s;
        croak $e;
    }

    $v += $rhs->[0];

    return bless [ $v, $rhs->[1] ], ref $lhs;
}
# }}}
# pv_mul {{{
sub pv_mul {
    my ($lhs, $rhs) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;

    my ($v, $u) = (@$lhs);

    $v *= $rhs->[0];
    $u *= $rhs->[1];

    return bless [ $v, $u ], ref $lhs;
}
# }}}
# pv_mulmul {{{
sub pv_mulmul {
    my ($lhs, $rhs) = @_;

    croak "right hand side must be a scalar (ie no units)" if ref($rhs);

    my ($v, $u) = (@$lhs);

    $v = $v ** $rhs;
    $u = $u ** $rhs;

    return bless [ $v, $u ], ref $lhs;
}
# }}}
# pv_sqrt {{{
sub pv_sqrt {
    my ($lhs) = @_;

    my ($v, $u) = (@$lhs);

    $v = sqrt( $v );
    $u = sqrt( $u );

    return bless [ $v, $u ], ref $lhs;
}
# }}}
# pv_div {{{
sub pv_div {
    my ($lhs, $rhs, $assbackwards) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;
    return $rhs / $lhs if $assbackwards;

    my ($v, $u) = (@$lhs);

    $v /= $rhs->[0];
    $u /= $rhs->[1];

    return bless [ $v, $u ], ref $lhs;
}
# }}}

# pv_sub {{{
sub pv_sub {
    my ($lhs, $rhs, $assbackwards) = @_;

    $rhs = ref($lhs)->new($rhs eq "0" ? "0 $lhs->[1]" : $rhs) unless ref $rhs eq ref $lhs;
    return ($rhs - $lhs) if $assbackwards;

    return $lhs->pv_add( $rhs->pv_mul(-1) );
}
# }}}

# pv_inc {{{
sub pv_inc {
    my $this = shift;

    $this->[0] ++;

    return $this;
}
# }}}
# pv_dec {{{
sub pv_dec {
    my $this = shift;

    $this->[0] --;

    return $this;
}
# }}}

# pv_str_eq {{{
sub pv_str_eq {
    my ($lhs, $rhs) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;

    my $v;
    eval {
        $v = convert(@$rhs, $lhs->[1]);
    };

    $rhs->[0] = $v;
    $rhs->[1] = $lhs->[1];

    if( $@ ) {
        my $e = $@;
        $e =~ s/'1'/''/;
        $e =~ s/ at .*PhysicalValue.*//s;
        croak $e;
    }

    return "$lhs" eq "$rhs";
}
# }}}
# pv_str_ne {{{
sub pv_str_ne {
    my ($lhs, $rhs) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;

    my $v;
    eval {
        $v = convert(@$rhs, $lhs->[1]);
    };

    $rhs->[0] = $v;
    $rhs->[1] = $lhs->[1];

    if( $@ ) {
        my $e = $@;
        $e =~ s/'1'/''/;
        $e =~ s/ at .*PhysicalValue.*//s;
        croak $e;
    }

    return "$lhs" ne "$rhs";
}
# }}}
# pv_num_eq {{{
sub pv_num_eq {
    my ($lhs, $rhs) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;

    my $v;
    eval {
        $v = convert(@$rhs, $lhs->[1]);
    };

    if( $@ ) {
        my $e = $@;
        $e =~ s/'1'/''/;
        $e =~ s/ at .*PhysicalValue.*//s;
        croak $e;
    }

    return $lhs->[0] == $v;
}
# }}}
# pv_num_lt {{{
sub pv_num_lt {
    my ($lhs, $rhs, $assbackwards) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;
    return $rhs < $lhs if $assbackwards;

    my $v;
    eval {
        $v = convert(@$rhs, $lhs->[1]);
    };

    if( $@ ) {
        my $e = $@;
        $e =~ s/'1'/''/;
        $e =~ s/ at .*PhysicalValue.*//s;
        croak $e;
    }

    return $lhs->[0] < $v;
}
# }}}
# pv_num_gt {{{
sub pv_num_gt {
    my ($lhs, $rhs, $assbackwards) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;
    return $rhs > $lhs if $assbackwards;

    my $v;
    eval {
        $v = convert(@$rhs, $lhs->[1]);
    };

    if( $@ ) {
        my $e = $@;
        $e =~ s/'1'/''/;
        $e =~ s/ at .*PhysicalValue.*//s;
        croak $e;
    }

    return $lhs->[0] > $v;
}
# }}}
# pv_num_lte {{{
sub pv_num_lte {
    my ($lhs, $rhs, $assbackwards) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;
    return $rhs <= $lhs if $assbackwards;

    my $v;
    eval {
        $v = convert(@$rhs, $lhs->[1]);
    };

    if( $@ ) {
        my $e = $@;
        $e =~ s/'1'/''/;
        $e =~ s/ at .*PhysicalValue.*//s;
        croak $e;
    }

    return $lhs->[0] <= $v;
}
# }}}
# pv_num_gte {{{
sub pv_num_gte {
    my ($lhs, $rhs, $assbackwards) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;
    return $rhs >= $lhs if $assbackwards;

    my $v;
    eval {
        $v = convert(@$rhs, $lhs->[1]);
    };

    if( $@ ) {
        my $e = $@;
        $e =~ s/'1'/''/;
        $e =~ s/ at .*PhysicalValue.*//s;
        croak $e;
    }

    return $lhs->[0] >= $v;
}
# }}}

# pv_print {{{
sub pv_print {
    my $this = shift;
    my ($v, $u) = @$this;

    if( $u->{unit} == 1 ) {
        $u = "";
    } else {
        $u = " $u";
        if( $v != 1 ) {
            $u =~ s/\b$_->[0]\b/$_->[1]/sg for @AUTO_PLURALS;
        }
    }

    return $v . $u if $PrintPrecision < 0;

    # temprary fix until I hear back from the Number::Format guy

    # $v->bstr; returns a string number
    # $v->bsstr; returns a string in scinoti
    # we can maybe use sstr later?

    $v = $v->bstr;

    my $f = join('', $fmt->format_number( $v, $PrintPrecision ), $u);
    if( $f =~ m/^\S*e/ ) {
        $f = $v . $u;
        $f =~ s/e\+(\d+)/e$1/g;
        $f =~ s/^([\.\-\d]+)(?=e)/$fmt->format_number( $1, $PrintPrecision )/e if $PrintPrecision >= 0;
    }
    return $f;

    # original numbers

=cut
    return "$v $u" if $PrintPrecision < 0;
    return join(" ", $fmt->format_number( $v, $PrintPrecision ), $u);
=cut

}
# }}}
# pv_bool {{{
sub pv_bool {
    my $this = shift;
    my ($v, $u) = @$this;

    return $v;
}
# }}}
# pv_ncmp {{{
sub pv_ncmp {
    my ($lhs, $rhs, $assbackwards) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;
    return $rhs <=> $lhs if $assbackwards;

    return -1 if $lhs < $rhs;
    return  1 if $lhs > $rhs;
    return 0;
}
# }}}
# pv_scmp {{{
sub pv_scmp {
    my ($lhs, $rhs, $assbackwards) = @_;

    $rhs = ref($lhs)->new($rhs) unless ref $rhs eq ref $lhs;
    return $rhs cmp $lhs if $assbackwards;

    return -1 if "$lhs" lt "$rhs";
    return  1 if "$lhs" gt "$rhs";
    return 0;
}
# }}}
# sci {{{
sub sci {
    my $this   = shift;
    my $digits = shift;
    my ($v, $u) = @$this;
    my $e = 0;
       $e = int( log($v) / log(10) ) unless $v == 0;

    if( $u->{unit} == 1 ) {
        $u = "";
    } else {
        $u = " $u";
    }

    croak "please use 0 or more sigfigs..." if $digits < 0;

    # $v->bstr; returns a string number
    # $v->bsstr; returns a string in scinoti
    # we can maybe use sstr later?

    $v /= (10 ** $e);
    $v  = $v->bstr;

    $v = $fmt->format_number($v, $digits-1) . "e$e";

    return $v . $u;
}
# }}}