view release on metacpan or  search on metacpan

PhysicalValue.pm  view on Meta::CPAN

    $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";

        # XXX: evil hack
        # Attempt to impose alphabetical ordering 
        # on kg*m/s vs m*kg/s
        # (this will only catch simple cases)
        my @to_fix;
        while($u =~ m/\b(\w+\*\w+)\b/g) {
            my $orig = $1;
            my @s = split m/\*/, $orig;
            my $fixed = join('*', sort @s);
            push @to_fix, [quotemeta($orig) => $fixed] if $orig ne $fixed;
        }

        $u =~ s/$_->[0]/$_->[1]/ for @to_fix;

        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 {