Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
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 scrutinizing the Monastery: (7)
As of 2014-08-23 10:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (173 votes), past polls