AOL-TOC
view release on metacpan or search on metacpan
$SFLAP_SIGNON = 1;
$SFLAP_DATA = 2;
$SFLAP_ERROR = 3;
$SFLAP_SIGNOFF = 4;
$SFLAP_KEEPALIVE = 5;
sub register_callback {
my ($self, $chan, $func, @args) = @_;
#print "register_callback() func $func for chan $chan adding to $self->{callback}{$chan}\n";
#print " self $self selfcb = $self->{callback}\n";
push (@{$self->{callback}{$chan}}, $func);
@{$self->{callback}{$func}} = @args;
return;
}
sub clear_callbacks {
my ($self) = @_;
my $k;
print "...............C SFLAP clear_callbacks\n";
for $k (keys %{$self->{callback}}) {
print ".............C Clear key ($k)\n";
delete $self->{callback}{$k};
}
print "...............S SFLAP scan callbacks\n";
for $k (keys %{$self->{callback}}) {
print ".............S Scan key ($k)\n";
}
}
sub callback {
my ($self, $chan, @args) = @_;
my $func;
for $func (@{$self->{callback}{$chan}}) {
#print ("callback() calling a func $func for $chan fd $self->{fd}..\n");
eval { &{$func} ($self, @args, @{$self->{callback}{$func}}) };
}
return;
}
sub new {
my ($tochost, $authorizer, $port, $nickname) = @_;
my $self;
my $ipaddr;
sequence => 1
};
bless($self);
return $self;
}
sub destroy {
my ($self) = @_;
print "sflap destroy\n";
CORE::close($self->{fd});
$self = undef;
return;
}
sub close {
my ($self) = @_;
my $k;
print "sflap close\n";
$self->clear_callbacks();
#CORE::close($self->{fd});
return;
}
sub set_debug {
my ($self, $level) = @_;
$self->{debug_level} = $level;
print "slfap debug level $level\n";
}
sub debug {
my ($self, @args) = @_;
if (exists $self->{debug_level} && $self->{debug_level} > 0) {
print @args;
}
}
sub __connect {
my ($self) = @_;
my $socksaddr = inet_aton("206.223.45.1");
my $proto = getprotobyname('tcp');
my $sin = sockaddr_in(1080, $socksaddr);
my $fd = IO::Handle->new();
return $fd;
}
sub recv {
my ($self) = @_;
my ($buffer, $from, $xfrom) = '';
my ($fd) = $self->{fd};
$foo = CORE::sysread($fd, $buffer, 6);
if ($foo <= 0) {
#print "recv failed! calling signoff....\n";
$self->callback($SFLAP_SIGNOFF);
return;
}
my ($id, $chan, $seq, $len, $data) = unpack("aCnn", $buffer);
$self->debug("sflap recv ($self->{fd}) $foo chan = $chan seq = $seq len = $len\n");
$foo = CORE::sysread($fd, $data, $len);
$self->debug(" data = $data\n");
my $rpassword = "0x";
my $i = 0;
if (!$key) { $key = $ROASTING_KEY; }
@skey = split('', $key);
for $c (split('', $password)) {
$p = unpack("c", $c);
$k = unpack("c", @skey[$i % length($key)]);
$rpassword = sprintf("%s%02x", $rpassword, $p ^ $k);
$i ++;
}
return ($rpassword);
}
sub encode_string {
my ($self, $str) = @_;
my ($estr, $i);
}
return;
}
sub clear_callbacks {
my ($self) = @_;
my $k;
print "................ TOC clear_callbacks\n";
for $k (keys %{$self->{callback}}) {
print ".............. Clear key ($k)\n";
delete $self->{callback}{$k};
}
print "...............S TOC scan callbacks\n";
for $k (keys %{$self->{callback}}) {
print ".............S Scan key ($k)\n";
}
}
sub new {
my ($tochost, $authorizer, $port, $nickname, $password) = @_;
my ($self, $ipaddr, $sflap);
$self = {
nickname => $nickname,
password => $password,
caller => "file:line"
};
bless($self);
$sflap = AOL::SFLAP::new($tochost, $authorizer, $port, $nickname);
$self->{sflap} = $sflap;
#print "*************************** AOL::TOC::new(...) sflap = $self->{sflap}\n";
#print " sflap cb = $self->{sflap}{callback}\n";
#$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_SIGNON, \&sflap_signon, $password, "english", "TIK:\$Revision: 1.148 \$", $self);
#$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_DATA, \&sflap_data, $self);
#$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_ERROR, \&sflap_error, $self);
#$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_SIGNOFF, \&sflap_signoff, $self);
#$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_KEEPALIVE, \&sflap_keepalive, $self);
#
#$self->register_callback("SIGN_ON", \&check_version);
#$self->register_callback("CHAT_JOIN", \&_chat_join);
return $self;
}
sub destroy {
my ($self) = @_;
print "toc destroy\n";
$self->{sflap}->destroy();
$self->{callback} = undef;
$self = undef;
return;
}
sub set_debug {
my ($self, $level) = @_;
$self->{sflap}->set_debug($level);
}
sub debug {
my ($self, @args) = @_;
if ($self->{debug_level} > 0) {
print @args;
}
}
sub connect {
my ($self) = @_;
$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_SIGNON, \&sflap_signon, $self->{password}, "english", "TIK:\$Revision: 1.148 \$", $self);
$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_DATA, \&sflap_data, $self);
$self->{sflap}->register_callback($AOL::SFLAP::SFLAP_ERROR, \&sflap_error, $self);
return;
}
sub sflap_signoff {
my ($self, $data, $toc) = @_;
$toc->callback("CLOSED");
#foreach $k (keys %{$toc->{callback}}) {
# print "Deleting .. $k\n";
# delete $toc->{callback}{$k};
#}
$toc->destroy();
return;
}
sub test {
my ($self) = @_;
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use AOL::TOC;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
tocbot/do.pl view on Meta::CPAN
sub do_init {
tocbot_register_command("do", \&do_func);
}
sub do_func {
my ($nickname, $cmd, @args) = @_;
if ($cmd eq "send_im") {
($nickname, @message) = @args;
print "tocbot: do: send_im($nickname, @message)\n";
$toc->send_im($nickname, "@message");
}
if ($cmd eq "add_buddy") {
print "tocbot: do: add_buddy(@args)\n";
$toc->add_buddy("@args");
}
if ($cmd eq "remove_buddy") {
print "tocbot: do: remove_buddy(@args)\n";
$toc->remove_buddy("@args");
}
if ($cmd eq "evil") {
($nickname, $mode) = @args;
print "tocbot: do: evil($nickname, $mode)\n";
$toc->evil($nickname, $mode);
}
if ($cmd eq "add_permit") {
print "tocbot: do: add_permit(@args)\n";
$toc->add_permit("@args");
}
if ($cmd eq "add_deny") {
print "tocbot: do: add_deny(@args)\n";
$toc->add_deny("@args");
}
if ($cmd eq "chat_join") {
print "tocbot: do: chat_join(@args)\n";
$toc->chat_join("@args");
}
if ($cmd eq "chat_send") {
my ($room, @message) = @args;
print "tocbot: do: chat_send($room, @message)\n";
$toc->chat_send($room, "@message");
}
if ($cmd eq "chat_whisper") {
my ($room, $nickname, @message) = @args;
print "tocbot: do: chat_whisper($room, $nickname, @message)\n";
$toc->chat_whisper($room, $nickname, "@message");
}
if ($cmd eq "chat_evil") {
my ($room, $nickname, $mode) = @args;
print "tocbot: do: chat_evil($room, $nickname, $mode)\n";
$toc->chat_evil($room, $nickname, $mode);
}
if ($cmd eq "chat_invite") {
my ($room, $message, @buddies) = @args;
print "tocbot: do: chat_invite($room, $message, @buddies)\n";
$toc->chat_invite($room, $message, "@buddies");
}
if ($cmd eq "chat_leave") {
my ($room) = @args;
print "tocbot: do: chat_leave($room)\n";
$toc->chat_leave($room);
}
if ($cmd eq "chat_accept") {
my ($room) = @args;
print "tocbot: do: chat_accept($room)\n";
$toc->chat_accept($room);
}
if ($cmd eq "get_info") {
my ($nickname) = @args;
print "tocbot: do: get_info($nickname)\n";
$toc->get_info($nickname);
}
if ($cmd eq "set_info") {
print "tocbot: do: set_info(@args)\n";
$toc->set_info("@args");
}
}
1;
tocbot/fortune.pl view on Meta::CPAN
#
sub fortune_init {
tocbot_register_command("fortune", \&fortune_func);
}
sub fortune_func {
my ($nickname, $relayto, @message) = @_;
my @fortune;
print "tocbot: fortune: $nickname requested a fortune!\n";
open (ff, "/bin/fortune|");
@fortune = <ff>;
close (ff);
$toc->send_im($nickname, "Your fortune is:");
sleep(1);
$toc->send_im($nickname, "<i> @fortune </i>");
}
tocbot/ident.pl view on Meta::CPAN
#
sub ident_init {
tocbot_register_command("ident", \&ident_identify);
tocbot_register_command("unident", \&ident_unidentify);
}
sub ident_identify {
my ($nickname, @args) = @_;
print "tocbot: ident: identified user $nickname\n";
$toc->add_buddy($nickname);
}
sub ident_unidentify {
my ($nickname, @args) = @_;
print "tocbot: ident: unidentified user $nickname\n";
$toc->remove_buddy($nickname);
}
1;
tocbot/relay.pl view on Meta::CPAN
# relay.pl
#
sub relay_init {
tocbot_register_command("relay", \&relay_func);
}
sub relay_func {
my ($nickname, $relayto, @message) = @_;
print "tocbot: relay: relay message \"@message\" to $relayto\n";
$toc->send_im($relayto, "Message relayed from $nickname: @message");
}
1;
tocbot/tocbot.pl view on Meta::CPAN
use AOL::TOC;
if ( ! -f "tocbot.config" ) {
die "tocbot: no config file!\n";
}
require "tocbot.config";
for $name (@tocbot_modules) {
print "tocbot: loading module $name\n";
require "$name".".pl";
eval { &{$name . "_init"} };
}
open(client_config, "toc.config");
$client_config = join('', <client_config>);
close(client_config);
$toc = AOL::TOC::new($tocbot_config{tochost}, $tocbot_config{authorizer},
$tocbot_config{port},
tocbot/tocbot.pl view on Meta::CPAN
while (1) {
$toc->dispatch();
}
sub client_im {
my ($self, $nickname, $autoresponse, $message) = @_;
my $cmd, $args;
print "tocbot: $nickname says \"$message\"\n";
if ($autoresponse eq "T") {
print "tocbot: $nickname is away, ignoring.\n";
return;
}
($cmd, $args) = ($message =~ /bot\((\w+)\b(.*)\)/i);
if ($cmd && do_command($nickname, $cmd, $args)) {
return;
}
if ($message =~ /HELP/i) {
send_help($nickname);
tocbot/tocbot.pl view on Meta::CPAN
sub client_signon {
$toc->add_buddy("jamersepoo", "jamers20VA");
$toc->send_im("jamersepoo", "tocbot online");
}
sub client_error {
my ($self, $code) = @_;
print "tocbot: TOC error $code.\n";
}
sub client_closed {
my ($self) = @_;
print "tocbot: connection closed, exiting.\n";
exit (0);
}
sub client_buddy {
my ($self, $nickname, $online, $evil, $signon_time, $idle_time, $class) = @_;
print "tocbot: buddy $nickname signed on\n";
}
sub tocbot_register_command {
my ($cmd, $func, @args) = @_;
print "Registered command '$cmd'\n";
$tocbot_commands{$cmd} = $func;
}
sub tocbot_exec_command {
my ($cmd, @args) = @_;
eval { &{$tocbot_commands{$cmd}} (@args) };
}
( run in 0.751 second using v1.01-cache-2.11-cpan-de7293f3b23 )