Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Small chat server...

by rlb3 (Deacon)
on Jul 27, 2003 at 12:21 UTC ( #278220=perlcraft: print w/ replies, xml ) Need Help??

   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: 

Comment on Small chat server...
Download Code
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
    Very cool, a buddy of mine and I have been working on improving it. Pretty slick, I don't know if we have anything better, but I will post if we do.
      That would be great! If you decide to post it I would be glad to see it.
      rlb3

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://278220]
Approved by phydeauxarff
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (9)
As of 2015-03-28 23:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When putting a smiley right before a closing parenthesis, do you:









    Results (627 votes), past polls