File Coverage

blib/lib/Number/Spice.pm

Criterion	Covered	Total	%
statement	38	40	95.0
branch	7	12	58.3
condition	2	2	100.0
subroutine	11	12	91.6
pod	7	7	100.0
total	65	73	89.0

package Number::Spice;
# $Id: Spice.pm,v 1.7 2000/09/22 15:32:04 verhaege Exp $
use strict;
use vars qw($RE_NUMBER $RE_SPICE_SUFFIX $RE_SPICE_NUMBER @RE_SUFFIX_VAL
	    $VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use Exporter;
use base qw(Exporter);
$VERSION = '0.011';
@EXPORT = ();
@EXPORT_OK = qw(
  $RE_NUMBER $RE_SPICE_SUFFIX $RE_SPICE_NUMBER
  pattern is_spice_number split_spice_number suffix_value
  spice_to_number number_to_spice normalize_spice_number
);
%EXPORT_TAGS = (
  convert => [qw(spice_to_number number_to_spice normalize_spice_number)],
  re      => [qw($RE_NUMBER $RE_SPICE_SUFFIX $RE_SPICE_NUMBER)],
  all     => \@EXPORT_OK,
);

BEGIN {
    # regular expression matching a plain number
    $RE_NUMBER = qr/
	(?
	[+-]?                           # optional sign
        (?:(?:\d+(?:\.\d*)?)|(?:\.\d+)) # mantissa
        (?:e[+-]?\d+)?                  # optional exponent
	/ix;

    # regular expression matching a spice suffix (special care is taken not to match an exponent)
    $RE_SPICE_SUFFIX = qr/
	(?:[a-df-z][a-z]*) # any word not starting with E
	|(?:e[a-z]+)       # OR an E followed by other characters
	/ix;

    # regular expression matching a spice number
    $RE_SPICE_NUMBER = qr/${RE_NUMBER}${RE_SPICE_SUFFIX}?\b/;

    # list of known spice suffices (as regular expressions) with their numerical value
    @RE_SUFFIX_VAL = (
      [qr/^t/i,            1e12], # tera
      [qr/^g/i,             1e9], # giga
      [qr/^(?:x|(?:meg))/i, 1e6], # mega
      [qr/^k/i,             1e3], # kilo
      [qr/^m(?!il)/i,      1e-3], # milli
      [qr/^u/i,            1e-6], # micro
      [qr/^n/i,            1e-9], # nano
      [qr/^p/i,           1e-12], # pico
      [qr/^f/i,           1e-15], # femto
      [qr/^a/i,           1e-18], # atto
      [qr/^mil/i,       2.54e-5], # mil (1/1000 inch)
    );
}

sub pattern {
    return $RE_SPICE_NUMBER;
}

sub is_spice_number {
    return $_[0] =~ /^\s*${RE_SPICE_NUMBER}\s*$/; # delimiting whitespace is allowed
}

sub split_spice_number {
    my $str = shift;
    if($str =~ /^\s*($RE_NUMBER)($RE_SPICE_SUFFIX?)\s*$/) { # the suffix is optional
        return ($1,$2 || '');
    }
    else { # not a spice number
	return wantarray ? () : undef;
    }
}

sub suffix_value {
    my $suffix = shift;

    # try all known suffices
    foreach(@RE_SUFFIX_VAL) {
	return $_->[1] if $suffix =~ $_->[0];
    }

    # Not a recognized suffix.
    # It is standard spice policy to discard the suffix in this case,
    # which corresponds to a multiplication with 1.0.
    return 1;
}

sub spice_to_number {
    my $spice_number = shift;
    defined($spice_number) or
	die "No argument given to spice_to_number()";

    my ($number,$suffix) = split_spice_number($spice_number) or
	die "Not a spice number: `$spice_number'";

    return $number * suffix_value($suffix);
}

sub number_to_spice {
    my $number = shift;
    my $abs_number = abs($number);
    my $suffix = '';

    # find the appropriate suffix
    foreach(
      [1e12,  't'],
      [1e9,   'g'],
      [1e6,   'meg'],
      [1e3,   'k'],
      [1e0,    ''], # if not introduced, 3.14 would be converted to '3140m' !!
      [1e-3,  'm'],
      [1e-6,  'u'],
      [1e-9,  'n'],
      [1e-12, 'p'],
      [1e-15, 'f'],
      [1e-18, 'a'],
    ) {
	if($abs_number >= $_->[0]) {
	    $number /= $_->[0];
	    $suffix = $_->[1];
	    last;
	}
    }
    # in case $abs_number < 1E-18, the suffix remains ''

    # format the adjusted number and suffix into a string
    return sprintf("%g$suffix",$number);
}

sub normalize_spice_number {
    return number_to_spice(spice_to_number($_[0]));
}

1;

__END__