Text-Filter-Froggy
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
blib*
Makefile
Makefile.old
Build
_build*
pm_to_blib*
*.tar.gz
.lwpcookies
Text-Filter-Froggy-*
cover_db
Revision history for Text-Filter-Froggy
0.0.0 2009-08-10/11:00
-Initial release.
Changes
MANIFEST
Makefile.PL
README
lib/Text/Filter/Froggy.pm
t/00-load.t
t/pod-coverage.t
t/pod.t
Makefile.PL view on Meta::CPAN
use strict;
use warnings;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'Text::Filter::Froggy',
AUTHOR => 'Zane C. Bowers <vvelox@vvelox.net>',
VERSION_FROM => 'lib/Text/Filter/Froggy.pm',
ABSTRACT_FROM => 'lib/Text/Filter/Froggy.pm',
($ExtUtils::MakeMaker::VERSION >= 6.3002
? ('LICENSE'=> 'perl')
: ()),
PL_FILES => {},
INST_SCRIPT => 'bin',
PREREQ_PM => {
'Test::More' => 0,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Text-Filter-Froggy-*' },
);
Text-Filter-Froggy
The README is used to introduce the module and provide instructions on
how to install the module, any machine dependencies it may have (for
example C compilers and installed libraries) and any other information
that should be provided before the module is installed.
A README file is required for CPAN modules since CPAN extracts the README
file from a module distribution so that people browsing the archive
can use it to get an idea of the module's uses. It is usually a good idea
to provide version information here so that people can decide whether
fixes for the module are worth downloading.
INSTALLATION
To install this module, run the following commands:
perl Makefile.PL
make
make test
make install
SUPPORT AND DOCUMENTATION
After installing, you can find documentation for this module with the
perldoc command.
perldoc Text::Filter::Froggy
You can also look for information at:
RT, CPAN's request tracker
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-Filter-Froggy
AnnoCPAN, Annotated CPAN documentation
http://annocpan.org/dist/Text-Filter-Froggy
CPAN Ratings
http://cpanratings.perl.org/d/Text-Filter-Froggy
Search CPAN
http://search.cpan.org/dist/Text-Filter-Froggy/
COPYRIGHT AND LICENCE
Copyright (C) 2009 Zane C. Bowers
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
bin/catfroggy view on Meta::CPAN
#!/usr/bin/perl
#Copyright (c) 2009, Zane C. Bowers
#All rights reserved.
#
#Redistribution and use in source and binary forms, with or without modification,
#are permitted provided that the following conditions are met:
#
# * Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
# * Redistributions in binary form must reproduce the above copyright notice,
# this list of conditions and the following disclaimer in the documentation
# and/or other materials provided with the distribution.
#
#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
#ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
#WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
#IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
#INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
#BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
#DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
#LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
#OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
#THE POSSIBILITY OF SUCH DAMAGE.
use warnings;
use strict;
use Getopt::Std;
use Text::Filter::Froggy;
$Getopt::Std::STANDARD_HELP_VERSION=1;
#version function
sub main::VERSION_MESSAGE {
print "catfroggy 0.0.0\n";
};
#print help
sub main::HELP_MESSAGE {
print "\n".
"-w <wrap> If this is defined, it is what it will be wrapped to.\n".
"-p <percent> This is the replacement percent.\n".
"-H <hi> This is the hi percent.\n".
"-r <replace> This is the number of them to replace.\n".
"-m <min> This is the min replacement length.\n".
"-M <max> This is the max replacement length.\n".
"\n".
"\n".
"Runs standard input through Text::Filter::Froggy.";
exit 1;
};
#gets the options
my %opts=();
getopts('w:p:H:r:m:M:', \%opts);
my $froggy=Text::Filter::Froggy->new({wrap=>$opts{w}, replaceP=>$opts{p},
hi=>$opts{H}, maxR=>$opts{r}, minL=>$opts{m},
maxL=>$opts{M}});
my @lines=<STDIN>;
#print join('', @lines);
print $froggy->process(join('', @lines));
=head1 NAME
catfroggy - the froggy goes rabbit rabbit rabbit
=head1 SYNOPSIS
catfroggy [B<-w> <wrap>] [B<-p> <replaceP>] [B<-H> <hi>] [B<-r> <maxR>] [B<-m> <minL>] [B<-M> <maxL>]
=head2 USAGE
Cat any text through it and it will process it and dump it to standard out.
For what the various switches do, see the information for Text::Filter::Froggy.
=head1 SWITCHES
=head2 [B<-w> <wrap>]
If this is defined, it is what it will be wrapped to.
=head2 [B<-p> <replaceP>]
This is the replacement percent.
=head2 [B<-H> <hi>]
This is the hi percent.
=head2 [B<-r> <maxR>]
This is the number of them to replace.
=head2 [B<-m> <minL>]
This is the min replacement length.
=head2 [B<-M> <maxL>]
This is the max replacement length.
=head1 AUTHOR
Copyright (c) 2009, Zame C. Bowers <vvelox@vvelox.net>
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS` OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
=head1 OSNAMES
any
=head1 CHANGE LOG
=head1 0.0.0/2009-08-10 11:00
Initial release.
=head1 README
catfroggy - the froggy goes rabbit rabbit rabbit
=cut
lib/Text/Filter/Froggy.pm view on Meta::CPAN
package Text::Filter::Froggy;
use warnings;
use strict;
use Text::Thesaurus::Aiksaurus;
use Text::Autoformat qw(autoformat);
=head1 NAME
Text::Filter::Froggy - the frog goes rabbit rabbit rabbit
=head1 VERSION
Version 0.0.0
=cut
our $VERSION = '0.0.0';
=head1 SYNOPSIS
use Text::Filter::Froggy;
my $froggy = Text::Filter::Froggy->new();
#read standard in and process it
my @lines=<STDIN>;
print $froggy->process(join('', @lines));
This takes a chunk of text and filters it. It will remove all
new lines, camas, semicolons, colons, single quotes, and double
quotes. Once it does it will search through the words and choose
some random words and replace them using a random selection from
Aiksaurus.
In regards to the Aiksaurus part, it ignores 'the', 'them', 'who',
'was', 'when', 'that', 'this', 'we', 'want', and 'what'.
=head1 METHODS
=head2 new
This initiates it.
=head3 args hash
=head4 hi
This is the is the random chance that will replace the
text with "hi\n". The default value is 5 and values between
0 and 100 are accepted.
=head4 minL
This is the minimum length for a word to be replaced. The
default is 5.
=head4 maxL
This is the max length for a word to be replaced. The
default is 20.
=head4 replaceP
This is the percentage that any of the words fitting in the
length restriction will be replaced. The default is 50.
=head4 maxR
This is the maximum number of words of words that will be replaced.
=head4 wrap
If this is defined, it should bethe number of columns to wrap the text to.
#initiates it a a replaceP value of 30
my $froggy=Text::Filter::Froggy->new({replaceP=>30})
=cut
sub new{
my %args;
if(defined($_[1])){
%args= %{$_[1]};
}
my $self={error=>undef, errorString=>'', hi=>5, minL=>5,
maxL=>20, replaceP=>50, maxR=>20};
bless $self;
if (defined($args{hi})) {
$self->{hi}=$args{hi};
}
if (defined($args{minL})) {
$self->{minL}=$args{minL};
}
if (defined($args{maxL})) {
$self->{maxL}=$args{maxL};
}
if (defined($args{replaceP})) {
$self->{replaceP}=$args{replaceP};
}
if (defined($args{maxR})) {
$self->{maxR}=$args{maxR};
}
if (defined($args{wrap})) {
$self->{wrap}=$args{wrap};
}
return $self;
}
=head2 process
This processes a chunk of text.
my $text=$froggy->process($text);
if($froggy->{error}){
print "Error!\n";
}
=cut
sub process{
my $self=$_[0];
my $text=$_[1];
if (!defined($text)) {
$self->{errorString}='No text specified';
$self->{error}=1;
warn('Text-Filter-Froggy process:1: '.$self->{errorString});
return undef;
}
$text=lc($text);
my $random=rand(100);
if ($random <= $self->{hi}) {
return "hi\n";
}
#remove all punctuation
$text=~s/\.//g;
$text=~s/\,//g;
$text=~s/\;//g;
$text=~s/\://g;
$text=~s/\'//g;
$text=~s/\"//g;
#make sure it is all jumbled
$text=~s/\n/ /g;
#words to ignore
my %ignore;
$ignore{'the'}=1;
$ignore{'them'}=1;
$ignore{'who'}=1;
$ignore{'was'}=1;
$ignore{'that'}=1;
$ignore{'this'}=1;
$ignore{'we'}=1;
$ignore{'want'}=1;
$ignore{'what'}=1;
#count the instances of various words
my @words=split(/ /, $text);
my %count;
my $int=0;
while (defined($words[$int])) {
#make sure it is within the specified word length
if ((length($words[$int]) > $self->{minL}) && (length($words[$int]) < $self->{maxR})) {
#make sure it is not a ignored word
if (!$ignore{$words[$int]}) {
#build the word count
if ($count{$words[$int]}) {
$count{$words[$int]}=1;
}else {
$count{$words[$int]}++;
}
}
}
$int++;
}
#handles replacing some words with random words from a thesaurus
my $replaceInt=0;
$int=0;
my @countKeys=keys(%count);
my $ata=Text::Thesaurus::Aiksaurus->new;
my $choosen=0;
while (defined($countKeys[$int])) {
$random=rand(100);
#
if (($random <= $self->{replaceP}) && ($choosen <= $self->{maxR})) {
my %returnH=$ata->search($countKeys[$int]);
if (defined($returnH{'%misspelled'})) {
my $max=$#{$returnH{'%misspelled'}};
my $replace=$returnH{'%misspelled'}[sprintf("%.0f", rand($max))];
my $regex=quotemeta($countKeys[$int]);
$text=~s/^$regex /$replace /g;
$text=~s/ $regex / $replace /g;
$text=~s/ $regex$/ $replace/g;
}else {
my @returnHkeys=keys(%returnH);
my $max=$#returnHkeys;
my $word1=$returnHkeys[sprintf("%.0f", rand($max) - 1)];
$max=$#{$returnH{$word1}};
my $replace=$returnH{$word1}[sprintf("%.0f", rand($max) - 1)];
my $regex=quotemeta($countKeys[$int]);
$text=~s/^$regex /$replace /g;
$text=~s/ $regex / $replace /g;
$text=~s/ $regex$/ $replace/g;
}
}
$choosen++;
$int++;
}
if (defined($self->{wrap})) {
$text = autoformat($text, { left=>0, right=>$self->{wrap} });
}
return $text;
}
=head2 errorblank
This blanks the error storage and is only meant for internal usage.
It does the following.
$self->{error}=undef;
$self->{errorString}="";
=cut
#blanks the error flags
sub errorblank{
my $self=$_[0];
$self->{error}=undef;
$self->{errorString}="";
return 1;
}
=head1 ERROR CODES
=head2 1
=head1 AUTHOR
Zane C. Bowers, C<< <vvelox at vvelox.net> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-text-filter-froggy at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Text-Filter-Froggy>. I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Text::Filter::Froggy
You can also look for information at:
=over 4
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-Filter-Froggy>
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Text-Filter-Froggy>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Text-Filter-Froggy>
=item * Search CPAN
L<http://search.cpan.org/dist/Text-Filter-Froggy/>
=back
=head1 ACKNOWLEDGEMENTS
=head1 COPYRIGHT & LICENSE
Copyright 2009 Zane C. Bowers, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
1; # End of Text::Filter::Froggy
t/00-load.t view on Meta::CPAN
#!perl -T
use Test::More tests => 1;
BEGIN {
use_ok( 'Text::Filter::Froggy' );
}
diag( "Testing Text::Filter::Froggy $Text::Filter::Froggy::VERSION, Perl $], $^X" );
t/boilerplate.t view on Meta::CPAN
#!perl -T
use strict;
use warnings;
use Test::More tests => 3;
sub not_in_file_ok {
my ($filename, %regex) = @_;
open( my $fh, '<', $filename )
or die "couldn't open $filename for reading: $!";
my %violated;
while (my $line = <$fh>) {
while (my ($desc, $regex) = each %regex) {
if ($line =~ $regex) {
push @{$violated{$desc}||=[]}, $.;
}
}
}
if (%violated) {
fail("$filename contains boilerplate text");
diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
} else {
pass("$filename contains no boilerplate text");
}
}
sub module_boilerplate_ok {
my ($module) = @_;
not_in_file_ok($module =>
'the great new $MODULENAME' => qr/ - The great new /,
'boilerplate description' => qr/Quick summary of what the module/,
'stub function definition' => qr/function[12]/,
);
}
TODO: {
local $TODO = "Need to replace the boilerplate text";
not_in_file_ok(README =>
"The README is used..." => qr/The README is used/,
"'version information here'" => qr/to provide version information/,
);
not_in_file_ok(Changes =>
"placeholder date/time" => qr(Date/time)
);
module_boilerplate_ok('lib/Text/Filter/Froggy.pm');
}
t/pod-coverage.t view on Meta::CPAN
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod::Coverage
my $min_tpc = 1.08;
eval "use Test::Pod::Coverage $min_tpc";
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
if $@;
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
# but older versions don't recognize some common documentation styles
my $min_pc = 0.18;
eval "use Pod::Coverage $min_pc";
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
if $@;
all_pod_coverage_ok();
#!perl -T
use strict;
use warnings;
use Test::More;
# Ensure a recent version of Test::Pod
my $min_tp = 1.22;
eval "use Test::Pod $min_tp";
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
all_pod_files_ok();
view release on metacpan - search on metacpan
( run in 1.350 second using v1.00-cache-2.02-grep-82fe00e-cpan-58dc6251afda )