File Coverage

blib/lib/Text/Typoifier.pm
Criterion Covered Total %
statement 9 81 11.1
branch 0 22 0.0
condition 0 3 0.0
subroutine 3 13 23.0
pod 2 9 22.2
total 14 128 10.9


line stmt bran cond sub pod time code
1             package Text::Typoifier;
2              
3             require 5.005_62;
4 1     1   1027 use strict;
  1         3  
  1         40  
5 1     1   4 use warnings;
  1         2  
  1         34  
6 1     1   921 use POSIX;
  1         8304  
  1         8  
7             our $VERSION = '0.04a';
8              
9              
10             sub new
11             {
12 0     0 0   my $self = {};
13 0           bless $self;
14 0           $self->errorRate(5); # default error rate
15 0           return $self;
16             }
17              
18             sub errorRate
19             {
20             # rate of errors, between 1 and 10
21 0     0 1   my $self = shift;
22 0           my $errorRate = shift;
23 0 0         if (defined($errorRate))
24             {
25 0           $self->{errorRate} = $errorRate;
26             }
27 0           return $self->{errorRate};
28             }
29              
30             sub transform
31             {
32 0     0 1   my $self = shift;
33 0           my $text = shift;
34 0           my $done = 0;
35 0 0         if (rand(10) < $self->errorRate())
36             {
37 0           for (my $x = 0; $x <= 100; $x++)
38             {
39 0           my $text2 = $self->_transform($text);
40 0 0         if ($text2 ne $text)
41             {
42 0           return $text2;
43             }
44             }
45             }
46 0           return $text;
47             }
48              
49              
50             sub _transform
51             {
52 0     0     my $self = shift;
53 0           my $text = shift;
54 0           my $rand = POSIX::ceil(rand(4));
55 0 0         return $self->transpose2($text) if ($rand == 1);
56 0 0         return $self->stickyshift($text) if ($rand == 2);
57 0 0         return $self->double($text) if ($rand == 3);
58 0 0         return $self->deletion($text) if ($rand == 4);
59             }
60              
61             sub arrayToString
62             {
63 0     0 0   my $self = shift;
64 0           my $ref2array = shift;
65 0           my $string = "";
66 0           for (my $x = 0; $x <= $#{$ref2array}; $x++)
  0            
67             {
68 0           $string .= $ref2array->[$x];
69             }
70 0           return $string;
71             }
72            
73             sub transpose
74             {
75             # this transposes any two characters. very unrealistic.
76 0     0 0   my $self = shift;
77 0           my $text = shift;
78 0           my $length = length($text);
79 0           my $randomChar = int(rand($length - 1));
80 0           $text =~ /(.{$randomChar})(.)(.)/;
81 0           return $` . $1 . $3 . $2 . $'
82             }
83              
84             sub double
85             {
86 0     0 0   my $self = shift;
87 0           my $text = shift;
88 0           my @sa = split '', $text;
89 0           my $randomChar = int(rand($#sa));
90 0 0         if ($sa[$randomChar] =~ /[A-Za-z]/)
91             {
92 0           splice(@sa, $randomChar, 0, $sa[$randomChar]);
93 0           return $self->arrayToString(\@sa);
94             }
95 0           return $text;
96             }
97              
98             sub deletion
99             {
100 0     0 0   my $self = shift;
101 0           my $text = shift;
102 0           my @sa = split '', $text;
103 0           my $randomChar = int(rand($#sa));
104 0           splice(@sa, $randomChar, 1);
105 0           return $self->arrayToString(\@sa);
106             }
107              
108             sub stickyshift
109             {
110             # this acts like a sticky shift key ie. TEsting
111 0     0 0   my $self = shift;
112 0           my $text = shift;
113 0           my @sa = split '', $text;
114 0           my $randomChar = int(rand($#sa));
115 0 0         if ($text =~ /[A-Z][a-zA-Z]/)
116             {
117 0           my $done = 0;
118 0           while ($done == 0)
119             {
120 0 0         if ($sa[$randomChar] =~ /[A-Z]/)
121             {
122 0           $sa[$randomChar+1] = uc($sa[$randomChar+1]);
123 0           $done = 1;
124             }
125 0           $randomChar = int(rand($#sa - 1));
126             }
127 0           return $self->arrayToString(\@sa);
128             }
129 0           return $text;
130             }
131              
132              
133             sub transpose2
134             {
135             # this transposes two characters, but only if they are lowercase
136             # and also [a-z]
137 0     0 0   my $self = shift;
138 0           my $text = shift;
139 0           my @sa = split '', $text;
140 0           my $randomChar = int(rand($#sa - 1));
141 0 0 0       if ($sa[$randomChar] =~ /[a-z\ ]/ && $sa[$randomChar] =~ /[a-z\ ]/)
142             {
143 0           ($sa[$randomChar], $sa[$randomChar + 1]) =
144             ($sa[$randomChar + 1], $sa[$randomChar]);
145             }
146 0           return $self->arrayToString(\@sa);
147             }
148              
149             1;
150             =cut
151              
152             =head1 NAME
153              
154             Text::Typoifier - mangles text
155              
156             =head1 SYNOPSIS
157              
158             use Text::Typoifier;
159              
160             $t = new Text::Typoifier;
161             $text = $t->transform($text);
162              
163             =head1 DESCRIPTION
164              
165             Text::Typoifier is used when you have a sample of text that you wish to induce random errors in the text. I use this for a few IRC bots to lend a little extra credibility to the bot. It's not really hard to use.
166              
167             =head1 METHODS
168              
169             =head2 transform
170            
171             Pass in the text to transform, returns the transformed text.
172              
173             =head1 ATTRIBUTES
174              
175             =head2 errorRate
176              
177             Configures the percentage of errors that the module outputs. The value must be an integer between 1 and 10. 10 means that 100% of the time an error will be present in the text. 5 means that 50% of the time an error will be in the text.
178              
179             =head1 REQUIRES
180              
181             Perl 5
182              
183             =head1 EXPORTS
184              
185             Nothing
186              
187             =head1 AUTHOR
188              
189             xjharding@mac.com
190              
191             =cut