File Coverage

blib/lib/Acme/MyPeek.pm
Criterion Covered Total %
statement 39 39 100.0
branch 8 10 80.0
condition n/a
subroutine 10 10 100.0
pod 0 5 0.0
total 57 64 89.0


line stmt bran cond sub pod time code
1             package Acme::MyPeek;
2             $Acme::MyPeek::VERSION = '0.06';
3 1     1   810 use strict;
  1         2  
  1         50  
4 1     1   7 use warnings;
  1         2  
  1         43  
5              
6 1     1   19 use B qw(svref_2object class);
  1         2  
  1         509  
7              
8             require Exporter;
9              
10             our @ISA = qw(Exporter);
11             our @EXPORT = qw(hi hd dt lv);
12             our @EXPORT_OK = qw();
13              
14             my $last_val;
15              
16 126     126 0 6145 sub hi { highval( sub{ $_[0] eq sprintf('%u', $_[0]) }); }
  1     1   5584  
17 111     111 0 448 sub hd { highval( sub{ sprintf('%.f', $_[0]) ne sprintf('%.f', $_[0] - 1) }); }
  1     1   231  
18 3     3 0 1867 sub dt { class(svref_2object(\$_[0])); }
19 2     2 0 20 sub lv { $last_val; }
20              
21             sub highval {
22 2     2 0 8 my ($ok) = @_;
23              
24 2         4 my $x = 1;
25 2         4 my $f = 1;
26              
27 2         9 for (1..100) {
28 36         45 my $y = $x * 10;
29              
30 36 100       53 unless ($ok->($y)) {
31 2         5 $f = 0;
32 2         5 last;
33             }
34              
35 34         56 $x = $y;
36             }
37              
38 2         5 $last_val = $x;
39              
40 2 50       10 return -1 if $f;
41              
42 2         4 my $r = $x;
43              
44 2         6 for (1..1000) {
45 201         249 my $y = $x + $r;
46              
47 201 100       291 unless ($ok->($y)) {
48 36 100       74 if ($r <= 1) {
49 2         4 $r = 0;
50 2         6 last;
51             }
52              
53 34         41 $r /= 10;
54 34         64 next;
55             }
56              
57 165         274 $x += $r;
58             }
59              
60 2         5 $last_val = $x;
61              
62 2 50       9 return -2 if $r;
63              
64 2         11 return $x
65             }
66              
67             1;
68              
69             __END__