line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::Filter::Froggy; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
19661
|
use warnings; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
29
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
28
|
|
5
|
1
|
|
|
1
|
|
333
|
use Text::Thesaurus::Aiksaurus; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
use Text::Autoformat qw(autoformat); |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Text::Filter::Froggy - the frog goes rabbit rabbit rabbit |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 VERSION |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Version 0.0.0 |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.0.0'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 SYNOPSIS |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
use Text::Filter::Froggy; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $froggy = Text::Filter::Froggy->new(); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
#read standard in and process it |
27
|
|
|
|
|
|
|
my @lines=; |
28
|
|
|
|
|
|
|
print $froggy->process(join('', @lines)); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
This takes a chunk of text and filters it. It will remove all |
31
|
|
|
|
|
|
|
new lines, camas, semicolons, colons, single quotes, and double |
32
|
|
|
|
|
|
|
quotes. Once it does it will search through the words and choose |
33
|
|
|
|
|
|
|
some random words and replace them using a random selection from |
34
|
|
|
|
|
|
|
Aiksaurus. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
In regards to the Aiksaurus part, it ignores 'the', 'them', 'who', |
37
|
|
|
|
|
|
|
'was', 'when', 'that', 'this', 'we', 'want', and 'what'. |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 METHODS |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head2 new |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
This initiates it. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head3 args hash |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head4 hi |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
This is the is the random chance that will replace the |
50
|
|
|
|
|
|
|
text with "hi\n". The default value is 5 and values between |
51
|
|
|
|
|
|
|
0 and 100 are accepted. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head4 minL |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
This is the minimum length for a word to be replaced. The |
56
|
|
|
|
|
|
|
default is 5. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=head4 maxL |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
This is the max length for a word to be replaced. The |
61
|
|
|
|
|
|
|
default is 20. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head4 replaceP |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
This is the percentage that any of the words fitting in the |
66
|
|
|
|
|
|
|
length restriction will be replaced. The default is 50. |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head4 maxR |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
This is the maximum number of words of words that will be replaced. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head4 wrap |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
If this is defined, it should bethe number of columns to wrap the text to. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
#initiates it a a replaceP value of 30 |
77
|
|
|
|
|
|
|
my $froggy=Text::Filter::Froggy->new({replaceP=>30}) |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=cut |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub new{ |
82
|
|
|
|
|
|
|
my %args; |
83
|
|
|
|
|
|
|
if(defined($_[1])){ |
84
|
|
|
|
|
|
|
%args= %{$_[1]}; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
my $self={error=>undef, errorString=>'', hi=>5, minL=>5, |
88
|
|
|
|
|
|
|
maxL=>20, replaceP=>50, maxR=>20}; |
89
|
|
|
|
|
|
|
bless $self; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
if (defined($args{hi})) { |
92
|
|
|
|
|
|
|
$self->{hi}=$args{hi}; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
if (defined($args{minL})) { |
96
|
|
|
|
|
|
|
$self->{minL}=$args{minL}; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
if (defined($args{maxL})) { |
100
|
|
|
|
|
|
|
$self->{maxL}=$args{maxL}; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
if (defined($args{replaceP})) { |
104
|
|
|
|
|
|
|
$self->{replaceP}=$args{replaceP}; |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
if (defined($args{maxR})) { |
108
|
|
|
|
|
|
|
$self->{maxR}=$args{maxR}; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
if (defined($args{wrap})) { |
112
|
|
|
|
|
|
|
$self->{wrap}=$args{wrap}; |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
return $self; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head2 process |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
This processes a chunk of text. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
my $text=$froggy->process($text); |
123
|
|
|
|
|
|
|
if($froggy->{error}){ |
124
|
|
|
|
|
|
|
print "Error!\n"; |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=cut |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub process{ |
130
|
|
|
|
|
|
|
my $self=$_[0]; |
131
|
|
|
|
|
|
|
my $text=$_[1]; |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
if (!defined($text)) { |
134
|
|
|
|
|
|
|
$self->{errorString}='No text specified'; |
135
|
|
|
|
|
|
|
$self->{error}=1; |
136
|
|
|
|
|
|
|
warn('Text-Filter-Froggy process:1: '.$self->{errorString}); |
137
|
|
|
|
|
|
|
return undef; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
$text=lc($text); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
my $random=rand(100); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
if ($random <= $self->{hi}) { |
145
|
|
|
|
|
|
|
return "hi\n"; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
#remove all punctuation |
149
|
|
|
|
|
|
|
$text=~s/\.//g; |
150
|
|
|
|
|
|
|
$text=~s/\,//g; |
151
|
|
|
|
|
|
|
$text=~s/\;//g; |
152
|
|
|
|
|
|
|
$text=~s/\://g; |
153
|
|
|
|
|
|
|
$text=~s/\'//g; |
154
|
|
|
|
|
|
|
$text=~s/\"//g; |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#make sure it is all jumbled |
157
|
|
|
|
|
|
|
$text=~s/\n/ /g; |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
#words to ignore |
160
|
|
|
|
|
|
|
my %ignore; |
161
|
|
|
|
|
|
|
$ignore{'the'}=1; |
162
|
|
|
|
|
|
|
$ignore{'them'}=1; |
163
|
|
|
|
|
|
|
$ignore{'who'}=1; |
164
|
|
|
|
|
|
|
$ignore{'was'}=1; |
165
|
|
|
|
|
|
|
$ignore{'that'}=1; |
166
|
|
|
|
|
|
|
$ignore{'this'}=1; |
167
|
|
|
|
|
|
|
$ignore{'we'}=1; |
168
|
|
|
|
|
|
|
$ignore{'want'}=1; |
169
|
|
|
|
|
|
|
$ignore{'what'}=1; |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
#count the instances of various words |
172
|
|
|
|
|
|
|
my @words=split(/ /, $text); |
173
|
|
|
|
|
|
|
my %count; |
174
|
|
|
|
|
|
|
my $int=0; |
175
|
|
|
|
|
|
|
while (defined($words[$int])) { |
176
|
|
|
|
|
|
|
#make sure it is within the specified word length |
177
|
|
|
|
|
|
|
if ((length($words[$int]) > $self->{minL}) && (length($words[$int]) < $self->{maxR})) { |
178
|
|
|
|
|
|
|
#make sure it is not a ignored word |
179
|
|
|
|
|
|
|
if (!$ignore{$words[$int]}) { |
180
|
|
|
|
|
|
|
#build the word count |
181
|
|
|
|
|
|
|
if ($count{$words[$int]}) { |
182
|
|
|
|
|
|
|
$count{$words[$int]}=1; |
183
|
|
|
|
|
|
|
}else { |
184
|
|
|
|
|
|
|
$count{$words[$int]}++; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
$int++; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
#handles replacing some words with random words from a thesaurus |
193
|
|
|
|
|
|
|
my $replaceInt=0; |
194
|
|
|
|
|
|
|
$int=0; |
195
|
|
|
|
|
|
|
my @countKeys=keys(%count); |
196
|
|
|
|
|
|
|
my $ata=Text::Thesaurus::Aiksaurus->new; |
197
|
|
|
|
|
|
|
my $choosen=0; |
198
|
|
|
|
|
|
|
while (defined($countKeys[$int])) { |
199
|
|
|
|
|
|
|
$random=rand(100); |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# |
202
|
|
|
|
|
|
|
if (($random <= $self->{replaceP}) && ($choosen <= $self->{maxR})) { |
203
|
|
|
|
|
|
|
my %returnH=$ata->search($countKeys[$int]); |
204
|
|
|
|
|
|
|
if (defined($returnH{'%misspelled'})) { |
205
|
|
|
|
|
|
|
my $max=$#{$returnH{'%misspelled'}}; |
206
|
|
|
|
|
|
|
my $replace=$returnH{'%misspelled'}[sprintf("%.0f", rand($max))]; |
207
|
|
|
|
|
|
|
my $regex=quotemeta($countKeys[$int]); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
$text=~s/^$regex /$replace /g; |
210
|
|
|
|
|
|
|
$text=~s/ $regex / $replace /g; |
211
|
|
|
|
|
|
|
$text=~s/ $regex$/ $replace/g; |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
}else { |
214
|
|
|
|
|
|
|
my @returnHkeys=keys(%returnH); |
215
|
|
|
|
|
|
|
my $max=$#returnHkeys; |
216
|
|
|
|
|
|
|
my $word1=$returnHkeys[sprintf("%.0f", rand($max) - 1)]; |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
$max=$#{$returnH{$word1}}; |
219
|
|
|
|
|
|
|
my $replace=$returnH{$word1}[sprintf("%.0f", rand($max) - 1)]; |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
my $regex=quotemeta($countKeys[$int]); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
$text=~s/^$regex /$replace /g; |
224
|
|
|
|
|
|
|
$text=~s/ $regex / $replace /g; |
225
|
|
|
|
|
|
|
$text=~s/ $regex$/ $replace/g; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
$choosen++; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
$int++; |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
if (defined($self->{wrap})) { |
234
|
|
|
|
|
|
|
$text = autoformat($text, { left=>0, right=>$self->{wrap} }); |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
return $text; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head2 errorblank |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
This blanks the error storage and is only meant for internal usage. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
It does the following. |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
$self->{error}=undef; |
247
|
|
|
|
|
|
|
$self->{errorString}=""; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=cut |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
#blanks the error flags |
252
|
|
|
|
|
|
|
sub errorblank{ |
253
|
|
|
|
|
|
|
my $self=$_[0]; |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
$self->{error}=undef; |
256
|
|
|
|
|
|
|
$self->{errorString}=""; |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
return 1; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head1 ERROR CODES |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=head2 1 |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head1 AUTHOR |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
Zane C. Bowers, C<< >> |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=head1 BUGS |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through |
272
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
273
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=head1 SUPPORT |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
perldoc Text::Filter::Froggy |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
You can also look for information at: |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
=over 4 |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
L |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
L |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
=item * CPAN Ratings |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
L |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=item * Search CPAN |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
L |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
=back |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=head1 ACKNOWLEDGEMENTS |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
Copyright 2009 Zane C. Bowers, all rights reserved. |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
316
|
|
|
|
|
|
|
under the same terms as Perl itself. |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=cut |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
1; # End of Text::Filter::Froggy |