#!/usr/bin/perl -w
#
#  Shows a very basic example of perl thread usage, simultaneous with
#  perl/Tk code.  Note that perl/Tk (which is NOT thread-safe) *must*
#  be kept isolated from any thread functionality.
#
#  References:
#    http://www.perlmonks.org/?node_id=1056724
#
#  2013-10-13 golux

###############
## Libraries ##
###############
use strict;
use warnings;
use threads;
use threads::shared;
use Tk;
use Tk::ROText;


##################
## User-defined ##
##################
my $tk_title  = 'perl/Tk with threads (basic example) - 2013-10-13 golux';


##############
## Globals  ##
##############
my @server_msgs : shared;
share(@server_msgs);


##################
## Main Program ##
##################
my $thread1 = threads->create(\&server_thread)->detach;
my $thread2 = threads->create(\&client_thread)->detach;
create_tk_gui();


#################
## Subroutines ##
#################

#===================#
## Tk Main Program ##
#===================#
sub create_tk_gui {
    my $mw  = new Tk::MainWindow(-title => $tk_title);
    my $top = frame($mw,  'B');
    my $f1  = frame($top, 'x');
    my $f2  = frame($top, 'B');
    my $b1  = tk_pack($f1->Button(-text => 'Exit (^X)', -bg => 'cyan'), '>');
    my $txt = tk_pack($f2->ROText(-bg   => '#ffefb2'), '^B');
    my $h   = { 'mw' => $mw, 'text' => $txt };

    $b1->configure(-command => sub { exit });
    $txt->insert("1.0", "[Server Messages]\n");
    $mw->bind('<Control-x>' => sub { $b1->invoke });
    $mw->repeat(250 => [ \&gui_loop, $h ]);
    $mw->MainLoop;
}


sub frame {
    my ($w, $pack, @args) = @_;

    my $frame = $w->Frame(@args);
    return tk_pack($frame, $pack);
}


sub tk_pack {
    my ($w, $pack) = @_;

    my $h_fill = { qw[ n none x x y y b both ] };
    my $h_side = { qw[ < left > right ^ top v bottom ] };

    $pack  ||= '^n';
    my $side = ($pack =~ s/^([<>^v])//)? $1: '^';
    $pack  ||= 'n';
    my $fill = lc $pack;
    my $exp  = ($fill eq $pack)? 0: 1;
    $fill    = $h_fill->{$fill};
    $side    = $h_side->{$side};
    $w->pack(-expand => $exp, -fill => $fill, -side => $side);

    return $w;
}


sub gui_loop {
    my ($h) = @_;

    if (0 == @server_msgs) {
        return;
    }

    my $txt = $h->{'text'};

    while (@server_msgs) {
        my $msg = shift @server_msgs;
        $txt->insert('end', "$msg\n");
    }
}


#=================#
## Server Thread ##
#=================#
sub server_thread {
    print "[Server]\n";
    use IO::Socket;
    use IO::Select;
    use strict;

    my $server = IO::Socket::INET::->new(Proto => 'tcp',
                                         LocalPort => 55555,
                                            Listen => 1,
                                         Reuse => 1
                                         ) or die "Server can't start: $!";
     
     
    my $readable_handles = new IO::Select();
    $readable_handles->add($server);
    my $buf;

    while (1) {
     
      # select() blocks until a socket is ready to be read or written
      my ($new_readable) = IO::Select->select($readable_handles,
                                              undef, undef, 0);
     
      # If it comes here, there is at least one handle
      # to read from or write to. For the moment, worry only about
      # the read side.
      foreach my $sock (@$new_readable) {
        print "Inside foreach $sock \n";
        if ($sock == $server) {
          my $new_sock = $sock->accept();
     
          # Add it to the list, and go back to select because the
          # new socket may not be readable yet.

          $readable_handles->add($new_sock);
        }
     
     
        #- server part
        else {
     
          #print STDERR "Reading...\n";
     
          # It is an ordinary client socket, ready for reading.
          $buf = <$sock>;
          if ($buf) {
            chomp $buf; 
            #- print the buffer
            # print "Read $buf\n";
            push @server_msgs, "Read $buf";
            # .... Do stuff with $buf
     
     
          } else {
            # Client closed socket. We do the same here, and remove
            # it from the readable_handles list
            $readable_handles->remove($sock);
            close($sock);
             }
        }
      }
    }
}



#=================#
## Client Thread ##
#=================#
sub client_thread {
    print "[Client]\n";
    use IO::Socket;

    my $client = IO::Socket::INET::->new(
        Proto    => 'tcp',
        PeerAddr => 'localhost',
        PeerPort => 55555
    ) or die "Client can't connect: $!";


    my @msgs = 1 .. 100;


    for (@msgs) {
        print $client "$_\n";
        sleep 1;
    }
}