0: This is based on a python script I found out on the net.
1: I have not writen a client but it works with unix telnet clients.
2: 
3: chat.pl...
4: 
5: #!/usr/bin/perl
6: 
7: use IO::Socket;
8: use IO::Select;
9: 
10: use Userlist;
11: 
12: # Fork off...
13: $pid = fork();
14: exit if ($pid);
15: 
16: #Turn off buffering
17: $|++;
18: 
19: my $quit = 0;
20: 
21: # Handle the control-c
22: $SIG{INT} = sub {$quit++};
23: 
24: my $listen = IO::Socket::INET->new(
25: 	LocalPort => 8080,
26: 	Listen    => 20,
27: 	Proto     => 'tcp',
28: 	Reuse     => 1,
29: 	Timeout   => 60*60
30: );
31: 
32: $read = IO::Select->new();
33: $read->add($listen);
34: 
35: while (!$quit) {
36: 	my @ready = $read->can_read;
37: 	
38: 	foreach $selected (@ready) {
39: 		if ($selected == $listen) {
40: 			my $conn = $listen->accept;
41: 			$ip = $conn->peerhost;
42: 
43:                         # Create new object
44: 			$user = Userlist->new($conn);
45:                         
46:                         # Get the user's name
47: 			$name = $user->getName;
48: 			$count = push(@users,$user);
49: 			print $conn $count."-".$name."-".$ip."\n";
50: 			$read->add($conn) if $conn;
51: 		} else {
52:                         # Get input from who's ready
53: 			$buffer = <$selected>;
54:                    
55:                         # Send message to all users
56: $user->broadcast($buffer,$selected,\@users);
57: 		}	
58: 	}
59: }
60: 
61: 
62: Userlist.pm...
63: 
64: package Userlist;
65: 
66: sub new {
67: 
68: 	$self = shift;
69: 	$obj = {
70: 		USER => shift,
71: 		NAME => ''
72: 	};
73: 
74: 	return bless $obj,$self;
75: }
76: 
77: sub conn {
78: 	$self = shift;
79: 	return $self->{USER};
80: }
81: 
82: sub getName {
83: 	$self = shift;
84: 	$conn = $self->{USER};
85: 
86: 	print $conn "Name: ";
87: 	$name = <$conn>;
88: 	$name =~ s/\s+$//;
89: 
90: 	$self->{NAME} = $name;
91: 	return $self->{NAME};
92: }
93: 
94: sub name {
95: 	$self = shift;
96: 	return $self->{NAME};
97: }
98: 
99: # I'm not really sure if this is the best place to make this
100: # sub, but its the only way I can think of to get the name
101: # of the user that sent the message.
102: 
103: 
104: sub broadcast {
105: 	$self = shift;
106: 	$buffer = shift;
107: 	$selected = shift;
108: 	$users = shift;
109: 	if ($buffer) {
110: 		foreach $client (@$users) {
111: 			$connection = $client->conn();
112: 			$name = $self->{NAME} if ($connection == $selected);
113: 			exit(0) if ($buffer =~ /quit/i);
114: 			print $connection $name.": ".$buffer;
115: 		}
116: 	}
117: }
118: 1;
119: 
120: