Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

ICQ group chat

by dpavlin (Friar)
on Mar 14, 2005 at 17:03 UTC ( #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();
}

Comment on ICQ group chat
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (12)
As of 2014-08-20 13:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (114 votes), past polls