line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Number::Compare; |
2
|
1
|
|
|
1
|
|
25601
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
42
|
|
3
|
1
|
|
|
1
|
|
6
|
use Carp qw(croak); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
87
|
|
4
|
1
|
|
|
1
|
|
6
|
use vars qw/$VERSION/; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
451
|
|
5
|
|
|
|
|
|
|
$VERSION = '0.03'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub new { |
8
|
12
|
|
|
12
|
1
|
27
|
my $referent = shift; |
9
|
12
|
|
33
|
|
|
48
|
my $class = ref $referent || $referent; |
10
|
12
|
|
|
|
|
27
|
my $expr = $class->parse_to_perl( shift ); |
11
|
|
|
|
|
|
|
|
12
|
12
|
|
|
|
|
758
|
bless eval "sub { \$_[0] $expr }", $class; |
13
|
|
|
|
|
|
|
} |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub parse_to_perl { |
16
|
13
|
|
|
13
|
1
|
12
|
shift; |
17
|
13
|
|
|
|
|
14
|
my $test = shift; |
18
|
|
|
|
|
|
|
|
19
|
13
|
50
|
|
|
|
77
|
$test =~ m{^ |
20
|
|
|
|
|
|
|
([<>]=?)? # comparison |
21
|
|
|
|
|
|
|
(.*?) # value |
22
|
|
|
|
|
|
|
([kmg]i?)? # magnitude |
23
|
|
|
|
|
|
|
$}ix |
24
|
|
|
|
|
|
|
or croak "don't understand '$test' as a test"; |
25
|
|
|
|
|
|
|
|
26
|
13
|
|
100
|
|
|
46
|
my $comparison = $1 || '=='; |
27
|
13
|
|
|
|
|
19
|
my $target = $2; |
28
|
13
|
|
100
|
|
|
39
|
my $magnitude = $3 || ''; |
29
|
13
|
100
|
|
|
|
29
|
$target *= 1000 if lc $magnitude eq 'k'; |
30
|
13
|
100
|
|
|
|
23
|
$target *= 1024 if lc $magnitude eq 'ki'; |
31
|
13
|
100
|
|
|
|
22
|
$target *= 1000000 if lc $magnitude eq 'm'; |
32
|
13
|
100
|
|
|
|
25
|
$target *= 1024*1024 if lc $magnitude eq 'mi'; |
33
|
13
|
100
|
|
|
|
22
|
$target *= 1000000000 if lc $magnitude eq 'g'; |
34
|
13
|
100
|
|
|
|
24
|
$target *= 1024*1024*1024 if lc $magnitude eq 'gi'; |
35
|
|
|
|
|
|
|
|
36
|
13
|
|
|
|
|
38
|
return "$comparison $target"; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
21
|
|
|
21
|
1
|
587
|
sub test { $_[0]->( $_[1] ) } |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
1; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
__END__ |