Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
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 making s'mores by the fire in the courtyard of the Monastery: (6)
As of 2015-09-01 02:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The oldest computer book still on my shelves (or on my digital media) is ...













    Results (366 votes), past polls