view release on metacpan or  search on metacpan

bin/units  view on Meta::CPAN

# Usage:
# units [-f unittab]
our $VERSION = '1.02';

BEGIN {
    require Data::Dumper;
	sub dumper { Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)->Deparse(1)->Dump }

	foreach my $letter ( qw( d p o l t ) ) {
	  no strict 'refs';
	  my $env_var = uc( "UNITS_DEBUG_$letter" );
	  my( $debugging ) = grep { defined and length } ( $ENV{$env_var}, $ENV{UNITS_DEBUG}, 0 );
	  *{"debug_$letter"} = ! $debugging ? sub {} : sub {
		my $indent;
		my $m = join '', @_;
		$indent = $1 if $m =~ s/\A(\s*)//;
		print "$indent$letter>>> $m\n";
	  }
	}
}

our %unittab;            # Definitions loaded here

# Metric prefixes.  These must be powers of ten or change the
# token_value subroutine
our %PREF;
our $PREF;
our $PARSE_ERROR;

BEGIN {
  %PREF = (
    yotta => -24,
    zetta => -21,
    atto  => -18,
    femto => -15,
    pico  => -12,
    nano  => - 9,
    micro => - 6,
    milli => - 3,
    centi => - 2,
    deci  => - 1,
    deca  =>   1,
    deka  =>   1,
    hecto =>   2,
    hect  =>   2,
    kilo  =>   3,
    myria =>   4,
    mega  =>   6,
    giga  =>   9,
    tera  =>  12,
    zepto =>  15,
    yocto =>  18,
  );
  $PREF = join '|', sort {$PREF{$a} <=> $PREF{$b}} (keys %PREF);
}

# run if called directly, indirectly, directly par-packed, undirectly par-packed
__PACKAGE__->run(@ARGV) if !caller() || caller(0) =~ /^(PerlPowerTools::Packed|PAR)$/ || caller(1) eq 'PAR'; # modulino

sub run {
  my( $class, @args ) = @_; local @ARGV;

  my $args = $class->process_args( @args );

  $class->read_unittab( $args->{unittabs}[0] );

  if (@{ $args->{args} }) {
    my ($have, $want) = @{ $args->{args} };
    my $have_hr = $class->unit_have($have);
    my $want_hr = $class->unit_want($want);
    my %r = $class->unit_convert($have_hr, $want_hr);
    print_result(%r);
  } else {
    while (1) {
      print "You have: ";
      my $have = <>;
      exit 0 unless defined($have) && $have =~ /\S/;
      my $have_hr = $class->unit_have($have);
      next if is_Zero($have_hr->{hu});

      print "You want: ";
      my $want = <>;
      exit 0 unless defined($want) && $want =~ /\S/;
      my $want_hr = $class->unit_want($want);
      next if is_Zero($want_hr->{wu});

      my %r = $class->unit_convert($have_hr, $want_hr);
      print_result(%r);
    }
  }

  exit 0;
}

sub test {
    my ($class, $have, $want) = @_;

    $class->read_unittab();
    my $have_hr = $class->unit_have($have);
    my $want_hr = $class->unit_want($want);
    my %r = $class->unit_convert($have_hr, $want_hr);
    return %r;
}

sub default_unittabs {
  grep { -e } qw(/usr/lib/unittab);
}

sub env_unittabs {
  no warnings 'uninitialized';
  split /$Config{path_sep}/, $ENV{UNITTAB};
}

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

    my @unittabs;
    while (@args and $args[0] =~ /^-/) {
      my $flag = shift @args;
      if ($flag =~ s/\A\-f//) {
        my $file = $flag;