added autopromote

This commit is contained in:
Ryan Voots 2011-06-28 18:55:19 -04:00
parent 766c73f32c
commit 34e94e1f91
5 changed files with 154 additions and 1 deletions

26
dbdump.pl Normal file
View file

@ -0,0 +1,26 @@
#!/usr/bin/perl
use strict;
use warnings;
use DBI;
my $dbh = DBI->connect("dbi:SQLite:dbname=bot-basicbot.sqlite","","");
=for comment
CREATE TABLE "basicbot" (
id INT PRIMARY KEY,
namespace TEXT,
store_key TEXT,
store_value LONGBLOB );
=cut
my $sth = $dbh->prepare("SELECT * FROM basicbot;");
$sth->execute();
while(my $row = $sth->fetchrow_hashref) {
$row->{store_value} =~ s/text\s*.*\s*alternat.*factoids$//ig;
$row->{store_value} =~ s/isis_\w*//ig;
print $row->{store_key}, "\n\t\t", $row->{store_value}, "\n" if ($row->{store_key} =~ s/infobot_//)
}

View file

@ -0,0 +1,54 @@
package Bot::BasicBot::Pluggable::Module::RssPromote;
use strict;
use warnings;
use Data::Dumper;
use base qw(Bot::BasicBot::Pluggable::Module);
use HTML::TreeBuilder;
use LWP::UserAgent;
my $regurl = "http://www.dirkocraft.com/regbackend";
my $command = ".c group %s Resident";
my $adminchan = "#dirkocraft-alert";
my $ua = LWP::UserAgent->new();
sub help {return ""}
our %seenusers;
our $counter = 0;
my $first = 1;
sub tick { # called every 5 seconds
my $self = shift; # get ourself, duh
if ($first) {
$self->say({who => "nickserv", body => "identify sindarin", channel => "msg"})
}
unless ($counter++ % 3) {# every 15 seconds, 3 * 5 seconds, check the feed
my $res = $ua->get($regurl);
if ($res->is_success()) {
my $cont = $res->content();
my $root = HTML::TreeBuilder->new_from_content($cont);
my $users_elem = $root->look_down(_tag => "div", class => qr/view-registrationbackendstupid/);
my $ulist = $users_elem->format();
my @users = ($ulist =~ m/\*\s*(\w+)/g);
for my $user (@users) {
if (!exists($seenusers{$user})) {
$seenusers{$user} = 1;
my $cmd = sprintf($command, $user);
$self->say({body => $cmd, channel => $adminchan });
}
}
} else {
printf "Damn: %s\n",$res->status_line();
}
};
}
1;

View file

@ -8,7 +8,7 @@ use lib './lib';
use Bot::BasicBot::Pluggable;
my $bot = Bot::BasicBot::Pluggable->new(
channels => ["#dirkocraft", "#dirkocraft-admin", "#dirkocraft-alert", "#dirkocraft-wanderer"],
channels => ["#dirkocraft", "#dirkocraft-admin", "#dirkocraft-alert", "#dirkocraft-wanderer", "#dirkocraft-local"],
server => "irc.freenode.net",
port => "6667",
@ -22,6 +22,8 @@ my $bot = Bot::BasicBot::Pluggable->new(
my $info = $bot->load("DirkMod");
my $seen = $bot->load("Seen");
my $rss = $bot->load("RssPromote");
$info->set(user_require_question => 0);
$info->set(user_passive_answer => 1);
$info->set(user_allow_searching =>1);

45
res.pl Normal file
View file

@ -0,0 +1,45 @@
use YAML qw/LoadFile/;
our $resdb;
sub checkres {
my ($res, $x, $y, $z) = @_;
my $areas = $res->{Areas};
for my $area (keys %$areas) {
my ($mx, $my, $mz, $nx, $ny, $nz) = @{$res->{Areas}{$area}}{qw(X2 Y2 Z2 X1 Y1 Z1)};
if ($x >= $mx && $y >= $my && $z >= $mz && $x < $nx && $y < $ny && $z < $nz) { # check the rectangle
return 1;
}
}
}
sub getsubzone
{
my ($zones, $x, $y, $z) = @_;
for my $zone (keys %$zones) {
my $zhr = $zones->{$zone};
if (checkres($zhr, $x, $y, $z)) {
return ($zone, getsubzone($zhr->{Subzones}));
}
}
return ();
}
sub findres {
my ($x, $y, $z) = @_;
my @names = getsubzone($resdb->{Residences}, $x, $y, $z);
return join ".", @names;
}
sub loadres
{
$resdb = LoadFile("var/res.yml");
}
loadres();

26
rsstest.pl Normal file
View file

@ -0,0 +1,26 @@
#!/usr/bin/perl
use strict;
use warnings;
use lib './lib';
use Bot::BasicBot::Pluggable;
my $bot = Bot::BasicBot::Pluggable->new(
channels => ["#DCTV"],
server => "irc.rizon.net",
port => "6667",
nick => "dirkobot-rss",
altnicks => ["pbot", "pluggable"],
username => "simcop2387",
name => "Yet Another Pluggable Bot, for dirkocraft",
ignore_list => [qw()],
);
my $info = $bot->load("RssPromote");
$bot->run();