textconsole.pm

MSN fast change name is new utility 4 you

package Net::OICQ::TextConsole;

# $Id: TextConsole.pm,v 1.9 2003/10/17 20:01:52 tans Exp $

# Copyright (c) 2003 Shufeng Tan.  All rights reserved.
# 
# This package is free software and is provided "as is" without express
# or implied warranty.  It may be used, redistributed and/or modified
# under the terms of the Perl Artistic License (see
# http://www.perl.com/perl/misc/Artistic.html)

use strict;
use warnings;
use Carp;
use IO::Select;
use Term::ANSIColor;
eval "no encoding; use bytes;" if $] >= 5.008;

use Net::OICQ;
use Net::OICQ::ServerEvent;
use Net::OICQ::ClientEvent;

# Variables

my $HELP = <<EOF ;
All lines that begin with / (slash) are treated as keyboard commands.

  /help, /?    - print this help message
  /52482796    - set destination id num to 52482796
  /away        - toggle auto-reply
  /ls [id]     - list id numbers saved in user directory
  /rm [id]     - remove locally saved user info
  /buf         - show message buffer
  /rmbuf       - clear message buffer
  /hist        - show history
  /obj         - show object
  /set         - set object attribute
  /clear       - clear screen

  /plugin /path/to/plugin [id] - load plugin for auto-reply

  /eval perl_one_liner - do whatever you want.  \$oicq is pre-defined.

  /xxxxx mesg  - send mesg to xxxx without changing destination id
  /get [id]    - get user info of the specified id (default to yourself)
  /f           - list all friends stored on the server
  /who         - get a list of online friends
  /s [n]       - list n x 25 online users if n < 100, or chekc if [n] is online
  /mode [n|i|a]- change mode to Normal, Invisible or Away
  /update      - update information
  /accept [id] - accept contact from id
  /reject [id] - reject contact from id
  /add [id]    - add a user to friend list
  /del [id]    - delete a user from friend list
  /ban [id]    - forbid a user from contacting you
  /passwd xxxx - change passwd to xxxx

Lines that do not begin with / will be stored in the message buffer
and will be sent to destination id when an empty line is entered.
This allows you to send a message of multiple lines.
EOF

# Keyboard commands

my %KbCmd = (  # Code ref          # Min num of arguments
    help    => [\&help,               0],
    '?'     => [\&help,               0],

    get     => [\&get_user_info,      0],
    f       => [\&get_friends_list,   0],
    who     => [\&get_online_friends, 0],
    s       => [\&search_users,       0],
    mode    => [\&set_mode,           0],
    update  => [\&update_info,        0],
    accept  => [\&accept_contact,     1],
    reject  => [\&reject_contact,     1],
    add     => [\&add_contact,        1],
    del     => [\&del_contact,        1],
    ban     => [\&forbid_contact,     1],
    passwd  => [\&set_passwd,         1],

    away    => [\&toggle_autoreply,   0],
    ls      => [\&list_saved_ids,     0],
    strangers => [\&show_strangers,   0],
    rm      => [\&remove_saved_ids,   1],
    buf     => [\&show_msg_buffer,    0],
    rmbuf   => [\&clear_msg_buffer,   0],
    hist    => [\&show_queue,         0],
    obj     => [\&show_object,        0],
    set     => [\&set_attribute,      0],
    plugin  => [\&load_plugin,        1],
    clear   => [sub {system "clear"}, 0],
);

my $MaxMsgSize = 0x400;  # 1024 bytes

my %AttrFilter = (
    LogChat      => sub { return $_[0] if $_[0] =~ /^\w*$/; undef },
    Debug        => sub { return $_[0] if $_[0] =~ /^\d$/; undef },
    AutoAwayTime => sub { return $_[0] if $_[0] =~ /^\d+$/; undef },
    Away         => sub { return $_[0] if $_[0] =~ /^\d+$/; undef },
);

my %Color = (
    message => 'blue',
    service => 'yellow',
    info    => 'green',
    warn    => 'yellow bold',
    error   => 'red bold',
    timestamp => 'green',
);

my $InfoHeader  = \@Net::OICQ::InfoHeader;
my $ConnectMode = \%Net::OICQ::ConnectMode;

# Constructor

sub new {
    my ($class, $oicq) = @_;

    defined $oicq or $oicq = new Net::OICQ;
    my $self = {
        OICQ      => $oicq,
        MsgBuffer => "",
        DstId     => "",
        Select    => new IO::Select(\*STDIN),
    };
    $oicq->{UI} = $self;
    return bless($self, $class);
}

# Begin required methods

sub msg {
    my ($self, $srcid, $dstid, $time, @text) = @_;
    my $oicq = $self->{OICQ};
    my $id_color = 'black';
    if ($oicq->{Id} ne $srcid) {
        $id_color = $self->id_color($srcid);
        $self->set_dstid($srcid);
    }
    my $nick = $oicq->get_nickname($srcid);
    my $srcinfo = $oicq->{Info}->{$srcid};
    my $addr = $srcinfo->{Addr} || 'unknown';
    my $ver  = defined $srcinfo->{Client} ?
                   '0x'.unpack('H*', $srcinfo->{Client}) :
                   'unknown';
    my $last = pop @text;
    $last =~ s/[\x00-\x09]/ /g;
    push @text, $last;
    print color($Color{'timestamp'}), substr(localtime($time), 11, 9),
          color($id_color), "$nick ($srcid, IP $addr, version $ver):\n",
          color($id_color), @text, "\n", color('reset');
    $self->beep;
}

sub info {
    my ($self, @text) = @_;
    print color('green'), @text, color('reset');
}

sub warn {
    my ($self, @text) = @_;
    print color('yellow'), @text, color('reset');
}

sub error {
    my ($self, @text) = @_;
    print color('red'), @text, color('reset');
}

sub ask {
    my ($self, $prompt, $timeout) = @_;
    defined $timeout or $timeout = 120;
    print color('yellow'), $prompt, color('reset');
    $self->beep;
    my $input;
    eval {
        local $SIG{ALRM} = sub { die };
        alarm $timeout;
        $input = <STDIN>;
        $self->{LastKbInput} = time;
        alarm 0;
    };
    return $input;
}

sub beep {
    print "\007";
}

sub on_mode_change {
    my ($self, $id, $mode) = @_;
    $self->info(substr(localtime, 11, 9), $id, " ",
                $self->{OICQ}->get_nickname($id), " ");
    if ($mode == 10) {
        $self->info("logged in.\n");
    } elsif ($mode == 20) {
        $self->info("logged out.\n");
    } elsif ($mode == 30) {
        $self->info("is away.\n");
    } else {
        $self->info("changed mode to $mode\n");
    }
}

sub show_user_info {
    my ($self, $field) = @_;
    $self->info('-'x34, ' User Info ', '-'x34, "\n");
    foreach my $i (0..24) { 
    	$field->[$i] =~ s/([\x00-\x1f])/'\x'.unpack("H*", $1)/ge;
        $self->info(sprintf("%-15s: %-25s", $InfoHeader->[$i], $field->[$i]));
        if (defined $field->[$i+25]) {
            $self->info(sprintf(" %-15s: %s\n",
                                $InfoHeader->[$i+25], $field->[$i+25]));
        } else {
            $self->info("\n");
        }
    }
    $self->info('='x79, "\n");
}

sub show_online_friends {
    my ($self, $aref) = @_;
    my $oicq = $self->{OICQ};
    $self->info(sprintf "%-9s %-12s %-20s %s\n",
                        'Id', 'Nickname', 'Address', 'Mode');
    $self->info(sprintf "%9s %-12s %-20s %s\n",
                        '-'x9, '-'x12, '-'x20, '----');
    foreach my $ref (@$aref) {
        my $fid = shift @$ref;
        #next if $fid >= 72000001 and $fid <= 72000012;
        my $nick = $oicq->get_nickname($fid);
        $self->info(sprintf "%9d %-12s %-20s %d\n", $fid, $nick,  @$ref);
    }
    $self->info('='x48,"\n");
}

sub show_search_result {
    my ($self, $aref) = @_;
    unless (@$aref) {
        $self->info("No result for user search\n");
        return;
    }
    $self->info('-'x32, ' Search Result ', '-'x32, "\n");
    foreach my $ref (@$aref) {
        $self->info(sprintf("%-10s %-40s %+20s %4s\n",
	                    map {s/([\x00-\x1f])/'\x'.unpack("H*", $1)/ge; $_} @$ref));
    }       
    $self->info('='x79, "\n");  
}       

sub show_friends_list {
  my ($self) = @_;
  $self->info('-'x20, " Friends List ", '-'x20, "\n");
  my $info = $self->{OICQ}->{Info};
  my $idx = 1;
  foreach my $id (sort {$a <=> $b} keys %$info) {
    my $hashref = $info->{$id};
    next unless defined $hashref->{Friend};
    $self->info(sprintf "%2d.  %9d  %3s  %3s  %4s : %-16s \n",
          $idx++, $id,
          defined($hashref->{Sex}) ? $hashref->{Sex} : '',
          defined($hashref->{Age}) ? $hashref->{Age} : '',
          defined($hashref->{Face}) ? $hashref->{Face} : '',
          defined($hashref->{Nickname}) ? $hashref->{Nickname} : '');
  }
  $self->info('='x55, "\n");
}

# End of required methods

# Methods for TextConsole

sub loop {
    my ($self) = @_;
    my $oicq = $self->{OICQ};
    my $select = $self->{Select};
    $select->add($oicq->{Socket});
  LOOP: while(1) {
	$oicq->keepalive if time - $oicq->{LastKeepaliveTime} >= 60;
    HANDLE: foreach my $handle ($select->can_read(0.1)) {
	    my $input = undef;
	    if (substr($handle, 0, 16) eq 'IO::Socket::INET') {
		$handle->recv($input, 0x4000, 0);
                print $oicq->hexdump($input) if $oicq->{Debug} > 2;
		$oicq->process_packet($input);
		next HANDLE;
	    }
	    $input = <$handle>;
            next unless defined $input;
            last LOOP if $input =~ /^\/(exit|quit)/;
	    $self->process_kbinput($input);
	}
    }
}

sub id_color {
    my ($self, $id) = @_;
    my $color;
    my $info = $self->{OICQ}->{Info}->{$id};
    if (defined $info && defined $info->{Sex} && $info->{Sex} !~/\D/) {
        return 'cyan' if $info->{Sex} == 0;
        return 'magenta'if $info->{Sex} == 1;
    }
    return 'yellow';
}

sub ask_passwd {
    my ($self) = @_;
    print "Enter new passwd: ";
    system('stty', '-echo');
    my $pw = <STDIN>;
    chomp $pw;
    print "\nRetype new passwd to confirm: ";
    my $pw2 = <STDIN>;
    chomp $pw2;
    system('stty', 'echo');
    print "\n";
    $self->{LastKbInput} = time;
    return $pw if $pw eq $pw2;
    $self->error("Passwd mismatch.\n");
    return;
}

sub process_kbinput {
    my ($self, $kbinp) = @_;

    $self->{LastKbInput} = time;
    if ($kbinp =~ s|^/||) {
        $kbinp =~ s/^\s+//;
        $kbinp =~ s/\s+$//;
        my ($cmd, @args) = split(/\s+/, $kbinp);
        unless (defined $cmd) {
            $self->{OICQ}->get_online_friends;
            return;
        }
        if ($cmd =~ /^\d+$/) {
            if (@args) {
                my $dstid = ($cmd <= 1000) ? $self->find_friend_id($cmd) : $cmd;
                $self->{OICQ}->send_msg($dstid, "@args") if defined $dstid;
            } else {
                $self->set_dstid($cmd);
            }
        } elsif ($cmd eq 'eval') {
            my $ui = $self;
            my $oicq = $self->{OICQ};
            eval "@args";
            $@ && $self->error("$@");
            return;
        } elsif (exists $KbCmd{$cmd}) {
            if (@args < $KbCmd{$cmd}->[1]) {
                $self->error("Not enought argument for command $cmd\n");
            } else {
                eval { $KbCmd{$cmd}->[0]->($self, @args) };
                $@ && $self->error("$@");
                return;  # don't return prompt
	    }
        } else {
            $self->error("Unknown command: $cmd\n");
        }
        $self->prompt;
        return;
    }

    if ($kbinp =~ /^$/) {
        if ($self->{MsgBuffer} =~ /\S/) {
            if (exists($self->{DstId}) &&$self->{DstId} =~ /^\d+$/) {
                $self->{OICQ}->send_msg($self->{DstId}, $self->{MsgBuffer});
                $self->{MsgBuffer} = "";
            } else {
                $self->error("Destination Id not given.\n");
		$self->prompt;