File Coverage

blib/lib/Acme/KeyboardMarathon.pm
Criterion Covered Total %
statement 70 74 94.5
branch 3 6 50.0
condition n/a
subroutine 9 9 100.0
pod 0 2 0.0
total 82 91 90.1


line stmt bran cond sub pod time code
1             package Acme::KeyboardMarathon;
2             $Acme::KeyboardMarathon::VERSION = '1.25';
3              
4 4     4   10253 use Carp;
  4         4  
  4         249  
5 4     4   2311 use Data::Dumper;
  4         28544  
  4         198  
6 4     4   3704 use Math::BigInt;
  4         62485  
  4         16  
7              
8 4     4   38406 use integer;
  4         6  
  4         12  
9 4     4   71 use warnings;
  4         4  
  4         98  
10 4     4   12 use strict;
  4         4  
  4         194  
11              
12             sub new {
13 7     7 0 1807 my @args = @_;
14 7         12 my $class = shift @args;
15 7         11 my $self = {};
16 7         11 bless($self,$class);
17              
18             # all measures in 100ths of a cm
19              
20 7         9 my $depress_distance = 25;
21 7         6 my $shift_distance = 200;
22              
23             # horizontal distances
24              
25 7         23 $self->{k} = {};
26              
27 4     4   13 no warnings 'qw';
  4         3  
  4         1747  
28 7         11 map { $self->{k}->{$_} = 550 } ( '\\', '|' );
  14         29  
29 7         9 map { $self->{k}->{$_} = 500 } ( qw/6 ^ ` ~/ );
  28         39  
30 7         8 map { $self->{k}->{$_} = 450 } ( qw/= +/ );
  14         26  
31 7         13 map { $self->{k}->{$_} = 400 } ( qw/] 1 2 3 4 7 8 9 0 5 - _ ! @ # $ % & * ( ) }/ );
  154         191  
32 7         9 map { $self->{k}->{$_} = 350 } ( qw/B b/ );
  14         33  
33 7         8 map { $self->{k}->{$_} = 230 } ( qw/[ {/ );
  14         19  
34 7         19 map { $self->{k}->{$_} = 200 } ( qw/Q q W w G g H h E e R r T t Y y U u I i O o P p Z z X x C c V v N n M m , < > . \/ ? ' "/ );
  308         376  
35 7         14 map { $self->{k}->{$_} = 0 } ( qw/A a S s D d F f J j K k L l ; :/ );
  112         123  
36              
37 7         13 $self->{k}->{"\n"} = 400;
38 7         8 $self->{k}->{"\t"} = 230;
39 7         9 $self->{k}->{' '} = 0;
40              
41             # Add the depress distance
42 7         8 for my $key ( keys %{$self->{k}} ) {
  7         75  
43 679         461 $self->{k}->{$key} += $depress_distance;
44             }
45              
46             # Add shift distance
47 7         31 for my $key ( qw/! @ # $ % ^ & * ( ) _ + < > ? : " { } | ~ '/, 'A' .. 'Z' ) {
48 336         270 $self->{k}->{$key} += $shift_distance;
49             }
50              
51             # override
52 7         12 $self->{k}->{"\a"} = 0; # alarm
53 7         8 $self->{k}->{"\b"} = 0; # backspace
54 7         10 $self->{k}->{"\e"} = 0; # escape
55 7         9 $self->{k}->{"\f"} = 0; # form feed
56 7         51 $self->{k}->{"\r"} = 0; # carriage return
57              
58 7         15 return $self;
59             }
60              
61             # split is 2m27.476s for 9.3megs of text (9754400 chars)
62             sub distance {
63 5     5 0 35 my $k = shift->{k};
64              
65 5         19 my $bint = Math::BigInt->bzero;
66 5         181 my $int = 0;
67              
68 5         12 for my $i (0 .. $#_) {
69 5 50       12 croak "FAR OUT! A REFERENCE: $_[$i]" if ref $_[$i];
70              
71 5         22249 for ( split '', $_[$i] ) {
72 195248 50       212956 unless ( defined $k->{$_} ) {
73 0         0 carp 'WHOAH! I DON\'T KNOW WHAT THIS IS: [' . sprintf('%2.2x',ord($_)) . " : $_] assigning it a 2.5 cm distance\n";
74              
75 0         0 $k->{$_} = 250;
76             }
77              
78 195248         118772 $int += $k->{$_};
79              
80             # Hold the value in a native int until it reaches an unsafe limit.
81             # Then add to the BigInt, this avoids repeated slow calls to badd.
82             #
83             # To play it safe, this value is the max signed 32bit int minus
84             # the max distance a key can be (| - 550), i.e.
85             # 2 ** 31 - 551 = 2_147_483_097
86 195248 50       224357 if ( $int >= 2_147_483_097 ) {
87 0         0 $bint->badd($int);
88              
89 0         0 $int = 0;
90             }
91             }
92             }
93              
94             # Add whatever remaining value we have in the native int.
95 5         29 $bint->badd($int);
96              
97 5         521 $bint->bdiv(100);
98              
99 5         404 return $bint->bstr;
100             }
101              
102             # substr is 2m30.419s
103             #sub distance {
104             # my $self = shift @_;
105             # my $distance = Math::BigInt->bzero();
106             # for my $i (0 .. $#_) {
107             # croak "FAR OUT! A REFERENCE: $_[$i]" if ref $_[$i];
108             # my $length = length($_[$i]) - 1;
109             # for my $s ( 0 .. $length ) {
110             # my $char = substr($_[$i],$s,1);
111             # unless ( defined $self->{k}->{$char} ) {
112             # carp "WHOAH! I DON'T KNOW WHAT THIS IS: [$char] at $s assigning it a 2.5 cm distance\n";
113             # $self->{k}->{$char} = 250;
114             # }
115             # $distance += $self->{k}->{$char};
116             # }
117             # }
118             # $distance /= 100;
119             # return $distance->bstr();
120             #}
121              
122             # Regex is 2m32.690s
123             #sub distance {
124             # my $self = shift @_;
125             # my $distance = Math::BigInt->bzero();
126             # for my $i (0 .. $#_) {
127             # croak "FAR OUT! A REFERENCE: $_[$i]" if ref $_[$i];
128             # while ( $_[$i] =~ /(.)/gs ) {
129             # my $char = $1;
130             # unless ( defined $self->{k}->{$char} ) {
131             # carp "WHOAH! I DON'T KNOW WHAT THIS IS: [$char] assigning it a 2.5 cm distance\n";
132             # $self->{k}->{$char} = 250;
133             # }
134             # $distance += $self->{k}->{$char};
135             # }
136             # }
137             # $distance /= 100;
138             # return $distance->bstr();
139             #}
140              
141              
142             1;
143             __END__