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