Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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();
}
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://439357]
help
Chatterbox?
[1nickt]: So if I was to offer any editorial advice it would be to (1) make it endure time passing (2) make it positive (3) make it about you and your beliefs
[1nickt]: (Disicpulus The new best choice is maybe "First People"
[karlgoethebier]: Discipulus: This is called "Volksverhetzung" in German which means
[karlgoethebier]: incitement of the people and it is prohibited by law
[1nickt]: The best sign I have sign in a protest march was carried by a kid of about 10 years "If you build a wall my generation will tear it down."
[1nickt]: ... sign I have seen ...
[1nickt]: Now that one made me hopeful! First time not angry in a long time when I saw that kid.
[Discipulus]: i propend for removing: why? because we are so few that we must find i minimal common divisor, this is certainly Perl not our (anyway private) thougths. And i say this still wondering because i love a lot freedom of expression. And i say this not for roho
[1nickt]: Discipulus that was the point of my story of taking the sticker off my truck. I know there are lots of people in the world who if I knw their private beliefs I might want to argue with them. And they with me. But life cannot all be arguments!
[1nickt]: This is less than perfect ... but demanding perfection (from people or from life) is a sure way to unhappiness.

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (9)
As of 2017-06-22 12:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How many monitors do you use while coding?















    Results (519 votes). Check out past polls.