I recently took on another project to write somewhat of a chat client to teach myself socket programming in perl a little better. However like always I have hit some snags.

I have found a way to implement multiple socket connections it have this working quiet well but the problems are:

1) How do I get my "server" program to broadcast what it reveives to all it's sockets?

The following code is what I have so far in the "server" app. 

#!/usr/bin/perl -w

use strict;
use IO::Socket;
use IO::Select;

$| = 1;   # Make program hot!

my $sock = IO::Socket::INET->new(Proto     => 'tcp',    
                                 LocalAddr => '192.168.0.100',
                                 LocalPort => 7778,
                                 Broadcast => 1,
                                 Blocking  => 0,
                                 Reuse     => 1,
                                 Listen    => 1)
                             or die "Can't bind : $@\n";
my $sel = new IO::Select($sock, undef, undef, 0);

print "Server now listening for connections!\n" if ($sock);

#while ($sock) {
#   if ($sock->recv(my $data, 1024)) {
#      print STDOUT "Input detected is: $data\n";
#      $sock->send($data);
#   }
#}

while(my @queues = $sel->can_read) {
   foreach my $obj (@queues) {
      my $new;
      if($obj == $sock) {
         # Create a new socket
         $new = $sock->accept;
         $sel->add($new);
      }else {
         # Process socket
         if (my $pid = fork()) {
            # parent: close the connection so we can
            # keep listening

            $sel->remove($obj);
            $obj->close();
         }else {
            # child: deal with connection
            while ($obj) {
               #my $recv = $obj->recv(my $data, 1024);
               #if (defined($recv)) {
               if (defined($obj->recv(my $data, 1024))) {
                  last if (($data =~ /^quit/i)||($data eq ""));
                  print STDOUT "Input detected is: $data\n";
                  $obj->send($data);
               }else{
                  last;
               }
            }

            #$obj->send("thanks, goodbye\r\n");

            # finished with the socket
            $sel->remove($obj);
            $obj->close;
         }
      }
   }
}

[download]
2) Now for the client, I have written a simple Tk gui and this also works quiet well for what it is suppose to do so far but I need a way to have it poll for buffered text every second or two and needless to say I cannot implement an endless loop in a gui so I am somewhat confused on how to accomplish this.

Here is the client gui code: 

#!/usr/bin/perl

# The following comments are for perl2exe compilation!

#perl2exe_include Tk;
#perl2exe_include Tk::Text;
#perl2exe_include Tk::Menu;
#perl2exe_include Tk::Photo;
#perl2exe_include Tk::ROText;
#perl2exe_include strict;

use Tk;
use Tk::Text;
use Tk::Menu;
use Tk::Photo;
use Tk::ROText;
use IO::Socket::INET;
use strict;

$| = 1;    # Make buffers hot!

my ($sock);
my $main_title = "pIM v0.3 (Beta Release)";
my $info       = $main_title;
 
my $mw = MainWindow->new();
$mw->minsize(qw(300 500));
$mw->title($main_title);

# Create main application widgets

my $t = $mw->Scrolled("ROText", -scrollbars => 'e', -font => ['Courier
+', 8], -background => 'white')->pack(-pady => 3,
                      -padx => 3, -ipady => 3, -ipadx => 3, -side => '
+top', -fill => 'both', -expand => 1);

my $ts = $mw->Frame->pack(-side => 'top', -fill => 'x');
$mw->Label(-textvariable => \$info, -relief => 'ridge')->
   pack(-side => 'top', -fill => 'x');
my $data = $mw->Scrolled("Text", -scrollbars => 'e', -height => '3', -
+font => ['Courier New', 8], 
                            -background => 'white')->pack(-pady => 3, 
+-padx => 3, -ipady => 3, -ipadx => 3,
                                -side => 'left',-fill => 'none', -expa
+nd => 0);
my $butt = $mw->Button(-text => "Send", -command => \&send)->pack(-pad
+y => 3, -padx => 3, -ipady => 3, -ipadx => 3,
                                -side => 'right',-fill => 'none', -exp
+and => 0);


#####################################################
#Start of menubar creation
my $menubar = $mw->Menu;

my $file_menu = $menubar->cascade(-label => "~File", -tearoff => 0);
$file_menu->command(-label => '~Some Function',
            -command => sub {return});
$file_menu->command(-label => '~Dis-Connect',
            -command => \&disconnect);
$file_menu->command(-label => '~Grab',
            -command => \&grab);

$file_menu->command(-label => '~Exit',
            -command => sub {exit(0)});

my $edit_menu = $menubar->cascade(-label => "~Edit", -tearoff => 0);
$edit_menu->command(-label => '~Some Function',
            -command => sub {return});

my $functions_menu = $menubar->cascade(-label => "~Functions", -tearof
+f => 0);
$functions_menu->command(-label => '~Some Function',    
            -command => sub {return});

my $help_menu = $menubar->cascade(-label => "~Info", -tearoff => 0);
$help_menu->command(-label => '~About',    
            -command => sub {return});

$mw->configure(-menu => $menubar);
#End of menubar creation
#######################################################

my $temp_dir = $ENV{TEMP} || $ENV{TMP} || ($^O eq "MSWin32" ? $ENV{WIN
+DIR} : '/tmp');

######################################################################
+########
# The following code is used to define specific text tags for formatti
+ng.

$t->tagConfigure("blue",   -foreground => "blue");
$t->tagConfigure("red",    -foreground => "red");
$t->tagConfigure("orange", -foreground => "orange");
$t->tagConfigure("brown",  -foreground => "brown");
$t->tagConfigure("grey",   -foreground => "grey");
$t->tagConfigure("green",  -foreground => "forest green");


$t->tagConfigure('bold',       -font => ['Courier New', 8, 'bold']);
$t->tagConfigure('italic',     -font => ['Courier New', 8, 'italic']);
$t->tagConfigure('bg',         -background => 'yellow');
$t->tagConfigure('big_italic', -font => ['Courier New', 18, 'italic'])
+;

######################################################################
+#######
# Some of my own bindings!

#$mw->bind('Tk::Text', '<Control-s>', [\&save_file]);
$mw->bind('Tk::Text', '<Control-a>', sub {$t->tagAdd('sel','1.0','end'
+)});
#$mw->bind('Tk::Text', '<Control-n>', [\&clear_new]);
#$mw->bind('Tk::Text', '<Control-p>', [\&print]);
$mw->bind('Tk::Text', '<Return>', [\&send]);
$mw->bind('Tk::Text', '<Shift-Return>', [sub {$data->insert("end", "\n
+");}]);
$mw->bind('<MouseWheel>' => 
[  sub {$_[0]->yview('scroll', -($_[1] / 120) * 4, 'units');}, Ev('D')
+ ]); 

# Automatically prepends $data to called sub's args
$data->bind('<KeyRelease>', [\&checkKey,Ev('K')]);

######################################################################
+#######

$sock = new IO::Socket::INET->new(PeerPort => '7778',
                                  PeerAddr => '192.168.0.100',
                                  Blocking => 0,
                                  Proto    => 'tcp')
                                 or $t->insert("end", "Can't bind : $@
+\n");
if ($sock) {
   my $paddr = $sock->peerhost();
   my $pport = $sock->peerport();
   $t->insert("end", "Connection to $paddr:$pport successfull...\n\n")
+;
}

MainLoop();

sub disconnect {
   $t->insert("end", "Connection closed\n");
   $sock->close();
   undef $sock;
}

sub checkKey {
   return;
}

sub send {
   chomp(my $text = $data->get("1.0", "end"));
   if ($sock) {
      if ($text ne "") {
         $sock->send($text);
         $t->insert("end", "<YOU>: $text\n");
         $data->delete("1.0", "end");
         grab();
      }
   }else{
      $t->insert("end", "Error: Not connected!\n");
   }
}

sub grab {
   my $stat = $sock->recv(my $incoming, 1024);
   print "stat is $stat\n";
   if ($stat) {
      $t->insert("end", "<USER>: $incoming\n") if ($incoming ne "");
   }
}

[download]
A few last things, is setting $| = 1 neccessary when using non-blocking socket? Also when I try to recv() data from the socket when none is available it locks up the application and I have to break the process to get it to close. This will be a problem if and when I get the app to poll itself if nothing is available at that time.

Thanks for any help..


www.perlskripts.com

In reply to Two-Part Socket Question. by Elijah

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.