textconsole.pm

Net-OICQ-1.6

	$self->info("Server reponse to add_contact_2: $event->{Data}\n");
}

sub ui_del_contact {
	my ($self, $event) = @_;
	$self->info($event->dump);
}

sub ui_update_info {
	my ($self, $event) = @_;
	$self->info("Server reponse to update_info: $event->{Data}\n");
}

# This method is used by ui_recv_msg
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, $prompt) = @_;
	print $prompt;
	local $SIG{__DIE__} = { ReadMode 0 };
	ReadMode 2;
	my $pw = <STDIN>;
	ReadMode 0;
	print "\n";
	$pw =~ s/[^ -~]+$//;
	return $pw;
}

sub get_new_passwd {
	my ($self) = @_;
	my $pw  = $self->ask_passwd("Enter new passwd: ");
	my $pw2 = $self->ask_passwd("Retype new passwd to confirm: ");
	$self->{LastKbInput} = time;
	return $pw if $pw eq $pw2;
	$self->error("Passwords don't match.\n");
	return;
}

sub kb_cmd {
	my ($self, $cmd) = @_;
	return undef unless exists $KbCmd{$cmd};
	return $KbCmd{$cmd};
}

sub input_filter {
	my $self = shift;
	return @_ unless $self->{'UTF-8'};
	map { encode('euc-cn', decode('utf-8', $_)) } @_
}

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

	$self->{LastKbInput} = time;
	my $oicq = $self->{OICQ};
	if ($kbinp =~ s|^/||) {
		$kbinp =~ s/^\s+//;
		$kbinp =~ s/\s+$//;
		my ($cmd, @args) = split(/\s+/, $kbinp);
		unless (defined $cmd) {
			$oicq->get_online_friends;
			return;
		}
		if ($cmd =~ /^\d+$/) {
			if (@args) {
				my $dstid = ($cmd <= 1000) ? $self->find_friend_id($cmd) : $cmd;
				my $text = join('', @args);
				($text) = $self->input_filter($text);
				$oicq->send_msg($dstid, $text) if defined $dstid;
			} else {
				$self->set_dstid($cmd);
			}
		} elsif ($cmd eq 'eval') {
			my $ui = $self;
			eval "@args";
			$@ && $self->error("$@");
			print "\n";
			$self->prompt;
			return;
		} elsif (exists $KbCmd{$cmd}) {
			if (@args < $KbCmd{$cmd}->[1]) {
				$self->error("Not enough argument for command $cmd\n");
			} else {
				@args = $self->input_filter(@args);
				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+$/) {
				my $dstid = $self->{DstId};
				my $text = $self->{MsgBuffer};
				chomp $text;
				($text) = $self->input_filter($text);
				if ($oicq->send_msg($dstid, $text)) {
					$self->{MsgBuffer} = "";
				} else {
					$self->error("Message not sent.\n");
				}
			} else {
				$self->error("Destination Id not given.\n");
				$self->prompt;
			}
		} else {
			$self->prompt;
		}
	} else {
		$self->{MsgBuffer} .= $kbinp;
	}
}

# Keyboard command help message
	
sub help {
	pop->info('-'x32, ' Help Message ', '-'x32, "\n", $HELP);
}

sub set_attribute {
	my ($self, $attr, $val) = @_;
	my $oicq = $self->{OICQ};
	if (defined($attr)) {
		if (exists $AttrFilter{$attr}) {
		    if (defined $val) {
		        my $newval = $AttrFilter{$attr}->($val);
		        if (defined $newval) {
		            $oicq->{$attr} = $newval;
		        } else {
		            $self->error("Invalid value for $attr: $val\n");
		        }
		    } else {
		        $self->warn("$attr = $oicq->{$attr}\n");
		    }
		} else {
		   $self->error("Cannot change $attr\n");
		}
	} else {
		$self->warn("These attributes can be changed:\n",
		           join(', ', keys(%AttrFilter)), "\n");
	}
	$self->prompt;
	return;
}

sub prompt {
	my ($self) = @_;
	my $oicq = $self->{OICQ};
	my $bufsize = length($self->{MsgBuffer});
	my $myid = $oicq->{Id};
	my $mynick = $oicq->get_nickname($myid);
	my $dstid = $self->{DstId};
	my $dstnick = $dstid ? $oicq->get_nickname($dstid) : "";
	my $time = time - $oicq->{LastSvrAck};
	my $c = $time > 60 ? '?' : '%';
	$self->info(sprintf("%s %-8s %8s => %-8s %8s  %12d bytes in buffer %2d\"\n",
		               $c, $mynick, $myid, $dstnick, $dstid, $bufsize, $time));
}

sub find_friend_id {
	my ($self, $index) = @_;
	my $info = $self->{OICQ}->{Info};
	my $count = 0;
	foreach my $id (sort {$a <=> $b} keys %$info) {
		next unless defined $info->{$id}->{Friend};
		$count++;
		if ($count == $index) {
		    return $id;
		}
	}
	$self->error("Invalid friend index $index ignored.\n");
	return undef;
}

sub set_dstid {
	my ($self, $dstid) = @_;
	if ($dstid =~ /^\d+$/) {
		if ($dstid <= 1000) {   # Assume user gives index, ranther than qq id
		    my $real_dstid = $self->find_friend_id($dstid);
		    defined $real_dstid and $self->{DstId} = $real_dstid;
		} else {
		    $self->{DstId} = $dstid;
		}
	} else {
		$self->error("Invalid destination id '$dstid' ignored.\n");
	}
}

sub toggle_autoreply {
	my ($self) = @_;
	my $oicq = $self->{OICQ};
	$self->warn("Auto-reply ", $oicq->toggle_autoreply, "\n");
	$self->prompt;
}

sub remove_saved_ids {
	my $self = shift;
	my $oicq = $self->{OICQ};
	foreach my $id (@_) {
		unless ($id =~ /^\d+$/) {
		    $self->error("Invalid ID $id ignored\n");
		    next;
		}
		$oicq->remove_saved_id($id) or $self->error("Failed to remove $id\n");
	}
	$self->prompt;
}

sub list_saved_ids {
	my $self = shift;
	my $oicq = $self->{OICQ};
	my $dir = "$oicq->{Dir}/$oicq->{Id}";
	if (@_) {
		foreach my $id (@_) {
		    system('cat', "$dir/$id.dat");
		}
	} else {
		$self->info('-'x30, ' Stored User Info ', '-'x30,"\n");
		foreach my $id ($oicq->get_saved_ids) {
			my $nick = $oicq->get_nickname($id);
			my $mtime = substr(localtime((stat("$dir/$id.dat"))[9]), 4, 16);
			$self->info(sprintf("$mtime %9s ", $id), $nick, "\n");
		}
		$self->info('='x78, "\n");
	}
	$self->prompt;
}

sub clear_msg_buffer {
	my $self = shift;
	$self->{MsgBuffer} = "";
	$self->info("Message buffer deleted\n");
	$self->prompt;
}

sub show_oicq {
	my ($self, $oicq) = @_;
	$self->info("{\n");
	my $pre = "    ";
	foreach my $attr (sort keys(%$oicq)) {
	   next if $attr =~ /Passw/;
	   my $val = $oicq->{$attr};
	   $val = unpack("H*", $val) if $val =~ /[\0-\x1f]/;
	   $self->info($pre, "$attr = $val\n"); 
	}
	$self->info("}\n");
}

sub show_object {
	my ($self) = @_;
	$self->info('-'x35, ' Object ', '-'x35,"\n");
	foreach my $key (keys %$self) {
		$self->info("$key = ");
		my $val = $self->{$key};
		if (ref($val) eq 'Net::OICQ') {
		    $self->show_oicq($val);
		} elsif (ref($val) =~ /ARRAY/) {
		    $self->info("[ ", join(', ', @$val), " ]\n");
		} else {
		    $self->info($val, "\n");
		}
	}
	$self->prompt;
}

sub load_plugin {
	my ($self, $file, $id) = @_;
	my $oicq = $self->{OICQ};
	if (defined $id) {
		if ($id =~ /^\d+$/) {
		    defined $oicq->{Info}->{$id} or $oicq->{Info}->{$id} = {};
		    $oicq->{Info}->{$id}->{ChatBot} = $file;
		    $self->info("Plugin $file will be used on $id\n");
		} else {
		    $self->error("Bad id $id\n");
		}
	} else {
		$oicq->{ChatBot} = $file;
		$self->info("Plugin $file will be used on all ids\n");
	}
}

sub AUTOLOAD {
	my $self = shift;
	my $type = ref($self) or die "$self is not an object";
	my $name = $AUTOLOAD;
	$name =~ s/.*://;
	return if $name eq 'DESTROY';
	if ($name =~ s/^ui_//) {
		$self->warn("Don't know how to handle QQ command $name.\n");
		my $event = shift;
		if (defined($event) && ref($event) =~ /Event/) {
			$self->info($event->dump);
		}
		return;
	}
	my $oicq = $self->{OICQ};
	unless (defined $oicq) {
		$self->warn("Command $name ignored.\n");
		return;
	}
	unless (Net::OICQ->can($name)) {
		$self->warn("$name is not a Net::OICQ method.\n");
		return;
	}
	if (defined $_[0]) {
		$self->valid_id($_[0]) or return;
	}
	$oicq->$name(@_);
}

sub show_strangers {
	my ($self) = @_;
	$self->info('-'x22, " Strangers ", '-'x22, "\n");
	my $info = $self->{OICQ}->{Info};
	my $myid = $self->{OICQ}->{Id};
	my $idx = 1;
	foreach my $id (sort {$a <=> $b} keys %$info) {
		my $hashref = $info->{$id};
		next if $id == $myid or 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");
}

sub set_mode {
	my ($self, $mode) = @_;
	unless (defined $mode) {
		$self->info("Please use i for invisible, a for away, n for normal.\n");
		return;
	}
	my $oicq = $self->{OICQ};
	my $code;
	use bytes;
	if    ($mode =~ /^i/i) { $oicq->{ConnectMode} = 'Invisible'; $code = chr(40) }
	elsif ($mode =~ /^a/i) { $oicq->{ConnectMode} = 'Away';      $code = chr(30) }
	elsif ($mode =~ /^n/i) { $oicq->{ConnectMode} = 'Normal';    $code = chr(10) }
	elsif ($mode =~ /^\d\d?/) { $code = chr($mode) }  # You can enter code directly
	else {
		$self->info("Unknown mode \"$mode\" ignored.\n");
		return;
	}
	$self->{OICQ}->set_mode($code);
}

sub get_user_info {
	my ($self, $id) = @_;
	my $oicq = $self->{OICQ};
	defined $id or $id = $oicq->{Id};
	$self->valid_id($id) or return;
	if ($id < 1000) {
		my $fid = $self->find_friend_id($id);
		defined $fid or return;
		$oicq->get_user_info($fid);
	} else {
		$oicq->get_user_info($id);
	}
}

sub update_info {
	my $self = shift;
	unless (@_) {
		$self->info("You can change the following attributes of yourself:\n");
		for(my $i = 1; $i < (@$InfoHeader -2); $i++) {
		    $self->info(sprintf " %-19s", $InfoHeader->[$i]);
		    $self->info("\n") if $i%4 == 0;
		}
		$self->info("\n");
		$self->prompt;
		return;
	}
	push @_, "" if @_ % 2;
	my %hash = @_;
	foreach my $attr (keys %hash) {
		# Allow updating unknown attributes
		#if ($attr =~ /^unkn/i) {
		#    print "Invalid attribute $attr ignored\n";
		#    delete $hash{$attr};
		#    next;
		#}
		my $val = $hash{$attr};
		$val =~ s/\\s/ /g;
		$val =~ s/\\n/\n/g;
		$hash{uc($attr)} = $val;
		printf "%-19s : %s\n", $attr, $val;
	}
	$self->{OICQ}->update_info(\%hash);
	return 1;
}

sub set_passwd {
	my ($self) = @_;
	my $newpw = $self->get_new_passwd;
	if ($newpw) {
		$self->{OICQ}->set_passwd($newpw);
		return 1;
	}
	return 0; 
}

sub valid_id {
	my ($self, $id) = @_;
	if ($id =~ /^\d+$/) {
		return 1;
	} else {
		$self->error("Invalid id: $id\n");
		return 0;
	}
}

sub search_users {
	my ($self, $arg) = @_;
	my $oicq = $self->{OICQ};
	unless (defined $arg) {
		$oicq->list_online_users(1);
		return;
	}
	if ($arg =~ /\D/) {
		$oicq->search_user($arg);
	} elsif ($arg == 0) {
		$oicq->{SearchCount} = 0;
	} elsif ($arg > 100) {
		$oicq->search_user($arg);
	} else {
		$oicq->list_online_users($arg);
	}
}

sub add_contact {
	my ($self, $id, @mesg) = @_;
	$self->valid_id($id) or return;
	my $oicq = $self->{OICQ};
	if (@mesg) {
		$oicq->add_contact_2($id, "@mesg");
	} else {
		$oicq->add_contact($id);
	}
}

# sub accept_contact handled by AUTOLOAD

# sub reject_contact handled by AUTOLOAD

# sub add_contact handled by AUTOLOAD

# sub del_contact handled by AUTOLOAD

# sub forbid_contact handled by AUTOLOAD

# sub search_group handled by AUTOLOAD

# sub get_group_info handled by AUTOLOAD

# sub send_group_msg handled by AUTOLOAD

# sub group_online_members handled by AUTOLOAD

1;