Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/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(); }

In reply to ICQ group chat by dpavlin

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2024-06-23 11:57 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.