1: #!/usr/bin/env perl
2:
3: #
4: # ChivaNet AIM Bot
5: # Copyright (C) 2024, 2025 Coherent Logic Development LLC
6: #
7: # Author: Serena Willis <snw@coherent-logic.com>
8: #
9: # Licensed AGPL-3.0
10: #
11: # $Log: bot.pl,v $
12: # Revision 1.1.1.1 2025/01/30 05:27:42 snw
13: # ChivaNet Chat Bot
14: #
15: #
16:
17: use Net::OSCAR qw(:standard :loglevels);
18: use HTML::Strip;
19: use REST::Client;
20: use JSON::XS;
21: use Data::Dumper;
22: use Getopt::Long;
23:
24: my $botsn = '';
25: my $botsrv = '';
26: my $botpw = '';
27: my $rasurl = '';
28:
29: GetOptions("aimsn=s" => \$botsn,
30: "aimhost=s" => \$botsrv,
31: "aimpw=s" => \$botpw,
32: "rasurl=s" => \$rasurl)
33: or die("error in command line arguments");
34:
35:
36: %signon = (
37: screenname => $botsn,
38: password => $botpw,
39: host => $botsrv,
40: );
41:
42: $oscar = Net::OSCAR->new();
43: %invites;
44:
45: sub signon_done {
46: print "[OK]\n";
47: $online = 1;
48: }
49:
50: sub chat_joined {
51: my($oscar, $chatname, $chat) = @_;
52:
53: print "bot: joined $chatname\n";
54:
55: foreach my $i ( 0 .. $invites{$chatname}->$#* ) {
56: $invitee = $invites{$chatname}[$i];
57: print "bot: inviting $invitee to $chatname...\n";
58: $chat->chat_send("Inviting $invitee to $chatname...\n");
59: $chat->invite($invitee, "Please join us in $chatname");
60: }
61:
62: delete($invites{$chatname});
63:
64: $chat->part();
65: }
66:
67: sub im_in {
68:
69: my($oscar, $sender, $message, $is_away) = @_;
70: my $hs = HTML::Strip->new();
71: my $rawcmd = $hs->parse($message);
72: my @cmd = split(' ', $rawcmd);
73:
74: print "bot: command $cmd[0] received from $sender\n";
75:
76: if($cmd[0] eq "ping") {
77: $oscar->send_im($sender, "pong", $is_away);
78: }
79: elsif($cmd[0] eq "join") {
80: my @rooma = @cmd[1..$#cmd];
81: my $room = join(' ', @rooma);
82: my $client = REST::Client->new();
83: $client->GET("$rasurl/chat/room/public");
84: my $json = $client->responseContent();
85: my $arrayref = decode_json $json;
86: foreach my $hash(@{$arrayref}) {
87: if ($$hash{"name"} eq $room) {
88: print "bot: sending invite to $sender for $room\n";
89: push $invites{$room}->@*, $sender;
90: $oscar->send_im($sender, "Okay, I'll invite you to <b>$room</b>. You may need to have me in your buddy list for this to work.", $is_away);
91: my $chat = $oscar->chat_join($room, 5);
92: return;
93: }
94: }
95: $oscar->send_im($sender, "You have specified a chat room that does not exist. Please remember that chat room names are case-sensitive.", $is_away);
96:
97: }
98: elsif($cmd[0] eq "listchat") {
99: my $client = REST::Client->new();
100: $client->GET("$rasurl/chat/room/public");
101: my $json = $client->responseContent();
102: my $arrayref = decode_json $json;
103:
104: print "bot: sending chat list to $sender\n";
105: foreach my $hash(@{$arrayref}) {
106: my $url = "<a href=\"" . $$hash{"url"} . "\">" . $$hash{"name"} . "</a>";
107: $oscar->send_im($sender, $url, $is_away);
108: }
109: $oscar->send_im($sender, "<b>You may join one of the above chat rooms by clicking the link or sending me 'join <i>chat-room-name</i>' to request an invite.</b>");
110: }
111: else {
112: $oscar->send_im($sender, "<b>You can send me any of the following commands:</b>", $is_away);
113: $oscar->send_im($sender, " <b>help</b>: lists available bot commands", $is_away);
114: $oscar->send_im($sender, " <b>ping</b>: tests the bot for response", $is_away);
115: $oscar->send_im($sender, " <b>listchat</b>: lists the public chat roooms available on ChivaNet", $is_away);
116: $oscar->send_im($sender, " <b>join <i>chat-room-name</i></b>: joins public chat room <i>chat-room-name</i>", $is_away);
117: $oscar->send_im($sender, " <b><font color=red>Please note that <i>chat-room-name</i> is case-sensitive</font></b>", $is_away);
118: }
119:
120: }
121:
122: $oscar->set_callback_signon_done(\&signon_done);
123: $oscar->set_callback_im_in(\&im_in);
124: $oscar->set_callback_chat_joined(\&chat_joined);
125:
126: print "ChivaNet AIM Bot v0.1.0\n";
127: print " Copyright (C) 2024, 2025 Coherent Logic Development LLC\n\n";
128:
129: print "bot: attempting to sign in... ";
130: $oscar->signon(%signon);
131:
132: while(1) {
133: $oscar->do_one_loop();
134: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>