added a buttecho server for tef. OH GOD WHY
This commit is contained in:
parent
09845662d5
commit
24ecdb163d
49
Butts.pm
49
Butts.pm
|
@ -1,3 +1,32 @@
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Butts - replace random syllables with the arbitrary memes.
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
# with all defaults
|
||||||
|
my $butter = Butts->new;
|
||||||
|
$butter->buttify_string("hello there");
|
||||||
|
|
||||||
|
# with all known options
|
||||||
|
my $butter = Butts->new(
|
||||||
|
meme => 'butt',
|
||||||
|
replace_freq => (1/11),
|
||||||
|
debug => 0,
|
||||||
|
hyphen_file => 'hyphens.tex',
|
||||||
|
stopwords_file => 'stopwords',
|
||||||
|
);
|
||||||
|
|
||||||
|
$butter->buttify(@tokens);
|
||||||
|
$butter->buttify_string($string);
|
||||||
|
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
Yes.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
package Butts;
|
package Butts;
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
|
@ -19,6 +48,10 @@ use fields qw/replace_freq
|
||||||
_words
|
_words
|
||||||
_word_indices/;
|
_word_indices/;
|
||||||
|
|
||||||
|
=head1 METHODS
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my Butts $self = shift;
|
my Butts $self = shift;
|
||||||
unless (ref $self) {
|
unless (ref $self) {
|
||||||
|
@ -55,6 +88,14 @@ sub new {
|
||||||
return $self;
|
return $self;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
=head2 meme($value)
|
||||||
|
|
||||||
|
Method which sets / returns the current replacement meme. If called without
|
||||||
|
additional arguments, it returns the current meme. Calling it with a scalar
|
||||||
|
replaces the old meme with a new one.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
# accessors
|
# accessors
|
||||||
sub meme {
|
sub meme {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
@ -64,6 +105,14 @@ sub meme {
|
||||||
return $self->{meme}
|
return $self->{meme}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
=head2 replace_freq($value)
|
||||||
|
|
||||||
|
Getter/Setter Method for the replacement frequency. Value should be passed as a
|
||||||
|
fractional value, which corresponds to the number of words considered for meme
|
||||||
|
replacement via the following calculation:
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
sub replace_freq {
|
sub replace_freq {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
if (@_) {
|
if (@_) {
|
||||||
|
|
|
@ -0,0 +1,28 @@
|
||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings;
|
||||||
|
|
||||||
|
use POE;
|
||||||
|
use POE::Component::Server::TCP;
|
||||||
|
|
||||||
|
use Butts;
|
||||||
|
|
||||||
|
# Start a TCP server. Client input will be logged to the console and
|
||||||
|
# echoed back to the client, one line at a time.
|
||||||
|
my $butter = Butts->new();
|
||||||
|
|
||||||
|
POE::Component::Server::TCP->new
|
||||||
|
(
|
||||||
|
Alias => "echo_server",
|
||||||
|
Port => $ARGV[0] // 1095,
|
||||||
|
ClientInput => sub {
|
||||||
|
my ($session, $heap, $input) = @_[SESSION, HEAP, ARG0];
|
||||||
|
#print "Session ", $session->ID(), " got input: $input\n";
|
||||||
|
$heap->{client}->put($butter->buttify_string($input));
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
# Start the server.
|
||||||
|
$poe_kernel->run();
|
||||||
|
exit 0;
|
Loading…
Reference in New Issue