first commit, downward spiral starts here
This commit is contained in:
thomas.figg
commit
fe73cbc021
|
|
@ -0,0 +1,8 @@
|
|||
server = irc.example.org
|
||||
port = 6667
|
||||
nick = buttbot
|
||||
ident = null
|
||||
gecos = heh
|
||||
channel = #channel
|
||||
debug = yes
|
||||
pass = SOMESECRET
|
||||
|
|
@ -0,0 +1,149 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use IO::Socket;
|
||||
require 'butts.pl';
|
||||
|
||||
|
||||
## globals
|
||||
use vars qw<$sock %CONF %results $hyp>;
|
||||
$|=1;
|
||||
|
||||
$CONF{file} = shift;
|
||||
if (not $CONF{file}) {
|
||||
$CONF{file}=$0;
|
||||
$CONF{file}=~s/\.pl$/\.conf/i;
|
||||
}
|
||||
|
||||
&readconf();
|
||||
|
||||
$sock=&connect($CONF{server},$CONF{port});
|
||||
&error("socket: $! $@") if ($sock eq "");
|
||||
|
||||
&send("NICK $CONF{nick}");
|
||||
&send("USER $CONF{ident} 0 * :$CONF{gecos}");
|
||||
|
||||
&forks() if (not $CONF{debug});;
|
||||
|
||||
my ($auth, @buffer) ;
|
||||
$auth ="";
|
||||
@buffer=();
|
||||
my ($from,$command,@data);
|
||||
|
||||
|
||||
while (1) {
|
||||
|
||||
&error("main: $! $@") if (($! ne "" ) || ($@ ne ""));
|
||||
|
||||
@buffer=split(/\n/,&gets());
|
||||
|
||||
foreach my $thing (@buffer) {
|
||||
|
||||
($from,$command,@data)=split(/\s+/,$thing);
|
||||
|
||||
if ($from eq "PING") {
|
||||
if ($command=~/^:\d+$/) {
|
||||
&send("PONG $command");
|
||||
} else {
|
||||
&send("PONG :$CONF{nick}");
|
||||
}
|
||||
}
|
||||
|
||||
&error("from server: @data") if ($from eq "ERROR");
|
||||
|
||||
if ($command eq "001") {
|
||||
&send("JOIN $CONF{channel}") if (defined $CONF{channel});
|
||||
} elsif ($command eq "PRIVMSG") {
|
||||
my $to=shift(@data);
|
||||
my $sub=shift(@data);
|
||||
$sub=~s/^://;
|
||||
|
||||
if ($sub eq $CONF{pass}) {
|
||||
$auth=$from;
|
||||
}
|
||||
|
||||
if ($auth eq $from) {
|
||||
&send(@data) if ($sub eq "quote");
|
||||
}
|
||||
if ($to =~ /^#/) {
|
||||
if (($from !~/^:cout/) && ($from !~/^:[^!]*bot[^!]*!/i)) {
|
||||
if ($sub !~ /^!/) {
|
||||
my $rnd = 1;
|
||||
if (@data > 2) {
|
||||
if ($from =~ /floWenoL/ ) {
|
||||
$rnd = int(rand(23));
|
||||
} else {
|
||||
$rnd = int(rand(37));
|
||||
}
|
||||
}
|
||||
if ($rnd ==0) {
|
||||
unshift (@data,$sub);
|
||||
sleep(@data*0.2+1);
|
||||
&send("PRIVMSG $to :".join(" ",&buttify(@data)));
|
||||
}
|
||||
} elsif ($sub eq "!butt" and @data >0 ) {
|
||||
if (($data[0] !~ /^!/) && ($data[0] !~ /^cout/)) {
|
||||
&send("PRIVMSG $to :".join(" ",&buttify(@data)));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub connect {
|
||||
my ($remote_host,$remote_port,$local_host)=(shift,shift,shift);
|
||||
my $socket=IO::Socket::INET->new( PeerAddr => $remote_host,
|
||||
PeerPort => $remote_port,
|
||||
proto => "tcp",
|
||||
Type => SOCK_STREAM,
|
||||
Timeout => 10
|
||||
);
|
||||
return $socket;
|
||||
}
|
||||
|
||||
sub gets {
|
||||
my $data = "";
|
||||
$sock->recv($data,1024) ;
|
||||
#or &error("get: $! $@");
|
||||
return $data;
|
||||
}
|
||||
sub send {
|
||||
my ($text) = join(" ",@_);
|
||||
$text.="\n";
|
||||
$sock->send($text);
|
||||
}
|
||||
|
||||
sub forks {
|
||||
my $spoon=fork();
|
||||
if (defined $spoon) {
|
||||
if ($spoon==0) {
|
||||
return;
|
||||
} else {
|
||||
print "exiting, child pid=$spoon\n";
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
&error("fork: $! $@");
|
||||
}
|
||||
}
|
||||
|
||||
sub error {
|
||||
print "\nerror: @_\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
sub readconf {
|
||||
our %CONF;
|
||||
my ($conffile)=@_;
|
||||
open(CONF,"$CONF{file}") or &error("readconf: cannot open $CONF{file}");
|
||||
while (my $line=<CONF>) {
|
||||
if (substr($line,0,1) ne "#") {
|
||||
if ($line =~/^\s*([^\s]+)\s*=\s*(.+)$/) {
|
||||
$CONF{lc($1)}=$2;
|
||||
}
|
||||
}
|
||||
}
|
||||
close(CONF);
|
||||
}
|
||||
|
||||
|
|
@ -0,0 +1,137 @@
|
|||
#!/usr/bin/perl
|
||||
use TeX::Hyphen;
|
||||
use List::Util 'max';
|
||||
|
||||
|
||||
our $hyp;
|
||||
if ( -e "hyphen.tex") {
|
||||
$hyp = new TeX::Hyphen file=>"hyphen.tex";
|
||||
} else {
|
||||
$hyp = new TeX::Hyphen ;
|
||||
}
|
||||
sub buttify {
|
||||
my (@words) = (@_);
|
||||
my $rep = int(@words/11)+1;
|
||||
my $c =0;
|
||||
|
||||
# sort indicies by word length
|
||||
my @longest= map { $_->[0] }
|
||||
sort { $b->[1] <=> $a->[1] }
|
||||
map { [$c++ , length($_) ] } @words;
|
||||
$c=0;
|
||||
|
||||
# remove stop words
|
||||
@longest = grep {$words[$_] !~/^(a|an|and|or|but|it|in|its|It's|it's|the|of|you|I|i)$/} @longest;
|
||||
# print "Words in order: ".join(",",map {$words[$_]} @longest)."\n";
|
||||
|
||||
# create weighed index array of words by length
|
||||
my @index= map {$longest[$_]} weighed_index_array(scalar @longest);
|
||||
#print "Weighed words in order: ".join(",",map {$words[$_]} @index)."\n";
|
||||
|
||||
shuffle(\@index) if (scalar @index);
|
||||
while ($c < $rep) {
|
||||
$words[$index[$c]]=&buttsub($words[$index[$c]]);
|
||||
$c++;
|
||||
}
|
||||
|
||||
return @words;
|
||||
}
|
||||
|
||||
sub buttifynew {
|
||||
my (@words) = (@_);
|
||||
my $rep = int(@words/11)+1;
|
||||
my $c =0;
|
||||
|
||||
# create list of weights and sort them.
|
||||
|
||||
my $factor = max(map {length($_)} @words);
|
||||
|
||||
# print "Factor : $factor \n";
|
||||
# sort indicies by word length
|
||||
|
||||
my @pairs = map { [$c++,length($_)] } @words;
|
||||
|
||||
#print "Pairs: ".join(",",map{$_->[0]." ".$_->[1]}@pairs)."\n";
|
||||
|
||||
@pairs = grep {$words[$_->[0]] !~/^(a|an|and|or|but|it|in|the|of|you|I|i)$/} @pairs;
|
||||
|
||||
#print "Stripped Pairs: ".join(",",map{$_->[0]." ".$_->[1]}@pairs)."\n";
|
||||
|
||||
#@pairs = map { [$_->[0], rand($factor**$_->[1])**(1.0/$_->[1])]} @pairs;
|
||||
@pairs = map { [$_->[0], rand($_->[1]**$factor)**(1.0/$factor)]} @pairs;
|
||||
#@pairs = map { [$_->[0], log(rand(exp($_->[1]))+1)]} @pairs;
|
||||
|
||||
#print "Weighed Pairs: ".join(",",map{$_->[0]." ".$_->[1]}@pairs)."\n";
|
||||
|
||||
@pairs = sort { $b->[1] <=> $a->[1]} @pairs;
|
||||
|
||||
#print "Sorted Pairs: ".join(",",map{$_->[0]." ".$_->[1]}@pairs)."\n";
|
||||
|
||||
my @index = map { $_->[0]} @pairs;
|
||||
|
||||
$c=0;
|
||||
|
||||
# remove stop words
|
||||
|
||||
while ($c < $rep) {
|
||||
$words[$index[$c]]=&buttsub($words[$index[$c]]);
|
||||
$c++;
|
||||
}
|
||||
|
||||
return @words;
|
||||
}
|
||||
|
||||
|
||||
sub buttsub {
|
||||
my $word = shift @_;
|
||||
|
||||
my @points = $hyp->hyphenate($word);
|
||||
unshift(@points,0);
|
||||
|
||||
my $factor = 2;
|
||||
my $len = scalar @points;
|
||||
my $replace = $len -1 - int(rand($len ** $factor) ** (1.0/$factor));
|
||||
push @points,length($word);
|
||||
|
||||
my $l = $points[$replace];
|
||||
my $r = $points[$replace+1]- $l ;
|
||||
while (substr($word,$l+$r,1) eq "t") { $r++; }
|
||||
my $sub = substr($word,$l,$r);
|
||||
my $butt ="butt";
|
||||
|
||||
if ($sub eq uc $sub) {
|
||||
$butt = "BUTT";
|
||||
} elsif ($sub =~/^[A-Z]/) {
|
||||
$butt = "Butt";
|
||||
}
|
||||
substr($word,$l,$r) = $butt;
|
||||
return $word;
|
||||
}
|
||||
|
||||
## perl cookbook
|
||||
# fisher_yates_shuffle( \@array ) : generate a random permutation
|
||||
# of @array in place
|
||||
sub shuffle {
|
||||
my $array = shift;
|
||||
my $i;
|
||||
for ($i = @$array; --$i; ) {
|
||||
my $j = int rand ($i+1);
|
||||
next if $i == $j;
|
||||
@$array[$i,$j] = @$array[$j,$i];
|
||||
}
|
||||
}
|
||||
|
||||
sub weighed_index_array {
|
||||
my $len = shift;
|
||||
my $c = 0;
|
||||
my $n = $len;
|
||||
my @a = ();
|
||||
while ($c < $len) {
|
||||
push @a, ($c) x ($n*$n);
|
||||
$n--;
|
||||
$c++;
|
||||
}
|
||||
return @a;
|
||||
}
|
||||
|
||||
1;
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue