File:  [Coherent Logic Development] / ChivanetChatBot / bot.pl
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Thu Jan 30 05:27:42 2025 UTC (6 months ago) by snw
Branches: MAIN, CoherentLogicDevelopment
CVS tags: start, HEAD
ChivaNet Chat Bot

    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>