local-lib5/lib/perl5/Number/Compare.pm

   1 # $Id: Compare.pm 846 2002-10-25 15:46:01Z richardc $
   2 package Number::Compare;
   3 use strict;
   4 use Carp qw(croak);
   5 use vars qw/$VERSION/;
   6 $VERSION = '0.01';
   7
   8 sub new  {
   9     my $referent = shift;
  10     my $class = ref $referent || $referent;
  11     my $expr = $class->parse_to_perl( shift );
  12
  13     bless eval "sub { \$_[0] $expr }", $class;
  14 }
  15
  16 sub parse_to_perl {
  17     shift;
  18     my $test = shift;
  19
  20     $test =~ m{^
  21                ([<>]=?)?   # comparison
  22                (.*?)       # value
  23                ([kmg]i?)?  # magnitude
  24               $}ix
  25        or croak "don't understand '$test' as a test";
  26
  27     my $comparison = $1 || '==';
  28     my $target     = $2;
  29     my $magnitude  = $3;
  30     $target *=           1000 if lc $magnitude eq 'k';
  31     $target *=           1024 if lc $magnitude eq 'ki';
  32     $target *=        1000000 if lc $magnitude eq 'm';
  33     $target *=      1024*1024 if lc $magnitude eq 'mi';
  34     $target *=     1000000000 if lc $magnitude eq 'g';
  35     $target *= 1024*1024*1024 if lc $magnitude eq 'gi';
  36
  37     return "$comparison $target";
  38 }
  39
  40 sub test { $_[0]->( $_[1] ) }
  41
  42 1;
  43
  44 __END__
  45
  46 =head1 NAME
  47
  48 Number::Compare - numeric comparisons
  49
  50 =head1 SYNOPSIS
  51
  52  Number::Compare->new(">1Ki")->test(1025); # is 1025 > 1024
  53
  54  my $c = Number::Compare->new(">1M");
  55  $c->(1_200_000);                          # slightly terser invocation
  56
  57 =head1 DESCRIPTION
  58
  59 Number::Compare compiles a simple comparison to an anonymous
  60 subroutine, which you can call with a value to be tested again.
  61
  62 Now this would be very pointless, if Number::Compare didn't understand
  63 magnitudes.
  64
  65 The target value may use magnitudes of kilobytes (C<k>, C<ki>),
  66 megabytes (C<m>, C<mi>), or gigabytes (C<g>, C<gi>).  Those suffixed
  67 with an C<i> use the appropriate 2**n version in accordance with the
  68 IEC standard: http://physics.nist.gov/cuu/Units/binary.html
  69
  70 =head1 METHODS
  71
  72 =head2 ->new( $test )
  73
  74 Returns a new object that compares the specified test.
  75
  76 =head2 ->test( $value )
  77
  78 A longhanded version of $compare->( $value ).  Predates blessed
  79 subroutine reference implementation.
  80
  81 =head2 ->parse_to_perl( $test )
  82
  83 Returns a perl code fragment equivalent to the test.
  84
  85 =head1 AUTHOR
  86
  87 Richard Clamp <richardc@unixbeard.net>
  88
  89 =head1 COPYRIGHT
  90
  91 Copyright (C) 2002 Richard Clamp.  All Rights Reserved.
  92
  93 This module is free software; you can redistribute it and/or modify it
  94 under the same terms as Perl itself.
  95
  96 =head1 SEE ALSO
  97
  98 http://physics.nist.gov/cuu/Units/binary.html
  99
 100 =cut