Return to bot.pl CVS log

Up to [Coherent Logic Development] / ChivanetChatBot

Annotation of ChivanetChatBot/bot.pl, revision 1.1

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