Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

ICQ group chat

by dpavlin (Friar)
on Mar 14, 2005 at 17:03 UTC ( [id://439357]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info Dobrica Pavlinusic <dpavlin@rot13.org>
Description: This small script is for unlucky people (like me) who need group chat functionality for ICQ, but don't have client which supports it.

You will need separate account for this bot. !config command exists so that you can edit YAML configuration file (to kick somebody out) and reload config without restarting script.

Latest development version (with support for buddies, logging using DBI, !last and ton of other features) is available from Subversion repository.

#!/usr/bin/perl -w

use strict;
use Net::OSCAR qw(:standard);
use YAML qw(LoadFile DumpFile);

my $config_file = $ENV{'HOME'}.'/.icq-chat';
my $config;

sub readln {
    my $msg = shift || return;
    print "$msg ";
    my $in = <STDIN>;
    chomp($in);
    return $in;
}

sub read_config {
    if (-e $config_file) {
        $config = LoadFile($config_file) || die "can't open $config_fi
+le: $!";
        die "configuration file $config_file is corrupt. Erase it to r
+ecover.\n" unless ($config->{'uin'} && $config->{'passwd'});
    } else {
        $config->{'uin'} = readln("group uin:");
        $config->{'passwd'} = readln("password:");
        $config->{'members'} = {};

        save_config();
    }
}

sub save_config {
    print DumpFile($config_file, $config) || die "can't open $config_f
+ile: $!";
}


sub im_in {
    my($oscar, $sender, $message, $is_away) = @_;
    print "[AWAY] " if $is_away;
    print "$sender: $message\n";

    unless ($config->{'members'}->{$sender}) {
        $config->{'members'}->{$sender} = $sender;
        $oscar->send_im($sender, 'Welcome to group ICQ chat. Change yo
+ur name with: "!nick your_name". You can leave group chat with !exit 
+or !leave.');
        save_config();
    }

    if ($message =~ m#^!nick\s+(.+)\s*$#) {
        $config->{'members'}->{$sender} = $1;
        $oscar->send_im($sender, "Your name will be: $1");
        save_config();
        return;
    }

    if ($message =~ m#^!(?:skip|leave|exit)\s*(\S*)\s*$#) {
        my $uin = $1 || $sender;
        if ($config->{'members'}->{$uin}) {
            $oscar->send_im($sender, "You left group chat.");
            delete ($config->{'members'}->{$uin});
        } else {
            $oscar->send_im($sender, "UIN $uin is not member of group"
+);
        }
        save_config();
        return;
    }

    if ($message =~ m#^!config#) {
        read_config();
        $oscar->send_im($sender, "Configuration reloaded.");
        return;
    }

    if ($message =~ m#^!help#) {
        $oscar->send_im($sender, "Confused? !nick [nickname], !leave, 
+!exit");
        return;
    }

    my $msg = $config->{'members'}->{$sender} || die "no member?";
    $msg = "[$msg] $message";

    foreach my $uin (keys %{$config->{'members'}}) {
        next if ($uin == $sender);
        print "$uin ";
        $oscar->send_im($uin, $msg);
    }
    print "\n";
}

my $oscar = Net::OSCAR->new() || die;
$oscar->loglevel(3);

read_config();

$oscar->set_callback_im_in(\&im_in);
$oscar->signon($config->{'uin'}, $config->{'passwd'}) || die "can't si
+gn on as ".$config->{'uin'};

while(1) {
    $oscar->do_one_loop();
}

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://439357]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (3)
As of 2024-04-20 14:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found